packages feed

ghc-lib-parser (empty) → 0.20190402

raw patch · 297 files changed

+160439/−0 lines, 297 filesdep +Win32dep +arraydep +basesetup-changed

Dependencies added: Win32, array, base, binary, bytestring, containers, deepseq, directory, filepath, ghc-prim, hpc, pretty, process, time, transformers, unix

Files

+ LICENSE view
@@ -0,0 +1,31 @@+The Glasgow Haskell Compiler License++Copyright 2002, The University Court of the University of Glasgow. +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ compiler/HsVersions.h view
@@ -0,0 +1,65 @@+#pragma once++#if 0++IMPORTANT!  If you put extra tabs/spaces in these macro definitions,+you will screw up the layout where they are used in case expressions!++(This is cpp-dependent, of course)++#endif++/* Useful in the headers that we share with the RTS */+#define COMPILING_GHC 1++/* Pull in all the platform defines for this build (foo_TARGET_ARCH etc.) */+#include "ghc_boot_platform.h"++/* Pull in the autoconf defines (HAVE_FOO), but don't include+ * ghcconfig.h, because that will include ghcplatform.h which has the+ * wrong platform settings for the compiler (it has the platform+ * settings for the target plat instead). */+#include "ghcautoconf.h"++#define GLOBAL_VAR(name,value,ty)  \+{-# NOINLINE name #-};             \+name :: IORef (ty);                \+name = Util.global (value);++#define GLOBAL_VAR_M(name,value,ty) \+{-# NOINLINE name #-};              \+name :: IORef (ty);                 \+name = Util.globalM (value);+++#define SHARED_GLOBAL_VAR(name,accessor,saccessor,value,ty) \+{-# NOINLINE name #-};                                      \+name :: IORef (ty);                                         \+name = Util.sharedGlobal (value) (accessor);                \+foreign import ccall unsafe saccessor                       \+  accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));++#define SHARED_GLOBAL_VAR_M(name,accessor,saccessor,value,ty)  \+{-# NOINLINE name #-};                                         \+name :: IORef (ty);                                            \+name = Util.sharedGlobalM (value) (accessor);                  \+foreign import ccall unsafe saccessor                          \+  accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));+++#define ASSERT(e)      if debugIsOn && not (e) then (assertPanic __FILE__ __LINE__) else+#define ASSERT2(e,msg) if debugIsOn && not (e) then (assertPprPanic __FILE__ __LINE__ (msg)) else+#define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) $++-- Examples:   Assuming   flagSet :: String -> m Bool+--+--    do { c   <- getChar; MASSERT( isUpper c ); ... }+--    do { c   <- getChar; MASSERT2( isUpper c, text "Bad" ); ... }+--    do { str <- getStr;  ASSERTM( flagSet str ); .. }+--    do { str <- getStr;  ASSERTM2( flagSet str, text "Bad" ); .. }+--    do { str <- getStr;  WARNM2( flagSet str, text "Flag is set" ); .. }+#define MASSERT(e)      ASSERT(e) return ()+#define MASSERT2(e,msg) ASSERT2(e,msg) return ()+#define ASSERTM(e)      do { bool <- e; MASSERT(bool) }+#define ASSERTM2(e,msg) do { bool <- e; MASSERT2(bool,msg) }+#define WARNM2(e,msg)   do { bool <- e; WARN(bool, msg) return () }
+ compiler/Unique.h view
@@ -0,0 +1,5 @@+/* unique has the following structure:+ * HsInt unique =+ *    (unique_tag << (sizeof (HsInt) - UNIQUE_TAG_BITS)) | unique_number+ */+#define UNIQUE_TAG_BITS 8
+ compiler/backpack/BkpSyn.hs view
@@ -0,0 +1,84 @@+-- | This is the syntax for bkp files which are parsed in 'ghc --backpack'+-- mode.  This syntax is used purely for testing purposes.++module BkpSyn (+    -- * Backpack abstract syntax+    HsUnitId(..),+    LHsUnitId,+    HsModuleSubst,+    LHsModuleSubst,+    HsModuleId(..),+    LHsModuleId,+    HsComponentId(..),+    LHsUnit, HsUnit(..),+    LHsUnitDecl, HsUnitDecl(..),+    HsDeclType(..),+    IncludeDecl(..),+    LRenaming, Renaming(..),+    ) where++import GhcPrelude++import HsSyn+import SrcLoc+import Outputable+import Module+import PackageConfig++{-+************************************************************************+*                                                                      *+                        User syntax+*                                                                      *+************************************************************************+-}++data HsComponentId = HsComponentId {+    hsPackageName :: PackageName,+    hsComponentId :: ComponentId+    }++instance Outputable HsComponentId where+    ppr (HsComponentId _pn cid) = ppr cid -- todo debug with pn++data HsUnitId n = HsUnitId (Located n) [LHsModuleSubst n]+type LHsUnitId n = Located (HsUnitId n)++type HsModuleSubst n = (Located ModuleName, LHsModuleId n)+type LHsModuleSubst n = Located (HsModuleSubst n)++data HsModuleId n = HsModuleVar (Located ModuleName)+                  | HsModuleId (LHsUnitId n) (Located ModuleName)+type LHsModuleId n = Located (HsModuleId n)++-- | Top level @unit@ declaration in a Backpack file.+data HsUnit n = HsUnit {+        hsunitName :: Located n,+        hsunitBody :: [LHsUnitDecl n]+    }+type LHsUnit n = Located (HsUnit n)++-- | A declaration in a package, e.g. a module or signature definition,+-- or an include.+data HsDeclType = ModuleD | SignatureD+data HsUnitDecl n+    = DeclD   HsDeclType (Located ModuleName) (Maybe (Located (HsModule GhcPs)))+    | IncludeD   (IncludeDecl n)+type LHsUnitDecl n = Located (HsUnitDecl n)++-- | An include of another unit+data IncludeDecl n = IncludeDecl {+        idUnitId :: LHsUnitId n,+        idModRenaming :: Maybe [ LRenaming ],+        -- | Is this a @dependency signature@ include?  If so,+        -- we don't compile this include when we instantiate this+        -- unit (as there should not be any modules brought into+        -- scope.)+        idSignatureInclude :: Bool+    }++-- | Rename a module from one name to another.  The identity renaming+-- means that the module should be brought into scope.+data Renaming = Renaming { renameFrom :: Located ModuleName+                         , renameTo :: Maybe (Located ModuleName) }+type LRenaming = Located Renaming
+ compiler/basicTypes/Avail.hs view
@@ -0,0 +1,286 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+--+-- (c) The University of Glasgow+--++#include "HsVersions.h"++module Avail (+    Avails,+    AvailInfo(..),+    avail,+    availsToNameSet,+    availsToNameSetWithSelectors,+    availsToNameEnv,+    availName, availNames, availNonFldNames,+    availNamesWithSelectors,+    availFlds,+    availsNamesWithOccs,+    availNamesWithOccs,+    stableAvailCmp,+    plusAvail,+    trimAvail,+    filterAvail,+    filterAvails,+    nubAvails+++  ) where++import GhcPrelude++import Name+import NameEnv+import NameSet++import FieldLabel+import Binary+import ListSetOps+import Outputable+import Util++import Data.Data ( Data )+import Data.List ( find )+import Data.Function++-- -----------------------------------------------------------------------------+-- The AvailInfo type++-- | Records what things are \"available\", i.e. in scope+data AvailInfo++  -- | An ordinary identifier in scope+  = Avail Name++  -- | A type or class in scope+  --+  -- The __AvailTC Invariant__: If the type or class is itself to be in scope,+  -- it must be /first/ in this list.  Thus, typically:+  --+  -- > AvailTC Eq [Eq, ==, \/=] []+  | AvailTC+       Name         -- ^ The name of the type or class+       [Name]       -- ^ The available pieces of type or class,+                    -- excluding field selectors.+       [FieldLabel] -- ^ The record fields of the type+                    -- (see Note [Representing fields in AvailInfo]).++   deriving ( Eq    -- ^ Used when deciding if the interface has changed+            , Data )++-- | A collection of 'AvailInfo' - several things that are \"available\"+type Avails = [AvailInfo]++{-+Note [Representing fields in AvailInfo]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When -XDuplicateRecordFields is disabled (the normal case), a+datatype like++  data T = MkT { foo :: Int }++gives rise to the AvailInfo++  AvailTC T [T, MkT] [FieldLabel "foo" False foo]++whereas if -XDuplicateRecordFields is enabled it gives++  AvailTC T [T, MkT] [FieldLabel "foo" True $sel:foo:MkT]++since the label does not match the selector name.++The labels in a field list are not necessarily unique:+data families allow the same parent (the family tycon) to have+multiple distinct fields with the same label. For example,++  data family F a+  data instance F Int  = MkFInt { foo :: Int }+  data instance F Bool = MkFBool { foo :: Bool}++gives rise to++  AvailTC F [ F, MkFInt, MkFBool ]+            [ FieldLabel "foo" True $sel:foo:MkFInt+            , FieldLabel "foo" True $sel:foo:MkFBool ]++Moreover, note that the flIsOverloaded flag need not be the same for+all the elements of the list.  In the example above, this occurs if+the two data instances are defined in different modules, one with+`-XDuplicateRecordFields` enabled and one with it disabled.  Thus it+is possible to have++  AvailTC F [ F, MkFInt, MkFBool ]+            [ FieldLabel "foo" True $sel:foo:MkFInt+            , FieldLabel "foo" False foo ]++If the two data instances are defined in different modules, both+without `-XDuplicateRecordFields`, it will be impossible to export+them from the same module (even with `-XDuplicateRecordfields`+enabled), because they would be represented identically.  The+workaround here is to enable `-XDuplicateRecordFields` on the defining+modules.+-}++-- | Compare lexicographically+stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering+stableAvailCmp (Avail n1)       (Avail n2)   = n1 `stableNameCmp` n2+stableAvailCmp (Avail {})         (AvailTC {})   = LT+stableAvailCmp (AvailTC n ns nfs) (AvailTC m ms mfs) =+    (n `stableNameCmp` m) `thenCmp`+    (cmpList stableNameCmp ns ms) `thenCmp`+    (cmpList (stableNameCmp `on` flSelector) nfs mfs)+stableAvailCmp (AvailTC {})       (Avail {})     = GT++avail :: Name -> AvailInfo+avail n = Avail n++-- -----------------------------------------------------------------------------+-- Operations on AvailInfo++availsToNameSet :: [AvailInfo] -> NameSet+availsToNameSet avails = foldr add emptyNameSet avails+      where add avail set = extendNameSetList set (availNames avail)++availsToNameSetWithSelectors :: [AvailInfo] -> NameSet+availsToNameSetWithSelectors avails = foldr add emptyNameSet avails+      where add avail set = extendNameSetList set (availNamesWithSelectors avail)++availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo+availsToNameEnv avails = foldr add emptyNameEnv avails+     where add avail env = extendNameEnvList env+                                (zip (availNames avail) (repeat avail))++-- | Just the main name made available, i.e. not the available pieces+-- of type or class brought into scope by the 'GenAvailInfo'+availName :: AvailInfo -> Name+availName (Avail n)     = n+availName (AvailTC n _ _) = n++-- | All names made available by the availability information (excluding overloaded selectors)+availNames :: AvailInfo -> [Name]+availNames (Avail n)         = [n]+availNames (AvailTC _ ns fs) = ns ++ [ flSelector f | f <- fs, not (flIsOverloaded f) ]++-- | All names made available by the availability information (including overloaded selectors)+availNamesWithSelectors :: AvailInfo -> [Name]+availNamesWithSelectors (Avail n)         = [n]+availNamesWithSelectors (AvailTC _ ns fs) = ns ++ map flSelector fs++-- | Names for non-fields made available by the availability information+availNonFldNames :: AvailInfo -> [Name]+availNonFldNames (Avail n)        = [n]+availNonFldNames (AvailTC _ ns _) = ns++-- | Fields made available by the availability information+availFlds :: AvailInfo -> [FieldLabel]+availFlds (AvailTC _ _ fs) = fs+availFlds _                = []++availsNamesWithOccs :: [AvailInfo] -> [(Name, OccName)]+availsNamesWithOccs = concatMap availNamesWithOccs++-- | 'Name's made available by the availability information, paired with+-- the 'OccName' used to refer to each one.+--+-- When @DuplicateRecordFields@ is in use, the 'Name' may be the+-- mangled name of a record selector (e.g. @$sel:foo:MkT@) while the+-- 'OccName' will be the label of the field (e.g. @foo@).+--+-- See Note [Representing fields in AvailInfo].+availNamesWithOccs :: AvailInfo -> [(Name, OccName)]+availNamesWithOccs (Avail n) = [(n, nameOccName n)]+availNamesWithOccs (AvailTC _ ns fs)+  = [ (n, nameOccName n) | n <- ns ] +++    [ (flSelector fl, mkVarOccFS (flLabel fl)) | fl <- fs ]++-- -----------------------------------------------------------------------------+-- Utility++plusAvail :: AvailInfo -> AvailInfo -> AvailInfo+plusAvail a1 a2+  | debugIsOn && availName a1 /= availName a2+  = pprPanic "RnEnv.plusAvail names differ" (hsep [ppr a1,ppr a2])+plusAvail a1@(Avail {})         (Avail {})        = a1+plusAvail (AvailTC _ [] [])     a2@(AvailTC {})   = a2+plusAvail a1@(AvailTC {})       (AvailTC _ [] []) = a1+plusAvail (AvailTC n1 (s1:ss1) fs1) (AvailTC n2 (s2:ss2) fs2)+  = case (n1==s1, n2==s2) of  -- Maintain invariant the parent is first+       (True,True)   -> AvailTC n1 (s1 : (ss1 `unionLists` ss2))+                                   (fs1 `unionLists` fs2)+       (True,False)  -> AvailTC n1 (s1 : (ss1 `unionLists` (s2:ss2)))+                                   (fs1 `unionLists` fs2)+       (False,True)  -> AvailTC n1 (s2 : ((s1:ss1) `unionLists` ss2))+                                   (fs1 `unionLists` fs2)+       (False,False) -> AvailTC n1 ((s1:ss1) `unionLists` (s2:ss2))+                                   (fs1 `unionLists` fs2)+plusAvail (AvailTC n1 ss1 fs1) (AvailTC _ [] fs2)+  = AvailTC n1 ss1 (fs1 `unionLists` fs2)+plusAvail (AvailTC n1 [] fs1)  (AvailTC _ ss2 fs2)+  = AvailTC n1 ss2 (fs1 `unionLists` fs2)+plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])++-- | trims an 'AvailInfo' to keep only a single name+trimAvail :: AvailInfo -> Name -> AvailInfo+trimAvail (Avail n)         _ = Avail n+trimAvail (AvailTC n ns fs) m = case find ((== m) . flSelector) fs of+    Just x  -> AvailTC n [] [x]+    Nothing -> ASSERT( m `elem` ns ) AvailTC n [m] []++-- | filters 'AvailInfo's by the given predicate+filterAvails  :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]+filterAvails keep avails = foldr (filterAvail keep) [] avails++-- | filters an 'AvailInfo' by the given predicate+filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]+filterAvail keep ie rest =+  case ie of+    Avail n | keep n    -> ie : rest+            | otherwise -> rest+    AvailTC tc ns fs ->+        let ns' = filter keep ns+            fs' = filter (keep . flSelector) fs in+        if null ns' && null fs' then rest else AvailTC tc ns' fs' : rest+++-- | Combines 'AvailInfo's from the same family+-- 'avails' may have several items with the same availName+-- E.g  import Ix( Ix(..), index )+-- will give Ix(Ix,index,range) and Ix(index)+-- We want to combine these; addAvail does that+nubAvails :: [AvailInfo] -> [AvailInfo]+nubAvails avails = nameEnvElts (foldl' add emptyNameEnv avails)+  where+    add env avail = extendNameEnv_C plusAvail env (availName avail) avail++-- -----------------------------------------------------------------------------+-- Printing++instance Outputable AvailInfo where+   ppr = pprAvail++pprAvail :: AvailInfo -> SDoc+pprAvail (Avail n)+  = ppr n+pprAvail (AvailTC n ns fs)+  = ppr n <> braces (sep [ fsep (punctuate comma (map ppr ns)) <> semi+                         , fsep (punctuate comma (map (ppr . flLabel) fs))])++instance Binary AvailInfo where+    put_ bh (Avail aa) = do+            putByte bh 0+            put_ bh aa+    put_ bh (AvailTC ab ac ad) = do+            putByte bh 1+            put_ bh ab+            put_ bh ac+            put_ bh ad+    get bh = do+            h <- getByte bh+            case h of+              0 -> do aa <- get bh+                      return (Avail aa)+              _ -> do ab <- get bh+                      ac <- get bh+                      ad <- get bh+                      return (AvailTC ab ac ad)
+ compiler/basicTypes/BasicTypes.hs view
@@ -0,0 +1,1614 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1997-1998++\section[BasicTypes]{Miscellanous types}++This module defines a miscellaneously collection of very simple+types that++\begin{itemize}+\item have no other obvious home+\item don't depend on any other complicated types+\item are used in more than one "part" of the compiler+\end{itemize}+-}++{-# LANGUAGE DeriveDataTypeable #-}++module BasicTypes(+        Version, bumpVersion, initialVersion,++        LeftOrRight(..),+        pickLR,++        ConTag, ConTagZ, fIRST_TAG,++        Arity, RepArity, JoinArity,++        Alignment,++        PromotionFlag(..), isPromoted,+        FunctionOrData(..),++        WarningTxt(..), pprWarningTxtForMsg, StringLiteral(..),++        Fixity(..), FixityDirection(..),+        defaultFixity, maxPrecedence, minPrecedence,+        negateFixity, funTyFixity,+        compareFixity,+        LexicalFixity(..),++        RecFlag(..), isRec, isNonRec, boolToRecFlag,+        Origin(..), isGenerated,++        RuleName, pprRuleName,++        TopLevelFlag(..), isTopLevel, isNotTopLevel,++        OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,+        hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag,++        Boxity(..), isBoxed,++        PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen,++        TupleSort(..), tupleSortBoxity, boxityTupleSort,+        tupleParens,++        sumParens, pprAlternative,++        -- ** The OneShotInfo type+        OneShotInfo(..),+        noOneShotInfo, hasNoOneShotInfo, isOneShotInfo,+        bestOneShot, worstOneShot,++        OccInfo(..), noOccInfo, seqOccInfo, zapFragileOcc, isOneOcc,+        isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isManyOccs,+        strongLoopBreaker, weakLoopBreaker,++        InsideLam, insideLam, notInsideLam,+        OneBranch, oneBranch, notOneBranch,+        InterestingCxt,+        TailCallInfo(..), tailCallInfo, zapOccTailCallInfo,+        isAlwaysTailCalled,++        EP(..),++        DefMethSpec(..),+        SwapFlag(..), flipSwap, unSwap, isSwapped,++        CompilerPhase(..), PhaseNum,++        Activation(..), isActive, isActiveIn, competesWith,+        isNeverActive, isAlwaysActive, isEarlyActive,+        activeAfterInitial, activeDuringFinal,++        RuleMatchInfo(..), isConLike, isFunLike,+        InlineSpec(..), noUserInlineSpec,+        InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,+        neverInlinePragma, dfunInlinePragma,+        isDefaultInlinePragma,+        isInlinePragma, isInlinablePragma, isAnyInlinePragma,+        inlinePragmaSpec, inlinePragmaSat,+        inlinePragmaActivation, inlinePragmaRuleMatchInfo,+        setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,+        pprInline, pprInlineDebug,++        SuccessFlag(..), succeeded, failed, successIf,++        IntegralLit(..), FractionalLit(..),+        negateIntegralLit, negateFractionalLit,+        mkIntegralLit, mkFractionalLit,+        integralFractionalLit,++        SourceText(..), pprWithSourceText,++        IntWithInf, infinity, treatZeroAsInf, mkIntWithInf, intGtLimit,++        SpliceExplicitFlag(..)+   ) where++import GhcPrelude++import FastString+import Outputable+import SrcLoc ( Located,unLoc )+import Data.Data hiding (Fixity, Prefix, Infix)+import Data.Function (on)++{-+************************************************************************+*                                                                      *+          Binary choice+*                                                                      *+************************************************************************+-}++data LeftOrRight = CLeft | CRight+                 deriving( Eq, Data )++pickLR :: LeftOrRight -> (a,a) -> a+pickLR CLeft  (l,_) = l+pickLR CRight (_,r) = r++instance Outputable LeftOrRight where+  ppr CLeft    = text "Left"+  ppr CRight   = text "Right"++{-+************************************************************************+*                                                                      *+\subsection[Arity]{Arity}+*                                                                      *+************************************************************************+-}++-- | The number of value arguments that can be applied to a value before it does+-- "real work". So:+--  fib 100     has arity 0+--  \x -> fib x has arity 1+-- See also Note [Definition of arity] in CoreArity+type Arity = Int++-- | Representation Arity+--+-- The number of represented arguments that can be applied to a value before it does+-- "real work". So:+--  fib 100                    has representation arity 0+--  \x -> fib x                has representation arity 1+--  \(# x, y #) -> fib (x + y) has representation arity 2+type RepArity = Int++-- | The number of arguments that a join point takes. Unlike the arity of a+-- function, this is a purely syntactic property and is fixed when the join+-- point is created (or converted from a value). Both type and value arguments+-- are counted.+type JoinArity = Int++{-+************************************************************************+*                                                                      *+              Constructor tags+*                                                                      *+************************************************************************+-}++-- | Constructor Tag+--+-- Type of the tags associated with each constructor possibility or superclass+-- selector+type ConTag = Int++-- | A *zero-indexed* constructor tag+type ConTagZ = Int++fIRST_TAG :: ConTag+-- ^ Tags are allocated from here for real constructors+--   or for superclass selectors+fIRST_TAG =  1++{-+************************************************************************+*                                                                      *+\subsection[Alignment]{Alignment}+*                                                                      *+************************************************************************+-}++type Alignment = Int -- align to next N-byte boundary (N must be a power of 2).++{-+************************************************************************+*                                                                      *+         One-shot information+*                                                                      *+************************************************************************+-}++-- | If the 'Id' is a lambda-bound variable then it may have lambda-bound+-- variable info. Sometimes we know whether the lambda binding this variable+-- is a \"one-shot\" lambda; that is, whether it is applied at most once.+--+-- This information may be useful in optimisation, as computations may+-- safely be floated inside such a lambda without risk of duplicating+-- work.+data OneShotInfo+  = NoOneShotInfo -- ^ No information+  | OneShotLam    -- ^ The lambda is applied at most once.+  deriving (Eq)++-- | It is always safe to assume that an 'Id' has no lambda-bound variable information+noOneShotInfo :: OneShotInfo+noOneShotInfo = NoOneShotInfo++isOneShotInfo, hasNoOneShotInfo :: OneShotInfo -> Bool+isOneShotInfo OneShotLam = True+isOneShotInfo _          = False++hasNoOneShotInfo NoOneShotInfo = True+hasNoOneShotInfo _             = False++worstOneShot, bestOneShot :: OneShotInfo -> OneShotInfo -> OneShotInfo+worstOneShot NoOneShotInfo _             = NoOneShotInfo+worstOneShot OneShotLam    os            = os++bestOneShot NoOneShotInfo os         = os+bestOneShot OneShotLam    _          = OneShotLam++pprOneShotInfo :: OneShotInfo -> SDoc+pprOneShotInfo NoOneShotInfo = empty+pprOneShotInfo OneShotLam    = text "OneShot"++instance Outputable OneShotInfo where+    ppr = pprOneShotInfo++{-+************************************************************************+*                                                                      *+           Swap flag+*                                                                      *+************************************************************************+-}++data SwapFlag+  = NotSwapped  -- Args are: actual,   expected+  | IsSwapped   -- Args are: expected, actual++instance Outputable SwapFlag where+  ppr IsSwapped  = text "Is-swapped"+  ppr NotSwapped = text "Not-swapped"++flipSwap :: SwapFlag -> SwapFlag+flipSwap IsSwapped  = NotSwapped+flipSwap NotSwapped = IsSwapped++isSwapped :: SwapFlag -> Bool+isSwapped IsSwapped  = True+isSwapped NotSwapped = False++unSwap :: SwapFlag -> (a->a->b) -> a -> a -> b+unSwap NotSwapped f a b = f a b+unSwap IsSwapped  f a b = f b a+++{- *********************************************************************+*                                                                      *+           Promotion flag+*                                                                      *+********************************************************************* -}++-- | Is a TyCon a promoted data constructor or just a normal type constructor?+data PromotionFlag+  = NotPromoted+  | IsPromoted+  deriving ( Eq, Data )++isPromoted :: PromotionFlag -> Bool+isPromoted IsPromoted  = True+isPromoted NotPromoted = False+++{-+************************************************************************+*                                                                      *+\subsection[FunctionOrData]{FunctionOrData}+*                                                                      *+************************************************************************+-}++data FunctionOrData = IsFunction | IsData+    deriving (Eq, Ord, Data)++instance Outputable FunctionOrData where+    ppr IsFunction = text "(function)"+    ppr IsData     = text "(data)"++{-+************************************************************************+*                                                                      *+\subsection[Version]{Module and identifier version numbers}+*                                                                      *+************************************************************************+-}++type Version = Int++bumpVersion :: Version -> Version+bumpVersion v = v+1++initialVersion :: Version+initialVersion = 1++{-+************************************************************************+*                                                                      *+                Deprecations+*                                                                      *+************************************************************************+-}++-- | A String Literal in the source, including its original raw format for use by+-- source to source manipulation tools.+data StringLiteral = StringLiteral+                       { sl_st :: SourceText, -- literal raw source.+                                              -- See not [Literal source text]+                         sl_fs :: FastString  -- literal string value+                       } deriving Data++instance Eq StringLiteral where+  (StringLiteral _ a) == (StringLiteral _ b) = a == b++instance Outputable StringLiteral where+  ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl)++-- | Warning Text+--+-- reason/explanation from a WARNING or DEPRECATED pragma+data WarningTxt = WarningTxt (Located SourceText)+                             [Located StringLiteral]+                | DeprecatedTxt (Located SourceText)+                                [Located StringLiteral]+    deriving (Eq, Data)++instance Outputable WarningTxt where+    ppr (WarningTxt    lsrc ws)+      = case unLoc lsrc of+          NoSourceText   -> pp_ws ws+          SourceText src -> text src <+> pp_ws ws <+> text "#-}"++    ppr (DeprecatedTxt lsrc  ds)+      = case unLoc lsrc of+          NoSourceText   -> pp_ws ds+          SourceText src -> text src <+> pp_ws ds <+> text "#-}"++pp_ws :: [Located StringLiteral] -> SDoc+pp_ws [l] = ppr $ unLoc l+pp_ws ws+  = text "["+    <+> vcat (punctuate comma (map (ppr . unLoc) ws))+    <+> text "]"+++pprWarningTxtForMsg :: WarningTxt -> SDoc+pprWarningTxtForMsg (WarningTxt    _ ws)+                     = doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ws))+pprWarningTxtForMsg (DeprecatedTxt _ ds)+                     = text "Deprecated:" <+>+                       doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ds))++{-+************************************************************************+*                                                                      *+                Rules+*                                                                      *+************************************************************************+-}++type RuleName = FastString++pprRuleName :: RuleName -> SDoc+pprRuleName rn = doubleQuotes (ftext rn)++{-+************************************************************************+*                                                                      *+\subsection[Fixity]{Fixity info}+*                                                                      *+************************************************************************+-}++------------------------+data Fixity = Fixity SourceText Int FixityDirection+  -- Note [Pragma source text]+  deriving Data++instance Outputable Fixity where+    ppr (Fixity _ prec dir) = hcat [ppr dir, space, int prec]++instance Eq Fixity where -- Used to determine if two fixities conflict+  (Fixity _ p1 dir1) == (Fixity _ p2 dir2) = p1==p2 && dir1 == dir2++------------------------+data FixityDirection = InfixL | InfixR | InfixN+                     deriving (Eq, Data)++instance Outputable FixityDirection where+    ppr InfixL = text "infixl"+    ppr InfixR = text "infixr"+    ppr InfixN = text "infix"++------------------------+maxPrecedence, minPrecedence :: Int+maxPrecedence = 9+minPrecedence = 0++defaultFixity :: Fixity+defaultFixity = Fixity NoSourceText maxPrecedence InfixL++negateFixity, funTyFixity :: Fixity+-- Wired-in fixities+negateFixity = Fixity NoSourceText 6 InfixL  -- Fixity of unary negate+funTyFixity  = Fixity NoSourceText (-1) InfixR  -- Fixity of '->', see #15235++{-+Consider++\begin{verbatim}+        a `op1` b `op2` c+\end{verbatim}+@(compareFixity op1 op2)@ tells which way to arrange application, or+whether there's an error.+-}++compareFixity :: Fixity -> Fixity+              -> (Bool,         -- Error please+                  Bool)         -- Associate to the right: a op1 (b op2 c)+compareFixity (Fixity _ prec1 dir1) (Fixity _ prec2 dir2)+  = case prec1 `compare` prec2 of+        GT -> left+        LT -> right+        EQ -> case (dir1, dir2) of+                        (InfixR, InfixR) -> right+                        (InfixL, InfixL) -> left+                        _                -> error_please+  where+    right        = (False, True)+    left         = (False, False)+    error_please = (True,  False)++-- |Captures the fixity of declarations as they are parsed. This is not+-- necessarily the same as the fixity declaration, as the normal fixity may be+-- overridden using parens or backticks.+data LexicalFixity = Prefix | Infix deriving (Data,Eq)++instance Outputable LexicalFixity where+  ppr Prefix = text "Prefix"+  ppr Infix  = text "Infix"++{-+************************************************************************+*                                                                      *+\subsection[Top-level/local]{Top-level/not-top level flag}+*                                                                      *+************************************************************************+-}++data TopLevelFlag+  = TopLevel+  | NotTopLevel++isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool++isNotTopLevel NotTopLevel = True+isNotTopLevel TopLevel    = False++isTopLevel TopLevel     = True+isTopLevel NotTopLevel  = False++instance Outputable TopLevelFlag where+  ppr TopLevel    = text "<TopLevel>"+  ppr NotTopLevel = text "<NotTopLevel>"++{-+************************************************************************+*                                                                      *+                Boxity flag+*                                                                      *+************************************************************************+-}++data Boxity+  = Boxed+  | Unboxed+  deriving( Eq, Data )++isBoxed :: Boxity -> Bool+isBoxed Boxed   = True+isBoxed Unboxed = False++instance Outputable Boxity where+  ppr Boxed   = text "Boxed"+  ppr Unboxed = text "Unboxed"++{-+************************************************************************+*                                                                      *+                Recursive/Non-Recursive flag+*                                                                      *+************************************************************************+-}++-- | Recursivity Flag+data RecFlag = Recursive+             | NonRecursive+             deriving( Eq, Data )++isRec :: RecFlag -> Bool+isRec Recursive    = True+isRec NonRecursive = False++isNonRec :: RecFlag -> Bool+isNonRec Recursive    = False+isNonRec NonRecursive = True++boolToRecFlag :: Bool -> RecFlag+boolToRecFlag True  = Recursive+boolToRecFlag False = NonRecursive++instance Outputable RecFlag where+  ppr Recursive    = text "Recursive"+  ppr NonRecursive = text "NonRecursive"++{-+************************************************************************+*                                                                      *+                Code origin+*                                                                      *+************************************************************************+-}++data Origin = FromSource+            | Generated+            deriving( Eq, Data )++isGenerated :: Origin -> Bool+isGenerated Generated = True+isGenerated FromSource = False++instance Outputable Origin where+  ppr FromSource  = text "FromSource"+  ppr Generated   = text "Generated"++{-+************************************************************************+*                                                                      *+                Instance overlap flag+*                                                                      *+************************************************************************+-}++-- | The semantics allowed for overlapping instances for a particular+-- instance. See Note [Safe Haskell isSafeOverlap] (in `InstEnv.hs`) for a+-- explanation of the `isSafeOverlap` field.+--+-- - 'ApiAnnotation.AnnKeywordId' :+--      'ApiAnnotation.AnnOpen' @'\{-\# OVERLAPPABLE'@ or+--                              @'\{-\# OVERLAPPING'@ or+--                              @'\{-\# OVERLAPS'@ or+--                              @'\{-\# INCOHERENT'@,+--      'ApiAnnotation.AnnClose' @`\#-\}`@,++-- For details on above see note [Api annotations] in ApiAnnotation+data OverlapFlag = OverlapFlag+  { overlapMode   :: OverlapMode+  , isSafeOverlap :: Bool+  } deriving (Eq, Data)++setOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag+setOverlapModeMaybe f Nothing  = f+setOverlapModeMaybe f (Just m) = f { overlapMode = m }++hasIncoherentFlag :: OverlapMode -> Bool+hasIncoherentFlag mode =+  case mode of+    Incoherent   _ -> True+    _              -> False++hasOverlappableFlag :: OverlapMode -> Bool+hasOverlappableFlag mode =+  case mode of+    Overlappable _ -> True+    Overlaps     _ -> True+    Incoherent   _ -> True+    _              -> False++hasOverlappingFlag :: OverlapMode -> Bool+hasOverlappingFlag mode =+  case mode of+    Overlapping  _ -> True+    Overlaps     _ -> True+    Incoherent   _ -> True+    _              -> False++data OverlapMode  -- See Note [Rules for instance lookup] in InstEnv+  = NoOverlap SourceText+                  -- See Note [Pragma source text]+    -- ^ This instance must not overlap another `NoOverlap` instance.+    -- However, it may be overlapped by `Overlapping` instances,+    -- and it may overlap `Overlappable` instances.+++  | Overlappable SourceText+                  -- See Note [Pragma source text]+    -- ^ Silently ignore this instance if you find a+    -- more specific one that matches the constraint+    -- you are trying to resolve+    --+    -- Example: constraint (Foo [Int])+    --   instance                      Foo [Int]+    --   instance {-# OVERLAPPABLE #-} Foo [a]+    --+    -- Since the second instance has the Overlappable flag,+    -- the first instance will be chosen (otherwise+    -- its ambiguous which to choose)+++  | Overlapping SourceText+                  -- See Note [Pragma source text]+    -- ^ Silently ignore any more general instances that may be+    --   used to solve the constraint.+    --+    -- Example: constraint (Foo [Int])+    --   instance {-# OVERLAPPING #-} Foo [Int]+    --   instance                     Foo [a]+    --+    -- Since the first instance has the Overlapping flag,+    -- the second---more general---instance will be ignored (otherwise+    -- it is ambiguous which to choose)+++  | Overlaps SourceText+                  -- See Note [Pragma source text]+    -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.++  | Incoherent SourceText+                  -- See Note [Pragma source text]+    -- ^ Behave like Overlappable and Overlapping, and in addition pick+    -- an an arbitrary one if there are multiple matching candidates, and+    -- don't worry about later instantiation+    --+    -- Example: constraint (Foo [b])+    -- instance {-# INCOHERENT -} Foo [Int]+    -- instance                   Foo [a]+    -- Without the Incoherent flag, we'd complain that+    -- instantiating 'b' would change which instance+    -- was chosen. See also note [Incoherent instances] in InstEnv++  deriving (Eq, Data)+++instance Outputable OverlapFlag where+   ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)++instance Outputable OverlapMode where+   ppr (NoOverlap    _) = empty+   ppr (Overlappable _) = text "[overlappable]"+   ppr (Overlapping  _) = text "[overlapping]"+   ppr (Overlaps     _) = text "[overlap ok]"+   ppr (Incoherent   _) = text "[incoherent]"++pprSafeOverlap :: Bool -> SDoc+pprSafeOverlap True  = text "[safe]"+pprSafeOverlap False = empty++{-+************************************************************************+*                                                                      *+                Precedence+*                                                                      *+************************************************************************+-}++-- | A general-purpose pretty-printing precedence type.+newtype PprPrec = PprPrec Int deriving (Eq, Ord, Show)+-- See Note [Precedence in types]++topPrec, sigPrec, funPrec, opPrec, appPrec :: PprPrec+topPrec = PprPrec 0 -- No parens+sigPrec = PprPrec 1 -- Explicit type signatures+funPrec = PprPrec 2 -- Function args; no parens for constructor apps+                    -- See [Type operator precedence] for why both+                    -- funPrec and opPrec exist.+opPrec  = PprPrec 2 -- Infix operator+appPrec = PprPrec 3 -- Constructor args; no parens for atomic++maybeParen :: PprPrec -> PprPrec -> SDoc -> SDoc+maybeParen ctxt_prec inner_prec pretty+  | ctxt_prec < inner_prec = pretty+  | otherwise              = parens pretty++{- Note [Precedence in types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Many pretty-printing functions have type+    ppr_ty :: PprPrec -> Type -> SDoc++The PprPrec gives the binding strength of the context.  For example, in+   T ty1 ty2+we will pretty-print 'ty1' and 'ty2' with the call+  (ppr_ty appPrec ty)+to indicate that the context is that of an argument of a TyConApp.++We use this consistently for Type and HsType.++Note [Type operator precedence]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We don't keep the fixity of type operators in the operator. So the+pretty printer follows the following precedence order:++   TyConPrec         Type constructor application+   TyOpPrec/FunPrec  Operator application and function arrow++We have funPrec and opPrec to represent the precedence of function+arrow and type operators respectively, but currently we implement+funPrec == opPrec, so that we don't distinguish the two. Reason:+it's hard to parse a type like+    a ~ b => c * d -> e - f++By treating opPrec = funPrec we end up with more parens+    (a ~ b) => (c * d) -> (e - f)++But the two are different constructors of PprPrec so we could make+(->) bind more or less tightly if we wanted.+-}++{-+************************************************************************+*                                                                      *+                Tuples+*                                                                      *+************************************************************************+-}++data TupleSort+  = BoxedTuple+  | UnboxedTuple+  | ConstraintTuple+  deriving( Eq, Data )++tupleSortBoxity :: TupleSort -> Boxity+tupleSortBoxity BoxedTuple      = Boxed+tupleSortBoxity UnboxedTuple    = Unboxed+tupleSortBoxity ConstraintTuple = Boxed++boxityTupleSort :: Boxity -> TupleSort+boxityTupleSort Boxed   = BoxedTuple+boxityTupleSort Unboxed = UnboxedTuple++tupleParens :: TupleSort -> SDoc -> SDoc+tupleParens BoxedTuple      p = parens p+tupleParens UnboxedTuple    p = text "(#" <+> p <+> ptext (sLit "#)")+tupleParens ConstraintTuple p   -- In debug-style write (% Eq a, Ord b %)+  = ifPprDebug (text "(%" <+> p <+> ptext (sLit "%)"))+               (parens p)++{-+************************************************************************+*                                                                      *+                Sums+*                                                                      *+************************************************************************+-}++sumParens :: SDoc -> SDoc+sumParens p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")++-- | Pretty print an alternative in an unboxed sum e.g. "| a | |".+pprAlternative :: (a -> SDoc) -- ^ The pretty printing function to use+               -> a           -- ^ The things to be pretty printed+               -> ConTag      -- ^ Alternative (one-based)+               -> Arity       -- ^ Arity+               -> SDoc        -- ^ 'SDoc' where the alternative havs been pretty+                              -- printed and finally packed into a paragraph.+pprAlternative pp x alt arity =+    fsep (replicate (alt - 1) vbar ++ [pp x] ++ replicate (arity - alt) vbar)++{-+************************************************************************+*                                                                      *+\subsection[Generic]{Generic flag}+*                                                                      *+************************************************************************++This is the "Embedding-Projection pair" datatype, it contains+two pieces of code (normally either RenamedExpr's or Id's)+If we have a such a pair (EP from to), the idea is that 'from' and 'to'+represents functions of type++        from :: T -> Tring+        to   :: Tring -> T++And we should have++        to (from x) = x++T and Tring are arbitrary, but typically T is the 'main' type while+Tring is the 'representation' type.  (This just helps us remember+whether to use 'from' or 'to'.+-}++-- | Embedding Projection pair+data EP a = EP { fromEP :: a,   -- :: T -> Tring+                 toEP   :: a }  -- :: Tring -> T++{-+Embedding-projection pairs are used in several places:++First of all, each type constructor has an EP associated with it, the+code in EP converts (datatype T) from T to Tring and back again.++Secondly, when we are filling in Generic methods (in the typechecker,+tcMethodBinds), we are constructing bimaps by induction on the structure+of the type of the method signature.+++************************************************************************+*                                                                      *+\subsection{Occurrence information}+*                                                                      *+************************************************************************++This data type is used exclusively by the simplifier, but it appears in a+SubstResult, which is currently defined in VarEnv, which is pretty near+the base of the module hierarchy.  So it seemed simpler to put the+defn of OccInfo here, safely at the bottom+-}++-- | identifier Occurrence Information+data OccInfo+  = ManyOccs        { occ_tail    :: !TailCallInfo }+                        -- ^ There are many occurrences, or unknown occurrences++  | IAmDead             -- ^ Marks unused variables.  Sometimes useful for+                        -- lambda and case-bound variables.++  | OneOcc          { occ_in_lam  :: !InsideLam+                    , occ_one_br  :: !OneBranch+                    , occ_int_cxt :: !InterestingCxt+                    , occ_tail    :: !TailCallInfo }+                        -- ^ Occurs exactly once (per branch), not inside a rule++  -- | This identifier breaks a loop of mutually recursive functions. The field+  -- marks whether it is only a loop breaker due to a reference in a rule+  | IAmALoopBreaker { occ_rules_only :: !RulesOnly+                    , occ_tail       :: !TailCallInfo }+                        -- Note [LoopBreaker OccInfo]++  deriving (Eq)++type RulesOnly = Bool++{-+Note [LoopBreaker OccInfo]+~~~~~~~~~~~~~~~~~~~~~~~~~~+   IAmALoopBreaker True  <=> A "weak" or rules-only loop breaker+                             Do not preInlineUnconditionally++   IAmALoopBreaker False <=> A "strong" loop breaker+                             Do not inline at all++See OccurAnal Note [Weak loop breakers]+-}++noOccInfo :: OccInfo+noOccInfo = ManyOccs { occ_tail = NoTailCallInfo }++isManyOccs :: OccInfo -> Bool+isManyOccs ManyOccs{} = True+isManyOccs _          = False++seqOccInfo :: OccInfo -> ()+seqOccInfo occ = occ `seq` ()++-----------------+-- | Interesting Context+type InterestingCxt = Bool      -- True <=> Function: is applied+                                --          Data value: scrutinised by a case with+                                --                      at least one non-DEFAULT branch++-----------------+-- | Inside Lambda+type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda+                        -- Substituting a redex for this occurrence is+                        -- dangerous because it might duplicate work.+insideLam, notInsideLam :: InsideLam+insideLam    = True+notInsideLam = False++-----------------+type OneBranch = Bool   -- True <=> Occurs in only one case branch+                        --      so no code-duplication issue to worry about+oneBranch, notOneBranch :: OneBranch+oneBranch    = True+notOneBranch = False++-----------------+data TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo]+                  | NoTailCallInfo+  deriving (Eq)++tailCallInfo :: OccInfo -> TailCallInfo+tailCallInfo IAmDead   = NoTailCallInfo+tailCallInfo other     = occ_tail other++zapOccTailCallInfo :: OccInfo -> OccInfo+zapOccTailCallInfo IAmDead   = IAmDead+zapOccTailCallInfo occ       = occ { occ_tail = NoTailCallInfo }++isAlwaysTailCalled :: OccInfo -> Bool+isAlwaysTailCalled occ+  = case tailCallInfo occ of AlwaysTailCalled{} -> True+                             NoTailCallInfo     -> False++instance Outputable TailCallInfo where+  ppr (AlwaysTailCalled ar) = sep [ text "Tail", int ar ]+  ppr _                     = empty++-----------------+strongLoopBreaker, weakLoopBreaker :: OccInfo+strongLoopBreaker = IAmALoopBreaker False NoTailCallInfo+weakLoopBreaker   = IAmALoopBreaker True  NoTailCallInfo++isWeakLoopBreaker :: OccInfo -> Bool+isWeakLoopBreaker (IAmALoopBreaker{}) = True+isWeakLoopBreaker _                   = False++isStrongLoopBreaker :: OccInfo -> Bool+isStrongLoopBreaker (IAmALoopBreaker { occ_rules_only = False }) = True+  -- Loop-breaker that breaks a non-rule cycle+isStrongLoopBreaker _                                            = False++isDeadOcc :: OccInfo -> Bool+isDeadOcc IAmDead = True+isDeadOcc _       = False++isOneOcc :: OccInfo -> Bool+isOneOcc (OneOcc {}) = True+isOneOcc _           = False++zapFragileOcc :: OccInfo -> OccInfo+-- Keep only the most robust data: deadness, loop-breaker-hood+zapFragileOcc (OneOcc {}) = noOccInfo+zapFragileOcc occ         = zapOccTailCallInfo occ++instance Outputable OccInfo where+  -- only used for debugging; never parsed.  KSW 1999-07+  ppr (ManyOccs tails)     = pprShortTailCallInfo tails+  ppr IAmDead              = text "Dead"+  ppr (IAmALoopBreaker rule_only tails)+        = text "LoopBreaker" <> pp_ro <> pprShortTailCallInfo tails+        where+          pp_ro | rule_only = char '!'+                | otherwise = empty+  ppr (OneOcc inside_lam one_branch int_cxt tail_info)+        = text "Once" <> pp_lam <> pp_br <> pp_args <> pp_tail+        where+          pp_lam | inside_lam = char 'L'+                 | otherwise  = empty+          pp_br  | one_branch = empty+                 | otherwise  = char '*'+          pp_args | int_cxt   = char '!'+                  | otherwise = empty+          pp_tail             = pprShortTailCallInfo tail_info++pprShortTailCallInfo :: TailCallInfo -> SDoc+pprShortTailCallInfo (AlwaysTailCalled ar) = char 'T' <> brackets (int ar)+pprShortTailCallInfo NoTailCallInfo        = empty++{-+Note [TailCallInfo]+~~~~~~~~~~~~~~~~~~~+The occurrence analyser determines what can be made into a join point, but it+doesn't change the binder into a JoinId because then it would be inconsistent+with the occurrences. Thus it's left to the simplifier (or to simpleOptExpr) to+change the IdDetails.++The AlwaysTailCalled marker actually means slightly more than simply that the+function is always tail-called. See Note [Invariants on join points].++This info is quite fragile and should not be relied upon unless the occurrence+analyser has *just* run. Use 'Id.isJoinId_maybe' for the permanent state of+the join-point-hood of a binder; a join id itself will not be marked+AlwaysTailCalled.++Note that there is a 'TailCallInfo' on a 'ManyOccs' value. One might expect that+being tail-called would mean that the variable could only appear once per branch+(thus getting a `OneOcc { occ_one_br = True }` occurrence info), but a join+point can also be invoked from other join points, not just from case branches:++  let j1 x = ...+      j2 y = ... j1 z {- tail call -} ...+  in case w of+       A -> j1 v+       B -> j2 u+       C -> j2 q++Here both 'j1' and 'j2' will get marked AlwaysTailCalled, but j1 will get+ManyOccs and j2 will get `OneOcc { occ_one_br = True }`.++************************************************************************+*                                                                      *+                Default method specification+*                                                                      *+************************************************************************++The DefMethSpec enumeration just indicates what sort of default method+is used for a class. It is generated from source code, and present in+interface files; it is converted to Class.DefMethInfo before begin put in a+Class object.+-}++-- | Default Method Specification+data DefMethSpec ty+  = VanillaDM     -- Default method given with polymorphic code+  | GenericDM ty  -- Default method given with code of this type++instance Outputable (DefMethSpec ty) where+  ppr VanillaDM      = text "{- Has default method -}"+  ppr (GenericDM {}) = text "{- Has generic default method -}"++{-+************************************************************************+*                                                                      *+\subsection{Success flag}+*                                                                      *+************************************************************************+-}++data SuccessFlag = Succeeded | Failed++instance Outputable SuccessFlag where+    ppr Succeeded = text "Succeeded"+    ppr Failed    = text "Failed"++successIf :: Bool -> SuccessFlag+successIf True  = Succeeded+successIf False = Failed++succeeded, failed :: SuccessFlag -> Bool+succeeded Succeeded = True+succeeded Failed    = False++failed Succeeded = False+failed Failed    = True++{-+************************************************************************+*                                                                      *+\subsection{Source Text}+*                                                                      *+************************************************************************+Keeping Source Text for source to source conversions++Note [Pragma source text]+~~~~~~~~~~~~~~~~~~~~~~~~~+The lexer does a case-insensitive match for pragmas, as well as+accepting both UK and US spelling variants.++So++  {-# SPECIALISE #-}+  {-# SPECIALIZE #-}+  {-# Specialize #-}++will all generate ITspec_prag token for the start of the pragma.++In order to be able to do source to source conversions, the original+source text for the token needs to be preserved, hence the+`SourceText` field.++So the lexer will then generate++  ITspec_prag "{ -# SPECIALISE"+  ITspec_prag "{ -# SPECIALIZE"+  ITspec_prag "{ -# Specialize"++for the cases above.+ [without the space between '{' and '-', otherwise this comment won't parse]+++Note [Literal source text]+~~~~~~~~~~~~~~~~~~~~~~~~~~+The lexer/parser converts literals from their original source text+versions to an appropriate internal representation. This is a problem+for tools doing source to source conversions, so the original source+text is stored in literals where this can occur.++Motivating examples for HsLit++  HsChar          '\n'       == '\x20`+  HsCharPrim      '\x41`#    == `A`+  HsString        "\x20\x41" == " A"+  HsStringPrim    "\x20"#    == " "#+  HsInt           001        == 1+  HsIntPrim       002#       == 2#+  HsWordPrim      003##      == 3##+  HsInt64Prim     004##      == 4##+  HsWord64Prim    005##      == 5##+  HsInteger       006        == 6++For OverLitVal++  HsIntegral      003      == 0x003+  HsIsString      "\x41nd" == "And"+-}++ -- Note [Literal source text],[Pragma source text]+data SourceText = SourceText String+                | NoSourceText -- ^ For when code is generated, e.g. TH,+                               -- deriving. The pretty printer will then make+                               -- its own representation of the item.+                deriving (Data, Show, Eq )++instance Outputable SourceText where+  ppr (SourceText s) = text "SourceText" <+> text s+  ppr NoSourceText   = text "NoSourceText"++-- | Special combinator for showing string literals.+pprWithSourceText :: SourceText -> SDoc -> SDoc+pprWithSourceText NoSourceText     d = d+pprWithSourceText (SourceText src) _ = text src++{-+************************************************************************+*                                                                      *+\subsection{Activation}+*                                                                      *+************************************************************************++When a rule or inlining is active+-}++-- | Phase Number+type PhaseNum = Int  -- Compilation phase+                     -- Phases decrease towards zero+                     -- Zero is the last phase++data CompilerPhase+  = Phase PhaseNum+  | InitialPhase    -- The first phase -- number = infinity!++instance Outputable CompilerPhase where+   ppr (Phase n)    = int n+   ppr InitialPhase = text "InitialPhase"++activeAfterInitial :: Activation+-- Active in the first phase after the initial phase+-- Currently we have just phases [2,1,0]+activeAfterInitial = ActiveAfter NoSourceText 2++activeDuringFinal :: Activation+-- Active in the final simplification phase (which is repeated)+activeDuringFinal = ActiveAfter NoSourceText 0++-- See note [Pragma source text]+data Activation = NeverActive+                | AlwaysActive+                | ActiveBefore SourceText PhaseNum+                  -- Active only *strictly before* this phase+                | ActiveAfter SourceText PhaseNum+                  -- Active in this phase and later+                deriving( Eq, Data )+                  -- Eq used in comparing rules in HsDecls++-- | Rule Match Information+data RuleMatchInfo = ConLike                    -- See Note [CONLIKE pragma]+                   | FunLike+                   deriving( Eq, Data, Show )+        -- Show needed for Lexer.x++data InlinePragma            -- Note [InlinePragma]+  = InlinePragma+      { inl_src    :: SourceText -- Note [Pragma source text]+      , inl_inline :: InlineSpec -- See Note [inl_inline and inl_act]++      , inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n+                                     --            explicit (non-type, non-dictionary) args+                                     --   That is, inl_sat describes the number of *source-code*+                                     --   arguments the thing must be applied to.  We add on the+                                     --   number of implicit, dictionary arguments when making+                                     --   the Unfolding, and don't look at inl_sat further++      , inl_act    :: Activation     -- Says during which phases inlining is allowed+                                     -- See Note [inl_inline and inl_act]++      , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?+    } deriving( Eq, Data )++-- | Inline Specification+data InlineSpec   -- What the user's INLINE pragma looked like+  = Inline       -- User wrote INLINE+  | Inlinable    -- User wrote INLINABLE+  | NoInline     -- User wrote NOINLINE+  | NoUserInline -- User did not write any of INLINE/INLINABLE/NOINLINE+                 -- e.g. in `defaultInlinePragma` or when created by CSE+  deriving( Eq, Data, Show )+        -- Show needed for Lexer.x++{- Note [InlinePragma]+~~~~~~~~~~~~~~~~~~~~~~+This data type mirrors what you can write in an INLINE or NOINLINE pragma in+the source program.++If you write nothing at all, you get defaultInlinePragma:+   inl_inline = NoUserInline+   inl_act    = AlwaysActive+   inl_rule   = FunLike++It's not possible to get that combination by *writing* something, so+if an Id has defaultInlinePragma it means the user didn't specify anything.++If inl_inline = Inline or Inlineable, then the Id should have an InlineRule unfolding.++If you want to know where InlinePragmas take effect: Look in DsBinds.makeCorePair++Note [inl_inline and inl_act]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+* inl_inline says what the user wrote: did she say INLINE, NOINLINE,+  INLINABLE, or nothing at all++* inl_act says in what phases the unfolding is active or inactive+  E.g  If you write INLINE[1]    then inl_act will be set to ActiveAfter 1+       If you write NOINLINE[1]  then inl_act will be set to ActiveBefore 1+       If you write NOINLINE[~1] then inl_act will be set to ActiveAfter 1+  So note that inl_act does not say what pragma you wrote: it just+  expresses its consequences++* inl_act just says when the unfolding is active; it doesn't say what+  to inline.  If you say INLINE f, then f's inl_act will be AlwaysActive,+  but in addition f will get a "stable unfolding" with UnfoldingGuidance+  that tells the inliner to be pretty eager about it.++Note [CONLIKE pragma]+~~~~~~~~~~~~~~~~~~~~~+The ConLike constructor of a RuleMatchInfo is aimed at the following.+Consider first+    {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}+    g b bs = let x = b:bs in ..x...x...(r x)...+Now, the rule applies to the (r x) term, because GHC "looks through"+the definition of 'x' to see that it is (b:bs).++Now consider+    {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}+    g v = let x = f v in ..x...x...(r x)...+Normally the (r x) would *not* match the rule, because GHC would be+scared about duplicating the redex (f v), so it does not "look+through" the bindings.++However the CONLIKE modifier says to treat 'f' like a constructor in+this situation, and "look through" the unfolding for x.  So (r x)+fires, yielding (f (v+1)).++This is all controlled with a user-visible pragma:+     {-# NOINLINE CONLIKE [1] f #-}++The main effects of CONLIKE are:++    - The occurrence analyser (OccAnal) and simplifier (Simplify) treat+      CONLIKE thing like constructors, by ANF-ing them++    - New function CoreUtils.exprIsExpandable is like exprIsCheap, but+      additionally spots applications of CONLIKE functions++    - A CoreUnfolding has a field that caches exprIsExpandable++    - The rule matcher consults this field.  See+      Note [Expanding variables] in Rules.hs.+-}++isConLike :: RuleMatchInfo -> Bool+isConLike ConLike = True+isConLike _       = False++isFunLike :: RuleMatchInfo -> Bool+isFunLike FunLike = True+isFunLike _       = False++noUserInlineSpec :: InlineSpec -> Bool+noUserInlineSpec NoUserInline = True+noUserInlineSpec _            = False++defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma+  :: InlinePragma+defaultInlinePragma = InlinePragma { inl_src = SourceText "{-# INLINE"+                                   , inl_act = AlwaysActive+                                   , inl_rule = FunLike+                                   , inl_inline = NoUserInline+                                   , inl_sat = Nothing }++alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }+neverInlinePragma  = defaultInlinePragma { inl_act    = NeverActive }++inlinePragmaSpec :: InlinePragma -> InlineSpec+inlinePragmaSpec = inl_inline++-- A DFun has an always-active inline activation so that+-- exprIsConApp_maybe can "see" its unfolding+-- (However, its actual Unfolding is a DFunUnfolding, which is+--  never inlined other than via exprIsConApp_maybe.)+dfunInlinePragma   = defaultInlinePragma { inl_act  = AlwaysActive+                                         , inl_rule = ConLike }++isDefaultInlinePragma :: InlinePragma -> Bool+isDefaultInlinePragma (InlinePragma { inl_act = activation+                                    , inl_rule = match_info+                                    , inl_inline = inline })+  = noUserInlineSpec inline && isAlwaysActive activation && isFunLike match_info++isInlinePragma :: InlinePragma -> Bool+isInlinePragma prag = case inl_inline prag of+                        Inline -> True+                        _      -> False++isInlinablePragma :: InlinePragma -> Bool+isInlinablePragma prag = case inl_inline prag of+                           Inlinable -> True+                           _         -> False++isAnyInlinePragma :: InlinePragma -> Bool+-- INLINE or INLINABLE+isAnyInlinePragma prag = case inl_inline prag of+                        Inline    -> True+                        Inlinable -> True+                        _         -> False++inlinePragmaSat :: InlinePragma -> Maybe Arity+inlinePragmaSat = inl_sat++inlinePragmaActivation :: InlinePragma -> Activation+inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation++inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo+inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info++setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma+setInlinePragmaActivation prag activation = prag { inl_act = activation }++setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma+setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }++instance Outputable Activation where+   ppr AlwaysActive       = empty+   ppr NeverActive        = brackets (text "~")+   ppr (ActiveBefore _ n) = brackets (char '~' <> int n)+   ppr (ActiveAfter  _ n) = brackets (int n)++instance Outputable RuleMatchInfo where+   ppr ConLike = text "CONLIKE"+   ppr FunLike = text "FUNLIKE"++instance Outputable InlineSpec where+   ppr Inline       = text "INLINE"+   ppr NoInline     = text "NOINLINE"+   ppr Inlinable    = text "INLINABLE"+   ppr NoUserInline = text "NOUSERINLINE" -- what is better?++instance Outputable InlinePragma where+  ppr = pprInline++pprInline :: InlinePragma -> SDoc+pprInline = pprInline' True++pprInlineDebug :: InlinePragma -> SDoc+pprInlineDebug = pprInline' False++pprInline' :: Bool           -- True <=> do not display the inl_inline field+           -> InlinePragma+           -> SDoc+pprInline' emptyInline (InlinePragma { inl_inline = inline, inl_act = activation+                                    , inl_rule = info, inl_sat = mb_arity })+    = pp_inl inline <> pp_act inline activation <+> pp_sat <+> pp_info+    where+      pp_inl x = if emptyInline then empty else ppr x++      pp_act Inline   AlwaysActive = empty+      pp_act NoInline NeverActive  = empty+      pp_act _        act          = ppr act++      pp_sat | Just ar <- mb_arity = parens (text "sat-args=" <> int ar)+             | otherwise           = empty+      pp_info | isFunLike info = empty+              | otherwise      = ppr info++isActive :: CompilerPhase -> Activation -> Bool+isActive InitialPhase AlwaysActive      = True+isActive InitialPhase (ActiveBefore {}) = True+isActive InitialPhase _                 = False+isActive (Phase p)    act               = isActiveIn p act++isActiveIn :: PhaseNum -> Activation -> Bool+isActiveIn _ NeverActive        = False+isActiveIn _ AlwaysActive       = True+isActiveIn p (ActiveAfter _ n)  = p <= n+isActiveIn p (ActiveBefore _ n) = p >  n++competesWith :: Activation -> Activation -> Bool+-- See Note [Activation competition]+competesWith NeverActive       _                = False+competesWith _                 NeverActive      = False+competesWith AlwaysActive      _                = True++competesWith (ActiveBefore {})  AlwaysActive      = True+competesWith (ActiveBefore {})  (ActiveBefore {}) = True+competesWith (ActiveBefore _ a) (ActiveAfter _ b) = a < b++competesWith (ActiveAfter {})  AlwaysActive      = False+competesWith (ActiveAfter {})  (ActiveBefore {}) = False+competesWith (ActiveAfter _ a) (ActiveAfter _ b) = a >= b++{- Note [Competing activations]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Sometimes a RULE and an inlining may compete, or two RULES.+See Note [Rules and inlining/other rules] in Desugar.++We say that act1 "competes with" act2 iff+   act1 is active in the phase when act2 *becomes* active+NB: remember that phases count *down*: 2, 1, 0!++It's too conservative to ensure that the two are never simultaneously+active.  For example, a rule might be always active, and an inlining+might switch on in phase 2.  We could switch off the rule, but it does+no harm.+-}++isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool+isNeverActive NeverActive = True+isNeverActive _           = False++isAlwaysActive AlwaysActive = True+isAlwaysActive _            = False++isEarlyActive AlwaysActive      = True+isEarlyActive (ActiveBefore {}) = True+isEarlyActive _                 = False++-- | Integral Literal+--+-- Used (instead of Integer) to represent negative zegative zero which is+-- required for NegativeLiterals extension to correctly parse `-0::Double`+-- as negative zero. See also #13211.+data IntegralLit+  = IL { il_text :: SourceText+       , il_neg :: Bool -- See Note [Negative zero]+       , il_value :: Integer+       }+  deriving (Data, Show)++mkIntegralLit :: Integral a => a -> IntegralLit+mkIntegralLit i = IL { il_text = SourceText (show i_integer)+                     , il_neg = i < 0+                     , il_value = i_integer }+  where+    i_integer :: Integer+    i_integer = toInteger i++negateIntegralLit :: IntegralLit -> IntegralLit+negateIntegralLit (IL text neg value)+  = case text of+      SourceText ('-':src) -> IL (SourceText src)       False    (negate value)+      SourceText      src  -> IL (SourceText ('-':src)) True     (negate value)+      NoSourceText         -> IL NoSourceText          (not neg) (negate value)++-- | Fractional Literal+--+-- Used (instead of Rational) to represent exactly the floating point literal that we+-- encountered in the user's source program. This allows us to pretty-print exactly what+-- the user wrote, which is important e.g. for floating point numbers that can't represented+-- as Doubles (we used to via Double for pretty-printing). See also #2245.+data FractionalLit+  = FL { fl_text :: SourceText     -- How the value was written in the source+       , fl_neg :: Bool            -- See Note [Negative zero]+       , fl_value :: Rational      -- Numeric value of the literal+       }+  deriving (Data, Show)+  -- The Show instance is required for the derived Lexer.x:Token instance when DEBUG is on++mkFractionalLit :: Real a => a -> FractionalLit+mkFractionalLit r = FL { fl_text = SourceText (show (realToFrac r::Double))+                           -- Converting to a Double here may technically lose+                           -- precision (see #15502). We could alternatively+                           -- convert to a Rational for the most accuracy, but+                           -- it would cause Floats and Doubles to be displayed+                           -- strangely, so we opt not to do this. (In contrast+                           -- to mkIntegralLit, where we always convert to an+                           -- Integer for the highest accuracy.)+                       , fl_neg = r < 0+                       , fl_value = toRational r }++negateFractionalLit :: FractionalLit -> FractionalLit+negateFractionalLit (FL text neg value)+  = case text of+      SourceText ('-':src) -> FL (SourceText src)     False value+      SourceText      src  -> FL (SourceText ('-':src)) True  value+      NoSourceText         -> FL NoSourceText (not neg) (negate value)++integralFractionalLit :: Bool -> Integer -> FractionalLit+integralFractionalLit neg i = FL { fl_text = SourceText (show i),+                                   fl_neg = neg,+                                   fl_value = fromInteger i }++-- Comparison operations are needed when grouping literals+-- for compiling pattern-matching (module MatchLit)++instance Eq IntegralLit where+  (==) = (==) `on` il_value++instance Ord IntegralLit where+  compare = compare `on` il_value++instance Outputable IntegralLit where+  ppr (IL (SourceText src) _ _) = text src+  ppr (IL NoSourceText _ value) = text (show value)++instance Eq FractionalLit where+  (==) = (==) `on` fl_value++instance Ord FractionalLit where+  compare = compare `on` fl_value++instance Outputable FractionalLit where+  ppr f = pprWithSourceText (fl_text f) (rational (fl_value f))++{-+************************************************************************+*                                                                      *+    IntWithInf+*                                                                      *+************************************************************************++Represents an integer or positive infinity++-}++-- | An integer or infinity+data IntWithInf = Int {-# UNPACK #-} !Int+                | Infinity+  deriving Eq++-- | A representation of infinity+infinity :: IntWithInf+infinity = Infinity++instance Ord IntWithInf where+  compare Infinity Infinity = EQ+  compare (Int _)  Infinity = LT+  compare Infinity (Int _)  = GT+  compare (Int a)  (Int b)  = a `compare` b++instance Outputable IntWithInf where+  ppr Infinity = char '∞'+  ppr (Int n)  = int n++instance Num IntWithInf where+  (+) = plusWithInf+  (*) = mulWithInf++  abs Infinity = Infinity+  abs (Int n)  = Int (abs n)++  signum Infinity = Int 1+  signum (Int n)  = Int (signum n)++  fromInteger = Int . fromInteger++  (-) = panic "subtracting IntWithInfs"++intGtLimit :: Int -> IntWithInf -> Bool+intGtLimit _ Infinity = False+intGtLimit n (Int m)  = n > m++-- | Add two 'IntWithInf's+plusWithInf :: IntWithInf -> IntWithInf -> IntWithInf+plusWithInf Infinity _        = Infinity+plusWithInf _        Infinity = Infinity+plusWithInf (Int a)  (Int b)  = Int (a + b)++-- | Multiply two 'IntWithInf's+mulWithInf :: IntWithInf -> IntWithInf -> IntWithInf+mulWithInf Infinity _        = Infinity+mulWithInf _        Infinity = Infinity+mulWithInf (Int a)  (Int b)  = Int (a * b)++-- | Turn a positive number into an 'IntWithInf', where 0 represents infinity+treatZeroAsInf :: Int -> IntWithInf+treatZeroAsInf 0 = Infinity+treatZeroAsInf n = Int n++-- | Inject any integer into an 'IntWithInf'+mkIntWithInf :: Int -> IntWithInf+mkIntWithInf = Int++data SpliceExplicitFlag+          = ExplicitSplice | -- ^ <=> $(f x y)+            ImplicitSplice   -- ^ <=> f x y,  i.e. a naked top level expression+    deriving Data
+ compiler/basicTypes/ConLike.hs view
@@ -0,0 +1,196 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1998++\section[ConLike]{@ConLike@: Constructor-like things}+-}++{-# LANGUAGE CPP #-}++module ConLike (+          ConLike(..)+        , conLikeArity+        , conLikeFieldLabels+        , conLikeInstOrigArgTys+        , conLikeExTyCoVars+        , conLikeName+        , conLikeStupidTheta+        , conLikeWrapId_maybe+        , conLikeImplBangs+        , conLikeFullSig+        , conLikeResTy+        , conLikeFieldType+        , conLikesWithFields+        , conLikeIsInfix+    ) where++#include "HsVersions.h"++import GhcPrelude++import DataCon+import PatSyn+import Outputable+import Unique+import Util+import Name+import BasicTypes+import TyCoRep (Type, ThetaType)+import Var+import Type (mkTyConApp)++import qualified Data.Data as Data++{-+************************************************************************+*                                                                      *+\subsection{Constructor-like things}+*                                                                      *+************************************************************************+-}++-- | A constructor-like thing+data ConLike = RealDataCon DataCon+             | PatSynCon PatSyn++{-+************************************************************************+*                                                                      *+\subsection{Instances}+*                                                                      *+************************************************************************+-}++instance Eq ConLike where+    (==) = eqConLike++eqConLike :: ConLike -> ConLike -> Bool+eqConLike x y = getUnique x == getUnique y++-- There used to be an Ord ConLike instance here that used Unique for ordering.+-- It was intentionally removed to prevent determinism problems.+-- See Note [Unique Determinism] in Unique.++instance Uniquable ConLike where+    getUnique (RealDataCon dc) = getUnique dc+    getUnique (PatSynCon ps)   = getUnique ps++instance NamedThing ConLike where+    getName (RealDataCon dc) = getName dc+    getName (PatSynCon ps)   = getName ps++instance Outputable ConLike where+    ppr (RealDataCon dc) = ppr dc+    ppr (PatSynCon ps) = ppr ps++instance OutputableBndr ConLike where+    pprInfixOcc (RealDataCon dc) = pprInfixOcc dc+    pprInfixOcc (PatSynCon ps) = pprInfixOcc ps+    pprPrefixOcc (RealDataCon dc) = pprPrefixOcc dc+    pprPrefixOcc (PatSynCon ps) = pprPrefixOcc ps++instance Data.Data ConLike where+    -- don't traverse?+    toConstr _   = abstractConstr "ConLike"+    gunfold _ _  = error "gunfold"+    dataTypeOf _ = mkNoRepType "ConLike"++-- | Number of arguments+conLikeArity :: ConLike -> Arity+conLikeArity (RealDataCon data_con) = dataConSourceArity data_con+conLikeArity (PatSynCon pat_syn)    = patSynArity pat_syn++-- | Names of fields used for selectors+conLikeFieldLabels :: ConLike -> [FieldLabel]+conLikeFieldLabels (RealDataCon data_con) = dataConFieldLabels data_con+conLikeFieldLabels (PatSynCon pat_syn)    = patSynFieldLabels pat_syn++-- | Returns just the instantiated /value/ argument types of a 'ConLike',+-- (excluding dictionary args)+conLikeInstOrigArgTys :: ConLike -> [Type] -> [Type]+conLikeInstOrigArgTys (RealDataCon data_con) tys =+    dataConInstOrigArgTys data_con tys+conLikeInstOrigArgTys (PatSynCon pat_syn) tys =+    patSynInstArgTys pat_syn tys++-- | Existentially quantified type/coercion variables+conLikeExTyCoVars :: ConLike -> [TyCoVar]+conLikeExTyCoVars (RealDataCon dcon1) = dataConExTyCoVars dcon1+conLikeExTyCoVars (PatSynCon psyn1)   = patSynExTyVars psyn1++conLikeName :: ConLike -> Name+conLikeName (RealDataCon data_con) = dataConName data_con+conLikeName (PatSynCon pat_syn)    = patSynName pat_syn++-- | The \"stupid theta\" of the 'ConLike', such as @data Eq a@ in:+--+-- > data Eq a => T a = ...+-- It is empty for `PatSynCon` as they do not allow such contexts.+conLikeStupidTheta :: ConLike -> ThetaType+conLikeStupidTheta (RealDataCon data_con) = dataConStupidTheta data_con+conLikeStupidTheta (PatSynCon {})         = []++-- | Returns the `Id` of the wrapper. This is also known as the builder in+-- some contexts. The value is Nothing only in the case of unidirectional+-- pattern synonyms.+conLikeWrapId_maybe :: ConLike -> Maybe Id+conLikeWrapId_maybe (RealDataCon data_con) = Just $ dataConWrapId data_con+conLikeWrapId_maybe (PatSynCon pat_syn)    = fst <$> patSynBuilder pat_syn++-- | Returns the strictness information for each constructor+conLikeImplBangs :: ConLike -> [HsImplBang]+conLikeImplBangs (RealDataCon data_con) = dataConImplBangs data_con+conLikeImplBangs (PatSynCon pat_syn)    =+    replicate (patSynArity pat_syn) HsLazy++-- | Returns the type of the whole pattern+conLikeResTy :: ConLike -> [Type] -> Type+conLikeResTy (RealDataCon con) tys = mkTyConApp (dataConTyCon con) tys+conLikeResTy (PatSynCon ps)    tys = patSynInstResTy ps tys++-- | The \"full signature\" of the 'ConLike' returns, in order:+--+-- 1) The universally quantified type variables+--+-- 2) The existentially quantified type/coercion variables+--+-- 3) The equality specification+--+-- 4) The provided theta (the constraints provided by a match)+--+-- 5) The required theta (the constraints required for a match)+--+-- 6) The original argument types (i.e. before+--    any change of the representation of the type)+--+-- 7) The original result type+conLikeFullSig :: ConLike+               -> ([TyVar], [TyCoVar], [EqSpec]+                   -- Why tyvars for universal but tycovars for existential?+                   -- See Note [Existential coercion variables] in DataCon+                  , ThetaType, ThetaType, [Type], Type)+conLikeFullSig (RealDataCon con) =+  let (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty) = dataConFullSig con+  -- Required theta is empty as normal data cons require no additional+  -- constraints for a match+  in (univ_tvs, ex_tvs, eq_spec, theta, [], arg_tys, res_ty)+conLikeFullSig (PatSynCon pat_syn) =+ let (univ_tvs, req, ex_tvs, prov, arg_tys, res_ty) = patSynSig pat_syn+ -- eqSpec is empty+ in (univ_tvs, ex_tvs, [], prov, req, arg_tys, res_ty)++-- | Extract the type for any given labelled field of the 'ConLike'+conLikeFieldType :: ConLike -> FieldLabelString -> Type+conLikeFieldType (PatSynCon ps) label = patSynFieldType ps label+conLikeFieldType (RealDataCon dc) label = dataConFieldType dc label+++-- | The ConLikes that have *all* the given fields+conLikesWithFields :: [ConLike] -> [FieldLabelString] -> [ConLike]+conLikesWithFields con_likes lbls = filter has_flds con_likes+  where has_flds dc = all (has_fld dc) lbls+        has_fld dc lbl = any (\ fl -> flLabel fl == lbl) (conLikeFieldLabels dc)++conLikeIsInfix :: ConLike -> Bool+conLikeIsInfix (RealDataCon dc) = dataConIsInfix dc+conLikeIsInfix (PatSynCon ps)   = patSynIsInfix  ps
+ compiler/basicTypes/ConLike.hs-boot view
@@ -0,0 +1,9 @@+module ConLike where+import {-# SOURCE #-} DataCon (DataCon)+import {-# SOURCE #-} PatSyn (PatSyn)+import Name ( Name )++data ConLike = RealDataCon DataCon+             | PatSynCon PatSyn++conLikeName :: ConLike -> Name
+ compiler/basicTypes/DataCon.hs view
@@ -0,0 +1,1515 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1998++\section[DataCon]{@DataCon@: Data Constructors}+-}++{-# LANGUAGE CPP, DeriveDataTypeable #-}++module DataCon (+        -- * Main data types+        DataCon, DataConRep(..),+        SrcStrictness(..), SrcUnpackedness(..),+        HsSrcBang(..), HsImplBang(..),+        StrictnessMark(..),+        ConTag,++        -- ** Equality specs+        EqSpec, mkEqSpec, eqSpecTyVar, eqSpecType,+        eqSpecPair, eqSpecPreds,+        substEqSpec, filterEqSpec,++        -- ** Field labels+        FieldLbl(..), FieldLabel, FieldLabelString,++        -- ** Type construction+        mkDataCon, buildAlgTyCon, buildSynTyCon, fIRST_TAG,++        -- ** Type deconstruction+        dataConRepType, dataConSig, dataConInstSig, dataConFullSig,+        dataConName, dataConIdentity, dataConTag, dataConTagZ,+        dataConTyCon, dataConOrigTyCon,+        dataConUserType,+        dataConUnivTyVars, dataConExTyCoVars, dataConUnivAndExTyCoVars,+        dataConUserTyVars, dataConUserTyVarBinders,+        dataConEqSpec, dataConTheta,+        dataConStupidTheta,+        dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,+        dataConInstOrigArgTys, dataConRepArgTys,+        dataConFieldLabels, dataConFieldType, dataConFieldType_maybe,+        dataConSrcBangs,+        dataConSourceArity, dataConRepArity,+        dataConIsInfix,+        dataConWorkId, dataConWrapId, dataConWrapId_maybe,+        dataConImplicitTyThings,+        dataConRepStrictness, dataConImplBangs, dataConBoxer,++        splitDataProductType_maybe,++        -- ** Predicates on DataCons+        isNullarySrcDataCon, isNullaryRepDataCon, isTupleDataCon, isUnboxedTupleCon,+        isUnboxedSumCon,+        isVanillaDataCon, classDataCon, dataConCannotMatch,+        dataConUserTyVarsArePermuted,+        isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked,+        specialPromotedDc,++        -- ** Promotion related functions+        promoteDataCon+    ) where++#include "HsVersions.h"++import GhcPrelude++import {-# SOURCE #-} MkId( DataConBoxer )+import Type+import ForeignCall ( CType )+import Coercion+import Unify+import TyCon+import FieldLabel+import Class+import Name+import PrelNames+import Var+import VarSet( emptyVarSet )+import Outputable+import Util+import BasicTypes+import FastString+import Module+import Binary+import UniqSet+import Unique( mkAlphaTyVarUnique )++import Data.ByteString (ByteString)+import qualified Data.ByteString.Builder as BSB+import qualified Data.ByteString.Lazy    as LBS+import qualified Data.Data as Data+import Data.Char+import Data.List( find )++{-+Data constructor representation+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider the following Haskell data type declaration++        data T = T !Int ![Int]++Using the strictness annotations, GHC will represent this as++        data T = T Int# [Int]++That is, the Int has been unboxed.  Furthermore, the Haskell source construction++        T e1 e2++is translated to++        case e1 of { I# x ->+        case e2 of { r ->+        T x r }}++That is, the first argument is unboxed, and the second is evaluated.  Finally,+pattern matching is translated too:++        case e of { T a b -> ... }++becomes++        case e of { T a' b -> let a = I# a' in ... }++To keep ourselves sane, we name the different versions of the data constructor+differently, as follows.+++Note [Data Constructor Naming]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Each data constructor C has two, and possibly up to four, Names associated with it:++                   OccName   Name space   Name of   Notes+ ---------------------------------------------------------------------------+ The "data con itself"   C     DataName   DataCon   In dom( GlobalRdrEnv )+ The "worker data con"   C     VarName    Id        The worker+ The "wrapper data con"  $WC   VarName    Id        The wrapper+ The "newtype coercion"  :CoT  TcClsName  TyCon++EVERY data constructor (incl for newtypes) has the former two (the+data con itself, and its worker.  But only some data constructors have a+wrapper (see Note [The need for a wrapper]).++Each of these three has a distinct Unique.  The "data con itself" name+appears in the output of the renamer, and names the Haskell-source+data constructor.  The type checker translates it into either the wrapper Id+(if it exists) or worker Id (otherwise).++The data con has one or two Ids associated with it:++The "worker Id", is the actual data constructor.+* Every data constructor (newtype or data type) has a worker++* The worker is very like a primop, in that it has no binding.++* For a *data* type, the worker *is* the data constructor;+  it has no unfolding++* For a *newtype*, the worker has a compulsory unfolding which+  does a cast, e.g.+        newtype T = MkT Int+        The worker for MkT has unfolding+                \\(x:Int). x `cast` sym CoT+  Here CoT is the type constructor, witnessing the FC axiom+        axiom CoT : T = Int++The "wrapper Id", \$WC, goes as follows++* Its type is exactly what it looks like in the source program.++* It is an ordinary function, and it gets a top-level binding+  like any other function.++* The wrapper Id isn't generated for a data type if there is+  nothing for the wrapper to do.  That is, if its defn would be+        \$wC = C++Note [Data constructor workers and wrappers]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+* Algebraic data types+  - Always have a worker, with no unfolding+  - May or may not have a wrapper; see Note [The need for a wrapper]++* Newtypes+  - Always have a worker, which has a compulsory unfolding (just a cast)+  - May or may not have a wrapper; see Note [The need for a wrapper]++* INVARIANT: the dictionary constructor for a class+             never has a wrapper.++* Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments++* The wrapper (if it exists) takes dcOrigArgTys as its arguments+  The worker takes dataConRepArgTys as its arguments+  If the worker is absent, dataConRepArgTys is the same as dcOrigArgTys++* The 'NoDataConRep' case of DataConRep is important. Not only is it+  efficient, but it also ensures that the wrapper is replaced by the+  worker (because it *is* the worker) even when there are no+  args. E.g. in+               f (:) x+  the (:) *is* the worker.  This is really important in rule matching,+  (We could match on the wrappers, but that makes it less likely that+  rules will match when we bring bits of unfoldings together.)++Note [The need for a wrapper]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Why might the wrapper have anything to do?  The full story is+in wrapper_reqd in MkId.mkDataConRep.++* Unboxing strict fields (with -funbox-strict-fields)+        data T = MkT !(Int,Int)+        \$wMkT :: (Int,Int) -> T+        \$wMkT (x,y) = MkT x y+  Notice that the worker has two fields where the wapper has+  just one.  That is, the worker has type+                MkT :: Int -> Int -> T++* Equality constraints for GADTs+        data T a where { MkT :: a -> T [a] }++  The worker gets a type with explicit equality+  constraints, thus:+        MkT :: forall a b. (a=[b]) => b -> T a++  The wrapper has the programmer-specified type:+        \$wMkT :: a -> T [a]+        \$wMkT a x = MkT [a] a [a] x+  The third argument is a coercion+        [a] :: [a]~[a]++* Data family instances may do a cast on the result++* Type variables may be permuted; see MkId+  Note [Data con wrappers and GADT syntax]+++Note [The stupid context]+~~~~~~~~~~~~~~~~~~~~~~~~~+Data types can have a context:++        data (Eq a, Ord b) => T a b = T1 a b | T2 a++and that makes the constructors have a context too+(notice that T2's context is "thinned"):++        T1 :: (Eq a, Ord b) => a -> b -> T a b+        T2 :: (Eq a) => a -> T a b++Furthermore, this context pops up when pattern matching+(though GHC hasn't implemented this, but it is in H98, and+I've fixed GHC so that it now does):++        f (T2 x) = x+gets inferred type+        f :: Eq a => T a b -> a++I say the context is "stupid" because the dictionaries passed+are immediately discarded -- they do nothing and have no benefit.+It's a flaw in the language.++        Up to now [March 2002] I have put this stupid context into the+        type of the "wrapper" constructors functions, T1 and T2, but+        that turned out to be jolly inconvenient for generics, and+        record update, and other functions that build values of type T+        (because they don't have suitable dictionaries available).++        So now I've taken the stupid context out.  I simply deal with+        it separately in the type checker on occurrences of a+        constructor, either in an expression or in a pattern.++        [May 2003: actually I think this decision could easily be+        reversed now, and probably should be.  Generics could be+        disabled for types with a stupid context; record updates now+        (H98) needs the context too; etc.  It's an unforced change, so+        I'm leaving it for now --- but it does seem odd that the+        wrapper doesn't include the stupid context.]++[July 04] With the advent of generalised data types, it's less obvious+what the "stupid context" is.  Consider+        C :: forall a. Ord a => a -> a -> T (Foo a)+Does the C constructor in Core contain the Ord dictionary?  Yes, it must:++        f :: T b -> Ordering+        f = /\b. \x:T b.+            case x of+                C a (d:Ord a) (p:a) (q:a) -> compare d p q++Note that (Foo a) might not be an instance of Ord.++************************************************************************+*                                                                      *+\subsection{Data constructors}+*                                                                      *+************************************************************************+-}++-- | A data constructor+--+-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',+--             'ApiAnnotation.AnnClose','ApiAnnotation.AnnComma'++-- For details on above see note [Api annotations] in ApiAnnotation+data DataCon+  = MkData {+        dcName    :: Name,      -- This is the name of the *source data con*+                                -- (see "Note [Data Constructor Naming]" above)+        dcUnique :: Unique,     -- Cached from Name+        dcTag    :: ConTag,     -- ^ Tag, used for ordering 'DataCon's++        -- Running example:+        --+        --      *** As declared by the user+        --  data T a b c where+        --    MkT :: forall c y x b. (x~y,Ord x) => x -> y -> T (x,y) b c++        --      *** As represented internally+        --  data T a b c where+        --    MkT :: forall a b c. forall x y. (a~(x,y),x~y,Ord x)+        --        => x -> y -> T a b c+        --+        -- The next six fields express the type of the constructor, in pieces+        -- e.g.+        --+        --      dcUnivTyVars       = [a,b,c]+        --      dcExTyCoVars       = [x,y]+        --      dcUserTyVarBinders = [c,y,x,b]+        --      dcEqSpec           = [a~(x,y)]+        --      dcOtherTheta       = [x~y, Ord x]+        --      dcOrigArgTys       = [x,y]+        --      dcRepTyCon         = T++        -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE+        -- TYVARS FOR THE PARENT TyCon. (This is a change (Oct05): previously,+        -- vanilla datacons guaranteed to have the same type variables as their+        -- parent TyCon, but that seems ugly.) They can be different in the case+        -- where a GADT constructor uses different names for the universal+        -- tyvars than does the tycon. For example:+        --+        --   data H a where+        --     MkH :: b -> H b+        --+        -- Here, the tyConTyVars of H will be [a], but the dcUnivTyVars of MkH+        -- will be [b].++        dcVanilla :: Bool,      -- True <=> This is a vanilla Haskell 98 data constructor+                                --          Its type is of form+                                --              forall a1..an . t1 -> ... tm -> T a1..an+                                --          No existentials, no coercions, nothing.+                                -- That is: dcExTyCoVars = dcEqSpec = dcOtherTheta = []+                -- NB 1: newtypes always have a vanilla data con+                -- NB 2: a vanilla constructor can still be declared in GADT-style+                --       syntax, provided its type looks like the above.+                --       The declaration format is held in the TyCon (algTcGadtSyntax)++        -- Universally-quantified type vars [a,b,c]+        -- INVARIANT: length matches arity of the dcRepTyCon+        -- INVARIANT: result type of data con worker is exactly (T a b c)+        -- COROLLARY: The dcUnivTyVars are always in one-to-one correspondence with+        --            the tyConTyVars of the parent TyCon+        dcUnivTyVars     :: [TyVar],++        -- Existentially-quantified type and coercion vars [x,y]+        -- For an example involving coercion variables,+        -- Why tycovars? See Note [Existential coercion variables]+        dcExTyCoVars     :: [TyCoVar],++        -- INVARIANT: the UnivTyVars and ExTyCoVars all have distinct OccNames+        -- Reason: less confusing, and easier to generate IfaceSyn++        -- The type/coercion vars in the order the user wrote them [c,y,x,b]+        -- INVARIANT: the set of tyvars in dcUserTyVarBinders is exactly the set+        --            of tyvars (*not* covars) of dcExTyCoVars unioned with the+        --            set of dcUnivTyVars whose tyvars do not appear in dcEqSpec+        -- See Note [DataCon user type variable binders]+        dcUserTyVarBinders :: [TyVarBinder],++        dcEqSpec :: [EqSpec],   -- Equalities derived from the result type,+                                -- _as written by the programmer_.+                                -- Only non-dependent GADT equalities (dependent+                                -- GADT equalities are in the covars of+                                -- dcExTyCoVars).++                -- This field allows us to move conveniently between the two ways+                -- of representing a GADT constructor's type:+                --      MkT :: forall a b. (a ~ [b]) => b -> T a+                --      MkT :: forall b. b -> T [b]+                -- Each equality is of the form (a ~ ty), where 'a' is one of+                -- the universally quantified type variables++                -- The next two fields give the type context of the data constructor+                --      (aside from the GADT constraints,+                --       which are given by the dcExpSpec)+                -- In GADT form, this is *exactly* what the programmer writes, even if+                -- the context constrains only universally quantified variables+                --      MkT :: forall a b. (a ~ b, Ord b) => a -> T a b+        dcOtherTheta :: ThetaType,  -- The other constraints in the data con's type+                                    -- other than those in the dcEqSpec++        dcStupidTheta :: ThetaType,     -- The context of the data type declaration+                                        --      data Eq a => T a = ...+                                        -- or, rather, a "thinned" version thereof+                -- "Thinned", because the Report says+                -- to eliminate any constraints that don't mention+                -- tyvars free in the arg types for this constructor+                --+                -- INVARIANT: the free tyvars of dcStupidTheta are a subset of dcUnivTyVars+                -- Reason: dcStupidTeta is gotten by thinning the stupid theta from the tycon+                --+                -- "Stupid", because the dictionaries aren't used for anything.+                -- Indeed, [as of March 02] they are no longer in the type of+                -- the wrapper Id, because that makes it harder to use the wrap-id+                -- to rebuild values after record selection or in generics.++        dcOrigArgTys :: [Type],         -- Original argument types+                                        -- (before unboxing and flattening of strict fields)+        dcOrigResTy :: Type,            -- Original result type, as seen by the user+                -- NB: for a data instance, the original user result type may+                -- differ from the DataCon's representation TyCon.  Example+                --      data instance T [a] where MkT :: a -> T [a]+                -- The OrigResTy is T [a], but the dcRepTyCon might be :T123++        -- Now the strictness annotations and field labels of the constructor+        dcSrcBangs :: [HsSrcBang],+                -- See Note [Bangs on data constructor arguments]+                --+                -- The [HsSrcBang] as written by the programmer.+                --+                -- Matches 1-1 with dcOrigArgTys+                -- Hence length = dataConSourceArity dataCon++        dcFields  :: [FieldLabel],+                -- Field labels for this constructor, in the+                -- same order as the dcOrigArgTys;+                -- length = 0 (if not a record) or dataConSourceArity.++        -- The curried worker function that corresponds to the constructor:+        -- It doesn't have an unfolding; the code generator saturates these Ids+        -- and allocates a real constructor when it finds one.+        dcWorkId :: Id,++        -- Constructor representation+        dcRep      :: DataConRep,++        -- Cached; see Note [DataCon arities]+        -- INVARIANT: dcRepArity    == length dataConRepArgTys + count isCoVar (dcExTyCoVars)+        -- INVARIANT: dcSourceArity == length dcOrigArgTys+        dcRepArity    :: Arity,+        dcSourceArity :: Arity,++        -- Result type of constructor is T t1..tn+        dcRepTyCon  :: TyCon,           -- Result tycon, T++        dcRepType   :: Type,    -- Type of the constructor+                                --      forall a x y. (a~(x,y), x~y, Ord x) =>+                                --        x -> y -> T a+                                -- (this is *not* of the constructor wrapper Id:+                                --  see Note [Data con representation] below)+        -- Notice that the existential type parameters come *second*.+        -- Reason: in a case expression we may find:+        --      case (e :: T t) of+        --        MkT x y co1 co2 (d:Ord x) (v:r) (w:F s) -> ...+        -- It's convenient to apply the rep-type of MkT to 't', to get+        --      forall x y. (t~(x,y), x~y, Ord x) => x -> y -> T t+        -- and use that to check the pattern.  Mind you, this is really only+        -- used in CoreLint.+++        dcInfix :: Bool,        -- True <=> declared infix+                                -- Used for Template Haskell and 'deriving' only+                                -- The actual fixity is stored elsewhere++        dcPromoted :: TyCon    -- The promoted TyCon+                               -- See Note [Promoted data constructors] in TyCon+  }+++{- Note [TyVarBinders in DataCons]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For the TyVarBinders in a DataCon and PatSyn:++ * Each argument flag is Inferred or Specified.+   None are Required. (A DataCon is a term-level function; see+   Note [No Required TyCoBinder in terms] in TyCoRep.)++Why do we need the TyVarBinders, rather than just the TyVars?  So that+we can construct the right type for the DataCon with its foralls+attributed the correct visibility.  That in turn governs whether you+can use visible type application at a call of the data constructor.++See also [DataCon user type variable binders] for an extended discussion on the+order in which TyVarBinders appear in a DataCon.++Note [Existential coercion variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++For now (Aug 2018) we can't write coercion quantifications in source Haskell, but+we can in Core. Consider having:++  data T :: forall k. k -> k -> Constraint where+    MkT :: forall k (a::k) (b::k). forall k' (c::k') (co::k'~k). (b~(c|>co))+        => T k a b++  dcUnivTyVars       = [k,a,b]+  dcExTyCoVars       = [k',c,co]+  dcUserTyVarBinders = [k,a,k',c]+  dcEqSpec           = [b~(c|>co)]+  dcOtherTheta       = []+  dcOrigArgTys       = []+  dcRepTyCon         = T++  Function call 'dataConKindEqSpec' returns [k'~k]++Note [DataCon arities]+~~~~~~~~~~~~~~~~~~~~~~+dcSourceArity does not take constraints into account,+but dcRepArity does.  For example:+   MkT :: Ord a => a -> T a+    dcSourceArity = 1+    dcRepArity    = 2++Note [DataCon user type variable binders]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In System FC, data constructor type signatures always quantify over all of+their universal type variables, followed by their existential type variables.+Normally, this isn't a problem, as most datatypes naturally quantify their type+variables in this order anyway. For example:++  data T a b = forall c. MkT b c++Here, we have `MkT :: forall {k} (a :: k) (b :: *) (c :: *). b -> c -> T a b`,+where k, a, and b are universal and c is existential. (The inferred variable k+isn't available for TypeApplications, hence why it's in braces.) This is a+perfectly reasonable order to use, as the syntax of H98-style datatypes+(+ ExistentialQuantification) suggests it.++Things become more complicated when GADT syntax enters the picture. Consider+this example:++  data X a where+    MkX :: forall b a. b -> Proxy a -> X a++If we adopt the earlier approach of quantifying all the universal variables+followed by all the existential ones, GHC would come up with this type+signature for MkX:++  MkX :: forall {k} (a :: k) (b :: *). b -> Proxy a -> X a++But this is not what we want at all! After all, if a user were to use+TypeApplications on MkX, they would expect to instantiate `b` before `a`,+as that's the order in which they were written in the `forall`. (See #11721.)+Instead, we'd like GHC to come up with this type signature:++  MkX :: forall {k} (b :: *) (a :: k). b -> Proxy a -> X a++In fact, even if we left off the explicit forall:++  data X a where+    MkX :: b -> Proxy a -> X a++Then a user should still expect `b` to be quantified before `a`, since+according to the rules of TypeApplications, in the absence of `forall` GHC+performs a stable topological sort on the type variables in the user-written+type signature, which would place `b` before `a`.++But as noted above, enacting this behavior is not entirely trivial, as System+FC demands the variables go in universal-then-existential order under the hood.+Our solution is thus to equip DataCon with two different sets of type+variables:++* dcUnivTyVars and dcExTyCoVars, for the universal type variable and existential+  type/coercion variables, respectively. Their order is irrelevant for the+  purposes of TypeApplications, and as a consequence, they do not come equipped+  with visibilities (that is, they are TyVars/TyCoVars instead of+  TyCoVarBinders).+* dcUserTyVarBinders, for the type variables binders in the order in which they+  originally arose in the user-written type signature. Their order *does* matter+  for TypeApplications, so they are full TyVarBinders, complete with+  visibilities.++This encoding has some redundancy. The set of tyvars in dcUserTyVarBinders+consists precisely of:++* The set of tyvars in dcUnivTyVars whose type variables do not appear in+  dcEqSpec, unioned with:+* The set of tyvars (*not* covars) in dcExTyCoVars+  No covars here because because they're not user-written++The word "set" is used above because the order in which the tyvars appear in+dcUserTyVarBinders can be completely different from the order in dcUnivTyVars or+dcExTyCoVars. That is, the tyvars in dcUserTyVarBinders are a permutation of+(tyvars of dcExTyCoVars + a subset of dcUnivTyVars). But aside from the+ordering, they in fact share the same type variables (with the same Uniques). We+sometimes refer to this as "the dcUserTyVarBinders invariant".++dcUserTyVarBinders, as the name suggests, is the one that users will see most of+the time. It's used when computing the type signature of a data constructor (see+dataConUserType), and as a result, it's what matters from a TypeApplications+perspective.+-}++-- | Data Constructor Representation+-- See Note [Data constructor workers and wrappers]+data DataConRep+  = -- NoDataConRep means that the data con has no wrapper+    NoDataConRep++    -- DCR means that the data con has a wrapper+  | DCR { dcr_wrap_id :: Id   -- Takes src args, unboxes/flattens,+                              -- and constructs the representation++        , dcr_boxer   :: DataConBoxer++        , dcr_arg_tys :: [Type]  -- Final, representation argument types,+                                 -- after unboxing and flattening,+                                 -- and *including* all evidence args++        , dcr_stricts :: [StrictnessMark]  -- 1-1 with dcr_arg_tys+                -- See also Note [Data-con worker strictness] in MkId.hs++        , dcr_bangs :: [HsImplBang]  -- The actual decisions made (including failures)+                                     -- about the original arguments; 1-1 with orig_arg_tys+                                     -- See Note [Bangs on data constructor arguments]++    }++-------------------------++-- | Haskell Source Bang+--+-- Bangs on data constructor arguments as the user wrote them in the+-- source code.+--+-- @(HsSrcBang _ SrcUnpack SrcLazy)@ and+-- @(HsSrcBang _ SrcUnpack NoSrcStrict)@ (without StrictData) makes no sense, we+-- emit a warning (in checkValidDataCon) and treat it like+-- @(HsSrcBang _ NoSrcUnpack SrcLazy)@+data HsSrcBang =+  HsSrcBang SourceText -- Note [Pragma source text] in BasicTypes+            SrcUnpackedness+            SrcStrictness+  deriving Data.Data++-- | Haskell Implementation Bang+--+-- Bangs of data constructor arguments as generated by the compiler+-- after consulting HsSrcBang, flags, etc.+data HsImplBang+  = HsLazy    -- ^ Lazy field, or one with an unlifted type+  | HsStrict  -- ^ Strict but not unpacked field+  | HsUnpack (Maybe Coercion)+    -- ^ Strict and unpacked field+    -- co :: arg-ty ~ product-ty HsBang+  deriving Data.Data++-- | Source Strictness+--+-- What strictness annotation the user wrote+data SrcStrictness = SrcLazy -- ^ Lazy, ie '~'+                   | SrcStrict -- ^ Strict, ie '!'+                   | NoSrcStrict -- ^ no strictness annotation+     deriving (Eq, Data.Data)++-- | Source Unpackedness+--+-- What unpackedness the user requested+data SrcUnpackedness = SrcUnpack -- ^ {-# UNPACK #-} specified+                     | SrcNoUnpack -- ^ {-# NOUNPACK #-} specified+                     | NoSrcUnpack -- ^ no unpack pragma+     deriving (Eq, Data.Data)++++-------------------------+-- StrictnessMark is internal only, used to indicate strictness+-- of the DataCon *worker* fields+data StrictnessMark = MarkedStrict | NotMarkedStrict++-- | An 'EqSpec' is a tyvar/type pair representing an equality made in+-- rejigging a GADT constructor+data EqSpec = EqSpec TyVar+                     Type++-- | Make a non-dependent 'EqSpec'+mkEqSpec :: TyVar -> Type -> EqSpec+mkEqSpec tv ty = EqSpec tv ty++eqSpecTyVar :: EqSpec -> TyVar+eqSpecTyVar (EqSpec tv _) = tv++eqSpecType :: EqSpec -> Type+eqSpecType (EqSpec _ ty) = ty++eqSpecPair :: EqSpec -> (TyVar, Type)+eqSpecPair (EqSpec tv ty) = (tv, ty)++eqSpecPreds :: [EqSpec] -> ThetaType+eqSpecPreds spec = [ mkPrimEqPred (mkTyVarTy tv) ty+                   | EqSpec tv ty <- spec ]++-- | Substitute in an 'EqSpec'. Precondition: if the LHS of the EqSpec+-- is mapped in the substitution, it is mapped to a type variable, not+-- a full type.+substEqSpec :: TCvSubst -> EqSpec -> EqSpec+substEqSpec subst (EqSpec tv ty)+  = EqSpec tv' (substTy subst ty)+  where+    tv' = getTyVar "substEqSpec" (substTyVar subst tv)++-- | Filter out any 'TyVar's mentioned in an 'EqSpec'.+filterEqSpec :: [EqSpec] -> [TyVar] -> [TyVar]+filterEqSpec eq_spec+  = filter not_in_eq_spec+  where+    not_in_eq_spec var = all (not . (== var) . eqSpecTyVar) eq_spec++instance Outputable EqSpec where+  ppr (EqSpec tv ty) = ppr (tv, ty)++{- Note [Bangs on data constructor arguments]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+  data T = MkT !Int {-# UNPACK #-} !Int Bool++When compiling the module, GHC will decide how to represent+MkT, depending on the optimisation level, and settings of+flags like -funbox-small-strict-fields.++Terminology:+  * HsSrcBang:  What the user wrote+                Constructors: HsSrcBang++  * HsImplBang: What GHC decided+                Constructors: HsLazy, HsStrict, HsUnpack++* If T was defined in this module, MkT's dcSrcBangs field+  records the [HsSrcBang] of what the user wrote; in the example+    [ HsSrcBang _ NoSrcUnpack SrcStrict+    , HsSrcBang _ SrcUnpack SrcStrict+    , HsSrcBang _ NoSrcUnpack NoSrcStrictness]++* However, if T was defined in an imported module, the importing module+  must follow the decisions made in the original module, regardless of+  the flag settings in the importing module.+  Also see Note [Bangs on imported data constructors] in MkId++* The dcr_bangs field of the dcRep field records the [HsImplBang]+  If T was defined in this module, Without -O the dcr_bangs might be+    [HsStrict, HsStrict, HsLazy]+  With -O it might be+    [HsStrict, HsUnpack _, HsLazy]+  With -funbox-small-strict-fields it might be+    [HsUnpack, HsUnpack _, HsLazy]+  With -XStrictData it might be+    [HsStrict, HsUnpack _, HsStrict]++Note [Data con representation]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The dcRepType field contains the type of the representation of a constructor+This may differ from the type of the constructor *Id* (built+by MkId.mkDataConId) for two reasons:+        a) the constructor Id may be overloaded, but the dictionary isn't stored+           e.g.    data Eq a => T a = MkT a a++        b) the constructor may store an unboxed version of a strict field.++Here's an example illustrating both:+        data Ord a => T a = MkT Int! a+Here+        T :: Ord a => Int -> a -> T a+but the rep type is+        Trep :: Int# -> a -> T a+Actually, the unboxed part isn't implemented yet!++++************************************************************************+*                                                                      *+\subsection{Instances}+*                                                                      *+************************************************************************+-}++instance Eq DataCon where+    a == b = getUnique a == getUnique b+    a /= b = getUnique a /= getUnique b++instance Uniquable DataCon where+    getUnique = dcUnique++instance NamedThing DataCon where+    getName = dcName++instance Outputable DataCon where+    ppr con = ppr (dataConName con)++instance OutputableBndr DataCon where+    pprInfixOcc con = pprInfixName (dataConName con)+    pprPrefixOcc con = pprPrefixName (dataConName con)++instance Data.Data DataCon where+    -- don't traverse?+    toConstr _   = abstractConstr "DataCon"+    gunfold _ _  = error "gunfold"+    dataTypeOf _ = mkNoRepType "DataCon"++instance Outputable HsSrcBang where+    ppr (HsSrcBang _ prag mark) = ppr prag <+> ppr mark++instance Outputable HsImplBang where+    ppr HsLazy                  = text "Lazy"+    ppr (HsUnpack Nothing)      = text "Unpacked"+    ppr (HsUnpack (Just co))    = text "Unpacked" <> parens (ppr co)+    ppr HsStrict                = text "StrictNotUnpacked"++instance Outputable SrcStrictness where+    ppr SrcLazy     = char '~'+    ppr SrcStrict   = char '!'+    ppr NoSrcStrict = empty++instance Outputable SrcUnpackedness where+    ppr SrcUnpack   = text "{-# UNPACK #-}"+    ppr SrcNoUnpack = text "{-# NOUNPACK #-}"+    ppr NoSrcUnpack = empty++instance Outputable StrictnessMark where+    ppr MarkedStrict    = text "!"+    ppr NotMarkedStrict = empty++instance Binary SrcStrictness where+    put_ bh SrcLazy     = putByte bh 0+    put_ bh SrcStrict   = putByte bh 1+    put_ bh NoSrcStrict = putByte bh 2++    get bh =+      do h <- getByte bh+         case h of+           0 -> return SrcLazy+           1 -> return SrcStrict+           _ -> return NoSrcStrict++instance Binary SrcUnpackedness where+    put_ bh SrcNoUnpack = putByte bh 0+    put_ bh SrcUnpack   = putByte bh 1+    put_ bh NoSrcUnpack = putByte bh 2++    get bh =+      do h <- getByte bh+         case h of+           0 -> return SrcNoUnpack+           1 -> return SrcUnpack+           _ -> return NoSrcUnpack++-- | Compare strictness annotations+eqHsBang :: HsImplBang -> HsImplBang -> Bool+eqHsBang HsLazy               HsLazy              = True+eqHsBang HsStrict             HsStrict            = True+eqHsBang (HsUnpack Nothing)   (HsUnpack Nothing)  = True+eqHsBang (HsUnpack (Just c1)) (HsUnpack (Just c2))+  = eqType (coercionType c1) (coercionType c2)+eqHsBang _ _                                       = False++isBanged :: HsImplBang -> Bool+isBanged (HsUnpack {}) = True+isBanged (HsStrict {}) = True+isBanged HsLazy        = False++isSrcStrict :: SrcStrictness -> Bool+isSrcStrict SrcStrict = True+isSrcStrict _ = False++isSrcUnpacked :: SrcUnpackedness -> Bool+isSrcUnpacked SrcUnpack = True+isSrcUnpacked _ = False++isMarkedStrict :: StrictnessMark -> Bool+isMarkedStrict NotMarkedStrict = False+isMarkedStrict _               = True   -- All others are strict++{- *********************************************************************+*                                                                      *+\subsection{Construction}+*                                                                      *+********************************************************************* -}++-- | Build a new data constructor+mkDataCon :: Name+          -> Bool           -- ^ Is the constructor declared infix?+          -> TyConRepName   -- ^  TyConRepName for the promoted TyCon+          -> [HsSrcBang]    -- ^ Strictness/unpack annotations, from user+          -> [FieldLabel]   -- ^ Field labels for the constructor,+                            -- if it is a record, otherwise empty+          -> [TyVar]        -- ^ Universals.+          -> [TyCoVar]      -- ^ Existentials.+          -> [TyVarBinder]  -- ^ User-written 'TyVarBinder's.+                            --   These must be Inferred/Specified.+                            --   See @Note [TyVarBinders in DataCons]@+          -> [EqSpec]       -- ^ GADT equalities+          -> KnotTied ThetaType -- ^ Theta-type occurring before the arguments proper+          -> [KnotTied Type]    -- ^ Original argument types+          -> KnotTied Type      -- ^ Original result type+          -> RuntimeRepInfo     -- ^ See comments on 'TyCon.RuntimeRepInfo'+          -> KnotTied TyCon     -- ^ Representation type constructor+          -> ConTag             -- ^ Constructor tag+          -> ThetaType          -- ^ The "stupid theta", context of the data+                                -- declaration e.g. @data Eq a => T a ...@+          -> Id                 -- ^ Worker Id+          -> DataConRep         -- ^ Representation+          -> DataCon+  -- Can get the tag from the TyCon++mkDataCon name declared_infix prom_info+          arg_stricts   -- Must match orig_arg_tys 1-1+          fields+          univ_tvs ex_tvs user_tvbs+          eq_spec theta+          orig_arg_tys orig_res_ty rep_info rep_tycon tag+          stupid_theta work_id rep+-- Warning: mkDataCon is not a good place to check certain invariants.+-- If the programmer writes the wrong result type in the decl, thus:+--      data T a where { MkT :: S }+-- then it's possible that the univ_tvs may hit an assertion failure+-- if you pull on univ_tvs.  This case is checked by checkValidDataCon,+-- so the error is detected properly... it's just that assertions here+-- are a little dodgy.++  = con+  where+    is_vanilla = null ex_tvs && null eq_spec && null theta++    con = MkData {dcName = name, dcUnique = nameUnique name,+                  dcVanilla = is_vanilla, dcInfix = declared_infix,+                  dcUnivTyVars = univ_tvs,+                  dcExTyCoVars = ex_tvs,+                  dcUserTyVarBinders = user_tvbs,+                  dcEqSpec = eq_spec,+                  dcOtherTheta = theta,+                  dcStupidTheta = stupid_theta,+                  dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,+                  dcRepTyCon = rep_tycon,+                  dcSrcBangs = arg_stricts,+                  dcFields = fields, dcTag = tag, dcRepType = rep_ty,+                  dcWorkId = work_id,+                  dcRep = rep,+                  dcSourceArity = length orig_arg_tys,+                  dcRepArity = length rep_arg_tys + count isCoVar ex_tvs,+                  dcPromoted = promoted }++        -- The 'arg_stricts' passed to mkDataCon are simply those for the+        -- source-language arguments.  We add extra ones for the+        -- dictionary arguments right here.++    rep_arg_tys = dataConRepArgTys con++    rep_ty =+      case rep of+        -- If the DataCon has no wrapper, then the worker's type *is* the+        -- user-facing type, so we can simply use dataConUserType.+        NoDataConRep -> dataConUserType con+        -- If the DataCon has a wrapper, then the worker's type is never seen+        -- by the user. The visibilities we pick do not matter here.+        DCR{} -> mkInvForAllTys univ_tvs $ mkTyCoInvForAllTys ex_tvs $+                 mkVisFunTys rep_arg_tys $+                 mkTyConApp rep_tycon (mkTyVarTys univ_tvs)++      -- See Note [Promoted data constructors] in TyCon+    prom_tv_bndrs = [ mkNamedTyConBinder vis tv+                    | Bndr tv vis <- user_tvbs ]++    fresh_names = freshNames (map getName user_tvbs)+      -- fresh_names: make sure that the "anonymous" tyvars don't+      -- clash in name or unique with the universal/existential ones.+      -- Tiresome!  And unnecessary because these tyvars are never looked at+    prom_theta_bndrs = [ mkAnonTyConBinder InvisArg (mkTyVar n t)+     {- Invisible -}   | (n,t) <- fresh_names `zip` theta ]+    prom_arg_bndrs   = [ mkAnonTyConBinder VisArg (mkTyVar n t)+     {- Visible -}     | (n,t) <- dropList theta fresh_names `zip` orig_arg_tys ]+    prom_bndrs       = prom_tv_bndrs ++ prom_theta_bndrs ++ prom_arg_bndrs+    prom_res_kind    = orig_res_ty+    promoted         = mkPromotedDataCon con name prom_info prom_bndrs+                                         prom_res_kind roles rep_info++    roles = map (\tv -> if isTyVar tv then Nominal else Phantom)+                (univ_tvs ++ ex_tvs)+            ++ map (const Representational) (theta ++ orig_arg_tys)++freshNames :: [Name] -> [Name]+-- Make an infinite list of Names whose Uniques and OccNames+-- differ from those in the 'avoid' list+freshNames avoids+  = [ mkSystemName uniq occ+    | n <- [0..]+    , let uniq = mkAlphaTyVarUnique n+          occ = mkTyVarOccFS (mkFastString ('x' : show n))++    , not (uniq `elementOfUniqSet` avoid_uniqs)+    , not (occ `elemOccSet` avoid_occs) ]++  where+    avoid_uniqs :: UniqSet Unique+    avoid_uniqs = mkUniqSet (map getUnique avoids)++    avoid_occs :: OccSet+    avoid_occs = mkOccSet (map getOccName avoids)++-- | The 'Name' of the 'DataCon', giving it a unique, rooted identification+dataConName :: DataCon -> Name+dataConName = dcName++-- | The tag used for ordering 'DataCon's+dataConTag :: DataCon -> ConTag+dataConTag  = dcTag++dataConTagZ :: DataCon -> ConTagZ+dataConTagZ con = dataConTag con - fIRST_TAG++-- | The type constructor that we are building via this data constructor+dataConTyCon :: DataCon -> TyCon+dataConTyCon = dcRepTyCon++-- | The original type constructor used in the definition of this data+-- constructor.  In case of a data family instance, that will be the family+-- type constructor.+dataConOrigTyCon :: DataCon -> TyCon+dataConOrigTyCon dc+  | Just (tc, _) <- tyConFamInst_maybe (dcRepTyCon dc) = tc+  | otherwise                                          = dcRepTyCon dc++-- | The representation type of the data constructor, i.e. the sort+-- type that will represent values of this type at runtime+dataConRepType :: DataCon -> Type+dataConRepType = dcRepType++-- | Should the 'DataCon' be presented infix?+dataConIsInfix :: DataCon -> Bool+dataConIsInfix = dcInfix++-- | The universally-quantified type variables of the constructor+dataConUnivTyVars :: DataCon -> [TyVar]+dataConUnivTyVars (MkData { dcUnivTyVars = tvbs }) = tvbs++-- | The existentially-quantified type/coercion variables of the constructor+-- including dependent (kind-) GADT equalities+dataConExTyCoVars :: DataCon -> [TyCoVar]+dataConExTyCoVars (MkData { dcExTyCoVars = tvbs }) = tvbs++-- | Both the universal and existential type/coercion variables of the constructor+dataConUnivAndExTyCoVars :: DataCon -> [TyCoVar]+dataConUnivAndExTyCoVars (MkData { dcUnivTyVars = univ_tvs, dcExTyCoVars = ex_tvs })+  = univ_tvs ++ ex_tvs++-- See Note [DataCon user type variable binders]+-- | The type variables of the constructor, in the order the user wrote them+dataConUserTyVars :: DataCon -> [TyVar]+dataConUserTyVars (MkData { dcUserTyVarBinders = tvbs }) = binderVars tvbs++-- See Note [DataCon user type variable binders]+-- | 'TyCoVarBinder's for the type variables of the constructor, in the order the+-- user wrote them+dataConUserTyVarBinders :: DataCon -> [TyVarBinder]+dataConUserTyVarBinders = dcUserTyVarBinders++-- | Equalities derived from the result type of the data constructor, as written+-- by the programmer in any GADT declaration. This includes *all* GADT-like+-- equalities, including those written in by hand by the programmer.+dataConEqSpec :: DataCon -> [EqSpec]+dataConEqSpec con@(MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })+  = dataConKindEqSpec con+    ++ eq_spec +++    [ spec   -- heterogeneous equality+    | Just (tc, [_k1, _k2, ty1, ty2]) <- map splitTyConApp_maybe theta+    , tc `hasKey` heqTyConKey+    , spec <- case (getTyVar_maybe ty1, getTyVar_maybe ty2) of+                    (Just tv1, _) -> [mkEqSpec tv1 ty2]+                    (_, Just tv2) -> [mkEqSpec tv2 ty1]+                    _             -> []+    ] +++    [ spec   -- homogeneous equality+    | Just (tc, [_k, ty1, ty2]) <- map splitTyConApp_maybe theta+    , tc `hasKey` eqTyConKey+    , spec <- case (getTyVar_maybe ty1, getTyVar_maybe ty2) of+                    (Just tv1, _) -> [mkEqSpec tv1 ty2]+                    (_, Just tv2) -> [mkEqSpec tv2 ty1]+                    _             -> []+    ]++-- | Dependent (kind-level) equalities in a constructor.+-- There are extracted from the existential variables.+-- See Note [Existential coercion variables]+dataConKindEqSpec :: DataCon -> [EqSpec]+dataConKindEqSpec (MkData {dcExTyCoVars = ex_tcvs})+  -- It is used in 'dataConEqSpec' (maybe also 'dataConFullSig' in the future),+  -- which are frequently used functions.+  -- For now (Aug 2018) this function always return empty set as we don't really+  -- have coercion variables.+  -- In the future when we do, we might want to cache this information in DataCon+  -- so it won't be computed every time when aforementioned functions are called.+  = [ EqSpec tv ty+    | cv <- ex_tcvs+    , isCoVar cv+    , let (_, _, ty1, ty, _) = coVarKindsTypesRole cv+          tv = getTyVar "dataConKindEqSpec" ty1+    ]++-- | The *full* constraints on the constructor type, including dependent GADT+-- equalities.+dataConTheta :: DataCon -> ThetaType+dataConTheta con@(MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })+  = eqSpecPreds (dataConKindEqSpec con ++ eq_spec) ++ theta++-- | Get the Id of the 'DataCon' worker: a function that is the "actual"+-- constructor and has no top level binding in the program. The type may+-- be different from the obvious one written in the source program. Panics+-- if there is no such 'Id' for this 'DataCon'+dataConWorkId :: DataCon -> Id+dataConWorkId dc = dcWorkId dc++-- | Get the Id of the 'DataCon' wrapper: a function that wraps the "actual"+-- constructor so it has the type visible in the source program: c.f.+-- 'dataConWorkId'.+-- Returns Nothing if there is no wrapper, which occurs for an algebraic data+-- constructor and also for a newtype (whose constructor is inlined+-- compulsorily)+dataConWrapId_maybe :: DataCon -> Maybe Id+dataConWrapId_maybe dc = case dcRep dc of+                           NoDataConRep -> Nothing+                           DCR { dcr_wrap_id = wrap_id } -> Just wrap_id++-- | Returns an Id which looks like the Haskell-source constructor by using+-- the wrapper if it exists (see 'dataConWrapId_maybe') and failing over to+-- the worker (see 'dataConWorkId')+dataConWrapId :: DataCon -> Id+dataConWrapId dc = case dcRep dc of+                     NoDataConRep-> dcWorkId dc    -- worker=wrapper+                     DCR { dcr_wrap_id = wrap_id } -> wrap_id++-- | Find all the 'Id's implicitly brought into scope by the data constructor. Currently,+-- the union of the 'dataConWorkId' and the 'dataConWrapId'+dataConImplicitTyThings :: DataCon -> [TyThing]+dataConImplicitTyThings (MkData { dcWorkId = work, dcRep = rep })+  = [AnId work] ++ wrap_ids+  where+    wrap_ids = case rep of+                 NoDataConRep               -> []+                 DCR { dcr_wrap_id = wrap } -> [AnId wrap]++-- | The labels for the fields of this particular 'DataCon'+dataConFieldLabels :: DataCon -> [FieldLabel]+dataConFieldLabels = dcFields++-- | Extract the type for any given labelled field of the 'DataCon'+dataConFieldType :: DataCon -> FieldLabelString -> Type+dataConFieldType con label = case dataConFieldType_maybe con label of+      Just (_, ty) -> ty+      Nothing      -> pprPanic "dataConFieldType" (ppr con <+> ppr label)++-- | Extract the label and type for any given labelled field of the+-- 'DataCon', or return 'Nothing' if the field does not belong to it+dataConFieldType_maybe :: DataCon -> FieldLabelString+                       -> Maybe (FieldLabel, Type)+dataConFieldType_maybe con label+  = find ((== label) . flLabel . fst) (dcFields con `zip` dcOrigArgTys con)++-- | Strictness/unpack annotations, from user; or, for imported+-- DataCons, from the interface file+-- The list is in one-to-one correspondence with the arity of the 'DataCon'++dataConSrcBangs :: DataCon -> [HsSrcBang]+dataConSrcBangs = dcSrcBangs++-- | Source-level arity of the data constructor+dataConSourceArity :: DataCon -> Arity+dataConSourceArity (MkData { dcSourceArity = arity }) = arity++-- | Gives the number of actual fields in the /representation/ of the+-- data constructor. This may be more than appear in the source code;+-- the extra ones are the existentially quantified dictionaries+dataConRepArity :: DataCon -> Arity+dataConRepArity (MkData { dcRepArity = arity }) = arity++-- | Return whether there are any argument types for this 'DataCon's original source type+-- See Note [DataCon arities]+isNullarySrcDataCon :: DataCon -> Bool+isNullarySrcDataCon dc = dataConSourceArity dc == 0++-- | Return whether there are any argument types for this 'DataCon's runtime representation type+-- See Note [DataCon arities]+isNullaryRepDataCon :: DataCon -> Bool+isNullaryRepDataCon dc = dataConRepArity dc == 0++dataConRepStrictness :: DataCon -> [StrictnessMark]+-- ^ Give the demands on the arguments of a+-- Core constructor application (Con dc args)+dataConRepStrictness dc = case dcRep dc of+                            NoDataConRep -> [NotMarkedStrict | _ <- dataConRepArgTys dc]+                            DCR { dcr_stricts = strs } -> strs++dataConImplBangs :: DataCon -> [HsImplBang]+-- The implementation decisions about the strictness/unpack of each+-- source program argument to the data constructor+dataConImplBangs dc+  = case dcRep dc of+      NoDataConRep              -> replicate (dcSourceArity dc) HsLazy+      DCR { dcr_bangs = bangs } -> bangs++dataConBoxer :: DataCon -> Maybe DataConBoxer+dataConBoxer (MkData { dcRep = DCR { dcr_boxer = boxer } }) = Just boxer+dataConBoxer _ = Nothing++-- | The \"signature\" of the 'DataCon' returns, in order:+--+-- 1) The result of 'dataConUnivAndExTyCoVars',+--+-- 2) All the 'ThetaType's relating to the 'DataCon' (coercion, dictionary,+--    implicit parameter - whatever), including dependent GADT equalities.+--    Dependent GADT equalities are *also* listed in return value (1), so be+--    careful!+--+-- 3) The type arguments to the constructor+--+-- 4) The /original/ result type of the 'DataCon'+dataConSig :: DataCon -> ([TyCoVar], ThetaType, [Type], Type)+dataConSig con@(MkData {dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})+  = (dataConUnivAndExTyCoVars con, dataConTheta con, arg_tys, res_ty)++dataConInstSig+  :: DataCon+  -> [Type]    -- Instantiate the *universal* tyvars with these types+  -> ([TyCoVar], ThetaType, [Type])  -- Return instantiated existentials+                                     -- theta and arg tys+-- ^ Instantiate the universal tyvars of a data con,+--   returning+--     ( instantiated existentials+--     , instantiated constraints including dependent GADT equalities+--         which are *also* listed in the instantiated existentials+--     , instantiated args)+dataConInstSig con@(MkData { dcUnivTyVars = univ_tvs, dcExTyCoVars = ex_tvs+                           , dcOrigArgTys = arg_tys })+               univ_tys+  = ( ex_tvs'+    , substTheta subst (dataConTheta con)+    , substTys   subst arg_tys)+  where+    univ_subst = zipTvSubst univ_tvs univ_tys+    (subst, ex_tvs') = Type.substVarBndrs univ_subst ex_tvs+++-- | The \"full signature\" of the 'DataCon' returns, in order:+--+-- 1) The result of 'dataConUnivTyVars'+--+-- 2) The result of 'dataConExTyCoVars'+--+-- 3) The non-dependent GADT equalities.+--    Dependent GADT equalities are implied by coercion variables in+--    return value (2).+--+-- 4) The other constraints of the data constructor type, excluding GADT+-- equalities+--+-- 5) The original argument types to the 'DataCon' (i.e. before+--    any change of the representation of the type)+--+-- 6) The original result type of the 'DataCon'+dataConFullSig :: DataCon+               -> ([TyVar], [TyCoVar], [EqSpec], ThetaType, [Type], Type)+dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyCoVars = ex_tvs,+                        dcEqSpec = eq_spec, dcOtherTheta = theta,+                        dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})+  = (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty)++dataConOrigResTy :: DataCon -> Type+dataConOrigResTy dc = dcOrigResTy dc++-- | The \"stupid theta\" of the 'DataCon', such as @data Eq a@ in:+--+-- > data Eq a => T a = ...+dataConStupidTheta :: DataCon -> ThetaType+dataConStupidTheta dc = dcStupidTheta dc++dataConUserType :: DataCon -> Type+-- ^ The user-declared type of the data constructor+-- in the nice-to-read form:+--+-- > T :: forall a b. a -> b -> T [a]+--+-- rather than:+--+-- > T :: forall a c. forall b. (c~[a]) => a -> b -> T c+--+-- The type variables are quantified in the order that the user wrote them.+-- See @Note [DataCon user type variable binders]@.+--+-- NB: If the constructor is part of a data instance, the result type+-- mentions the family tycon, not the internal one.+dataConUserType (MkData { dcUserTyVarBinders = user_tvbs,+                          dcOtherTheta = theta, dcOrigArgTys = arg_tys,+                          dcOrigResTy = res_ty })+  = mkForAllTys user_tvbs $+    mkInvisFunTys theta $+    mkVisFunTys arg_tys $+    res_ty++-- | Finds the instantiated types of the arguments required to construct a+-- 'DataCon' representation+-- NB: these INCLUDE any dictionary args+--     but EXCLUDE the data-declaration context, which is discarded+-- It's all post-flattening etc; this is a representation type+dataConInstArgTys :: DataCon    -- ^ A datacon with no existentials or equality constraints+                                -- However, it can have a dcTheta (notably it can be a+                                -- class dictionary, with superclasses)+                  -> [Type]     -- ^ Instantiated at these types+                  -> [Type]+dataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs,+                              dcExTyCoVars = ex_tvs}) inst_tys+ = ASSERT2( univ_tvs `equalLength` inst_tys+          , text "dataConInstArgTys" <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)+   ASSERT2( null ex_tvs, ppr dc )+   map (substTyWith univ_tvs inst_tys) (dataConRepArgTys dc)++-- | Returns just the instantiated /value/ argument types of a 'DataCon',+-- (excluding dictionary args)+dataConInstOrigArgTys+        :: DataCon      -- Works for any DataCon+        -> [Type]       -- Includes existential tyvar args, but NOT+                        -- equality constraints or dicts+        -> [Type]+-- For vanilla datacons, it's all quite straightforward+-- But for the call in MatchCon, we really do want just the value args+dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,+                                  dcUnivTyVars = univ_tvs,+                                  dcExTyCoVars = ex_tvs}) inst_tys+  = ASSERT2( tyvars `equalLength` inst_tys+           , text "dataConInstOrigArgTys" <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )+    map (substTy subst) arg_tys+  where+    tyvars = univ_tvs ++ ex_tvs+    subst  = zipTCvSubst tyvars inst_tys++-- | Returns the argument types of the wrapper, excluding all dictionary arguments+-- and without substituting for any type variables+dataConOrigArgTys :: DataCon -> [Type]+dataConOrigArgTys dc = dcOrigArgTys dc++-- | Returns the arg types of the worker, including *all* non-dependent+-- evidence, after any flattening has been done and without substituting for+-- any type variables+dataConRepArgTys :: DataCon -> [Type]+dataConRepArgTys (MkData { dcRep = rep+                         , dcEqSpec = eq_spec+                         , dcOtherTheta = theta+                         , dcOrigArgTys = orig_arg_tys })+  = case rep of+      NoDataConRep -> ASSERT( null eq_spec ) theta ++ orig_arg_tys+      DCR { dcr_arg_tys = arg_tys } -> arg_tys++-- | The string @package:module.name@ identifying a constructor, which is attached+-- to its info table and used by the GHCi debugger and the heap profiler+dataConIdentity :: DataCon -> ByteString+-- We want this string to be UTF-8, so we get the bytes directly from the FastStrings.+dataConIdentity dc = LBS.toStrict $ BSB.toLazyByteString $ mconcat+   [ BSB.byteString $ bytesFS (unitIdFS (moduleUnitId mod))+   , BSB.int8 $ fromIntegral (ord ':')+   , BSB.byteString $ bytesFS (moduleNameFS (moduleName mod))+   , BSB.int8 $ fromIntegral (ord '.')+   , BSB.byteString $ bytesFS (occNameFS (nameOccName name))+   ]+  where name = dataConName dc+        mod  = ASSERT( isExternalName name ) nameModule name++isTupleDataCon :: DataCon -> Bool+isTupleDataCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc++isUnboxedTupleCon :: DataCon -> Bool+isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc++isUnboxedSumCon :: DataCon -> Bool+isUnboxedSumCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc++-- | Vanilla 'DataCon's are those that are nice boring Haskell 98 constructors+isVanillaDataCon :: DataCon -> Bool+isVanillaDataCon dc = dcVanilla dc++-- | Should this DataCon be allowed in a type even without -XDataKinds?+-- Currently, only Lifted & Unlifted+specialPromotedDc :: DataCon -> Bool+specialPromotedDc = isKindTyCon . dataConTyCon++classDataCon :: Class -> DataCon+classDataCon clas = case tyConDataCons (classTyCon clas) of+                      (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr+                      [] -> panic "classDataCon"++dataConCannotMatch :: [Type] -> DataCon -> Bool+-- Returns True iff the data con *definitely cannot* match a+--                  scrutinee of type (T tys)+--                  where T is the dcRepTyCon for the data con+dataConCannotMatch tys con+  | null inst_theta   = False   -- Common+  | all isTyVarTy tys = False   -- Also common+  | otherwise         = typesCantMatch (concatMap predEqs inst_theta)+  where+    (_, inst_theta, _) = dataConInstSig con tys++    -- TODO: could gather equalities from superclasses too+    predEqs pred = case classifyPredType pred of+                     EqPred NomEq ty1 ty2         -> [(ty1, ty2)]+                     ClassPred eq args+                       | eq `hasKey` eqTyConKey+                       , [_, ty1, ty2] <- args    -> [(ty1, ty2)]+                       | eq `hasKey` heqTyConKey+                       , [_, _, ty1, ty2] <- args -> [(ty1, ty2)]+                     _                            -> []++-- | Were the type variables of the data con written in a different order+-- than the regular order (universal tyvars followed by existential tyvars)?+--+-- This is not a cheap test, so we minimize its use in GHC as much as possible.+-- Currently, its only call site in the GHC codebase is in 'mkDataConRep' in+-- "MkId", and so 'dataConUserTyVarsArePermuted' is only called at most once+-- during a data constructor's lifetime.++-- See Note [DataCon user type variable binders], as well as+-- Note [Data con wrappers and GADT syntax] for an explanation of what+-- mkDataConRep is doing with this function.+dataConUserTyVarsArePermuted :: DataCon -> Bool+dataConUserTyVarsArePermuted (MkData { dcUnivTyVars = univ_tvs+                                     , dcExTyCoVars = ex_tvs, dcEqSpec = eq_spec+                                     , dcUserTyVarBinders = user_tvbs }) =+  (filterEqSpec eq_spec univ_tvs ++ ex_tvs) /= binderVars user_tvbs++{-+%************************************************************************+%*                                                                      *+        Promoting of data types to the kind level+*                                                                      *+************************************************************************++-}++promoteDataCon :: DataCon -> TyCon+promoteDataCon (MkData { dcPromoted = tc }) = tc++{-+************************************************************************+*                                                                      *+\subsection{Splitting products}+*                                                                      *+************************************************************************+-}++-- | Extract the type constructor, type argument, data constructor and it's+-- /representation/ argument types from a type if it is a product type.+--+-- Precisely, we return @Just@ for any type that is all of:+--+--  * Concrete (i.e. constructors visible)+--+--  * Single-constructor+--+--  * Not existentially quantified+--+-- Whether the type is a @data@ type or a @newtype@+splitDataProductType_maybe+        :: Type                         -- ^ A product type, perhaps+        -> Maybe (TyCon,                -- The type constructor+                  [Type],               -- Type args of the tycon+                  DataCon,              -- The data constructor+                  [Type])               -- Its /representation/ arg types++        -- Rejecting existentials is conservative.  Maybe some things+        -- could be made to work with them, but I'm not going to sweat+        -- it through till someone finds it's important.++splitDataProductType_maybe ty+  | Just (tycon, ty_args) <- splitTyConApp_maybe ty+  , Just con <- isDataProductTyCon_maybe tycon+  = Just (tycon, ty_args, con, dataConInstArgTys con ty_args)+  | otherwise+  = Nothing++{-+************************************************************************+*                                                                      *+              Building an algebraic data type+*                                                                      *+************************************************************************++buildAlgTyCon is here because it is called from TysWiredIn, which can+depend on this module, but not on BuildTyCl.+-}++buildAlgTyCon :: Name+              -> [TyVar]               -- ^ Kind variables and type variables+              -> [Role]+              -> Maybe CType+              -> ThetaType             -- ^ Stupid theta+              -> AlgTyConRhs+              -> Bool                  -- ^ True <=> was declared in GADT syntax+              -> AlgTyConFlav+              -> TyCon++buildAlgTyCon tc_name ktvs roles cType stupid_theta rhs+              gadt_syn parent+  = mkAlgTyCon tc_name binders liftedTypeKind roles cType stupid_theta+               rhs parent gadt_syn+  where+    binders = mkTyConBindersPreferAnon ktvs emptyVarSet++buildSynTyCon :: Name -> [KnotTied TyConBinder] -> Kind   -- ^ /result/ kind+              -> [Role] -> KnotTied Type -> TyCon+buildSynTyCon name binders res_kind roles rhs+  = mkSynonymTyCon name binders res_kind roles rhs is_tau is_fam_free+  where+    is_tau      = isTauTy rhs+    is_fam_free = isFamFreeTy rhs
+ compiler/basicTypes/DataCon.hs-boot view
@@ -0,0 +1,34 @@+module DataCon where++import GhcPrelude+import Var( TyVar, TyCoVar, TyVarBinder )+import Name( Name, NamedThing )+import {-# SOURCE #-} TyCon( TyCon )+import FieldLabel ( FieldLabel )+import Unique ( Uniquable )+import Outputable ( Outputable, OutputableBndr )+import BasicTypes (Arity)+import {-# SOURCE #-} TyCoRep ( Type, ThetaType )++data DataCon+data DataConRep+data EqSpec++dataConName      :: DataCon -> Name+dataConTyCon     :: DataCon -> TyCon+dataConExTyCoVars :: DataCon -> [TyCoVar]+dataConUserTyVars :: DataCon -> [TyVar]+dataConUserTyVarBinders :: DataCon -> [TyVarBinder]+dataConSourceArity  :: DataCon -> Arity+dataConFieldLabels :: DataCon -> [FieldLabel]+dataConInstOrigArgTys  :: DataCon -> [Type] -> [Type]+dataConStupidTheta :: DataCon -> ThetaType+dataConFullSig :: DataCon+               -> ([TyVar], [TyCoVar], [EqSpec], ThetaType, [Type], Type)+isUnboxedSumCon :: DataCon -> Bool++instance Eq DataCon+instance Uniquable DataCon+instance NamedThing DataCon+instance Outputable DataCon+instance OutputableBndr DataCon
+ compiler/basicTypes/Demand.hs view
@@ -0,0 +1,2038 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[Demand]{@Demand@: A decoupled implementation of a demand domain}+-}++{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances, RecordWildCards #-}++module Demand (+        StrDmd, UseDmd(..), Count,++        Demand, DmdShell, CleanDemand, getStrDmd, getUseDmd,+        mkProdDmd, mkOnceUsedDmd, mkManyUsedDmd, mkHeadStrict, oneifyDmd,+        toCleanDmd,+        absDmd, topDmd, botDmd, seqDmd,+        lubDmd, bothDmd,+        lazyApply1Dmd, lazyApply2Dmd, strictApply1Dmd,+        isTopDmd, isAbsDmd, isSeqDmd,+        peelUseCall, cleanUseDmd_maybe, strictenDmd, bothCleanDmd,+        addCaseBndrDmd,++        DmdType(..), dmdTypeDepth, lubDmdType, bothDmdType,+        nopDmdType, botDmdType, mkDmdType,+        addDemand, removeDmdTyArgs,+        BothDmdArg, mkBothDmdArg, toBothDmdArg,++        DmdEnv, emptyDmdEnv,+        peelFV, findIdDemand,++        DmdResult, CPRResult,+        isBotRes, isTopRes,+        topRes, botRes, cprProdRes,+        vanillaCprProdRes, cprSumRes,+        appIsBottom, isBottomingSig, pprIfaceStrictSig,+        trimCPRInfo, returnsCPR_maybe,+        StrictSig(..), mkStrictSig, mkClosedStrictSig,+        nopSig, botSig, cprProdSig,+        isTopSig, hasDemandEnvSig,+        splitStrictSig, strictSigDmdEnv,+        increaseStrictSigArity, etaExpandStrictSig,++        seqDemand, seqDemandList, seqDmdType, seqStrictSig,++        evalDmd, cleanEvalDmd, cleanEvalProdDmd, isStrictDmd,+        splitDmdTy, splitFVs,+        deferAfterIO,+        postProcessUnsat, postProcessDmdType,++        splitProdDmd_maybe, peelCallDmd, peelManyCalls, mkCallDmd,+        mkWorkerDemand, dmdTransformSig, dmdTransformDataConSig,+        dmdTransformDictSelSig, argOneShots, argsOneShots, saturatedByOneShots,+        trimToType, TypeShape(..),++        useCount, isUsedOnce, reuseEnv,+        killUsageDemand, killUsageSig, zapUsageDemand, zapUsageEnvSig,+        zapUsedOnceDemand, zapUsedOnceSig,+        strictifyDictDmd, strictifyDmd++     ) where++#include "HsVersions.h"++import GhcPrelude++import DynFlags+import Outputable+import Var ( Var )+import VarEnv+import UniqFM+import Util+import BasicTypes+import Binary+import Maybes           ( orElse )++import Type            ( Type )+import TyCon           ( isNewTyCon, isClassTyCon )+import DataCon         ( splitDataProductType_maybe )++{-+************************************************************************+*                                                                      *+        Joint domain for Strictness and Absence+*                                                                      *+************************************************************************+-}++data JointDmd s u = JD { sd :: s, ud :: u }+  deriving ( Eq, Show )++getStrDmd :: JointDmd s u -> s+getStrDmd = sd++getUseDmd :: JointDmd s u -> u+getUseDmd = ud++-- Pretty-printing+instance (Outputable s, Outputable u) => Outputable (JointDmd s u) where+  ppr (JD {sd = s, ud = u}) = angleBrackets (ppr s <> char ',' <> ppr u)++-- Well-formedness preserving constructors for the joint domain+mkJointDmd :: s -> u -> JointDmd s u+mkJointDmd s u = JD { sd = s, ud = u }++mkJointDmds :: [s] -> [u] -> [JointDmd s u]+mkJointDmds ss as = zipWithEqual "mkJointDmds" mkJointDmd ss as+++{-+************************************************************************+*                                                                      *+            Strictness domain+*                                                                      *+************************************************************************++          Lazy+           |+        HeadStr+        /     \+    SCall      SProd+        \     /+        HyperStr++Note [Exceptions and strictness]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We used to smart about catching exceptions, but we aren't anymore.+See #14998 for the way it's resolved at the moment.++Here's a historic breakdown:++Apparently, exception handling prim-ops didn't use to have any special+strictness signatures, thus defaulting to topSig, which assumes they use their+arguments lazily. Joachim was the first to realise that we could provide richer+information. Thus, in 0558911f91c (Dec 13), he added signatures to+primops.txt.pp indicating that functions like `catch#` and `catchRetry#` call+their argument, which is useful information for usage analysis. Still with a+'Lazy' strictness demand (i.e. 'lazyApply1Dmd'), though, and the world was fine.++In 7c0fff4 (July 15), Simon argued that giving `catch#` et al. a+'strictApply1Dmd' leads to substantial performance gains. That was at the cost+of correctness, as #10712 proved. So, back to 'lazyApply1Dmd' in+28638dfe79e (Dec 15).++Motivated to reproduce the gains of 7c0fff4 without the breakage of #10712,+Ben opened #11222. Simon made the demand analyser "understand catch" in+9915b656 (Jan 16) by adding a new 'catchArgDmd', which basically said to call+its argument strictly, but also swallow any thrown exceptions in+'postProcessDmdResult'. This was realized by extending the 'Str' constructor of+'ArgStr' with a 'ExnStr' field, indicating that it catches the exception, and+adding a 'ThrowsExn' constructor to the 'Termination' lattice as an element+between 'Dunno' and 'Diverges'. Then along came #11555 and finally #13330,+so we had to revert to 'lazyApply1Dmd' again in 701256df88c (Mar 17).++This left the other variants like 'catchRetry#' having 'catchArgDmd', which is+where #14998 picked up. Item 1 was concerned with measuring the impact of also+making `catchRetry#` and `catchSTM#` have 'lazyApply1Dmd'. The result was that+there was none. We removed the last usages of 'catchArgDmd' in 00b8ecb7+(Apr 18). There was a lot of dead code resulting from that change, that we+removed in ef6b283 (Jan 19): We got rid of 'ThrowsExn' and 'ExnStr' again and+removed any code that was dealing with the peculiarities.++Where did the speed-ups vanish to? In #14998, item 3 established that+turning 'catch#' strict in its first argument didn't bring back any of the+alleged performance benefits. Item 2 of that ticket finally found out that it+was entirely due to 'catchException's new (since #11555) definition, which+was simply++    catchException !io handler = catch io handler++While 'catchException' is arguably the saner semantics for 'catch', it is an+internal helper function in "GHC.IO". Its use in+"GHC.IO.Handle.Internals.do_operation" made for the huge allocation differences:+Remove the bang and you find the regressions we originally wanted to avoid with+'catchArgDmd'. See also #exceptions_and_strictness# in "GHC.IO".++So history keeps telling us that the only possibly correct strictness annotation+for the first argument of 'catch#' is 'lazyApply1Dmd', because 'catch#' really+is not strict in its argument: Just try this in GHCi++  :set -XScopedTypeVariables+  import Control.Exception+  catch undefined (\(_ :: SomeException) -> putStrLn "you'll see this")++Any analysis that assumes otherwise will be broken in some way or another+(beyond `-fno-pendantic-bottoms`).+-}++-- | Vanilla strictness domain+data StrDmd+  = HyperStr             -- ^ Hyper-strict (bottom of the lattice).+                         -- See Note [HyperStr and Use demands]++  | SCall StrDmd         -- ^ Call demand+                         -- Used only for values of function type++  | SProd [ArgStr]       -- ^ Product+                         -- Used only for values of product type+                         -- Invariant: not all components are HyperStr (use HyperStr)+                         --            not all components are Lazy     (use HeadStr)++  | HeadStr              -- ^ Head-Strict+                         -- A polymorphic demand: used for values of all types,+                         --                       including a type variable++  deriving ( Eq, Show )++-- | Strictness of a function argument.+type ArgStr = Str StrDmd++-- | Strictness demand.+data Str s = Lazy  -- ^ Lazy (top of the lattice)+           | Str s -- ^ Strict+  deriving ( Eq, Show )++-- Well-formedness preserving constructors for the Strictness domain+strBot, strTop :: ArgStr+strBot = Str HyperStr+strTop = Lazy++mkSCall :: StrDmd -> StrDmd+mkSCall HyperStr = HyperStr+mkSCall s        = SCall s++mkSProd :: [ArgStr] -> StrDmd+mkSProd sx+  | any isHyperStr sx = HyperStr+  | all isLazy     sx = HeadStr+  | otherwise         = SProd sx++isLazy :: ArgStr -> Bool+isLazy Lazy     = True+isLazy (Str {}) = False++isHyperStr :: ArgStr -> Bool+isHyperStr (Str HyperStr) = True+isHyperStr _              = False++-- Pretty-printing+instance Outputable StrDmd where+  ppr HyperStr      = char 'B'+  ppr (SCall s)     = char 'C' <> parens (ppr s)+  ppr HeadStr       = char 'S'+  ppr (SProd sx)    = char 'S' <> parens (hcat (map ppr sx))++instance Outputable ArgStr where+  ppr (Str s) = ppr s+  ppr Lazy    = char 'L'++lubArgStr :: ArgStr -> ArgStr -> ArgStr+lubArgStr Lazy     _        = Lazy+lubArgStr _        Lazy     = Lazy+lubArgStr (Str s1) (Str s2) = Str (s1 `lubStr` s2)++lubStr :: StrDmd -> StrDmd -> StrDmd+lubStr HyperStr s              = s+lubStr (SCall s1) HyperStr     = SCall s1+lubStr (SCall _)  HeadStr      = HeadStr+lubStr (SCall s1) (SCall s2)   = SCall (s1 `lubStr` s2)+lubStr (SCall _)  (SProd _)    = HeadStr+lubStr (SProd sx) HyperStr     = SProd sx+lubStr (SProd _)  HeadStr      = HeadStr+lubStr (SProd s1) (SProd s2)+    | s1 `equalLength` s2      = mkSProd (zipWith lubArgStr s1 s2)+    | otherwise                = HeadStr+lubStr (SProd _) (SCall _)     = HeadStr+lubStr HeadStr   _             = HeadStr++bothArgStr :: ArgStr -> ArgStr -> ArgStr+bothArgStr Lazy     s        = s+bothArgStr s        Lazy     = s+bothArgStr (Str s1) (Str s2) = Str (s1 `bothStr` s2)++bothStr :: StrDmd -> StrDmd -> StrDmd+bothStr HyperStr _             = HyperStr+bothStr HeadStr s              = s+bothStr (SCall _)  HyperStr    = HyperStr+bothStr (SCall s1) HeadStr     = SCall s1+bothStr (SCall s1) (SCall s2)  = SCall (s1 `bothStr` s2)+bothStr (SCall _)  (SProd _)   = HyperStr  -- Weird++bothStr (SProd _)  HyperStr    = HyperStr+bothStr (SProd s1) HeadStr     = SProd s1+bothStr (SProd s1) (SProd s2)+    | s1 `equalLength` s2      = mkSProd (zipWith bothArgStr s1 s2)+    | otherwise                = HyperStr  -- Weird+bothStr (SProd _) (SCall _)    = HyperStr++-- utility functions to deal with memory leaks+seqStrDmd :: StrDmd -> ()+seqStrDmd (SProd ds)   = seqStrDmdList ds+seqStrDmd (SCall s)    = seqStrDmd s+seqStrDmd _            = ()++seqStrDmdList :: [ArgStr] -> ()+seqStrDmdList [] = ()+seqStrDmdList (d:ds) = seqArgStr d `seq` seqStrDmdList ds++seqArgStr :: ArgStr -> ()+seqArgStr Lazy    = ()+seqArgStr (Str s) = seqStrDmd s++-- Splitting polymorphic demands+splitArgStrProdDmd :: Int -> ArgStr -> Maybe [ArgStr]+splitArgStrProdDmd n Lazy    = Just (replicate n Lazy)+splitArgStrProdDmd n (Str s) = splitStrProdDmd n s++splitStrProdDmd :: Int -> StrDmd -> Maybe [ArgStr]+splitStrProdDmd n HyperStr   = Just (replicate n strBot)+splitStrProdDmd n HeadStr    = Just (replicate n strTop)+splitStrProdDmd n (SProd ds) = WARN( not (ds `lengthIs` n),+                                     text "splitStrProdDmd" $$ ppr n $$ ppr ds )+                               Just ds+splitStrProdDmd _ (SCall {}) = Nothing+      -- This can happen when the programmer uses unsafeCoerce,+      -- and we don't then want to crash the compiler (#9208)++{-+************************************************************************+*                                                                      *+            Absence domain+*                                                                      *+************************************************************************++         Used+         /   \+     UCall   UProd+         \   /+         UHead+          |+  Count x -+        |+       Abs+-}++-- | Domain for genuine usage+data UseDmd+  = UCall Count UseDmd   -- ^ Call demand for absence.+                         -- Used only for values of function type++  | UProd [ArgUse]       -- ^ Product.+                         -- Used only for values of product type+                         -- See Note [Don't optimise UProd(Used) to Used]+                         --+                         -- Invariant: Not all components are Abs+                         -- (in that case, use UHead)++  | UHead                -- ^ May be used but its sub-components are+                         -- definitely *not* used.  For product types, UHead+                         -- is equivalent to U(AAA); see mkUProd.+                         --+                         -- UHead is needed only to express the demand+                         -- of 'seq' and 'case' which are polymorphic;+                         -- i.e. the scrutinised value is of type 'a'+                         -- rather than a product type. That's why we+                         -- can't use UProd [A,A,A]+                         --+                         -- Since (UCall _ Abs) is ill-typed, UHead doesn't+                         -- make sense for lambdas++  | Used                 -- ^ May be used and its sub-components may be used.+                         -- (top of the lattice)+  deriving ( Eq, Show )++-- Extended usage demand for absence and counting+type ArgUse = Use UseDmd++data Use u+  = Abs             -- Definitely unused+                    -- Bottom of the lattice++  | Use Count u     -- May be used with some cardinality+  deriving ( Eq, Show )++-- | Abstract counting of usages+data Count = One | Many+  deriving ( Eq, Show )++-- Pretty-printing+instance Outputable ArgUse where+  ppr Abs           = char 'A'+  ppr (Use Many a)   = ppr a+  ppr (Use One  a)   = char '1' <> char '*' <> ppr a++instance Outputable UseDmd where+  ppr Used           = char 'U'+  ppr (UCall c a)    = char 'C' <> ppr c <> parens (ppr a)+  ppr UHead          = char 'H'+  ppr (UProd as)     = char 'U' <> parens (hcat (punctuate (char ',') (map ppr as)))++instance Outputable Count where+  ppr One  = char '1'+  ppr Many = text ""++useBot, useTop :: ArgUse+useBot     = Abs+useTop     = Use Many Used++mkUCall :: Count -> UseDmd -> UseDmd+--mkUCall c Used = Used c+mkUCall c a  = UCall c a++mkUProd :: [ArgUse] -> UseDmd+mkUProd ux+  | all (== Abs) ux    = UHead+  | otherwise          = UProd ux++lubCount :: Count -> Count -> Count+lubCount _ Many = Many+lubCount Many _ = Many+lubCount x _    = x++lubArgUse :: ArgUse -> ArgUse -> ArgUse+lubArgUse Abs x                   = x+lubArgUse x Abs                   = x+lubArgUse (Use c1 a1) (Use c2 a2) = Use (lubCount c1 c2) (lubUse a1 a2)++lubUse :: UseDmd -> UseDmd -> UseDmd+lubUse UHead       u               = u+lubUse (UCall c u) UHead           = UCall c u+lubUse (UCall c1 u1) (UCall c2 u2) = UCall (lubCount c1 c2) (lubUse u1 u2)+lubUse (UCall _ _) _               = Used+lubUse (UProd ux) UHead            = UProd ux+lubUse (UProd ux1) (UProd ux2)+     | ux1 `equalLength` ux2       = UProd $ zipWith lubArgUse ux1 ux2+     | otherwise                   = Used+lubUse (UProd {}) (UCall {})       = Used+-- lubUse (UProd {}) Used             = Used+lubUse (UProd ux) Used             = UProd (map (`lubArgUse` useTop) ux)+lubUse Used       (UProd ux)       = UProd (map (`lubArgUse` useTop) ux)+lubUse Used _                      = Used  -- Note [Used should win]++-- `both` is different from `lub` in its treatment of counting; if+-- `both` is computed for two used, the result always has+--  cardinality `Many` (except for the inner demands of UCall demand -- [TODO] explain).+--  Also,  x `bothUse` x /= x (for anything but Abs).++bothArgUse :: ArgUse -> ArgUse -> ArgUse+bothArgUse Abs x                   = x+bothArgUse x Abs                   = x+bothArgUse (Use _ a1) (Use _ a2)   = Use Many (bothUse a1 a2)+++bothUse :: UseDmd -> UseDmd -> UseDmd+bothUse UHead       u               = u+bothUse (UCall c u) UHead           = UCall c u++-- Exciting special treatment of inner demand for call demands:+--    use `lubUse` instead of `bothUse`!+bothUse (UCall _ u1) (UCall _ u2)   = UCall Many (u1 `lubUse` u2)++bothUse (UCall {}) _                = Used+bothUse (UProd ux) UHead            = UProd ux+bothUse (UProd ux1) (UProd ux2)+      | ux1 `equalLength` ux2       = UProd $ zipWith bothArgUse ux1 ux2+      | otherwise                   = Used+bothUse (UProd {}) (UCall {})       = Used+-- bothUse (UProd {}) Used             = Used  -- Note [Used should win]+bothUse Used (UProd ux)             = UProd (map (`bothArgUse` useTop) ux)+bothUse (UProd ux) Used             = UProd (map (`bothArgUse` useTop) ux)+bothUse Used _                      = Used  -- Note [Used should win]++peelUseCall :: UseDmd -> Maybe (Count, UseDmd)+peelUseCall (UCall c u)   = Just (c,u)+peelUseCall _             = Nothing++addCaseBndrDmd :: Demand    -- On the case binder+               -> [Demand]  -- On the components of the constructor+               -> [Demand]  -- Final demands for the components of the constructor+-- See Note [Demand on case-alternative binders]+addCaseBndrDmd (JD { sd = ms, ud = mu }) alt_dmds+  = case mu of+     Abs     -> alt_dmds+     Use _ u -> zipWith bothDmd alt_dmds (mkJointDmds ss us)+             where+                Just ss = splitArgStrProdDmd arity ms  -- Guaranteed not to be a call+                Just us = splitUseProdDmd      arity u   -- Ditto+  where+    arity = length alt_dmds++{- Note [Demand on case-alternative binders]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The demand on a binder in a case alternative comes+  (a) From the demand on the binder itself+  (b) From the demand on the case binder+Forgetting (b) led directly to #10148.++Example. Source code:+  f x@(p,_) = if p then foo x else True++  foo (p,True) = True+  foo (p,q)    = foo (q,p)++After strictness analysis:+  f = \ (x_an1 [Dmd=<S(SL),1*U(U,1*U)>] :: (Bool, Bool)) ->+      case x_an1+      of wild_X7 [Dmd=<L,1*U(1*U,1*U)>]+      { (p_an2 [Dmd=<S,1*U>], ds_dnz [Dmd=<L,A>]) ->+      case p_an2 of _ {+        False -> GHC.Types.True;+        True -> foo wild_X7 }++It's true that ds_dnz is *itself* absent, but the use of wild_X7 means+that it is very much alive and demanded.  See #10148 for how the+consequences play out.++This is needed even for non-product types, in case the case-binder+is used but the components of the case alternative are not.++Note [Don't optimise UProd(Used) to Used]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+These two UseDmds:+   UProd [Used, Used]   and    Used+are semantically equivalent, but we do not turn the former into+the latter, for a regrettable-subtle reason.  Suppose we did.+then+  f (x,y) = (y,x)+would get+  StrDmd = Str  = SProd [Lazy, Lazy]+  UseDmd = Used = UProd [Used, Used]+But with the joint demand of <Str, Used> doesn't convey any clue+that there is a product involved, and so the worthSplittingFun+will not fire.  (We'd need to use the type as well to make it fire.)+Moreover, consider+  g h p@(_,_) = h p+This too would get <Str, Used>, but this time there really isn't any+point in w/w since the components of the pair are not used at all.++So the solution is: don't aggressively collapse UProd [Used,Used] to+Used; intead leave it as-is. In effect we are using the UseDmd to do a+little bit of boxity analysis.  Not very nice.++Note [Used should win]+~~~~~~~~~~~~~~~~~~~~~~+Both in lubUse and bothUse we want (Used `both` UProd us) to be Used.+Why?  Because Used carries the implication the whole thing is used,+box and all, so we don't want to w/w it.  If we use it both boxed and+unboxed, then we are definitely using the box, and so we are quite+likely to pay a reboxing cost.  So we make Used win here.++Example is in the Buffer argument of GHC.IO.Handle.Internals.writeCharBuffer++Baseline: (A) Not making Used win (UProd wins)+Compare with: (B) making Used win for lub and both++            Min          -0.3%     -5.6%    -10.7%    -11.0%    -33.3%+            Max          +0.3%    +45.6%    +11.5%    +11.5%     +6.9%+ Geometric Mean          -0.0%     +0.5%     +0.3%     +0.2%     -0.8%++Baseline: (B) Making Used win for both lub and both+Compare with: (C) making Used win for both, but UProd win for lub++            Min          -0.1%     -0.3%     -7.9%     -8.0%     -6.5%+            Max          +0.1%     +1.0%    +21.0%    +21.0%     +0.5%+ Geometric Mean          +0.0%     +0.0%     -0.0%     -0.1%     -0.1%+-}++-- If a demand is used multiple times (i.e. reused), than any use-once+-- mentioned there, that is not protected by a UCall, can happen many times.+markReusedDmd :: ArgUse -> ArgUse+markReusedDmd Abs         = Abs+markReusedDmd (Use _ a)   = Use Many (markReused a)++markReused :: UseDmd -> UseDmd+markReused (UCall _ u)      = UCall Many u   -- No need to recurse here+markReused (UProd ux)       = UProd (map markReusedDmd ux)+markReused u                = u++isUsedMU :: ArgUse -> Bool+-- True <=> markReusedDmd d = d+isUsedMU Abs          = True+isUsedMU (Use One _)  = False+isUsedMU (Use Many u) = isUsedU u++isUsedU :: UseDmd -> Bool+-- True <=> markReused d = d+isUsedU Used           = True+isUsedU UHead          = True+isUsedU (UProd us)     = all isUsedMU us+isUsedU (UCall One _)  = False+isUsedU (UCall Many _) = True  -- No need to recurse++-- Squashing usage demand demands+seqUseDmd :: UseDmd -> ()+seqUseDmd (UProd ds)   = seqArgUseList ds+seqUseDmd (UCall c d)  = c `seq` seqUseDmd d+seqUseDmd _            = ()++seqArgUseList :: [ArgUse] -> ()+seqArgUseList []     = ()+seqArgUseList (d:ds) = seqArgUse d `seq` seqArgUseList ds++seqArgUse :: ArgUse -> ()+seqArgUse (Use c u)  = c `seq` seqUseDmd u+seqArgUse _          = ()++-- Splitting polymorphic Maybe-Used demands+splitUseProdDmd :: Int -> UseDmd -> Maybe [ArgUse]+splitUseProdDmd n Used        = Just (replicate n useTop)+splitUseProdDmd n UHead       = Just (replicate n Abs)+splitUseProdDmd n (UProd ds)  = WARN( not (ds `lengthIs` n),+                                      text "splitUseProdDmd" $$ ppr n+                                                             $$ ppr ds )+                                Just ds+splitUseProdDmd _ (UCall _ _) = Nothing+      -- This can happen when the programmer uses unsafeCoerce,+      -- and we don't then want to crash the compiler (#9208)++useCount :: Use u -> Count+useCount Abs         = One+useCount (Use One _) = One+useCount _           = Many+++{-+************************************************************************+*                                                                      *+         Clean demand for Strictness and Usage+*                                                                      *+************************************************************************++This domain differst from JointDemand in the sence that pure absence+is taken away, i.e., we deal *only* with non-absent demands.++Note [Strict demands]+~~~~~~~~~~~~~~~~~~~~~+isStrictDmd returns true only of demands that are+   both strict+   and  used+In particular, it is False for <HyperStr, Abs>, which can and does+arise in, say (#7319)+   f x = raise# <some exception>+Then 'x' is not used, so f gets strictness <HyperStr,Abs> -> .+Now the w/w generates+   fx = let x <HyperStr,Abs> = absentError "unused"+        in raise <some exception>+At this point we really don't want to convert to+   fx = case absentError "unused" of x -> raise <some exception>+Since the program is going to diverge, this swaps one error for another,+but it's really a bad idea to *ever* evaluate an absent argument.+In #7319 we get+   T7319.exe: Oops!  Entered absent arg w_s1Hd{v} [lid] [base:GHC.Base.String{tc 36u}]++Note [Dealing with call demands]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Call demands are constructed and deconstructed coherently for+strictness and absence. For instance, the strictness signature for the+following function++f :: (Int -> (Int, Int)) -> (Int, Bool)+f g = (snd (g 3), True)++should be: <L,C(U(AU))>m+-}++type CleanDemand = JointDmd StrDmd UseDmd+     -- A demand that is at least head-strict++bothCleanDmd :: CleanDemand -> CleanDemand -> CleanDemand+bothCleanDmd (JD { sd = s1, ud = a1}) (JD { sd = s2, ud = a2})+  = JD { sd = s1 `bothStr` s2, ud = a1 `bothUse` a2 }++mkHeadStrict :: CleanDemand -> CleanDemand+mkHeadStrict cd = cd { sd = HeadStr }++mkOnceUsedDmd, mkManyUsedDmd :: CleanDemand -> Demand+mkOnceUsedDmd (JD {sd = s,ud = a}) = JD { sd = Str s, ud = Use One a }+mkManyUsedDmd (JD {sd = s,ud = a}) = JD { sd = Str s, ud = Use Many a }++evalDmd :: Demand+-- Evaluated strictly, and used arbitrarily deeply+evalDmd = JD { sd = Str HeadStr, ud = useTop }++mkProdDmd :: [Demand] -> CleanDemand+mkProdDmd dx+  = JD { sd = mkSProd $ map getStrDmd dx+       , ud = mkUProd $ map getUseDmd dx }++mkCallDmd :: CleanDemand -> CleanDemand+mkCallDmd (JD {sd = d, ud = u})+  = JD { sd = mkSCall d, ud = mkUCall One u }++-- See Note [Demand on the worker] in WorkWrap+mkWorkerDemand :: Int -> Demand+mkWorkerDemand n = JD { sd = Lazy, ud = Use One (go n) }+  where go 0 = Used+        go n = mkUCall One $ go (n-1)++cleanEvalDmd :: CleanDemand+cleanEvalDmd = JD { sd = HeadStr, ud = Used }++cleanEvalProdDmd :: Arity -> CleanDemand+cleanEvalProdDmd n = JD { sd = HeadStr, ud = UProd (replicate n useTop) }+++{-+************************************************************************+*                                                                      *+           Demand: combining stricness and usage+*                                                                      *+************************************************************************+-}++type Demand = JointDmd ArgStr ArgUse++lubDmd :: Demand -> Demand -> Demand+lubDmd (JD {sd = s1, ud = a1}) (JD {sd = s2, ud = a2})+ = JD { sd = s1 `lubArgStr` s2+      , ud = a1 `lubArgUse` a2 }++bothDmd :: Demand -> Demand -> Demand+bothDmd (JD {sd = s1, ud = a1}) (JD {sd = s2, ud = a2})+ = JD { sd = s1 `bothArgStr` s2+      , ud = a1 `bothArgUse` a2 }++lazyApply1Dmd, lazyApply2Dmd, strictApply1Dmd :: Demand++strictApply1Dmd = JD { sd = Str (SCall HeadStr)+                     , ud = Use Many (UCall One Used) }++lazyApply1Dmd = JD { sd = Lazy+                   , ud = Use One (UCall One Used) }++-- Second argument of catch#:+--    uses its arg at most once, applies it once+--    but is lazy (might not be called at all)+lazyApply2Dmd = JD { sd = Lazy+                   , ud = Use One (UCall One (UCall One Used)) }++absDmd :: Demand+absDmd = JD { sd = Lazy, ud = Abs }++topDmd :: Demand+topDmd = JD { sd = Lazy, ud = useTop }++botDmd :: Demand+botDmd = JD { sd = strBot, ud = useBot }++seqDmd :: Demand+seqDmd = JD { sd = Str HeadStr, ud = Use One UHead }++oneifyDmd :: JointDmd s (Use u) -> JointDmd s (Use u)+oneifyDmd (JD { sd = s, ud = Use _ a }) = JD { sd = s, ud = Use One a }+oneifyDmd jd                            = jd++isTopDmd :: Demand -> Bool+-- Used to suppress pretty-printing of an uninformative demand+isTopDmd (JD {sd = Lazy, ud = Use Many Used}) = True+isTopDmd _                                    = False++isAbsDmd :: JointDmd (Str s) (Use u) -> Bool+isAbsDmd (JD {ud = Abs}) = True   -- The strictness part can be HyperStr+isAbsDmd _               = False  -- for a bottom demand++isSeqDmd :: Demand -> Bool+isSeqDmd (JD {sd = Str HeadStr, ud = Use _ UHead}) = True+isSeqDmd _                                                = False++isUsedOnce :: JointDmd (Str s) (Use u) -> Bool+isUsedOnce (JD { ud = a }) = case useCount a of+                               One  -> True+                               Many -> False++-- More utility functions for strictness+seqDemand :: Demand -> ()+seqDemand (JD {sd = s, ud = u}) = seqArgStr s `seq` seqArgUse u++seqDemandList :: [Demand] -> ()+seqDemandList [] = ()+seqDemandList (d:ds) = seqDemand d `seq` seqDemandList ds++isStrictDmd :: JointDmd (Str s) (Use u) -> Bool+-- See Note [Strict demands]+isStrictDmd (JD {ud = Abs})  = False+isStrictDmd (JD {sd = Lazy}) = False+isStrictDmd _                = True++isWeakDmd :: Demand -> Bool+isWeakDmd (JD {sd = s, ud = a}) = isLazy s && isUsedMU a++cleanUseDmd_maybe :: Demand -> Maybe UseDmd+cleanUseDmd_maybe (JD { ud = Use _ u }) = Just u+cleanUseDmd_maybe _                     = Nothing++splitFVs :: Bool   -- Thunk+         -> DmdEnv -> (DmdEnv, DmdEnv)+splitFVs is_thunk rhs_fvs+  | is_thunk  = nonDetFoldUFM_Directly add (emptyVarEnv, emptyVarEnv) rhs_fvs+                -- It's OK to use nonDetFoldUFM_Directly because we+                -- immediately forget the ordering by putting the elements+                -- in the envs again+  | otherwise = partitionVarEnv isWeakDmd rhs_fvs+  where+    add uniq dmd@(JD { sd = s, ud = u }) (lazy_fv, sig_fv)+      | Lazy <- s = (addToUFM_Directly lazy_fv uniq dmd, sig_fv)+      | otherwise = ( addToUFM_Directly lazy_fv uniq (JD { sd = Lazy, ud = u })+                    , addToUFM_Directly sig_fv  uniq (JD { sd = s,    ud = Abs }) )++data TypeShape = TsFun TypeShape+               | TsProd [TypeShape]+               | TsUnk++instance Outputable TypeShape where+  ppr TsUnk        = text "TsUnk"+  ppr (TsFun ts)   = text "TsFun" <> parens (ppr ts)+  ppr (TsProd tss) = parens (hsep $ punctuate comma $ map ppr tss)++trimToType :: Demand -> TypeShape -> Demand+-- See Note [Trimming a demand to a type]+trimToType (JD { sd = ms, ud = mu }) ts+  = JD (go_ms ms ts) (go_mu mu ts)+  where+    go_ms :: ArgStr -> TypeShape -> ArgStr+    go_ms Lazy    _  = Lazy+    go_ms (Str s) ts = Str (go_s s ts)++    go_s :: StrDmd -> TypeShape -> StrDmd+    go_s HyperStr    _            = HyperStr+    go_s (SCall s)   (TsFun ts)   = SCall (go_s s ts)+    go_s (SProd mss) (TsProd tss)+      | equalLength mss tss       = SProd (zipWith go_ms mss tss)+    go_s _           _            = HeadStr++    go_mu :: ArgUse -> TypeShape -> ArgUse+    go_mu Abs _ = Abs+    go_mu (Use c u) ts = Use c (go_u u ts)++    go_u :: UseDmd -> TypeShape -> UseDmd+    go_u UHead       _          = UHead+    go_u (UCall c u) (TsFun ts) = UCall c (go_u u ts)+    go_u (UProd mus) (TsProd tss)+      | equalLength mus tss      = UProd (zipWith go_mu mus tss)+    go_u _           _           = Used++{-+Note [Trimming a demand to a type]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider this:++  f :: a -> Bool+  f x = case ... of+          A g1 -> case (x |> g1) of (p,q) -> ...+          B    -> error "urk"++where A,B are the constructors of a GADT.  We'll get a U(U,U) demand+on x from the A branch, but that's a stupid demand for x itself, which+has type 'a'. Indeed we get ASSERTs going off (notably in+splitUseProdDmd, #8569).++Bottom line: we really don't want to have a binder whose demand is more+deeply-nested than its type.  There are various ways to tackle this.+When processing (x |> g1), we could "trim" the incoming demand U(U,U)+to match x's type.  But I'm currently doing so just at the moment when+we pin a demand on a binder, in DmdAnal.findBndrDmd.+++Note [Threshold demands]+~~~~~~~~~~~~~~~~~~~~~~~~+Threshold usage demand is generated to figure out if+cardinality-instrumented demands of a binding's free variables should+be unleashed. See also [Aggregated demand for cardinality].++Note [Replicating polymorphic demands]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Some demands can be considered as polymorphic. Generally, it is+applicable to such beasts as tops, bottoms as well as Head-Used and+Head-stricts demands. For instance,++S ~ S(L, ..., L)++Also, when top or bottom is occurred as a result demand, it in fact+can be expanded to saturate a callee's arity.+-}++splitProdDmd_maybe :: Demand -> Maybe [Demand]+-- Split a product into its components, iff there is any+-- useful information to be extracted thereby+-- The demand is not necessarily strict!+splitProdDmd_maybe (JD { sd = s, ud = u })+  = case (s,u) of+      (Str (SProd sx), Use _ u) | Just ux <- splitUseProdDmd (length sx) u+                                -> Just (mkJointDmds sx ux)+      (Str s, Use _ (UProd ux)) | Just sx <- splitStrProdDmd (length ux) s+                                -> Just (mkJointDmds sx ux)+      (Lazy,  Use _ (UProd ux)) -> Just (mkJointDmds (replicate (length ux) Lazy) ux)+      _ -> Nothing++{-+************************************************************************+*                                                                      *+                   Demand results+*                                                                      *+************************************************************************+++DmdResult:     Dunno CPRResult+               /+          Diverges+++CPRResult:         NoCPR+                   /    \+            RetProd    RetSum ConTag+++Product constructors return (Dunno (RetProd rs))+In a fixpoint iteration, start from Diverges+We have lubs, but not glbs; but that is ok.+-}++------------------------------------------------------------------------+-- Constructed Product Result+------------------------------------------------------------------------++data Termination r+  = Diverges    -- Definitely diverges+  | Dunno r     -- Might diverge or converge+  deriving( Eq, Show )++-- At this point, Termination is just the 'Lifted' lattice over 'r'+-- (https://hackage.haskell.org/package/lattices/docs/Algebra-Lattice-Lifted.html)++type DmdResult = Termination CPRResult++data CPRResult = NoCPR          -- Top of the lattice+               | RetProd        -- Returns a constructor from a product type+               | RetSum ConTag  -- Returns a constructor from a data type+               deriving( Eq, Show )++lubCPR :: CPRResult -> CPRResult -> CPRResult+lubCPR (RetSum t1) (RetSum t2)+  | t1 == t2                       = RetSum t1+lubCPR RetProd     RetProd     = RetProd+lubCPR _ _                     = NoCPR++lubDmdResult :: DmdResult -> DmdResult -> DmdResult+lubDmdResult Diverges       r              = r+lubDmdResult r              Diverges       = r+lubDmdResult (Dunno c1)     (Dunno c2)     = Dunno (c1 `lubCPR` c2)+-- This needs to commute with defaultDmd, i.e.+-- defaultDmd (r1 `lubDmdResult` r2) = defaultDmd r1 `lubDmd` defaultDmd r2+-- (See Note [Default demand on free variables] for why)++bothDmdResult :: DmdResult -> Termination () -> DmdResult+-- See Note [Asymmetry of 'both' for DmdType and DmdResult]+bothDmdResult _ Diverges   = Diverges+bothDmdResult r (Dunno {}) = r+-- This needs to commute with defaultDmd, i.e.+-- defaultDmd (r1 `bothDmdResult` r2) = defaultDmd r1 `bothDmd` defaultDmd r2+-- (See Note [Default demand on free variables] for why)++instance Outputable r => Outputable (Termination r) where+  ppr Diverges      = char 'b'+  ppr (Dunno c)     = ppr c++instance Outputable CPRResult where+  ppr NoCPR        = empty+  ppr (RetSum n)   = char 'm' <> int n+  ppr RetProd      = char 'm'++seqDmdResult :: DmdResult -> ()+seqDmdResult Diverges  = ()+seqDmdResult (Dunno c) = seqCPRResult c++seqCPRResult :: CPRResult -> ()+seqCPRResult NoCPR        = ()+seqCPRResult (RetSum n)   = n `seq` ()+seqCPRResult RetProd      = ()+++------------------------------------------------------------------------+-- Combined demand result                                             --+------------------------------------------------------------------------++-- [cprRes] lets us switch off CPR analysis+-- by making sure that everything uses TopRes+topRes, botRes :: DmdResult+topRes = Dunno NoCPR+botRes = Diverges++cprSumRes :: ConTag -> DmdResult+cprSumRes tag = Dunno $ RetSum tag++cprProdRes :: [DmdType] -> DmdResult+cprProdRes _arg_tys = Dunno $ RetProd++vanillaCprProdRes :: Arity -> DmdResult+vanillaCprProdRes _arity = Dunno $ RetProd++isTopRes :: DmdResult -> Bool+isTopRes (Dunno NoCPR) = True+isTopRes _             = False++-- | True if the result diverges or throws an exception+isBotRes :: DmdResult -> Bool+isBotRes Diverges   = True+isBotRes (Dunno {}) = False++trimCPRInfo :: Bool -> Bool -> DmdResult -> DmdResult+trimCPRInfo trim_all trim_sums res+  = trimR res+  where+    trimR (Dunno c) = Dunno (trimC c)+    trimR res       = res++    trimC (RetSum n)   | trim_all || trim_sums = NoCPR+                       | otherwise             = RetSum n+    trimC RetProd      | trim_all  = NoCPR+                       | otherwise = RetProd+    trimC NoCPR = NoCPR++returnsCPR_maybe :: DmdResult -> Maybe ConTag+returnsCPR_maybe (Dunno c) = retCPR_maybe c+returnsCPR_maybe _         = Nothing++retCPR_maybe :: CPRResult -> Maybe ConTag+retCPR_maybe (RetSum t)  = Just t+retCPR_maybe RetProd     = Just fIRST_TAG+retCPR_maybe NoCPR       = Nothing++-- See Notes [Default demand on free variables]+-- and [defaultDmd vs. resTypeArgDmd]+defaultDmd :: Termination r -> Demand+defaultDmd (Dunno {}) = absDmd+defaultDmd _          = botDmd  -- Diverges++resTypeArgDmd :: Termination r -> Demand+-- TopRes and BotRes are polymorphic, so that+--      BotRes === (Bot -> BotRes) === ...+--      TopRes === (Top -> TopRes) === ...+-- This function makes that concrete+-- Also see Note [defaultDmd vs. resTypeArgDmd]+resTypeArgDmd (Dunno _) = topDmd+resTypeArgDmd _         = botDmd   -- Diverges++{-+Note [defaultDmd and resTypeArgDmd]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++These functions are similar: They express the demand on something not+explicitly mentioned in the environment resp. the argument list. Yet they are+different:+ * Variables not mentioned in the free variables environment are definitely+   unused, so we can use absDmd there.+ * Further arguments *can* be used, of course. Hence topDmd is used.+++************************************************************************+*                                                                      *+           Demand environments and types+*                                                                      *+************************************************************************+-}++type DmdEnv = VarEnv Demand   -- See Note [Default demand on free variables]++data DmdType = DmdType+                  DmdEnv        -- Demand on explicitly-mentioned+                                --      free variables+                  [Demand]      -- Demand on arguments+                  DmdResult     -- See [Nature of result demand]++{-+Note [Nature of result demand]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A DmdResult contains information about termination (currently distinguishing+definite divergence and no information; it is possible to include definite+convergence here), and CPR information about the result.++The semantics of this depends on whether we are looking at a DmdType, i.e. the+demand put on by an expression _under a specific incoming demand_ on its+environment, or at a StrictSig describing a demand transformer.++For a+ * DmdType, the termination information is true given the demand it was+   generated with, while for+ * a StrictSig it holds after applying enough arguments.++The CPR information, though, is valid after the number of arguments mentioned+in the type is given. Therefore, when forgetting the demand on arguments, as in+dmdAnalRhs, this needs to be considere (via removeDmdTyArgs).++Consider+  b2 x y = x `seq` y `seq` error (show x)+this has a strictness signature of+  <S><S>b+meaning that "b2 `seq` ()" and "b2 1 `seq` ()" might well terminate, but+for "b2 1 2 `seq` ()" we get definite divergence.++For comparison,+  b1 x = x `seq` error (show x)+has a strictness signature of+  <S>b+and "b1 1 `seq` ()" is known to terminate.++Now consider a function h with signature "<C(S)>", and the expression+  e1 = h b1+now h puts a demand of <C(S)> onto its argument, and the demand transformer+turns it into+  <S>b+Now the DmdResult "b" does apply to us, even though "b1 `seq` ()" does not+diverge, and we do not anything being passed to b.++Note [Asymmetry of 'both' for DmdType and DmdResult]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+'both' for DmdTypes is *asymmetrical*, because there is only one+result!  For example, given (e1 e2), we get a DmdType dt1 for e1, use+its arg demand to analyse e2 giving dt2, and then do (dt1 `bothType` dt2).+Similarly with+  case e of { p -> rhs }+we get dt_scrut from the scrutinee and dt_rhs from the RHS, and then+compute (dt_rhs `bothType` dt_scrut).++We+ 1. combine the information on the free variables,+ 2. take the demand on arguments from the first argument+ 3. combine the termination results, but+ 4. take CPR info from the first argument.++3 and 4 are implementd in bothDmdResult.+-}++-- Equality needed for fixpoints in DmdAnal+instance Eq DmdType where+  (==) (DmdType fv1 ds1 res1)+       (DmdType fv2 ds2 res2) = nonDetUFMToList fv1 == nonDetUFMToList fv2+         -- It's OK to use nonDetUFMToList here because we're testing for+         -- equality and even though the lists will be in some arbitrary+         -- Unique order, it is the same order for both+                              && ds1 == ds2 && res1 == res2++lubDmdType :: DmdType -> DmdType -> DmdType+lubDmdType d1 d2+  = DmdType lub_fv lub_ds lub_res+  where+    n = max (dmdTypeDepth d1) (dmdTypeDepth d2)+    (DmdType fv1 ds1 r1) = ensureArgs n d1+    (DmdType fv2 ds2 r2) = ensureArgs n d2++    lub_fv  = plusVarEnv_CD lubDmd fv1 (defaultDmd r1) fv2 (defaultDmd r2)+    lub_ds  = zipWithEqual "lubDmdType" lubDmd ds1 ds2+    lub_res = lubDmdResult r1 r2++{-+Note [The need for BothDmdArg]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Previously, the right argument to bothDmdType, as well as the return value of+dmdAnalStar via postProcessDmdType, was a DmdType. But bothDmdType only needs+to know about the free variables and termination information, but nothing about+the demand put on arguments, nor cpr information. So we make that explicit by+only passing the relevant information.+-}++type BothDmdArg = (DmdEnv, Termination ())++mkBothDmdArg :: DmdEnv -> BothDmdArg+mkBothDmdArg env = (env, Dunno ())++toBothDmdArg :: DmdType -> BothDmdArg+toBothDmdArg (DmdType fv _ r) = (fv, go r)+  where+    go (Dunno {}) = Dunno ()+    go Diverges   = Diverges++bothDmdType :: DmdType -> BothDmdArg -> DmdType+bothDmdType (DmdType fv1 ds1 r1) (fv2, t2)+    -- See Note [Asymmetry of 'both' for DmdType and DmdResult]+    -- 'both' takes the argument/result info from its *first* arg,+    -- using its second arg just for its free-var info.+  = DmdType (plusVarEnv_CD bothDmd fv1 (defaultDmd r1) fv2 (defaultDmd t2))+            ds1+            (r1 `bothDmdResult` t2)++instance Outputable DmdType where+  ppr (DmdType fv ds res)+    = hsep [hcat (map ppr ds) <> ppr res,+            if null fv_elts then empty+            else braces (fsep (map pp_elt fv_elts))]+    where+      pp_elt (uniq, dmd) = ppr uniq <> text "->" <> ppr dmd+      fv_elts = nonDetUFMToList fv+        -- It's OK to use nonDetUFMToList here because we only do it for+        -- pretty printing++emptyDmdEnv :: VarEnv Demand+emptyDmdEnv = emptyVarEnv++-- nopDmdType is the demand of doing nothing+-- (lazy, absent, no CPR information, no termination information).+-- Note that it is ''not'' the top of the lattice (which would be "may use everything"),+-- so it is (no longer) called topDmd+nopDmdType, botDmdType :: DmdType+nopDmdType = DmdType emptyDmdEnv [] topRes+botDmdType = DmdType emptyDmdEnv [] botRes++cprProdDmdType :: Arity -> DmdType+cprProdDmdType arity+  = DmdType emptyDmdEnv [] (vanillaCprProdRes arity)++isTopDmdType :: DmdType -> Bool+isTopDmdType (DmdType env [] res)+  | isTopRes res && isEmptyVarEnv env = True+isTopDmdType _                        = False++mkDmdType :: DmdEnv -> [Demand] -> DmdResult -> DmdType+mkDmdType fv ds res = DmdType fv ds res++dmdTypeDepth :: DmdType -> Arity+dmdTypeDepth (DmdType _ ds _) = length ds++-- Remove any demand on arguments. This is used in dmdAnalRhs on the body+removeDmdTyArgs :: DmdType -> DmdType+removeDmdTyArgs = ensureArgs 0++-- This makes sure we can use the demand type with n arguments,+-- It extends the argument list with the correct resTypeArgDmd+-- It also adjusts the DmdResult: Divergence survives additional arguments,+-- CPR information does not (and definite converge also would not).+ensureArgs :: Arity -> DmdType -> DmdType+ensureArgs n d | n == depth = d+               | otherwise  = DmdType fv ds' r'+  where depth = dmdTypeDepth d+        DmdType fv ds r = d++        ds' = take n (ds ++ repeat (resTypeArgDmd r))+        r' = case r of    -- See [Nature of result demand]+              Dunno _ -> topRes+              _       -> r+++seqDmdType :: DmdType -> ()+seqDmdType (DmdType env ds res) =+  seqDmdEnv env `seq` seqDemandList ds `seq` seqDmdResult res `seq` ()++seqDmdEnv :: DmdEnv -> ()+seqDmdEnv env = seqEltsUFM seqDemandList env++splitDmdTy :: DmdType -> (Demand, DmdType)+-- Split off one function argument+-- We already have a suitable demand on all+-- free vars, so no need to add more!+splitDmdTy (DmdType fv (dmd:dmds) res_ty) = (dmd, DmdType fv dmds res_ty)+splitDmdTy ty@(DmdType _ [] res_ty)       = (resTypeArgDmd res_ty, ty)++-- When e is evaluated after executing an IO action, and d is e's demand, then+-- what of this demand should we consider, given that the IO action can cleanly+-- exit?+-- * We have to kill all strictness demands (i.e. lub with a lazy demand)+-- * We can keep usage information (i.e. lub with an absent demand)+-- * We have to kill definite divergence+-- * We can keep CPR information.+-- See Note [IO hack in the demand analyser] in DmdAnal+deferAfterIO :: DmdType -> DmdType+deferAfterIO d@(DmdType _ _ res) =+    case d `lubDmdType` nopDmdType of+        DmdType fv ds _ -> DmdType fv ds (defer_res res)+  where+  defer_res r@(Dunno {}) = r+  defer_res _            = topRes  -- Diverges++strictenDmd :: Demand -> CleanDemand+strictenDmd (JD { sd = s, ud = u})+  = JD { sd = poke_s s, ud = poke_u u }+  where+    poke_s Lazy      = HeadStr+    poke_s (Str s)   = s+    poke_u Abs       = UHead+    poke_u (Use _ u) = u++-- Deferring and peeling++type DmdShell   -- Describes the "outer shell"+                -- of a Demand+   = JointDmd (Str ()) (Use ())++toCleanDmd :: Demand -> (DmdShell, CleanDemand)+-- Splits a Demand into its "shell" and the inner "clean demand"+toCleanDmd (JD { sd = s, ud = u })+  = (JD { sd = ss, ud = us }, JD { sd = s', ud = u' })+    -- See Note [Analyzing with lazy demand and lambdas]+    -- See Note [Analysing with absent demand]+  where+    (ss, s') = case s of+                Str s' -> (Str (), s')+                Lazy   -> (Lazy,   HeadStr)++    (us, u') = case u of+                 Use c u' -> (Use c (), u')+                 Abs      -> (Abs,      Used)++-- This is used in dmdAnalStar when post-processing+-- a function's argument demand. So we only care about what+-- does to free variables, and whether it terminates.+-- see Note [The need for BothDmdArg]+postProcessDmdType :: DmdShell -> DmdType -> BothDmdArg+postProcessDmdType du@(JD { sd = ss }) (DmdType fv _ res_ty)+    = (postProcessDmdEnv du fv, term_info)+    where+       term_info = case postProcessDmdResult ss res_ty of+                     Dunno _   -> Dunno ()+                     Diverges  -> Diverges++postProcessDmdResult :: Str () -> DmdResult -> DmdResult+postProcessDmdResult Lazy _   = topRes+postProcessDmdResult _    res = res++postProcessDmdEnv :: DmdShell -> DmdEnv -> DmdEnv+postProcessDmdEnv ds@(JD { sd = ss, ud = us }) env+  | Abs <- us       = emptyDmdEnv+    -- In this case (postProcessDmd ds) == id; avoid a redundant rebuild+    -- of the environment. Be careful, bad things will happen if this doesn't+    -- match postProcessDmd (see #13977).+  | Str _ <- ss+  , Use One _ <- us = env+  | otherwise       = mapVarEnv (postProcessDmd ds) env+  -- For the Absent case just discard all usage information+  -- We only processed the thing at all to analyse the body+  -- See Note [Always analyse in virgin pass]++reuseEnv :: DmdEnv -> DmdEnv+reuseEnv = mapVarEnv (postProcessDmd+                        (JD { sd = Str (), ud = Use Many () }))++postProcessUnsat :: DmdShell -> DmdType -> DmdType+postProcessUnsat ds@(JD { sd = ss }) (DmdType fv args res_ty)+  = DmdType (postProcessDmdEnv ds fv)+            (map (postProcessDmd ds) args)+            (postProcessDmdResult ss res_ty)++postProcessDmd :: DmdShell -> Demand -> Demand+postProcessDmd (JD { sd = ss, ud = us }) (JD { sd = s, ud = a})+  = JD { sd = s', ud = a' }+  where+    s' = case ss of+           Lazy  -> Lazy+           Str _ -> s+    a' = case us of+           Abs        -> Abs+           Use Many _ -> markReusedDmd a+           Use One  _ -> a++-- Peels one call level from the demand, and also returns+-- whether it was unsaturated (separately for strictness and usage)+peelCallDmd :: CleanDemand -> (CleanDemand, DmdShell)+-- Exploiting the fact that+-- on the strictness side      C(B) = B+-- and on the usage side       C(U) = U+peelCallDmd (JD {sd = s, ud = u})+  = (JD { sd = s', ud = u' }, JD { sd = ss, ud = us })+  where+    (s', ss) = case s of+                 SCall s' -> (s',       Str ())+                 HyperStr -> (HyperStr, Str ())+                 _        -> (HeadStr,  Lazy)+    (u', us) = case u of+                 UCall c u' -> (u',   Use c    ())+                 _          -> (Used, Use Many ())+       -- The _ cases for usage includes UHead which seems a bit wrong+       -- because the body isn't used at all!+       -- c.f. the Abs case in toCleanDmd++-- Peels that multiple nestings of calls clean demand and also returns+-- whether it was unsaturated (separately for strictness and usage+-- see Note [Demands from unsaturated function calls]+peelManyCalls :: Int -> CleanDemand -> DmdShell+peelManyCalls n (JD { sd = str, ud = abs })+  = JD { sd = go_str n str, ud = go_abs n abs }+  where+    go_str :: Int -> StrDmd -> Str ()  -- True <=> unsaturated, defer+    go_str 0 _          = Str ()+    go_str _ HyperStr   = Str () -- == go_str (n-1) HyperStr, as HyperStr = Call(HyperStr)+    go_str n (SCall d') = go_str (n-1) d'+    go_str _ _          = Lazy++    go_abs :: Int -> UseDmd -> Use ()      -- Many <=> unsaturated, or at least+    go_abs 0 _              = Use One ()   --          one UCall Many in the demand+    go_abs n (UCall One d') = go_abs (n-1) d'+    go_abs _ _              = Use Many ()++{-+Note [Demands from unsaturated function calls]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Consider a demand transformer d1 -> d2 -> r for f.+If a sufficiently detailed demand is fed into this transformer,+e.g <C(C(S)), C1(C1(S))> arising from "f x1 x2" in a strict, use-once context,+then d1 and d2 is precisely the demand unleashed onto x1 and x2 (similar for+the free variable environment) and furthermore the result information r is the+one we want to use.++An anonymous lambda is also an unsaturated function all (needs one argument,+none given), so this applies to that case as well.++But the demand fed into f might be less than <C(C(S)), C1(C1(S))>. There are a few cases:+ * Not enough demand on the strictness side:+   - In that case, we need to zap all strictness in the demand on arguments and+     free variables.+   - Furthermore, we remove CPR information. It could be left, but given the incoming+     demand is not enough to evaluate so far we just do not bother.+   - And finally termination information: If r says that f diverges for sure,+     then this holds when the demand guarantees that two arguments are going to+     be passed. If the demand is lower, we may just as well converge.+     If we were tracking definite convegence, than that would still hold under+     a weaker demand than expected by the demand transformer.+ * Not enough demand from the usage side: The missing usage can be expanded+   using UCall Many, therefore this is subsumed by the third case:+ * At least one of the uses has a cardinality of Many.+   - Even if f puts a One demand on any of its argument or free variables, if+     we call f multiple times, we may evaluate this argument or free variable+     multiple times. So forget about any occurrence of "One" in the demand.++In dmdTransformSig, we call peelManyCalls to find out if we are in any of these+cases, and then call postProcessUnsat to reduce the demand appropriately.++Similarly, dmdTransformDictSelSig and dmdAnal, when analyzing a Lambda, use+peelCallDmd, which peels only one level, but also returns the demand put on the+body of the function.+-}++peelFV :: DmdType -> Var -> (DmdType, Demand)+peelFV (DmdType fv ds res) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv)+                               (DmdType fv' ds res, dmd)+  where+  fv' = fv `delVarEnv` id+  -- See Note [Default demand on free variables]+  dmd  = lookupVarEnv fv id `orElse` defaultDmd res++addDemand :: Demand -> DmdType -> DmdType+addDemand dmd (DmdType fv ds res) = DmdType fv (dmd:ds) res++findIdDemand :: DmdType -> Var -> Demand+findIdDemand (DmdType fv _ res) id+  = lookupVarEnv fv id `orElse` defaultDmd res++{-+Note [Default demand on free variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If the variable is not mentioned in the environment of a demand type,+its demand is taken to be a result demand of the type.+    For the stricness component,+     if the result demand is a Diverges, then we use HyperStr+                                         else we use Lazy+    For the usage component, we use Absent.+So we use either absDmd or botDmd.++Also note the equations for lubDmdResult (resp. bothDmdResult) noted there.++Note [Always analyse in virgin pass]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Tricky point: make sure that we analyse in the 'virgin' pass. Consider+   rec { f acc x True  = f (...rec { g y = ...g... }...)+         f acc x False = acc }+In the virgin pass for 'f' we'll give 'f' a very strict (bottom) type.+That might mean that we analyse the sub-expression containing the+E = "...rec g..." stuff in a bottom demand.  Suppose we *didn't analyse*+E, but just returned botType.++Then in the *next* (non-virgin) iteration for 'f', we might analyse E+in a weaker demand, and that will trigger doing a fixpoint iteration+for g.  But *because it's not the virgin pass* we won't start g's+iteration at bottom.  Disaster.  (This happened in $sfibToList' of+nofib/spectral/fibheaps.)++So in the virgin pass we make sure that we do analyse the expression+at least once, to initialise its signatures.++Note [Analyzing with lazy demand and lambdas]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The insight for analyzing lambdas follows from the fact that for+strictness S = C(L). This polymorphic expansion is critical for+cardinality analysis of the following example:++{-# NOINLINE build #-}+build g = (g (:) [], g (:) [])++h c z = build (\x ->+                let z1 = z ++ z+                 in if c+                    then \y -> x (y ++ z1)+                    else \y -> x (z1 ++ y))++One can see that `build` assigns to `g` demand <L,C(C1(U))>.+Therefore, when analyzing the lambda `(\x -> ...)`, we+expect each lambda \y -> ... to be annotated as "one-shot"+one. Therefore (\x -> \y -> x (y ++ z)) should be analyzed with a+demand <C(C(..), C(C1(U))>.++This is achieved by, first, converting the lazy demand L into the+strict S by the second clause of the analysis.++Note [Analysing with absent demand]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we analyse an expression with demand <L,A>.  The "A" means+"absent", so this expression will never be needed.  What should happen?+There are several wrinkles:++* We *do* want to analyse the expression regardless.+  Reason: Note [Always analyse in virgin pass]++  But we can post-process the results to ignore all the usage+  demands coming back. This is done by postProcessDmdType.++* In a previous incarnation of GHC we needed to be extra careful in the+  case of an *unlifted type*, because unlifted values are evaluated+  even if they are not used.  Example (see #9254):+     f :: (() -> (# Int#, () #)) -> ()+          -- Strictness signature is+          --    <C(S(LS)), 1*C1(U(A,1*U()))>+          -- I.e. calls k, but discards first component of result+     f k = case k () of (# _, r #) -> r++     g :: Int -> ()+     g y = f (\n -> (# case y of I# y2 -> y2, n #))++  Here f's strictness signature says (correctly) that it calls its+  argument function and ignores the first component of its result.+  This is correct in the sense that it'd be fine to (say) modify the+  function so that always returned 0# in the first component.++  But in function g, we *will* evaluate the 'case y of ...', because+  it has type Int#.  So 'y' will be evaluated.  So we must record this+  usage of 'y', else 'g' will say 'y' is absent, and will w/w so that+  'y' is bound to an aBSENT_ERROR thunk.++  However, the argument of toCleanDmd always satisfies the let/app+  invariant; so if it is unlifted it is also okForSpeculation, and so+  can be evaluated in a short finite time -- and that rules out nasty+  cases like the one above.  (I'm not quite sure why this was a+  problem in an earlier version of GHC, but it isn't now.)+++************************************************************************+*                                                                      *+                     Demand signatures+*                                                                      *+************************************************************************++In a let-bound Id we record its strictness info.+In principle, this strictness info is a demand transformer, mapping+a demand on the Id into a DmdType, which gives+        a) the free vars of the Id's value+        b) the Id's arguments+        c) an indication of the result of applying+           the Id to its arguments++However, in fact we store in the Id an extremely emascuated demand+transfomer, namely++                a single DmdType+(Nevertheless we dignify StrictSig as a distinct type.)++This DmdType gives the demands unleashed by the Id when it is applied+to as many arguments as are given in by the arg demands in the DmdType.+Also see Note [Nature of result demand] for the meaning of a DmdResult in a+strictness signature.++If an Id is applied to less arguments than its arity, it means that+the demand on the function at a call site is weaker than the vanilla+call demand, used for signature inference. Therefore we place a top+demand on all arguments. Otherwise, the demand is specified by Id's+signature.++For example, the demand transformer described by the demand signature+        StrictSig (DmdType {x -> <S,1*U>} <L,A><L,U(U,U)>m)+says that when the function is applied to two arguments, it+unleashes demand <S,1*U> on the free var x, <L,A> on the first arg,+and <L,U(U,U)> on the second, then returning a constructor.++If this same function is applied to one arg, all we can say is that it+uses x with <L,U>, and its arg with demand <L,U>.+-}++newtype StrictSig = StrictSig DmdType+                  deriving( Eq )++instance Outputable StrictSig where+   ppr (StrictSig ty) = ppr ty++-- Used for printing top-level strictness pragmas in interface files+pprIfaceStrictSig :: StrictSig -> SDoc+pprIfaceStrictSig (StrictSig (DmdType _ dmds res))+  = hcat (map ppr dmds) <> ppr res++mkStrictSig :: DmdType -> StrictSig+mkStrictSig dmd_ty = StrictSig dmd_ty++mkClosedStrictSig :: [Demand] -> DmdResult -> StrictSig+mkClosedStrictSig ds res = mkStrictSig (DmdType emptyDmdEnv ds res)++splitStrictSig :: StrictSig -> ([Demand], DmdResult)+splitStrictSig (StrictSig (DmdType _ dmds res)) = (dmds, res)++increaseStrictSigArity :: Int -> StrictSig -> StrictSig+-- Add extra arguments to a strictness signature+increaseStrictSigArity arity_increase sig@(StrictSig dmd_ty@(DmdType env dmds res))+  | isTopDmdType dmd_ty = sig+  | arity_increase <= 0 = sig+  | otherwise           = StrictSig (DmdType env dmds' res)+  where+    dmds' = replicate arity_increase topDmd ++ dmds++etaExpandStrictSig :: Arity -> StrictSig -> StrictSig+-- We are expanding (\x y. e) to (\x y z. e z)+-- Add exta demands to the /end/ of the arg demands if necessary+etaExpandStrictSig arity sig@(StrictSig dmd_ty@(DmdType env dmds res))+  | isTopDmdType dmd_ty = sig+  | arity_increase <= 0 = sig+  | otherwise           = StrictSig (DmdType env dmds' res)+  where+    arity_increase = arity - length dmds+    dmds' = dmds ++ replicate arity_increase topDmd++isTopSig :: StrictSig -> Bool+isTopSig (StrictSig ty) = isTopDmdType ty++hasDemandEnvSig :: StrictSig -> Bool+hasDemandEnvSig (StrictSig (DmdType env _ _)) = not (isEmptyVarEnv env)++strictSigDmdEnv :: StrictSig -> DmdEnv+strictSigDmdEnv (StrictSig (DmdType env _ _)) = env++-- | True if the signature diverges or throws an exception+isBottomingSig :: StrictSig -> Bool+isBottomingSig (StrictSig (DmdType _ _ res)) = isBotRes res++nopSig, botSig :: StrictSig+nopSig = StrictSig nopDmdType+botSig = StrictSig botDmdType++cprProdSig :: Arity -> StrictSig+cprProdSig arity = StrictSig (cprProdDmdType arity)++seqStrictSig :: StrictSig -> ()+seqStrictSig (StrictSig ty) = seqDmdType ty++dmdTransformSig :: StrictSig -> CleanDemand -> DmdType+-- (dmdTransformSig fun_sig dmd) considers a call to a function whose+-- signature is fun_sig, with demand dmd.  We return the demand+-- that the function places on its context (eg its args)+dmdTransformSig (StrictSig dmd_ty@(DmdType _ arg_ds _)) cd+  = postProcessUnsat (peelManyCalls (length arg_ds) cd) dmd_ty+    -- see Note [Demands from unsaturated function calls]++dmdTransformDataConSig :: Arity -> StrictSig -> CleanDemand -> DmdType+-- Same as dmdTransformSig but for a data constructor (worker),+-- which has a special kind of demand transformer.+-- If the constructor is saturated, we feed the demand on+-- the result into the constructor arguments.+dmdTransformDataConSig arity (StrictSig (DmdType _ _ con_res))+                             (JD { sd = str, ud = abs })+  | Just str_dmds <- go_str arity str+  , Just abs_dmds <- go_abs arity abs+  = DmdType emptyDmdEnv (mkJointDmds str_dmds abs_dmds) con_res+                -- Must remember whether it's a product, hence con_res, not TopRes++  | otherwise   -- Not saturated+  = nopDmdType+  where+    go_str 0 dmd        = splitStrProdDmd arity dmd+    go_str n (SCall s') = go_str (n-1) s'+    go_str n HyperStr   = go_str (n-1) HyperStr+    go_str _ _          = Nothing++    go_abs 0 dmd            = splitUseProdDmd arity dmd+    go_abs n (UCall One u') = go_abs (n-1) u'+    go_abs _ _              = Nothing++dmdTransformDictSelSig :: StrictSig -> CleanDemand -> DmdType+-- Like dmdTransformDataConSig, we have a special demand transformer+-- for dictionary selectors.  If the selector is saturated (ie has one+-- argument: the dictionary), we feed the demand on the result into+-- the indicated dictionary component.+dmdTransformDictSelSig (StrictSig (DmdType _ [dict_dmd] _)) cd+   | (cd',defer_use) <- peelCallDmd cd+   , Just jds <- splitProdDmd_maybe dict_dmd+   = postProcessUnsat defer_use $+     DmdType emptyDmdEnv [mkOnceUsedDmd $ mkProdDmd $ map (enhance cd') jds] topRes+   | otherwise+   = nopDmdType              -- See Note [Demand transformer for a dictionary selector]+  where+    enhance cd old | isAbsDmd old = old+                   | otherwise    = mkOnceUsedDmd cd  -- This is the one!++dmdTransformDictSelSig _ _ = panic "dmdTransformDictSelSig: no args"++{-+Note [Demand transformer for a dictionary selector]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If we evaluate (op dict-expr) under demand 'd', then we can push the demand 'd'+into the appropriate field of the dictionary. What *is* the appropriate field?+We just look at the strictness signature of the class op, which will be+something like: U(AAASAAAAA).  Then replace the 'S' by the demand 'd'.++For single-method classes, which are represented by newtypes the signature+of 'op' won't look like U(...), so the splitProdDmd_maybe will fail.+That's fine: if we are doing strictness analysis we are also doing inlining,+so we'll have inlined 'op' into a cast.  So we can bale out in a conservative+way, returning nopDmdType.++It is (just.. #8329) possible to be running strictness analysis *without*+having inlined class ops from single-method classes.  Suppose you are using+ghc --make; and the first module has a local -O0 flag.  So you may load a class+without interface pragmas, ie (currently) without an unfolding for the class+ops.   Now if a subsequent module in the --make sweep has a local -O flag+you might do strictness analysis, but there is no inlining for the class op.+This is weird, so I'm not worried about whether this optimises brilliantly; but+it should not fall over.+-}++argsOneShots :: StrictSig -> Arity -> [[OneShotInfo]]+-- See Note [Computing one-shot info]+argsOneShots (StrictSig (DmdType _ arg_ds _)) n_val_args+  | unsaturated_call = []+  | otherwise = go arg_ds+  where+    unsaturated_call = arg_ds `lengthExceeds` n_val_args++    go []               = []+    go (arg_d : arg_ds) = argOneShots arg_d `cons` go arg_ds++    -- Avoid list tail like [ [], [], [] ]+    cons [] [] = []+    cons a  as = a:as++-- saturatedByOneShots n C1(C1(...)) = True,+--   <=>+-- there are at least n nested C1(..) calls+-- See Note [Demand on the worker] in WorkWrap+saturatedByOneShots :: Int -> Demand -> Bool+saturatedByOneShots n (JD { ud = usg })+  = case usg of+      Use _ arg_usg -> go n arg_usg+      _             -> False+  where+    go 0 _             = True+    go n (UCall One u) = go (n-1) u+    go _ _             = False++argOneShots :: Demand          -- depending on saturation+            -> [OneShotInfo]+argOneShots (JD { ud = usg })+  = case usg of+      Use _ arg_usg -> go arg_usg+      _             -> []+  where+    go (UCall One  u) = OneShotLam : go u+    go (UCall Many u) = NoOneShotInfo : go u+    go _              = []++{- Note [Computing one-shot info]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider a call+    f (\pqr. e1) (\xyz. e2) e3+where f has usage signature+    C1(C(C1(U))) C1(U) U+Then argsOneShots returns a [[OneShotInfo]] of+    [[OneShot,NoOneShotInfo,OneShot],  [OneShot]]+The occurrence analyser propagates this one-shot infor to the+binders \pqr and \xyz; see Note [Use one-shot information] in OccurAnal.+-}++-- | Returns true if an application to n args+-- would diverge or throw an exception+-- See Note [Unsaturated applications]+appIsBottom :: StrictSig -> Int -> Bool+appIsBottom (StrictSig (DmdType _ ds res)) n+            | isBotRes res                   = not $ lengthExceeds ds n+appIsBottom _                              _ = False++{-+Note [Unsaturated applications]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If a function having bottom as its demand result is applied to a less+number of arguments than its syntactic arity, we cannot say for sure+that it is going to diverge. This is the reason why we use the+function appIsBottom, which, given a strictness signature and a number+of arguments, says conservatively if the function is going to diverge+or not.++Zap absence or one-shot information, under control of flags++Note [Killing usage information]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The flags -fkill-one-shot and -fkill-absence let you switch off the generation+of absence or one-shot information altogether.  This is only used for performance+tests, to see how important they are.+-}++zapUsageEnvSig :: StrictSig -> StrictSig+-- Remove the usage environment from the demand+zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r++zapUsageDemand :: Demand -> Demand+-- Remove the usage info, but not the strictness info, from the demand+zapUsageDemand = kill_usage $ KillFlags+    { kf_abs         = True+    , kf_used_once   = True+    , kf_called_once = True+    }++-- | Remove all 1* information (but not C1 information) from the demand+zapUsedOnceDemand :: Demand -> Demand+zapUsedOnceDemand = kill_usage $ KillFlags+    { kf_abs         = False+    , kf_used_once   = True+    , kf_called_once = False+    }++-- | Remove all 1* information (but not C1 information) from the strictness+--   signature+zapUsedOnceSig :: StrictSig -> StrictSig+zapUsedOnceSig (StrictSig (DmdType env ds r))+    = StrictSig (DmdType env (map zapUsedOnceDemand ds) r)++killUsageDemand :: DynFlags -> Demand -> Demand+-- See Note [Killing usage information]+killUsageDemand dflags dmd+  | Just kfs <- killFlags dflags = kill_usage kfs dmd+  | otherwise                    = dmd++killUsageSig :: DynFlags -> StrictSig -> StrictSig+-- See Note [Killing usage information]+killUsageSig dflags sig@(StrictSig (DmdType env ds r))+  | Just kfs <- killFlags dflags = StrictSig (DmdType env (map (kill_usage kfs) ds) r)+  | otherwise                    = sig++data KillFlags = KillFlags+    { kf_abs         :: Bool+    , kf_used_once   :: Bool+    , kf_called_once :: Bool+    }++killFlags :: DynFlags -> Maybe KillFlags+-- See Note [Killing usage information]+killFlags dflags+  | not kf_abs && not kf_used_once = Nothing+  | otherwise                      = Just (KillFlags {..})+  where+    kf_abs         = gopt Opt_KillAbsence dflags+    kf_used_once   = gopt Opt_KillOneShot dflags+    kf_called_once = kf_used_once++kill_usage :: KillFlags -> Demand -> Demand+kill_usage kfs (JD {sd = s, ud = u}) = JD {sd = s, ud = zap_musg kfs u}++zap_musg :: KillFlags -> ArgUse -> ArgUse+zap_musg kfs Abs+  | kf_abs kfs = useTop+  | otherwise  = Abs+zap_musg kfs (Use c u)+  | kf_used_once kfs = Use Many (zap_usg kfs u)+  | otherwise        = Use c    (zap_usg kfs u)++zap_usg :: KillFlags -> UseDmd -> UseDmd+zap_usg kfs (UCall c u)+    | kf_called_once kfs = UCall Many (zap_usg kfs u)+    | otherwise          = UCall c    (zap_usg kfs u)+zap_usg kfs (UProd us)   = UProd (map (zap_musg kfs) us)+zap_usg _   u            = u++-- If the argument is a used non-newtype dictionary, give it strict+-- demand. Also split the product type & demand and recur in order to+-- similarly strictify the argument's contained used non-newtype+-- superclass dictionaries. We use the demand as our recursive measure+-- to guarantee termination.+strictifyDictDmd :: Type -> Demand -> Demand+strictifyDictDmd ty dmd = case getUseDmd dmd of+  Use n _ |+    Just (tycon, _arg_tys, _data_con, inst_con_arg_tys)+      <- splitDataProductType_maybe ty,+    not (isNewTyCon tycon), isClassTyCon tycon -- is a non-newtype dictionary+    -> seqDmd `bothDmd` -- main idea: ensure it's strict+       case splitProdDmd_maybe dmd of+         -- superclass cycles should not be a problem, since the demand we are+         -- consuming would also have to be infinite in order for us to diverge+         Nothing -> dmd -- no components have interesting demand, so stop+                        -- looking for superclass dicts+         Just dmds+           | all (not . isAbsDmd) dmds -> evalDmd+             -- abstract to strict w/ arbitrary component use, since this+             -- smells like reboxing; results in CBV boxed+             --+             -- TODO revisit this if we ever do boxity analysis+           | otherwise -> case mkProdDmd $ zipWith strictifyDictDmd inst_con_arg_tys dmds of+               JD {sd = s,ud = a} -> JD (Str s) (Use n a)+             -- TODO could optimize with an aborting variant of zipWith since+             -- the superclass dicts are always a prefix+  _ -> dmd -- unused or not a dictionary++strictifyDmd :: Demand -> Demand+strictifyDmd dmd@(JD { sd = str })+  = dmd { sd = str `bothArgStr` Str HeadStr }++{-+Note [HyperStr and Use demands]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++The information "HyperStr" needs to be in the strictness signature, and not in+the demand signature, because we still want to know about the demand on things. Consider++    f (x,y) True  = error (show x)+    f (x,y) False = x+1++The signature of f should be <S(SL),1*U(1*U(U),A)><S,1*U>m. If we were not+distinguishing the uses on x and y in the True case, we could either not figure+out how deeply we can unpack x, or that we do not have to pass y.+++************************************************************************+*                                                                      *+                     Serialisation+*                                                                      *+************************************************************************+-}++instance Binary StrDmd where+  put_ bh HyperStr     = do putByte bh 0+  put_ bh HeadStr      = do putByte bh 1+  put_ bh (SCall s)    = do putByte bh 2+                            put_ bh s+  put_ bh (SProd sx)   = do putByte bh 3+                            put_ bh sx+  get bh = do+         h <- getByte bh+         case h of+           0 -> do return HyperStr+           1 -> do return HeadStr+           2 -> do s  <- get bh+                   return (SCall s)+           _ -> do sx <- get bh+                   return (SProd sx)++instance Binary ArgStr where+    put_ bh Lazy         = do+            putByte bh 0+    put_ bh (Str s)    = do+            putByte bh 1+            put_ bh s++    get  bh = do+            h <- getByte bh+            case h of+              0 -> return Lazy+              _ -> do s  <- get bh+                      return $ Str s++instance Binary Count where+    put_ bh One  = do putByte bh 0+    put_ bh Many = do putByte bh 1++    get  bh = do h <- getByte bh+                 case h of+                   0 -> return One+                   _ -> return Many++instance Binary ArgUse where+    put_ bh Abs          = do+            putByte bh 0+    put_ bh (Use c u)    = do+            putByte bh 1+            put_ bh c+            put_ bh u++    get  bh = do+            h <- getByte bh+            case h of+              0 -> return Abs+              _ -> do c  <- get bh+                      u  <- get bh+                      return $ Use c u++instance Binary UseDmd where+    put_ bh Used         = do+            putByte bh 0+    put_ bh UHead        = do+            putByte bh 1+    put_ bh (UCall c u)    = do+            putByte bh 2+            put_ bh c+            put_ bh u+    put_ bh (UProd ux)   = do+            putByte bh 3+            put_ bh ux++    get  bh = do+            h <- getByte bh+            case h of+              0 -> return $ Used+              1 -> return $ UHead+              2 -> do c <- get bh+                      u <- get bh+                      return (UCall c u)+              _ -> do ux <- get bh+                      return (UProd ux)++instance (Binary s, Binary u) => Binary (JointDmd s u) where+    put_ bh (JD { sd = x, ud = y }) = do put_ bh x; put_ bh y+    get  bh = do+              x <- get bh+              y <- get bh+              return $ JD { sd = x, ud = y }++instance Binary StrictSig where+    put_ bh (StrictSig aa) = do+            put_ bh aa+    get bh = do+          aa <- get bh+          return (StrictSig aa)++instance Binary DmdType where+  -- Ignore DmdEnv when spitting out the DmdType+  put_ bh (DmdType _ ds dr)+       = do put_ bh ds+            put_ bh dr+  get bh+      = do ds <- get bh+           dr <- get bh+           return (DmdType emptyDmdEnv ds dr)++instance Binary DmdResult where+  put_ bh (Dunno c)     = do { putByte bh 0; put_ bh c }+  put_ bh Diverges      = putByte bh 1++  get bh = do { h <- getByte bh+              ; case h of+                  0 -> do { c <- get bh; return (Dunno c) }+                  _ -> return Diverges }++instance Binary CPRResult where+    put_ bh (RetSum n)   = do { putByte bh 0; put_ bh n }+    put_ bh RetProd      = putByte bh 1+    put_ bh NoCPR        = putByte bh 2++    get  bh = do+            h <- getByte bh+            case h of+              0 -> do { n <- get bh; return (RetSum n) }+              1 -> return RetProd+              _ -> return NoCPR
+ compiler/basicTypes/FieldLabel.hs view
@@ -0,0 +1,130 @@+{-+%+% (c) Adam Gundry 2013-2015+%++This module defines the representation of FieldLabels as stored in+TyCons.  As well as a selector name, these have some extra structure+to support the DuplicateRecordFields extension.++In the normal case (with NoDuplicateRecordFields), a datatype like++    data T = MkT { foo :: Int }++has++    FieldLabel { flLabel        = "foo"+               , flIsOverloaded = False+               , flSelector     = foo }.++In particular, the Name of the selector has the same string+representation as the label.  If DuplicateRecordFields+is enabled, however, the same declaration instead gives++    FieldLabel { flLabel        = "foo"+               , flIsOverloaded = True+               , flSelector     = $sel:foo:MkT }.++Now the name of the selector ($sel:foo:MkT) does not match the label of+the field (foo).  We must be careful not to show the selector name to+the user!  The point of mangling the selector name is to allow a+module to define the same field label in different datatypes:++    data T = MkT { foo :: Int }+    data U = MkU { foo :: Bool }++Now there will be two FieldLabel values for 'foo', one in T and one in+U.  They share the same label (FieldLabelString), but the selector+functions differ.++See also Note [Representing fields in AvailInfo] in Avail.++Note [Why selector names include data constructors]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++As explained above, a selector name includes the name of the first+data constructor in the type, so that the same label can appear+multiple times in the same module.  (This is irrespective of whether+the first constructor has that field, for simplicity.)++We use a data constructor name, rather than the type constructor name,+because data family instances do not have a representation type+constructor name generated until relatively late in the typechecking+process.++Of course, datatypes with no constructors cannot have any fields.++-}++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE StandaloneDeriving #-}++module FieldLabel ( FieldLabelString+                  , FieldLabelEnv+                  , FieldLbl(..)+                  , FieldLabel+                  , mkFieldLabelOccs+                  ) where++import GhcPrelude++import OccName+import Name++import FastString+import FastStringEnv+import Outputable+import Binary++import Data.Data++-- | Field labels are just represented as strings;+-- they are not necessarily unique (even within a module)+type FieldLabelString = FastString++-- | A map from labels to all the auxiliary information+type FieldLabelEnv = DFastStringEnv FieldLabel+++type FieldLabel = FieldLbl Name++-- | Fields in an algebraic record type+data FieldLbl a = FieldLabel {+      flLabel        :: FieldLabelString, -- ^ User-visible label of the field+      flIsOverloaded :: Bool,             -- ^ Was DuplicateRecordFields on+                                          --   in the defining module for this datatype?+      flSelector     :: a                 -- ^ Record selector function+    }+  deriving (Eq, Functor, Foldable, Traversable)+deriving instance Data a => Data (FieldLbl a)++instance Outputable a => Outputable (FieldLbl a) where+    ppr fl = ppr (flLabel fl) <> braces (ppr (flSelector fl))++instance Binary a => Binary (FieldLbl a) where+    put_ bh (FieldLabel aa ab ac) = do+        put_ bh aa+        put_ bh ab+        put_ bh ac+    get bh = do+        ab <- get bh+        ac <- get bh+        ad <- get bh+        return (FieldLabel ab ac ad)+++-- | Record selector OccNames are built from the underlying field name+-- and the name of the first data constructor of the type, to support+-- duplicate record field names.+-- See Note [Why selector names include data constructors].+mkFieldLabelOccs :: FieldLabelString -> OccName -> Bool -> FieldLbl OccName+mkFieldLabelOccs lbl dc is_overloaded+  = FieldLabel { flLabel = lbl, flIsOverloaded = is_overloaded+               , flSelector = sel_occ }+  where+    str     = ":" ++ unpackFS lbl ++ ":" ++ occNameString dc+    sel_occ | is_overloaded = mkRecFldSelOcc str+            | otherwise     = mkVarOccFS lbl
+ compiler/basicTypes/Id.hs view
@@ -0,0 +1,987 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[Id]{@Ids@: Value and constructor identifiers}+-}++{-# LANGUAGE CPP #-}++-- |+-- #name_types#+-- GHC uses several kinds of name internally:+--+-- * 'OccName.OccName': see "OccName#name_types"+--+-- * 'RdrName.RdrName': see "RdrName#name_types"+--+-- * 'Name.Name': see "Name#name_types"+--+-- * 'Id.Id' represents names that not only have a 'Name.Name' but also a 'TyCoRep.Type' and some additional+--   details (a 'IdInfo.IdInfo' and one of 'Var.LocalIdDetails' or 'IdInfo.GlobalIdDetails') that+--   are added, modified and inspected by various compiler passes. These 'Var.Var' names may either+--   be global or local, see "Var#globalvslocal"+--+-- * 'Var.Var': see "Var#name_types"++module Id (+        -- * The main types+        Var, Id, isId,++        -- * In and Out variants+        InVar,  InId,+        OutVar, OutId,++        -- ** Simple construction+        mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,+        mkLocalId, mkLocalCoVar, mkLocalIdOrCoVar,+        mkLocalIdOrCoVarWithInfo,+        mkLocalIdWithInfo, mkExportedLocalId, mkExportedVanillaId,+        mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM,+        mkUserLocal, mkUserLocalOrCoVar,+        mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,+        mkWorkerId,++        -- ** Taking an Id apart+        idName, idType, idUnique, idInfo, idDetails,+        recordSelectorTyCon,++        -- ** Modifying an Id+        setIdName, setIdUnique, Id.setIdType,+        setIdExported, setIdNotExported,+        globaliseId, localiseId,+        setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,+        zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo,+        zapIdUsedOnceInfo, zapIdTailCallInfo,+        zapFragileIdInfo, zapIdStrictness, zapStableUnfolding,+        transferPolyIdInfo,++        -- ** Predicates on Ids+        isImplicitId, isDeadBinder,+        isStrictId,+        isExportedId, isLocalId, isGlobalId,+        isRecordSelector, isNaughtyRecordSelector,+        isPatSynRecordSelector,+        isDataConRecordSelector,+        isClassOpId_maybe, isDFunId,+        isPrimOpId, isPrimOpId_maybe,+        isFCallId, isFCallId_maybe,+        isDataConWorkId, isDataConWorkId_maybe,+        isDataConWrapId, isDataConWrapId_maybe,+        isDataConId_maybe,+        idDataCon,+        isConLikeId, isBottomingId, idIsFrom,+        hasNoBinding,++        -- ** Evidence variables+        DictId, isDictId, isEvVar,++        -- ** Join variables+        JoinId, isJoinId, isJoinId_maybe, idJoinArity,+        asJoinId, asJoinId_maybe, zapJoinId,++        -- ** Inline pragma stuff+        idInlinePragma, setInlinePragma, modifyInlinePragma,+        idInlineActivation, setInlineActivation, idRuleMatchInfo,++        -- ** One-shot lambdas+        isOneShotBndr, isProbablyOneShotLambda,+        setOneShotLambda, clearOneShotLambda,+        updOneShotInfo, setIdOneShotInfo,+        isStateHackType, stateHackOneShot, typeOneShot,++        -- ** Reading 'IdInfo' fields+        idArity,+        idCallArity, idFunRepArity,+        idUnfolding, realIdUnfolding,+        idSpecialisation, idCoreRules, idHasRules,+        idCafInfo,+        idOneShotInfo, idStateHackOneShotInfo,+        idOccInfo,+        isNeverLevPolyId,++        -- ** Writing 'IdInfo' fields+        setIdUnfolding, setCaseBndrEvald,+        setIdArity,+        setIdCallArity,++        setIdSpecialisation,+        setIdCafInfo,+        setIdOccInfo, zapIdOccInfo,++        setIdDemandInfo,+        setIdStrictness,++        idDemandInfo,+        idStrictness,++    ) where++#include "HsVersions.h"++import GhcPrelude++import DynFlags+import CoreSyn ( CoreRule, isStableUnfolding, evaldUnfolding,+                 isCompulsoryUnfolding, Unfolding( NoUnfolding ) )++import IdInfo+import BasicTypes++-- Imported and re-exported+import Var( Id, CoVar, DictId, JoinId,+            InId,  InVar,+            OutId, OutVar,+            idInfo, idDetails, setIdDetails, globaliseId, varType,+            isId, isLocalId, isGlobalId, isExportedId )+import qualified Var++import Type+import RepType+import TysPrim+import DataCon+import Demand+import Name+import Module+import Class+import {-# SOURCE #-} PrimOp (PrimOp)+import ForeignCall+import Maybes+import SrcLoc+import Outputable+import Unique+import UniqSupply+import FastString+import Util++-- infixl so you can say (id `set` a `set` b)+infixl  1 `setIdUnfolding`,+          `setIdArity`,+          `setIdCallArity`,+          `setIdOccInfo`,+          `setIdOneShotInfo`,++          `setIdSpecialisation`,+          `setInlinePragma`,+          `setInlineActivation`,+          `idCafInfo`,++          `setIdDemandInfo`,+          `setIdStrictness`,++          `asJoinId`,+          `asJoinId_maybe`++{-+************************************************************************+*                                                                      *+\subsection{Basic Id manipulation}+*                                                                      *+************************************************************************+-}++idName   :: Id -> Name+idName    = Var.varName++idUnique :: Id -> Unique+idUnique  = Var.varUnique++idType   :: Id -> Kind+idType    = Var.varType++setIdName :: Id -> Name -> Id+setIdName = Var.setVarName++setIdUnique :: Id -> Unique -> Id+setIdUnique = Var.setVarUnique++-- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and+-- reduce space usage+setIdType :: Id -> Type -> Id+setIdType id ty = seqType ty `seq` Var.setVarType id ty++setIdExported :: Id -> Id+setIdExported = Var.setIdExported++setIdNotExported :: Id -> Id+setIdNotExported = Var.setIdNotExported++localiseId :: Id -> Id+-- Make an Id with the same unique and type as the+-- incoming Id, but with an *Internal* Name and *LocalId* flavour+localiseId id+  | ASSERT( isId id ) isLocalId id && isInternalName name+  = id+  | otherwise+  = Var.mkLocalVar (idDetails id) (localiseName name) (idType id) (idInfo id)+  where+    name = idName id++lazySetIdInfo :: Id -> IdInfo -> Id+lazySetIdInfo = Var.lazySetIdInfo++setIdInfo :: Id -> IdInfo -> Id+setIdInfo id info = info `seq` (lazySetIdInfo id info)+        -- Try to avoid space leaks by seq'ing++modifyIdInfo :: HasDebugCallStack => (IdInfo -> IdInfo) -> Id -> Id+modifyIdInfo fn id = setIdInfo id (fn (idInfo id))++-- maybeModifyIdInfo tries to avoid unnecessary thrashing+maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id+maybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info+maybeModifyIdInfo Nothing         id = id++{-+************************************************************************+*                                                                      *+\subsection{Simple Id construction}+*                                                                      *+************************************************************************++Absolutely all Ids are made by mkId.  It is just like Var.mkId,+but in addition it pins free-tyvar-info onto the Id's type,+where it can easily be found.++Note [Free type variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~+At one time we cached the free type variables of the type of an Id+at the root of the type in a TyNote.  The idea was to avoid repeating+the free-type-variable calculation.  But it turned out to slow down+the compiler overall. I don't quite know why; perhaps finding free+type variables of an Id isn't all that common whereas applying a+substitution (which changes the free type variables) is more common.+Anyway, we removed it in March 2008.+-}++-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"+mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id+mkGlobalId = Var.mkGlobalVar++-- | Make a global 'Id' without any extra information at all+mkVanillaGlobal :: Name -> Type -> Id+mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo++-- | Make a global 'Id' with no global information but some generic 'IdInfo'+mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id+mkVanillaGlobalWithInfo = mkGlobalId VanillaId+++-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"+mkLocalId :: Name -> Type -> Id+mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo+ -- It's tempting to ASSERT( not (isCoVarType ty) ), but don't. Sometimes,+ -- the type is a panic. (Search invented_id)++-- | Make a local CoVar+mkLocalCoVar :: Name -> Type -> CoVar+mkLocalCoVar name ty+  = ASSERT( isCoVarType ty )+    Var.mkLocalVar CoVarId name ty vanillaIdInfo++-- | Like 'mkLocalId', but checks the type to see if it should make a covar+mkLocalIdOrCoVar :: Name -> Type -> Id+mkLocalIdOrCoVar name ty+  | isCoVarType ty = mkLocalCoVar name ty+  | otherwise      = mkLocalId    name ty++-- | Make a local id, with the IdDetails set to CoVarId if the type indicates+-- so.+mkLocalIdOrCoVarWithInfo :: Name -> Type -> IdInfo -> Id+mkLocalIdOrCoVarWithInfo name ty info+  = Var.mkLocalVar details name ty info+  where+    details | isCoVarType ty = CoVarId+            | otherwise      = VanillaId++    -- proper ids only; no covars!+mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id+mkLocalIdWithInfo name ty info = Var.mkLocalVar VanillaId name ty info+        -- Note [Free type variables]++-- | Create a local 'Id' that is marked as exported.+-- This prevents things attached to it from being removed as dead code.+-- See Note [Exported LocalIds]+mkExportedLocalId :: IdDetails -> Name -> Type -> Id+mkExportedLocalId details name ty = Var.mkExportedLocalVar details name ty vanillaIdInfo+        -- Note [Free type variables]++mkExportedVanillaId :: Name -> Type -> Id+mkExportedVanillaId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo+        -- Note [Free type variables]+++-- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal")+-- that are created by the compiler out of thin air+mkSysLocal :: FastString -> Unique -> Type -> Id+mkSysLocal fs uniq ty = ASSERT( not (isCoVarType ty) )+                        mkLocalId (mkSystemVarName uniq fs) ty++-- | Like 'mkSysLocal', but checks to see if we have a covar type+mkSysLocalOrCoVar :: FastString -> Unique -> Type -> Id+mkSysLocalOrCoVar fs uniq ty+  = mkLocalIdOrCoVar (mkSystemVarName uniq fs) ty++mkSysLocalM :: MonadUnique m => FastString -> Type -> m Id+mkSysLocalM fs ty = getUniqueM >>= (\uniq -> return (mkSysLocal fs uniq ty))++mkSysLocalOrCoVarM :: MonadUnique m => FastString -> Type -> m Id+mkSysLocalOrCoVarM fs ty+  = getUniqueM >>= (\uniq -> return (mkSysLocalOrCoVar fs uniq ty))++-- | Create a user local 'Id'. These are local 'Id's (see "Var#globalvslocal") with a name and location that the user might recognize+mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id+mkUserLocal occ uniq ty loc = ASSERT( not (isCoVarType ty) )+                              mkLocalId (mkInternalName uniq occ loc) ty++-- | Like 'mkUserLocal', but checks if we have a coercion type+mkUserLocalOrCoVar :: OccName -> Unique -> Type -> SrcSpan -> Id+mkUserLocalOrCoVar occ uniq ty loc+  = mkLocalIdOrCoVar (mkInternalName uniq occ loc) ty++{-+Make some local @Ids@ for a template @CoreExpr@.  These have bogus+@Uniques@, but that's OK because the templates are supposed to be+instantiated before use.+-}++-- | Workers get local names. "CoreTidy" will externalise these if necessary+mkWorkerId :: Unique -> Id -> Type -> Id+mkWorkerId uniq unwrkr ty+  = mkLocalIdOrCoVar (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty++-- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings+mkTemplateLocal :: Int -> Type -> Id+mkTemplateLocal i ty = mkSysLocalOrCoVar (fsLit "v") (mkBuiltinUnique i) ty++-- | Create a template local for a series of types+mkTemplateLocals :: [Type] -> [Id]+mkTemplateLocals = mkTemplateLocalsNum 1++-- | Create a template local for a series of type, but start from a specified template local+mkTemplateLocalsNum :: Int -> [Type] -> [Id]+mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys++{- Note [Exported LocalIds]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+We use mkExportedLocalId for things like+ - Dictionary functions (DFunId)+ - Wrapper and matcher Ids for pattern synonyms+ - Default methods for classes+ - Pattern-synonym matcher and builder Ids+ - etc++They marked as "exported" in the sense that they should be kept alive+even if apparently unused in other bindings, and not dropped as dead+code by the occurrence analyser.  (But "exported" here does not mean+"brought into lexical scope by an import declaration". Indeed these+things are always internal Ids that the user never sees.)++It's very important that they are *LocalIds*, not GlobalIds, for lots+of reasons:++ * We want to treat them as free variables for the purpose of+   dependency analysis (e.g. CoreFVs.exprFreeVars).++ * Look them up in the current substitution when we come across+   occurrences of them (in Subst.lookupIdSubst). Lacking this we+   can get an out-of-date unfolding, which can in turn make the+   simplifier go into an infinite loop (#9857)++ * Ensure that for dfuns that the specialiser does not float dict uses+   above their defns, which would prevent good simplifications happening.++ * The strictness analyser treats a occurrence of a GlobalId as+   imported and assumes it contains strictness in its IdInfo, which+   isn't true if the thing is bound in the same module as the+   occurrence.++In CoreTidy we must make all these LocalIds into GlobalIds, so that in+importing modules (in --make mode) we treat them as properly global.+That is what is happening in, say tidy_insts in TidyPgm.++************************************************************************+*                                                                      *+\subsection{Special Ids}+*                                                                      *+************************************************************************+-}++-- | If the 'Id' is that for a record selector, extract the 'sel_tycon'. Panic otherwise.+recordSelectorTyCon :: Id -> RecSelParent+recordSelectorTyCon id+  = case Var.idDetails id of+        RecSelId { sel_tycon = parent } -> parent+        _ -> panic "recordSelectorTyCon"+++isRecordSelector        :: Id -> Bool+isNaughtyRecordSelector :: Id -> Bool+isPatSynRecordSelector  :: Id -> Bool+isDataConRecordSelector  :: Id -> Bool+isPrimOpId              :: Id -> Bool+isFCallId               :: Id -> Bool+isDataConWorkId         :: Id -> Bool+isDataConWrapId         :: Id -> Bool+isDFunId                :: Id -> Bool++isClassOpId_maybe       :: Id -> Maybe Class+isPrimOpId_maybe        :: Id -> Maybe PrimOp+isFCallId_maybe         :: Id -> Maybe ForeignCall+isDataConWorkId_maybe   :: Id -> Maybe DataCon+isDataConWrapId_maybe   :: Id -> Maybe DataCon++isRecordSelector id = case Var.idDetails id of+                        RecSelId {}     -> True+                        _               -> False++isDataConRecordSelector id = case Var.idDetails id of+                        RecSelId {sel_tycon = RecSelData _} -> True+                        _               -> False++isPatSynRecordSelector id = case Var.idDetails id of+                        RecSelId {sel_tycon = RecSelPatSyn _} -> True+                        _               -> False++isNaughtyRecordSelector id = case Var.idDetails id of+                        RecSelId { sel_naughty = n } -> n+                        _                               -> False++isClassOpId_maybe id = case Var.idDetails id of+                        ClassOpId cls -> Just cls+                        _other        -> Nothing++isPrimOpId id = case Var.idDetails id of+                        PrimOpId _ -> True+                        _          -> False++isDFunId id = case Var.idDetails id of+                        DFunId {} -> True+                        _         -> False++isPrimOpId_maybe id = case Var.idDetails id of+                        PrimOpId op -> Just op+                        _           -> Nothing++isFCallId id = case Var.idDetails id of+                        FCallId _ -> True+                        _         -> False++isFCallId_maybe id = case Var.idDetails id of+                        FCallId call -> Just call+                        _            -> Nothing++isDataConWorkId id = case Var.idDetails id of+                        DataConWorkId _ -> True+                        _               -> False++isDataConWorkId_maybe id = case Var.idDetails id of+                        DataConWorkId con -> Just con+                        _                 -> Nothing++isDataConWrapId id = case Var.idDetails id of+                       DataConWrapId _ -> True+                       _               -> False++isDataConWrapId_maybe id = case Var.idDetails id of+                        DataConWrapId con -> Just con+                        _                 -> Nothing++isDataConId_maybe :: Id -> Maybe DataCon+isDataConId_maybe id = case Var.idDetails id of+                         DataConWorkId con -> Just con+                         DataConWrapId con -> Just con+                         _                 -> Nothing++isJoinId :: Var -> Bool+-- It is convenient in SetLevels.lvlMFE to apply isJoinId+-- to the free vars of an expression, so it's convenient+-- if it returns False for type variables+isJoinId id+  | isId id = case Var.idDetails id of+                JoinId {} -> True+                _         -> False+  | otherwise = False++isJoinId_maybe :: Var -> Maybe JoinArity+isJoinId_maybe id+ | isId id  = ASSERT2( isId id, ppr id )+              case Var.idDetails id of+                JoinId arity -> Just arity+                _            -> Nothing+ | otherwise = Nothing++idDataCon :: Id -> DataCon+-- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer.+--+-- INVARIANT: @idDataCon (dataConWrapId d) = d@: remember, 'dataConWrapId' can return either the wrapper or the worker+idDataCon id = isDataConId_maybe id `orElse` pprPanic "idDataCon" (ppr id)++hasNoBinding :: Id -> Bool+-- ^ Returns @True@ of an 'Id' which may not have a+-- binding, even though it is defined in this module.++-- Data constructor workers used to be things of this kind, but+-- they aren't any more.  Instead, we inject a binding for+-- them at the CorePrep stage.+-- EXCEPT: unboxed tuples, which definitely have no binding+hasNoBinding id = case Var.idDetails id of+                        PrimOpId _       -> True        -- See Note [Primop wrappers]+                        FCallId _        -> True+                        DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc+                        _                -> isCompulsoryUnfolding (idUnfolding id)+                                            -- See Note [Levity-polymorphic Ids]++isImplicitId :: Id -> Bool+-- ^ 'isImplicitId' tells whether an 'Id's info is implied by other+-- declarations, so we don't need to put its signature in an interface+-- file, even if it's mentioned in some other interface unfolding.+isImplicitId id+  = case Var.idDetails id of+        FCallId {}       -> True+        ClassOpId {}     -> True+        PrimOpId {}      -> True+        DataConWorkId {} -> True+        DataConWrapId {} -> True+                -- These are implied by their type or class decl;+                -- remember that all type and class decls appear in the interface file.+                -- The dfun id is not an implicit Id; it must *not* be omitted, because+                -- it carries version info for the instance decl+        _               -> False++idIsFrom :: Module -> Id -> Bool+idIsFrom mod id = nameIsLocalOrFrom mod (idName id)++{- Note [Levity-polymorphic Ids]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Some levity-polymorphic Ids must be applied and and inlined, not left+un-saturated.  Example:+  unsafeCoerceId :: forall r1 r2 (a::TYPE r1) (b::TYPE r2). a -> b++This has a compulsory unfolding because we can't lambda-bind those+arguments.  But the compulsory unfolding may leave levity-polymorphic+lambdas if it is not applied to enough arguments; e.g. (#14561)+  bad :: forall (a :: TYPE r). a -> a+  bad = unsafeCoerce#++The desugar has special magic to detect such cases: DsExpr.badUseOfLevPolyPrimop.+And we want that magic to apply to levity-polymorphic compulsory-inline things.+The easiest way to do this is for hasNoBinding to return True of all things+that have compulsory unfolding.  A very Ids with a compulsory unfolding also+have a binding, but it does not harm to say they don't here, and its a very+simple way to fix #14561.++Note [Primop wrappers]+~~~~~~~~~~~~~~~~~~~~~~+Currently hasNoBinding claims that PrimOpIds don't have a curried+function definition.  But actually they do, in GHC.PrimopWrappers,+which is auto-generated from prelude/primops.txt.pp.  So actually, hasNoBinding+could return 'False' for PrimOpIds.++But we'd need to add something in CoreToStg to swizzle any unsaturated+applications of GHC.Prim.plusInt# to GHC.PrimopWrappers.plusInt#.++Nota Bene: GHC.PrimopWrappers is needed *regardless*, because it's+used by GHCi, which does not implement primops direct at all.+-}++isDeadBinder :: Id -> Bool+isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)+                  | otherwise = False   -- TyVars count as not dead++{-+************************************************************************+*                                                                      *+              Evidence variables+*                                                                      *+************************************************************************+-}++isEvVar :: Var -> Bool+isEvVar var = isEvVarType (varType var)++isDictId :: Id -> Bool+isDictId id = isDictTy (idType id)++{-+************************************************************************+*                                                                      *+              Join variables+*                                                                      *+************************************************************************+-}++idJoinArity :: JoinId -> JoinArity+idJoinArity id = isJoinId_maybe id `orElse` pprPanic "idJoinArity" (ppr id)++asJoinId :: Id -> JoinArity -> JoinId+asJoinId id arity = WARN(not (isLocalId id),+                         text "global id being marked as join var:" <+> ppr id)+                    WARN(not (is_vanilla_or_join id),+                         ppr id <+> pprIdDetails (idDetails id))+                    id `setIdDetails` JoinId arity+  where+    is_vanilla_or_join id = case Var.idDetails id of+                              VanillaId -> True+                              JoinId {} -> True+                              _         -> False++zapJoinId :: Id -> Id+-- May be a regular id already+zapJoinId jid | isJoinId jid = zapIdTailCallInfo (jid `setIdDetails` VanillaId)+                                 -- Core Lint may complain if still marked+                                 -- as AlwaysTailCalled+              | otherwise    = jid++asJoinId_maybe :: Id -> Maybe JoinArity -> Id+asJoinId_maybe id (Just arity) = asJoinId id arity+asJoinId_maybe id Nothing      = zapJoinId id++{-+************************************************************************+*                                                                      *+\subsection{IdInfo stuff}+*                                                                      *+************************************************************************+-}++        ---------------------------------+        -- ARITY+idArity :: Id -> Arity+idArity id = arityInfo (idInfo id)++setIdArity :: Id -> Arity -> Id+setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id++idCallArity :: Id -> Arity+idCallArity id = callArityInfo (idInfo id)++setIdCallArity :: Id -> Arity -> Id+setIdCallArity id arity = modifyIdInfo (`setCallArityInfo` arity) id++idFunRepArity :: Id -> RepArity+idFunRepArity x = countFunRepArgs (idArity x) (idType x)++-- | Returns true if an application to n args would diverge+isBottomingId :: Var -> Bool+isBottomingId v+  | isId v    = isBottomingSig (idStrictness v)+  | otherwise = False++idStrictness :: Id -> StrictSig+idStrictness id = strictnessInfo (idInfo id)++setIdStrictness :: Id -> StrictSig -> Id+setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` sig) id++zapIdStrictness :: Id -> Id+zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` nopSig) id++-- | This predicate says whether the 'Id' has a strict demand placed on it or+-- has a type such that it can always be evaluated strictly (i.e an+-- unlifted type, as of GHC 7.6).  We need to+-- check separately whether the 'Id' has a so-called \"strict type\" because if+-- the demand for the given @id@ hasn't been computed yet but @id@ has a strict+-- type, we still want @isStrictId id@ to be @True@.+isStrictId :: Id -> Bool+isStrictId id+  = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )+         not (isJoinId id) && (+           (isStrictType (idType id)) ||+           -- Take the best of both strictnesses - old and new+           (isStrictDmd (idDemandInfo id))+         )++        ---------------------------------+        -- UNFOLDING+idUnfolding :: Id -> Unfolding+-- Do not expose the unfolding of a loop breaker!+idUnfolding id+  | isStrongLoopBreaker (occInfo info) = NoUnfolding+  | otherwise                          = unfoldingInfo info+  where+    info = idInfo id++realIdUnfolding :: Id -> Unfolding+-- Expose the unfolding if there is one, including for loop breakers+realIdUnfolding id = unfoldingInfo (idInfo id)++setIdUnfolding :: Id -> Unfolding -> Id+setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id++idDemandInfo       :: Id -> Demand+idDemandInfo       id = demandInfo (idInfo id)++setIdDemandInfo :: Id -> Demand -> Id+setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` dmd) id++setCaseBndrEvald :: StrictnessMark -> Id -> Id+-- Used for variables bound by a case expressions, both the case-binder+-- itself, and any pattern-bound variables that are argument of a+-- strict constructor.  It just marks the variable as already-evaluated,+-- so that (for example) a subsequent 'seq' can be dropped+setCaseBndrEvald str id+  | isMarkedStrict str = id `setIdUnfolding` evaldUnfolding+  | otherwise          = id++        ---------------------------------+        -- SPECIALISATION++-- See Note [Specialisations and RULES in IdInfo] in IdInfo.hs++idSpecialisation :: Id -> RuleInfo+idSpecialisation id = ruleInfo (idInfo id)++idCoreRules :: Id -> [CoreRule]+idCoreRules id = ruleInfoRules (idSpecialisation id)++idHasRules :: Id -> Bool+idHasRules id = not (isEmptyRuleInfo (idSpecialisation id))++setIdSpecialisation :: Id -> RuleInfo -> Id+setIdSpecialisation id spec_info = modifyIdInfo (`setRuleInfo` spec_info) id++        ---------------------------------+        -- CAF INFO+idCafInfo :: Id -> CafInfo+idCafInfo id = cafInfo (idInfo id)++setIdCafInfo :: Id -> CafInfo -> Id+setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id++        ---------------------------------+        -- Occurrence INFO+idOccInfo :: Id -> OccInfo+idOccInfo id = occInfo (idInfo id)++setIdOccInfo :: Id -> OccInfo -> Id+setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id++zapIdOccInfo :: Id -> Id+zapIdOccInfo b = b `setIdOccInfo` noOccInfo++{-+        ---------------------------------+        -- INLINING+The inline pragma tells us to be very keen to inline this Id, but it's still+OK not to if optimisation is switched off.+-}++idInlinePragma :: Id -> InlinePragma+idInlinePragma id = inlinePragInfo (idInfo id)++setInlinePragma :: Id -> InlinePragma -> Id+setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id++modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id+modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id++idInlineActivation :: Id -> Activation+idInlineActivation id = inlinePragmaActivation (idInlinePragma id)++setInlineActivation :: Id -> Activation -> Id+setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act)++idRuleMatchInfo :: Id -> RuleMatchInfo+idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)++isConLikeId :: Id -> Bool+isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id)++{-+        ---------------------------------+        -- ONE-SHOT LAMBDAS+-}++idOneShotInfo :: Id -> OneShotInfo+idOneShotInfo id = oneShotInfo (idInfo id)++-- | Like 'idOneShotInfo', but taking the Horrible State Hack in to account+-- See Note [The state-transformer hack] in CoreArity+idStateHackOneShotInfo :: Id -> OneShotInfo+idStateHackOneShotInfo id+    | isStateHackType (idType id) = stateHackOneShot+    | otherwise                   = idOneShotInfo id++-- | Returns whether the lambda associated with the 'Id' is certainly applied at most once+-- This one is the "business end", called externally.+-- It works on type variables as well as Ids, returning True+-- Its main purpose is to encapsulate the Horrible State Hack+-- See Note [The state-transformer hack] in CoreArity+isOneShotBndr :: Var -> Bool+isOneShotBndr var+  | isTyVar var                              = True+  | OneShotLam <- idStateHackOneShotInfo var = True+  | otherwise                                = False++-- | Should we apply the state hack to values of this 'Type'?+stateHackOneShot :: OneShotInfo+stateHackOneShot = OneShotLam++typeOneShot :: Type -> OneShotInfo+typeOneShot ty+   | isStateHackType ty = stateHackOneShot+   | otherwise          = NoOneShotInfo++isStateHackType :: Type -> Bool+isStateHackType ty+  | hasNoStateHack unsafeGlobalDynFlags+  = False+  | otherwise+  = case tyConAppTyCon_maybe ty of+        Just tycon -> tycon == statePrimTyCon+        _          -> False+        -- This is a gross hack.  It claims that+        -- every function over realWorldStatePrimTy is a one-shot+        -- function.  This is pretty true in practice, and makes a big+        -- difference.  For example, consider+        --      a `thenST` \ r -> ...E...+        -- The early full laziness pass, if it doesn't know that r is one-shot+        -- will pull out E (let's say it doesn't mention r) to give+        --      let lvl = E in a `thenST` \ r -> ...lvl...+        -- When `thenST` gets inlined, we end up with+        --      let lvl = E in \s -> case a s of (r, s') -> ...lvl...+        -- and we don't re-inline E.+        --+        -- It would be better to spot that r was one-shot to start with, but+        -- I don't want to rely on that.+        --+        -- Another good example is in fill_in in PrelPack.hs.  We should be able to+        -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.++isProbablyOneShotLambda :: Id -> Bool+isProbablyOneShotLambda id = case idStateHackOneShotInfo id of+                               OneShotLam    -> True+                               NoOneShotInfo -> False++setOneShotLambda :: Id -> Id+setOneShotLambda id = modifyIdInfo (`setOneShotInfo` OneShotLam) id++clearOneShotLambda :: Id -> Id+clearOneShotLambda id = modifyIdInfo (`setOneShotInfo` NoOneShotInfo) id++setIdOneShotInfo :: Id -> OneShotInfo -> Id+setIdOneShotInfo id one_shot = modifyIdInfo (`setOneShotInfo` one_shot) id++updOneShotInfo :: Id -> OneShotInfo -> Id+-- Combine the info in the Id with new info+updOneShotInfo id one_shot+  | do_upd    = setIdOneShotInfo id one_shot+  | otherwise = id+  where+    do_upd = case (idOneShotInfo id, one_shot) of+                (NoOneShotInfo, _) -> True+                (OneShotLam,    _) -> False++-- The OneShotLambda functions simply fiddle with the IdInfo flag+-- But watch out: this may change the type of something else+--      f = \x -> e+-- If we change the one-shot-ness of x, f's type changes++zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id+zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id++zapLamIdInfo :: Id -> Id+zapLamIdInfo = zapInfo zapLamInfo++zapFragileIdInfo :: Id -> Id+zapFragileIdInfo = zapInfo zapFragileInfo++zapIdDemandInfo :: Id -> Id+zapIdDemandInfo = zapInfo zapDemandInfo++zapIdUsageInfo :: Id -> Id+zapIdUsageInfo = zapInfo zapUsageInfo++zapIdUsageEnvInfo :: Id -> Id+zapIdUsageEnvInfo = zapInfo zapUsageEnvInfo++zapIdUsedOnceInfo :: Id -> Id+zapIdUsedOnceInfo = zapInfo zapUsedOnceInfo++zapIdTailCallInfo :: Id -> Id+zapIdTailCallInfo = zapInfo zapTailCallInfo++zapStableUnfolding :: Id -> Id+zapStableUnfolding id+ | isStableUnfolding (realIdUnfolding id) = setIdUnfolding id NoUnfolding+ | otherwise                              = id++{-+Note [transferPolyIdInfo]+~~~~~~~~~~~~~~~~~~~~~~~~~+This transfer is used in three places:+        FloatOut (long-distance let-floating)+        SimplUtils.abstractFloats (short-distance let-floating)+        StgLiftLams (selectively lambda-lift local functions to top-level)++Consider the short-distance let-floating:++   f = /\a. let g = rhs in ...++Then if we float thus++   g' = /\a. rhs+   f = /\a. ...[g' a/g]....++we *do not* want to lose g's+  * strictness information+  * arity+  * inline pragma (though that is bit more debatable)+  * occurrence info++Mostly this is just an optimisation, but it's *vital* to+transfer the occurrence info.  Consider++   NonRec { f = /\a. let Rec { g* = ..g.. } in ... }++where the '*' means 'LoopBreaker'.  Then if we float we must get++   Rec { g'* = /\a. ...(g' a)... }+   NonRec { f = /\a. ...[g' a/g]....}++where g' is also marked as LoopBreaker.  If not, terrible things+can happen if we re-simplify the binding (and the Simplifier does+sometimes simplify a term twice); see #4345.++It's not so simple to retain+  * worker info+  * rules+so we simply discard those.  Sooner or later this may bite us.++If we abstract wrt one or more *value* binders, we must modify the+arity and strictness info before transferring it.  E.g.+      f = \x. e+-->+      g' = \y. \x. e+      + substitute (g' y) for g+Notice that g' has an arity one more than the original g+-}++transferPolyIdInfo :: Id        -- Original Id+                   -> [Var]     -- Abstract wrt these variables+                   -> Id        -- New Id+                   -> Id+transferPolyIdInfo old_id abstract_wrt new_id+  = modifyIdInfo transfer new_id+  where+    arity_increase = count isId abstract_wrt    -- Arity increases by the+                                                -- number of value binders++    old_info        = idInfo old_id+    old_arity       = arityInfo old_info+    old_inline_prag = inlinePragInfo old_info+    old_occ_info    = occInfo old_info+    new_arity       = old_arity + arity_increase+    new_occ_info    = zapOccTailCallInfo old_occ_info++    old_strictness  = strictnessInfo old_info+    new_strictness  = increaseStrictSigArity arity_increase old_strictness++    transfer new_info = new_info `setArityInfo` new_arity+                                 `setInlinePragInfo` old_inline_prag+                                 `setOccInfo` new_occ_info+                                 `setStrictnessInfo` new_strictness++isNeverLevPolyId :: Id -> Bool+isNeverLevPolyId = isNeverLevPolyIdInfo . idInfo
+ compiler/basicTypes/IdInfo.hs view
@@ -0,0 +1,629 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1993-1998++\section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}++(And a pretty good illustration of quite a few things wrong with+Haskell. [WDP 94/11])+-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}++module IdInfo (+        -- * The IdDetails type+        IdDetails(..), pprIdDetails, coVarDetails, isCoVarDetails,+        JoinArity, isJoinIdDetails_maybe,+        RecSelParent(..),++        -- * The IdInfo type+        IdInfo,         -- Abstract+        vanillaIdInfo, noCafIdInfo,++        -- ** The OneShotInfo type+        OneShotInfo(..),+        oneShotInfo, noOneShotInfo, hasNoOneShotInfo,+        setOneShotInfo,++        -- ** Zapping various forms of Info+        zapLamInfo, zapFragileInfo,+        zapDemandInfo, zapUsageInfo, zapUsageEnvInfo, zapUsedOnceInfo,+        zapTailCallInfo, zapCallArityInfo, zapUnfolding,++        -- ** The ArityInfo type+        ArityInfo,+        unknownArity,+        arityInfo, setArityInfo, ppArityInfo,++        callArityInfo, setCallArityInfo,++        -- ** Demand and strictness Info+        strictnessInfo, setStrictnessInfo,+        demandInfo, setDemandInfo, pprStrictness,++        -- ** Unfolding Info+        unfoldingInfo, setUnfoldingInfo,++        -- ** The InlinePragInfo type+        InlinePragInfo,+        inlinePragInfo, setInlinePragInfo,++        -- ** The OccInfo type+        OccInfo(..),+        isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker,+        occInfo, setOccInfo,++        InsideLam, OneBranch,+        insideLam, notInsideLam, oneBranch, notOneBranch,++        TailCallInfo(..),+        tailCallInfo, isAlwaysTailCalled,++        -- ** The RuleInfo type+        RuleInfo(..),+        emptyRuleInfo,+        isEmptyRuleInfo, ruleInfoFreeVars,+        ruleInfoRules, setRuleInfoHead,+        ruleInfo, setRuleInfo,++        -- ** The CAFInfo type+        CafInfo(..),+        ppCafInfo, mayHaveCafRefs,+        cafInfo, setCafInfo,++        -- ** Tick-box Info+        TickBoxOp(..), TickBoxId,++        -- ** Levity info+        LevityInfo, levityInfo, setNeverLevPoly, setLevityInfoWithType,+        isNeverLevPolyIdInfo+    ) where++#include "HsVersions.h"++import GhcPrelude++import CoreSyn++import Class+import {-# SOURCE #-} PrimOp (PrimOp)+import Name+import VarSet+import BasicTypes+import DataCon+import TyCon+import PatSyn+import Type+import ForeignCall+import Outputable+import Module+import Demand+import Util++-- infixl so you can say (id `set` a `set` b)+infixl  1 `setRuleInfo`,+          `setArityInfo`,+          `setInlinePragInfo`,+          `setUnfoldingInfo`,+          `setOneShotInfo`,+          `setOccInfo`,+          `setCafInfo`,+          `setStrictnessInfo`,+          `setDemandInfo`,+          `setNeverLevPoly`,+          `setLevityInfoWithType`++{-+************************************************************************+*                                                                      *+                     IdDetails+*                                                                      *+************************************************************************+-}++-- | Identifier Details+--+-- The 'IdDetails' of an 'Id' give stable, and necessary,+-- information about the Id.+data IdDetails+  = VanillaId++  -- | The 'Id' for a record selector+  | RecSelId+    { sel_tycon   :: RecSelParent+    , sel_naughty :: Bool       -- True <=> a "naughty" selector which can't actually exist, for example @x@ in:+                                --    data T = forall a. MkT { x :: a }+    }                           -- See Note [Naughty record selectors] in TcTyClsDecls++  | DataConWorkId DataCon       -- ^ The 'Id' is for a data constructor /worker/+  | DataConWrapId DataCon       -- ^ The 'Id' is for a data constructor /wrapper/++                                -- [the only reasons we need to know is so that+                                --  a) to support isImplicitId+                                --  b) when desugaring a RecordCon we can get+                                --     from the Id back to the data con]+  | ClassOpId Class             -- ^ The 'Id' is a superclass selector,+                                -- or class operation of a class++  | PrimOpId PrimOp             -- ^ The 'Id' is for a primitive operator+  | FCallId ForeignCall         -- ^ The 'Id' is for a foreign call.+                                -- Type will be simple: no type families, newtypes, etc++  | TickBoxOpId TickBoxOp       -- ^ The 'Id' is for a HPC tick box (both traditional and binary)++  | DFunId Bool                 -- ^ A dictionary function.+       -- Bool = True <=> the class has only one method, so may be+       --                  implemented with a newtype, so it might be bad+       --                  to be strict on this dictionary++  | CoVarId    -- ^ A coercion variable+               -- This only covers /un-lifted/ coercions, of type+               -- (t1 ~# t2) or (t1 ~R# t2), not their lifted variants+  | JoinId JoinArity           -- ^ An 'Id' for a join point taking n arguments+       -- Note [Join points] in CoreSyn++-- | Recursive Selector Parent+data RecSelParent = RecSelData TyCon | RecSelPatSyn PatSyn deriving Eq+  -- Either `TyCon` or `PatSyn` depending+  -- on the origin of the record selector.+  -- For a data type family, this is the+  -- /instance/ 'TyCon' not the family 'TyCon'++instance Outputable RecSelParent where+  ppr p = case p of+            RecSelData ty_con -> ppr ty_con+            RecSelPatSyn ps   -> ppr ps++-- | Just a synonym for 'CoVarId'. Written separately so it can be+-- exported in the hs-boot file.+coVarDetails :: IdDetails+coVarDetails = CoVarId++-- | Check if an 'IdDetails' says 'CoVarId'.+isCoVarDetails :: IdDetails -> Bool+isCoVarDetails CoVarId = True+isCoVarDetails _       = False++isJoinIdDetails_maybe :: IdDetails -> Maybe JoinArity+isJoinIdDetails_maybe (JoinId join_arity) = Just join_arity+isJoinIdDetails_maybe _                   = Nothing++instance Outputable IdDetails where+    ppr = pprIdDetails++pprIdDetails :: IdDetails -> SDoc+pprIdDetails VanillaId = empty+pprIdDetails other     = brackets (pp other)+ where+   pp VanillaId               = panic "pprIdDetails"+   pp (DataConWorkId _)       = text "DataCon"+   pp (DataConWrapId _)       = text "DataConWrapper"+   pp (ClassOpId {})          = text "ClassOp"+   pp (PrimOpId _)            = text "PrimOp"+   pp (FCallId _)             = text "ForeignCall"+   pp (TickBoxOpId _)         = text "TickBoxOp"+   pp (DFunId nt)             = text "DFunId" <> ppWhen nt (text "(nt)")+   pp (RecSelId { sel_naughty = is_naughty })+                              = brackets $ text "RecSel" <>+                                           ppWhen is_naughty (text "(naughty)")+   pp CoVarId                 = text "CoVarId"+   pp (JoinId arity)          = text "JoinId" <> parens (int arity)++{-+************************************************************************+*                                                                      *+\subsection{The main IdInfo type}+*                                                                      *+************************************************************************+-}++-- | Identifier Information+--+-- An 'IdInfo' gives /optional/ information about an 'Id'.  If+-- present it never lies, but it may not be present, in which case there+-- is always a conservative assumption which can be made.+--+-- Two 'Id's may have different info even though they have the same+-- 'Unique' (and are hence the same 'Id'); for example, one might lack+-- the properties attached to the other.+--+-- Most of the 'IdInfo' gives information about the value, or definition, of+-- the 'Id', independent of its usage. Exceptions to this+-- are 'demandInfo', 'occInfo', 'oneShotInfo' and 'callArityInfo'.+--+-- Performance note: when we update 'IdInfo', we have to reallocate this+-- entire record, so it is a good idea not to let this data structure get+-- too big.+data IdInfo+  = IdInfo {+        arityInfo       :: !ArityInfo,          -- ^ 'Id' arity+        ruleInfo        :: RuleInfo,            -- ^ Specialisations of the 'Id's function which exist+                                                -- See Note [Specialisations and RULES in IdInfo]+        unfoldingInfo   :: Unfolding,           -- ^ The 'Id's unfolding+        cafInfo         :: CafInfo,             -- ^ 'Id' CAF info+        oneShotInfo     :: OneShotInfo,         -- ^ Info about a lambda-bound variable, if the 'Id' is one+        inlinePragInfo  :: InlinePragma,        -- ^ Any inline pragma atached to the 'Id'+        occInfo         :: OccInfo,             -- ^ How the 'Id' occurs in the program++        strictnessInfo  :: StrictSig,      --  ^ A strictness signature++        demandInfo      :: Demand,       -- ^ ID demand information+        callArityInfo   :: !ArityInfo,   -- ^ How this is called.+                                         -- n <=> all calls have at least n arguments++        levityInfo      :: LevityInfo    -- ^ when applied, will this Id ever have a levity-polymorphic type?+    }++-- Setters++setRuleInfo :: IdInfo -> RuleInfo -> IdInfo+setRuleInfo       info sp = sp `seq` info { ruleInfo = sp }+setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo+setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }+setOccInfo :: IdInfo -> OccInfo -> IdInfo+setOccInfo        info oc = oc `seq` info { occInfo = oc }+        -- Try to avoid space leaks by seq'ing++setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo+setUnfoldingInfo info uf+  = -- We don't seq the unfolding, as we generate intermediate+    -- unfoldings which are just thrown away, so evaluating them is a+    -- waste of time.+    -- seqUnfolding uf `seq`+    info { unfoldingInfo = uf }++setArityInfo :: IdInfo -> ArityInfo -> IdInfo+setArityInfo      info ar  = info { arityInfo = ar  }+setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo+setCallArityInfo info ar  = info { callArityInfo = ar  }+setCafInfo :: IdInfo -> CafInfo -> IdInfo+setCafInfo        info caf = info { cafInfo = caf }++setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo+setOneShotInfo      info lb = {-lb `seq`-} info { oneShotInfo = lb }++setDemandInfo :: IdInfo -> Demand -> IdInfo+setDemandInfo info dd = dd `seq` info { demandInfo = dd }++setStrictnessInfo :: IdInfo -> StrictSig -> IdInfo+setStrictnessInfo info dd = dd `seq` info { strictnessInfo = dd }++-- | Basic 'IdInfo' that carries no useful information whatsoever+vanillaIdInfo :: IdInfo+vanillaIdInfo+  = IdInfo {+            cafInfo             = vanillaCafInfo,+            arityInfo           = unknownArity,+            ruleInfo            = emptyRuleInfo,+            unfoldingInfo       = noUnfolding,+            oneShotInfo         = NoOneShotInfo,+            inlinePragInfo      = defaultInlinePragma,+            occInfo             = noOccInfo,+            demandInfo          = topDmd,+            strictnessInfo      = nopSig,+            callArityInfo       = unknownArity,+            levityInfo          = NoLevityInfo+           }++-- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references+noCafIdInfo :: IdInfo+noCafIdInfo  = vanillaIdInfo `setCafInfo`    NoCafRefs+        -- Used for built-in type Ids in MkId.++{-+************************************************************************+*                                                                      *+\subsection[arity-IdInfo]{Arity info about an @Id@}+*                                                                      *+************************************************************************++For locally-defined Ids, the code generator maintains its own notion+of their arities; so it should not be asking...  (but other things+besides the code-generator need arity info!)+-}++-- | Arity Information+--+-- An 'ArityInfo' of @n@ tells us that partial application of this+-- 'Id' to up to @n-1@ value arguments does essentially no work.+--+-- That is not necessarily the same as saying that it has @n@ leading+-- lambdas, because coerces may get in the way.+--+-- The arity might increase later in the compilation process, if+-- an extra lambda floats up to the binding site.+type ArityInfo = Arity++-- | It is always safe to assume that an 'Id' has an arity of 0+unknownArity :: Arity+unknownArity = 0++ppArityInfo :: Int -> SDoc+ppArityInfo 0 = empty+ppArityInfo n = hsep [text "Arity", int n]++{-+************************************************************************+*                                                                      *+\subsection{Inline-pragma information}+*                                                                      *+************************************************************************+-}++-- | Inline Pragma Information+--+-- Tells when the inlining is active.+-- When it is active the thing may be inlined, depending on how+-- big it is.+--+-- If there was an @INLINE@ pragma, then as a separate matter, the+-- RHS will have been made to look small with a Core inline 'Note'+--+-- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves+-- entirely as a way to inhibit inlining until we want it+type InlinePragInfo = InlinePragma++{-+************************************************************************+*                                                                      *+               Strictness+*                                                                      *+************************************************************************+-}++pprStrictness :: StrictSig -> SDoc+pprStrictness sig = ppr sig++{-+************************************************************************+*                                                                      *+        RuleInfo+*                                                                      *+************************************************************************++Note [Specialisations and RULES in IdInfo]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Generally speaking, a GlobalId has an *empty* RuleInfo.  All their+RULES are contained in the globally-built rule-base.  In principle,+one could attach the to M.f the RULES for M.f that are defined in M.+But we don't do that for instance declarations and so we just treat+them all uniformly.++The EXCEPTION is PrimOpIds, which do have rules in their IdInfo. That is+jsut for convenience really.++However, LocalIds may have non-empty RuleInfo.  We treat them+differently because:+  a) they might be nested, in which case a global table won't work+  b) the RULE might mention free variables, which we use to keep things alive++In TidyPgm, when the LocalId becomes a GlobalId, its RULES are stripped off+and put in the global list.+-}++-- | Rule Information+--+-- Records the specializations of this 'Id' that we know about+-- in the form of rewrite 'CoreRule's that target them+data RuleInfo+  = RuleInfo+        [CoreRule]+        DVarSet         -- Locally-defined free vars of *both* LHS and RHS+                        -- of rules.  I don't think it needs to include the+                        -- ru_fn though.+                        -- Note [Rule dependency info] in OccurAnal++-- | Assume that no specilizations exist: always safe+emptyRuleInfo :: RuleInfo+emptyRuleInfo = RuleInfo [] emptyDVarSet++isEmptyRuleInfo :: RuleInfo -> Bool+isEmptyRuleInfo (RuleInfo rs _) = null rs++-- | Retrieve the locally-defined free variables of both the left and+-- right hand sides of the specialization rules+ruleInfoFreeVars :: RuleInfo -> DVarSet+ruleInfoFreeVars (RuleInfo _ fvs) = fvs++ruleInfoRules :: RuleInfo -> [CoreRule]+ruleInfoRules (RuleInfo rules _) = rules++-- | Change the name of the function the rule is keyed on on all of the 'CoreRule's+setRuleInfoHead :: Name -> RuleInfo -> RuleInfo+setRuleInfoHead fn (RuleInfo rules fvs)+  = RuleInfo (map (setRuleIdName fn) rules) fvs++{-+************************************************************************+*                                                                      *+\subsection[CG-IdInfo]{Code generator-related information}+*                                                                      *+************************************************************************+-}++-- CafInfo is used to build Static Reference Tables (see simplStg/SRT.hs).++-- | Constant applicative form Information+--+-- Records whether an 'Id' makes Constant Applicative Form references+data CafInfo+        = MayHaveCafRefs                -- ^ Indicates that the 'Id' is for either:+                                        --+                                        -- 1. A function or static constructor+                                        --    that refers to one or more CAFs, or+                                        --+                                        -- 2. A real live CAF++        | NoCafRefs                     -- ^ A function or static constructor+                                        -- that refers to no CAFs.+        deriving (Eq, Ord)++-- | Assumes that the 'Id' has CAF references: definitely safe+vanillaCafInfo :: CafInfo+vanillaCafInfo = MayHaveCafRefs++mayHaveCafRefs :: CafInfo -> Bool+mayHaveCafRefs  MayHaveCafRefs = True+mayHaveCafRefs _               = False++instance Outputable CafInfo where+   ppr = ppCafInfo++ppCafInfo :: CafInfo -> SDoc+ppCafInfo NoCafRefs = text "NoCafRefs"+ppCafInfo MayHaveCafRefs = empty++{-+************************************************************************+*                                                                      *+\subsection{Bulk operations on IdInfo}+*                                                                      *+************************************************************************+-}++-- | This is used to remove information on lambda binders that we have+-- setup as part of a lambda group, assuming they will be applied all at once,+-- but turn out to be part of an unsaturated lambda as in e.g:+--+-- > (\x1. \x2. e) arg1+zapLamInfo :: IdInfo -> Maybe IdInfo+zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand})+  | is_safe_occ occ && is_safe_dmd demand+  = Nothing+  | otherwise+  = Just (info {occInfo = safe_occ, demandInfo = topDmd})+  where+        -- The "unsafe" occ info is the ones that say I'm not in a lambda+        -- because that might not be true for an unsaturated lambda+    is_safe_occ occ | isAlwaysTailCalled occ     = False+    is_safe_occ (OneOcc { occ_in_lam = in_lam }) = in_lam+    is_safe_occ _other                           = True++    safe_occ = case occ of+                 OneOcc{} -> occ { occ_in_lam = True+                                 , occ_tail   = NoTailCallInfo }+                 IAmALoopBreaker{}+                          -> occ { occ_tail   = NoTailCallInfo }+                 _other   -> occ++    is_safe_dmd dmd = not (isStrictDmd dmd)++-- | Remove all demand info on the 'IdInfo'+zapDemandInfo :: IdInfo -> Maybe IdInfo+zapDemandInfo info = Just (info {demandInfo = topDmd})++-- | Remove usage (but not strictness) info on the 'IdInfo'+zapUsageInfo :: IdInfo -> Maybe IdInfo+zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)})++-- | Remove usage environment info from the strictness signature on the 'IdInfo'+zapUsageEnvInfo :: IdInfo -> Maybe IdInfo+zapUsageEnvInfo info+    | hasDemandEnvSig (strictnessInfo info)+    = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)})+    | otherwise+    = Nothing++zapUsedOnceInfo :: IdInfo -> Maybe IdInfo+zapUsedOnceInfo info+    = Just $ info { strictnessInfo = zapUsedOnceSig    (strictnessInfo info)+                  , demandInfo     = zapUsedOnceDemand (demandInfo     info) }++zapFragileInfo :: IdInfo -> Maybe IdInfo+-- ^ Zap info that depends on free variables+zapFragileInfo info@(IdInfo { occInfo = occ, unfoldingInfo = unf })+  = new_unf `seq`  -- The unfolding field is not (currently) strict, so we+                   -- force it here to avoid a (zapFragileUnfolding unf) thunk+                   -- which might leak space+    Just (info `setRuleInfo` emptyRuleInfo+               `setUnfoldingInfo` new_unf+               `setOccInfo`       zapFragileOcc occ)+  where+    new_unf = zapFragileUnfolding unf++zapFragileUnfolding :: Unfolding -> Unfolding+zapFragileUnfolding unf+ | isFragileUnfolding unf = noUnfolding+ | otherwise              = unf++zapUnfolding :: Unfolding -> Unfolding+-- Squash all unfolding info, preserving only evaluated-ness+zapUnfolding unf | isEvaldUnfolding unf = evaldUnfolding+                 | otherwise            = noUnfolding++zapTailCallInfo :: IdInfo -> Maybe IdInfo+zapTailCallInfo info+  = case occInfo info of+      occ | isAlwaysTailCalled occ -> Just (info `setOccInfo` safe_occ)+          | otherwise              -> Nothing+        where+          safe_occ = occ { occ_tail = NoTailCallInfo }++zapCallArityInfo :: IdInfo -> IdInfo+zapCallArityInfo info = setCallArityInfo info 0++{-+************************************************************************+*                                                                      *+\subsection{TickBoxOp}+*                                                                      *+************************************************************************+-}++type TickBoxId = Int++-- | Tick box for Hpc-style coverage+data TickBoxOp+   = TickBox Module {-# UNPACK #-} !TickBoxId++instance Outputable TickBoxOp where+    ppr (TickBox mod n)         = text "tick" <+> ppr (mod,n)++{-+************************************************************************+*                                                                      *+   Levity+*                                                                      *+************************************************************************++Note [Levity info]+~~~~~~~~~~~~~~~~~~++Ids store whether or not they can be levity-polymorphic at any amount+of saturation. This is helpful in optimizing the levity-polymorphism check+done in the desugarer, where we can usually learn that something is not+levity-polymorphic without actually figuring out its type. See+isExprLevPoly in CoreUtils for where this info is used. Storing+this is required to prevent perf/compiler/T5631 from blowing up.++-}++-- See Note [Levity info]+data LevityInfo = NoLevityInfo  -- always safe+                | NeverLevityPolymorphic+  deriving Eq++instance Outputable LevityInfo where+  ppr NoLevityInfo           = text "NoLevityInfo"+  ppr NeverLevityPolymorphic = text "NeverLevityPolymorphic"++-- | Marks an IdInfo describing an Id that is never levity polymorphic (even when+-- applied). The Type is only there for checking that it's really never levity+-- polymorphic+setNeverLevPoly :: HasDebugCallStack => IdInfo -> Type -> IdInfo+setNeverLevPoly info ty+  = ASSERT2( not (resultIsLevPoly ty), ppr ty )+    info { levityInfo = NeverLevityPolymorphic }++setLevityInfoWithType :: IdInfo -> Type -> IdInfo+setLevityInfoWithType info ty+  | not (resultIsLevPoly ty)+  = info { levityInfo = NeverLevityPolymorphic }+  | otherwise+  = info++isNeverLevPolyIdInfo :: IdInfo -> Bool+isNeverLevPolyIdInfo info+  | NeverLevityPolymorphic <- levityInfo info = True+  | otherwise                                 = False
+ compiler/basicTypes/IdInfo.hs-boot view
@@ -0,0 +1,11 @@+module IdInfo where+import GhcPrelude+import Outputable+data IdInfo+data IdDetails++vanillaIdInfo :: IdInfo+coVarDetails :: IdDetails+isCoVarDetails :: IdDetails -> Bool+pprIdDetails :: IdDetails -> SDoc+
+ compiler/basicTypes/Lexeme.hs view
@@ -0,0 +1,240 @@+-- (c) The GHC Team+--+-- Functions to evaluate whether or not a string is a valid identifier.+-- There is considerable overlap between the logic here and the logic+-- in Lexer.x, but sadly there seems to be no way to merge them.++module Lexeme (+          -- * Lexical characteristics of Haskell names++          -- | Use these functions to figure what kind of name a 'FastString'+          -- represents; these functions do /not/ check that the identifier+          -- is valid.++        isLexCon, isLexVar, isLexId, isLexSym,+        isLexConId, isLexConSym, isLexVarId, isLexVarSym,+        startsVarSym, startsVarId, startsConSym, startsConId,++          -- * Validating identifiers++          -- | These functions (working over plain old 'String's) check+          -- to make sure that the identifier is valid.+        okVarOcc, okConOcc, okTcOcc,+        okVarIdOcc, okVarSymOcc, okConIdOcc, okConSymOcc++        -- Some of the exports above are not used within GHC, but may+        -- be of value to GHC API users.++  ) where++import GhcPrelude++import FastString++import Data.Char+import qualified Data.Set as Set++import GHC.Lexeme++{-++************************************************************************+*                                                                      *+    Lexical categories+*                                                                      *+************************************************************************++These functions test strings to see if they fit the lexical categories+defined in the Haskell report.++Note [Classification of generated names]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Some names generated for internal use can show up in debugging output,+e.g.  when using -ddump-simpl. These generated names start with a $+but should still be pretty-printed using prefix notation. We make sure+this is the case in isLexVarSym by only classifying a name as a symbol+if all its characters are symbols, not just its first one.+-}++isLexCon,   isLexVar,    isLexId,    isLexSym    :: FastString -> Bool+isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool++isLexCon cs = isLexConId  cs || isLexConSym cs+isLexVar cs = isLexVarId  cs || isLexVarSym cs++isLexId  cs = isLexConId  cs || isLexVarId  cs+isLexSym cs = isLexConSym cs || isLexVarSym cs++-------------+isLexConId cs                           -- Prefix type or data constructors+  | nullFS cs          = False          --      e.g. "Foo", "[]", "(,)"+  | cs == (fsLit "[]") = True+  | otherwise          = startsConId (headFS cs)++isLexVarId cs                           -- Ordinary prefix identifiers+  | nullFS cs         = False           --      e.g. "x", "_x"+  | otherwise         = startsVarId (headFS cs)++isLexConSym cs                          -- Infix type or data constructors+  | nullFS cs          = False          --      e.g. ":-:", ":", "->"+  | cs == (fsLit "->") = True+  | otherwise          = startsConSym (headFS cs)++isLexVarSym fs                          -- Infix identifiers e.g. "+"+  | fs == (fsLit "~R#") = True+  | otherwise+  = case (if nullFS fs then [] else unpackFS fs) of+      [] -> False+      (c:cs) -> startsVarSym c && all isVarSymChar cs+        -- See Note [Classification of generated names]++{-++************************************************************************+*                                                                      *+    Detecting valid names for Template Haskell+*                                                                      *+************************************************************************++-}++----------------------+-- External interface+----------------------++-- | Is this an acceptable variable name?+okVarOcc :: String -> Bool+okVarOcc str@(c:_)+  | startsVarId c+  = okVarIdOcc str+  | startsVarSym c+  = okVarSymOcc str+okVarOcc _ = False++-- | Is this an acceptable constructor name?+okConOcc :: String -> Bool+okConOcc str@(c:_)+  | startsConId c+  = okConIdOcc str+  | startsConSym c+  = okConSymOcc str+  | str == "[]"+  = True+okConOcc _ = False++-- | Is this an acceptable type name?+okTcOcc :: String -> Bool+okTcOcc "[]" = True+okTcOcc "->" = True+okTcOcc "~"  = True+okTcOcc str@(c:_)+  | startsConId c+  = okConIdOcc str+  | startsConSym c+  = okConSymOcc str+  | startsVarSym c+  = okVarSymOcc str+okTcOcc _ = False++-- | Is this an acceptable alphanumeric variable name, assuming it starts+-- with an acceptable letter?+okVarIdOcc :: String -> Bool+okVarIdOcc str = okIdOcc str &&+                 -- admit "_" as a valid identifier.  Required to support typed+                 -- holes in Template Haskell.  See #10267+                 (str == "_" || not (str `Set.member` reservedIds))++-- | Is this an acceptable symbolic variable name, assuming it starts+-- with an acceptable character?+okVarSymOcc :: String -> Bool+okVarSymOcc str = all okSymChar str &&+                  not (str `Set.member` reservedOps) &&+                  not (isDashes str)++-- | Is this an acceptable alphanumeric constructor name, assuming it+-- starts with an acceptable letter?+okConIdOcc :: String -> Bool+okConIdOcc str = okIdOcc str ||+                 is_tuple_name1 True  str ||+                   -- Is it a boxed tuple...+                 is_tuple_name1 False str ||+                   -- ...or an unboxed tuple (#12407)...+                 is_sum_name1 str+                   -- ...or an unboxed sum (#12514)?+  where+    -- check for tuple name, starting at the beginning+    is_tuple_name1 True  ('(' : rest)       = is_tuple_name2 True  rest+    is_tuple_name1 False ('(' : '#' : rest) = is_tuple_name2 False rest+    is_tuple_name1 _     _                  = False++    -- check for tuple tail+    is_tuple_name2 True  ")"          = True+    is_tuple_name2 False "#)"         = True+    is_tuple_name2 boxed (',' : rest) = is_tuple_name2 boxed rest+    is_tuple_name2 boxed (ws  : rest)+      | isSpace ws                    = is_tuple_name2 boxed rest+    is_tuple_name2 _     _            = False++    -- check for sum name, starting at the beginning+    is_sum_name1 ('(' : '#' : rest) = is_sum_name2 False rest+    is_sum_name1 _                  = False++    -- check for sum tail, only allowing at most one underscore+    is_sum_name2 _          "#)"         = True+    is_sum_name2 underscore ('|' : rest) = is_sum_name2 underscore rest+    is_sum_name2 False      ('_' : rest) = is_sum_name2 True rest+    is_sum_name2 underscore (ws  : rest)+      | isSpace ws                       = is_sum_name2 underscore rest+    is_sum_name2 _          _            = False++-- | Is this an acceptable symbolic constructor name, assuming it+-- starts with an acceptable character?+okConSymOcc :: String -> Bool+okConSymOcc ":" = True+okConSymOcc str = all okSymChar str &&+                  not (str `Set.member` reservedOps)++----------------------+-- Internal functions+----------------------++-- | Is this string an acceptable id, possibly with a suffix of hashes,+-- but not worrying about case or clashing with reserved words?+okIdOcc :: String -> Bool+okIdOcc str+  = let hashes = dropWhile okIdChar str in+    all (== '#') hashes   -- -XMagicHash allows a suffix of hashes+                          -- of course, `all` says "True" to an empty list++-- | Is this character acceptable in an identifier (after the first letter)?+-- See alexGetByte in Lexer.x+okIdChar :: Char -> Bool+okIdChar c = case generalCategory c of+  UppercaseLetter -> True+  LowercaseLetter -> True+  TitlecaseLetter -> True+  ModifierLetter  -> True -- See #10196+  OtherLetter     -> True -- See #1103+  NonSpacingMark  -> True -- See #7650+  DecimalNumber   -> True+  OtherNumber     -> True -- See #4373+  _               -> c == '\'' || c == '_'++-- | All reserved identifiers. Taken from section 2.4 of the 2010 Report.+reservedIds :: Set.Set String+reservedIds = Set.fromList [ "case", "class", "data", "default", "deriving"+                           , "do", "else", "foreign", "if", "import", "in"+                           , "infix", "infixl", "infixr", "instance", "let"+                           , "module", "newtype", "of", "then", "type", "where"+                           , "_" ]++-- | All reserved operators. Taken from section 2.4 of the 2010 Report.+reservedOps :: Set.Set String+reservedOps = Set.fromList [ "..", ":", "::", "=", "\\", "|", "<-", "->"+                           , "@", "~", "=>" ]++-- | Does this string contain only dashes and has at least 2 of them?+isDashes :: String -> Bool+isDashes ('-' : '-' : rest) = all (== '-') rest+isDashes _                  = False
+ compiler/basicTypes/Literal.hs view
@@ -0,0 +1,834 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1998++\section[Literal]{@Literal@: literals}+-}++{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}++module Literal+        (+        -- * Main data type+          Literal(..)           -- Exported to ParseIface+        , LitNumType(..)++        -- ** Creating Literals+        , mkLitInt, mkLitIntWrap, mkLitIntWrapC+        , mkLitWord, mkLitWordWrap, mkLitWordWrapC+        , mkLitInt64, mkLitInt64Wrap+        , mkLitWord64, mkLitWord64Wrap+        , mkLitFloat, mkLitDouble+        , mkLitChar, mkLitString+        , mkLitInteger, mkLitNatural+        , mkLitNumber, mkLitNumberWrap++        -- ** Operations on Literals+        , literalType+        , absentLiteralOf+        , pprLiteral+        , litNumIsSigned+        , litNumCheckRange++        -- ** Predicates on Literals and their contents+        , litIsDupable, litIsTrivial, litIsLifted+        , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange+        , isZeroLit+        , litFitsInChar+        , litValue, isLitValue, isLitValue_maybe, mapLitValue++        -- ** Coercions+        , word2IntLit, int2WordLit+        , narrowLit+        , narrow8IntLit, narrow16IntLit, narrow32IntLit+        , narrow8WordLit, narrow16WordLit, narrow32WordLit+        , char2IntLit, int2CharLit+        , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit+        , nullAddrLit, rubbishLit, float2DoubleLit, double2FloatLit+        ) where++#include "HsVersions.h"++import GhcPrelude++import TysPrim+import PrelNames+import Type+import TyCon+import Outputable+import FastString+import BasicTypes+import Binary+import Constants+import DynFlags+import Platform+import UniqFM+import Util++import Data.ByteString (ByteString)+import Data.Int+import Data.Word+import Data.Char+import Data.Maybe ( isJust )+import Data.Data ( Data )+import Data.Proxy+import Numeric ( fromRat )++{-+************************************************************************+*                                                                      *+\subsection{Literals}+*                                                                      *+************************************************************************+-}++-- | So-called 'Literal's are one of:+--+-- * An unboxed numeric literal or floating-point literal which is presumed+--   to be surrounded by appropriate constructors (@Int#@, etc.), so that+--   the overall thing makes sense.+--+--   We maintain the invariant that the 'Integer' in the 'LitNumber'+--   constructor is actually in the (possibly target-dependent) range.+--   The mkLit{Int,Word}*Wrap smart constructors ensure this by applying+--   the target machine's wrapping semantics. Use these in situations+--   where you know the wrapping semantics are correct.+--+-- * The literal derived from the label mentioned in a \"foreign label\"+--   declaration ('LitLabel')+--+-- * A 'LitRubbish' to be used in place of values of 'UnliftedRep'+--   (i.e. 'MutVar#') when the the value is never used.+--+-- * A character+-- * A string+-- * The NULL pointer+--+data Literal+  = LitChar    Char             -- ^ @Char#@ - at least 31 bits. Create with+                                -- 'mkLitChar'++  | LitNumber !LitNumType !Integer Type+                                -- ^ Any numeric literal that can be+                                -- internally represented with an Integer++  | LitString  ByteString       -- ^ A string-literal: stored and emitted+                                -- UTF-8 encoded, we'll arrange to decode it+                                -- at runtime.  Also emitted with a @\'\\0\'@+                                -- terminator. Create with 'mkLitString'++  | LitNullAddr                 -- ^ The @NULL@ pointer, the only pointer value+                                -- that can be represented as a Literal. Create+                                -- with 'nullAddrLit'++  | LitRubbish                  -- ^ A nonsense value, used when an unlifted+                                -- binding is absent and has type+                                -- @forall (a :: 'TYPE' 'UnliftedRep'). a@.+                                -- May be lowered by code-gen to any possible+                                -- value. Also see Note [Rubbish literals]++  | LitFloat   Rational         -- ^ @Float#@. Create with 'mkLitFloat'+  | LitDouble  Rational         -- ^ @Double#@. Create with 'mkLitDouble'++  | LitLabel   FastString (Maybe Int) FunctionOrData+                                -- ^ A label literal. Parameters:+                                --+                                -- 1) The name of the symbol mentioned in the+                                --    declaration+                                --+                                -- 2) The size (in bytes) of the arguments+                                --    the label expects. Only applicable with+                                --    @stdcall@ labels. @Just x@ => @\<x\>@ will+                                --    be appended to label name when emitting+                                --    assembly.+                                --+                                -- 3) Flag indicating whether the symbol+                                --    references a function or a data+  deriving Data++-- | Numeric literal type+data LitNumType+  = LitNumInteger -- ^ @Integer@ (see Note [Integer literals])+  | LitNumNatural -- ^ @Natural@ (see Note [Natural literals])+  | LitNumInt     -- ^ @Int#@ - according to target machine+  | LitNumInt64   -- ^ @Int64#@ - exactly 64 bits+  | LitNumWord    -- ^ @Word#@ - according to target machine+  | LitNumWord64  -- ^ @Word64#@ - exactly 64 bits+  deriving (Data,Enum,Eq,Ord)++-- | Indicate if a numeric literal type supports negative numbers+litNumIsSigned :: LitNumType -> Bool+litNumIsSigned nt = case nt of+  LitNumInteger -> True+  LitNumNatural -> False+  LitNumInt     -> True+  LitNumInt64   -> True+  LitNumWord    -> False+  LitNumWord64  -> False++{-+Note [Integer literals]+~~~~~~~~~~~~~~~~~~~~~~~+An Integer literal is represented using, well, an Integer, to make it+easier to write RULEs for them. They also contain the Integer type, so+that e.g. literalType can return the right Type for them.++They only get converted into real Core,+    mkInteger [c1, c2, .., cn]+during the CorePrep phase, although TidyPgm looks ahead at what the+core will be, so that it can see whether it involves CAFs.++When we initally build an Integer literal, notably when+deserialising it from an interface file (see the Binary instance+below), we don't have convenient access to the mkInteger Id.  So we+just use an error thunk, and fill in the real Id when we do tcIfaceLit+in TcIface.++Note [Natural literals]+~~~~~~~~~~~~~~~~~~~~~~~+Similar to Integer literals.++Note [String literals]+~~~~~~~~~~~~~~~~~~~~~~++String literals are UTF-8 encoded and stored into ByteStrings in the following+ASTs: Haskell, Core, Stg, Cmm. TH can also emit ByteString based string literals+with the BytesPrimL constructor (see #14741).++It wasn't true before as [Word8] was used in Cmm AST and in TH which was quite+bad for performance with large strings (see #16198 and #14741).++To include string literals into output objects, the assembler code generator has+to embed the UTF-8 encoded binary blob. See Note [Embedding large binary blobs]+for more details.++-}++instance Binary LitNumType where+   put_ bh numTyp = putByte bh (fromIntegral (fromEnum numTyp))+   get bh = do+      h <- getByte bh+      return (toEnum (fromIntegral h))++instance Binary Literal where+    put_ bh (LitChar aa)     = do putByte bh 0; put_ bh aa+    put_ bh (LitString ab)   = do putByte bh 1; put_ bh ab+    put_ bh (LitNullAddr)    = do putByte bh 2+    put_ bh (LitFloat ah)    = do putByte bh 3; put_ bh ah+    put_ bh (LitDouble ai)   = do putByte bh 4; put_ bh ai+    put_ bh (LitLabel aj mb fod)+        = do putByte bh 5+             put_ bh aj+             put_ bh mb+             put_ bh fod+    put_ bh (LitNumber nt i _)+        = do putByte bh 6+             put_ bh nt+             put_ bh i+    put_ bh (LitRubbish)     = do putByte bh 7+    get bh = do+            h <- getByte bh+            case h of+              0 -> do+                    aa <- get bh+                    return (LitChar aa)+              1 -> do+                    ab <- get bh+                    return (LitString ab)+              2 -> do+                    return (LitNullAddr)+              3 -> do+                    ah <- get bh+                    return (LitFloat ah)+              4 -> do+                    ai <- get bh+                    return (LitDouble ai)+              5 -> do+                    aj <- get bh+                    mb <- get bh+                    fod <- get bh+                    return (LitLabel aj mb fod)+              6 -> do+                    nt <- get bh+                    i  <- get bh+                    let t = case nt of+                            LitNumInt     -> intPrimTy+                            LitNumInt64   -> int64PrimTy+                            LitNumWord    -> wordPrimTy+                            LitNumWord64  -> word64PrimTy+                            -- See Note [Integer literals]+                            LitNumInteger ->+                              panic "Evaluated the place holder for mkInteger"+                            -- and Note [Natural literals]+                            LitNumNatural ->+                              panic "Evaluated the place holder for mkNatural"+                    return (LitNumber nt i t)+              _ -> do+                    return (LitRubbish)++instance Outputable Literal where+    ppr lit = pprLiteral (\d -> d) lit++instance Eq Literal where+    a == b = case (a `compare` b) of { EQ -> True;   _ -> False }+    a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }++-- | Needed for the @Ord@ instance of 'AltCon', which in turn is needed in+-- 'TrieMap.CoreMap'.+instance Ord Literal where+    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }+    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }+    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }+    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }+    compare a b = cmpLit a b++{-+        Construction+        ~~~~~~~~~~~~+-}++{- Note [Word/Int underflow/overflow]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+According to the Haskell Report 2010 (Sections 18.1 and 23.1 about signed and+unsigned integral types): "All arithmetic is performed modulo 2^n, where n is+the number of bits in the type."++GHC stores Word# and Int# constant values as Integer. Core optimizations such+as constant folding must ensure that the Integer value remains in the valid+target Word/Int range (see #13172). The following functions are used to+ensure this.++Note that we *don't* warn the user about overflow. It's not done at runtime+either, and compilation of completely harmless things like+   ((124076834 :: Word32) + (2147483647 :: Word32))+doesn't yield a warning. Instead we simply squash the value into the *target*+Int/Word range.+-}++-- | Wrap a literal number according to its type+wrapLitNumber :: DynFlags -> Literal -> Literal+wrapLitNumber dflags v@(LitNumber nt i t) = case nt of+  LitNumInt -> case platformWordSize (targetPlatform dflags) of+    4 -> LitNumber nt (toInteger (fromIntegral i :: Int32)) t+    8 -> LitNumber nt (toInteger (fromIntegral i :: Int64)) t+    w -> panic ("wrapLitNumber: Unknown platformWordSize: " ++ show w)+  LitNumWord -> case platformWordSize (targetPlatform dflags) of+    4 -> LitNumber nt (toInteger (fromIntegral i :: Word32)) t+    8 -> LitNumber nt (toInteger (fromIntegral i :: Word64)) t+    w -> panic ("wrapLitNumber: Unknown platformWordSize: " ++ show w)+  LitNumInt64   -> LitNumber nt (toInteger (fromIntegral i :: Int64)) t+  LitNumWord64  -> LitNumber nt (toInteger (fromIntegral i :: Word64)) t+  LitNumInteger -> v+  LitNumNatural -> v+wrapLitNumber _ x = x++-- | Create a numeric 'Literal' of the given type+mkLitNumberWrap :: DynFlags -> LitNumType -> Integer -> Type -> Literal+mkLitNumberWrap dflags nt i t = wrapLitNumber dflags (LitNumber nt i t)++-- | Check that a given number is in the range of a numeric literal+litNumCheckRange :: DynFlags -> LitNumType -> Integer -> Bool+litNumCheckRange dflags nt i = case nt of+     LitNumInt     -> inIntRange dflags i+     LitNumWord    -> inWordRange dflags i+     LitNumInt64   -> inInt64Range i+     LitNumWord64  -> inWord64Range i+     LitNumNatural -> i >= 0+     LitNumInteger -> True++-- | Create a numeric 'Literal' of the given type+mkLitNumber :: DynFlags -> LitNumType -> Integer -> Type -> Literal+mkLitNumber dflags nt i t =+  ASSERT2(litNumCheckRange dflags nt i, integer i)+  (LitNumber nt i t)++-- | Creates a 'Literal' of type @Int#@+mkLitInt :: DynFlags -> Integer -> Literal+mkLitInt dflags x   = ASSERT2( inIntRange dflags x,  integer x )+                       (mkLitIntUnchecked x)++-- | Creates a 'Literal' of type @Int#@.+--   If the argument is out of the (target-dependent) range, it is wrapped.+--   See Note [Word/Int underflow/overflow]+mkLitIntWrap :: DynFlags -> Integer -> Literal+mkLitIntWrap dflags i = wrapLitNumber dflags $ mkLitIntUnchecked i++-- | Creates a 'Literal' of type @Int#@ without checking its range.+mkLitIntUnchecked :: Integer -> Literal+mkLitIntUnchecked i = LitNumber LitNumInt i intPrimTy++-- | Creates a 'Literal' of type @Int#@, as well as a 'Bool'ean flag indicating+--   overflow. That is, if the argument is out of the (target-dependent) range+--   the argument is wrapped and the overflow flag will be set.+--   See Note [Word/Int underflow/overflow]+mkLitIntWrapC :: DynFlags -> Integer -> (Literal, Bool)+mkLitIntWrapC dflags i = (n, i /= i')+  where+    n@(LitNumber _ i' _) = mkLitIntWrap dflags i++-- | Creates a 'Literal' of type @Word#@+mkLitWord :: DynFlags -> Integer -> Literal+mkLitWord dflags x   = ASSERT2( inWordRange dflags x, integer x )+                        (mkLitWordUnchecked x)++-- | Creates a 'Literal' of type @Word#@.+--   If the argument is out of the (target-dependent) range, it is wrapped.+--   See Note [Word/Int underflow/overflow]+mkLitWordWrap :: DynFlags -> Integer -> Literal+mkLitWordWrap dflags i = wrapLitNumber dflags $ mkLitWordUnchecked i++-- | Creates a 'Literal' of type @Word#@ without checking its range.+mkLitWordUnchecked :: Integer -> Literal+mkLitWordUnchecked i = LitNumber LitNumWord i wordPrimTy++-- | Creates a 'Literal' of type @Word#@, as well as a 'Bool'ean flag indicating+--   carry. That is, if the argument is out of the (target-dependent) range+--   the argument is wrapped and the carry flag will be set.+--   See Note [Word/Int underflow/overflow]+mkLitWordWrapC :: DynFlags -> Integer -> (Literal, Bool)+mkLitWordWrapC dflags i = (n, i /= i')+  where+    n@(LitNumber _ i' _) = mkLitWordWrap dflags i++-- | Creates a 'Literal' of type @Int64#@+mkLitInt64 :: Integer -> Literal+mkLitInt64  x = ASSERT2( inInt64Range x, integer x ) (mkLitInt64Unchecked x)++-- | Creates a 'Literal' of type @Int64#@.+--   If the argument is out of the range, it is wrapped.+mkLitInt64Wrap :: DynFlags -> Integer -> Literal+mkLitInt64Wrap dflags i = wrapLitNumber dflags $ mkLitInt64Unchecked i++-- | Creates a 'Literal' of type @Int64#@ without checking its range.+mkLitInt64Unchecked :: Integer -> Literal+mkLitInt64Unchecked i = LitNumber LitNumInt64 i int64PrimTy++-- | Creates a 'Literal' of type @Word64#@+mkLitWord64 :: Integer -> Literal+mkLitWord64 x = ASSERT2( inWord64Range x, integer x ) (mkLitWord64Unchecked x)++-- | Creates a 'Literal' of type @Word64#@.+--   If the argument is out of the range, it is wrapped.+mkLitWord64Wrap :: DynFlags -> Integer -> Literal+mkLitWord64Wrap dflags i = wrapLitNumber dflags $ mkLitWord64Unchecked i++-- | Creates a 'Literal' of type @Word64#@ without checking its range.+mkLitWord64Unchecked :: Integer -> Literal+mkLitWord64Unchecked i = LitNumber LitNumWord64 i word64PrimTy++-- | Creates a 'Literal' of type @Float#@+mkLitFloat :: Rational -> Literal+mkLitFloat = LitFloat++-- | Creates a 'Literal' of type @Double#@+mkLitDouble :: Rational -> Literal+mkLitDouble = LitDouble++-- | Creates a 'Literal' of type @Char#@+mkLitChar :: Char -> Literal+mkLitChar = LitChar++-- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to+-- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@+mkLitString :: String -> Literal+-- stored UTF-8 encoded+mkLitString s = LitString (bytesFS $ mkFastString s)++mkLitInteger :: Integer -> Type -> Literal+mkLitInteger x ty = LitNumber LitNumInteger x ty++mkLitNatural :: Integer -> Type -> Literal+mkLitNatural x ty = ASSERT2( inNaturalRange x,  integer x )+                    (LitNumber LitNumNatural x ty)++inIntRange, inWordRange :: DynFlags -> Integer -> Bool+inIntRange  dflags x = x >= tARGET_MIN_INT dflags && x <= tARGET_MAX_INT dflags+inWordRange dflags x = x >= 0                     && x <= tARGET_MAX_WORD dflags++inNaturalRange :: Integer -> Bool+inNaturalRange x = x >= 0++inInt64Range, inWord64Range :: Integer -> Bool+inInt64Range x  = x >= toInteger (minBound :: Int64) &&+                  x <= toInteger (maxBound :: Int64)+inWord64Range x = x >= toInteger (minBound :: Word64) &&+                  x <= toInteger (maxBound :: Word64)++inCharRange :: Char -> Bool+inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR++-- | Tests whether the literal represents a zero of whatever type it is+isZeroLit :: Literal -> Bool+isZeroLit (LitNumber _ 0 _) = True+isZeroLit (LitFloat  0)     = True+isZeroLit (LitDouble 0)     = True+isZeroLit _                 = False++-- | Returns the 'Integer' contained in the 'Literal', for when that makes+-- sense, i.e. for 'Char', 'Int', 'Word', 'LitInteger' and 'LitNatural'.+litValue  :: Literal -> Integer+litValue l = case isLitValue_maybe l of+   Just x  -> x+   Nothing -> pprPanic "litValue" (ppr l)++-- | Returns the 'Integer' contained in the 'Literal', for when that makes+-- sense, i.e. for 'Char' and numbers.+isLitValue_maybe  :: Literal -> Maybe Integer+isLitValue_maybe (LitChar   c)     = Just $ toInteger $ ord c+isLitValue_maybe (LitNumber _ i _) = Just i+isLitValue_maybe _                 = Nothing++-- | Apply a function to the 'Integer' contained in the 'Literal', for when that+-- makes sense, e.g. for 'Char' and numbers.+-- For fixed-size integral literals, the result will be wrapped in accordance+-- with the semantics of the target type.+-- See Note [Word/Int underflow/overflow]+mapLitValue  :: DynFlags -> (Integer -> Integer) -> Literal -> Literal+mapLitValue _      f (LitChar   c)      = mkLitChar (fchar c)+   where fchar = chr . fromInteger . f . toInteger . ord+mapLitValue dflags f (LitNumber nt i t) = wrapLitNumber dflags+                                                        (LitNumber nt (f i) t)+mapLitValue _      _ l                  = pprPanic "mapLitValue" (ppr l)++-- | Indicate if the `Literal` contains an 'Integer' value, e.g. 'Char',+-- 'Int', 'Word', 'LitInteger' and 'LitNatural'.+isLitValue  :: Literal -> Bool+isLitValue = isJust . isLitValue_maybe++{-+        Coercions+        ~~~~~~~~~+-}++narrow8IntLit, narrow16IntLit, narrow32IntLit,+  narrow8WordLit, narrow16WordLit, narrow32WordLit,+  char2IntLit, int2CharLit,+  float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,+  float2DoubleLit, double2FloatLit+  :: Literal -> Literal++word2IntLit, int2WordLit :: DynFlags -> Literal -> Literal+word2IntLit dflags (LitNumber LitNumWord w _)+  -- Map Word range [max_int+1, max_word]+  -- to Int range   [min_int  , -1]+  -- Range [0,max_int] has the same representation with both Int and Word+  | w > tARGET_MAX_INT dflags = mkLitInt dflags (w - tARGET_MAX_WORD dflags - 1)+  | otherwise                 = mkLitInt dflags w+word2IntLit _ l = pprPanic "word2IntLit" (ppr l)++int2WordLit dflags (LitNumber LitNumInt i _)+  -- Map Int range [min_int  , -1]+  -- to Word range [max_int+1, max_word]+  -- Range [0,max_int] has the same representation with both Int and Word+  | i < 0     = mkLitWord dflags (1 + tARGET_MAX_WORD dflags + i)+  | otherwise = mkLitWord dflags i+int2WordLit _ l = pprPanic "int2WordLit" (ppr l)++-- | Narrow a literal number (unchecked result range)+narrowLit :: forall a. Integral a => Proxy a -> Literal -> Literal+narrowLit _ (LitNumber nt i t) = LitNumber nt (toInteger (fromInteger i :: a)) t+narrowLit _ l                  = pprPanic "narrowLit" (ppr l)++narrow8IntLit   = narrowLit (Proxy :: Proxy Int8)+narrow16IntLit  = narrowLit (Proxy :: Proxy Int16)+narrow32IntLit  = narrowLit (Proxy :: Proxy Int32)+narrow8WordLit  = narrowLit (Proxy :: Proxy Word8)+narrow16WordLit = narrowLit (Proxy :: Proxy Word16)+narrow32WordLit = narrowLit (Proxy :: Proxy Word32)++char2IntLit (LitChar c)       = mkLitIntUnchecked (toInteger (ord c))+char2IntLit l                 = pprPanic "char2IntLit" (ppr l)+int2CharLit (LitNumber _ i _) = LitChar (chr (fromInteger i))+int2CharLit l                 = pprPanic "int2CharLit" (ppr l)++float2IntLit (LitFloat f)      = mkLitIntUnchecked (truncate f)+float2IntLit l                 = pprPanic "float2IntLit" (ppr l)+int2FloatLit (LitNumber _ i _) = LitFloat (fromInteger i)+int2FloatLit l                 = pprPanic "int2FloatLit" (ppr l)++double2IntLit (LitDouble f)     = mkLitIntUnchecked (truncate f)+double2IntLit l                 = pprPanic "double2IntLit" (ppr l)+int2DoubleLit (LitNumber _ i _) = LitDouble (fromInteger i)+int2DoubleLit l                 = pprPanic "int2DoubleLit" (ppr l)++float2DoubleLit (LitFloat  f) = LitDouble f+float2DoubleLit l             = pprPanic "float2DoubleLit" (ppr l)+double2FloatLit (LitDouble d) = LitFloat  d+double2FloatLit l             = pprPanic "double2FloatLit" (ppr l)++nullAddrLit :: Literal+nullAddrLit = LitNullAddr++-- | A nonsense literal of type @forall (a :: 'TYPE' 'UnliftedRep'). a@.+rubbishLit :: Literal+rubbishLit = LitRubbish++{-+        Predicates+        ~~~~~~~~~~+-}++-- | True if there is absolutely no penalty to duplicating the literal.+-- False principally of strings.+--+-- "Why?", you say? I'm glad you asked. Well, for one duplicating strings would+-- blow up code sizes. Not only this, it's also unsafe.+--+-- Consider a program that wants to traverse a string. One way it might do this+-- is to first compute the Addr# pointing to the end of the string, and then,+-- starting from the beginning, bump a pointer using eqAddr# to determine the+-- end. For instance,+--+-- @+-- -- Given pointers to the start and end of a string, count how many zeros+-- -- the string contains.+-- countZeros :: Addr# -> Addr# -> -> Int+-- countZeros start end = go start 0+--   where+--     go off n+--       | off `addrEq#` end = n+--       | otherwise         = go (off `plusAddr#` 1) n'+--       where n' | isTrue# (indexInt8OffAddr# off 0# ==# 0#) = n + 1+--                | otherwise                                 = n+-- @+--+-- Consider what happens if we considered strings to be trivial (and therefore+-- duplicable) and emitted a call like @countZeros "hello"# ("hello"#+-- `plusAddr`# 5)@. The beginning and end pointers do not belong to the same+-- string, meaning that an iteration like the above would blow up terribly.+-- This is what happened in #12757.+--+-- Ultimately the solution here is to make primitive strings a bit more+-- structured, ensuring that the compiler can't inline in ways that will break+-- user code. One approach to this is described in #8472.+litIsTrivial :: Literal -> Bool+--      c.f. CoreUtils.exprIsTrivial+litIsTrivial (LitString _)      = False+litIsTrivial (LitNumber nt _ _) = case nt of+  LitNumInteger -> False+  LitNumNatural -> False+  LitNumInt     -> True+  LitNumInt64   -> True+  LitNumWord    -> True+  LitNumWord64  -> True+litIsTrivial _                  = True++-- | True if code space does not go bad if we duplicate this literal+litIsDupable :: DynFlags -> Literal -> Bool+--      c.f. CoreUtils.exprIsDupable+litIsDupable _      (LitString _)      = False+litIsDupable dflags (LitNumber nt i _) = case nt of+  LitNumInteger -> inIntRange dflags i+  LitNumNatural -> inIntRange dflags i+  LitNumInt     -> True+  LitNumInt64   -> True+  LitNumWord    -> True+  LitNumWord64  -> True+litIsDupable _      _                  = True++litFitsInChar :: Literal -> Bool+litFitsInChar (LitNumber _ i _) = i >= toInteger (ord minBound)+                               && i <= toInteger (ord maxBound)+litFitsInChar _                 = False++litIsLifted :: Literal -> Bool+litIsLifted (LitNumber nt _ _) = case nt of+  LitNumInteger -> True+  LitNumNatural -> True+  LitNumInt     -> False+  LitNumInt64   -> False+  LitNumWord    -> False+  LitNumWord64  -> False+litIsLifted _                  = False++{-+        Types+        ~~~~~+-}++-- | Find the Haskell 'Type' the literal occupies+literalType :: Literal -> Type+literalType LitNullAddr       = addrPrimTy+literalType (LitChar _)       = charPrimTy+literalType (LitString  _)    = addrPrimTy+literalType (LitFloat _)      = floatPrimTy+literalType (LitDouble _)     = doublePrimTy+literalType (LitLabel _ _ _)  = addrPrimTy+literalType (LitNumber _ _ t) = t+literalType (LitRubbish)      = mkForAllTy a Inferred (mkTyVarTy a)+  where+    a = alphaTyVarUnliftedRep++absentLiteralOf :: TyCon -> Maybe Literal+-- Return a literal of the appropriate primitive+-- TyCon, to use as a placeholder when it doesn't matter+-- Rubbish literals are handled in WwLib, because+--  1. Looking at the TyCon is not enough, we need the actual type+--  2. This would need to return a type application to a literal+absentLiteralOf tc = lookupUFM absent_lits (tyConName tc)++absent_lits :: UniqFM Literal+absent_lits = listToUFM [ (addrPrimTyConKey,    LitNullAddr)+                        , (charPrimTyConKey,    LitChar 'x')+                        , (intPrimTyConKey,     mkLitIntUnchecked 0)+                        , (int64PrimTyConKey,   mkLitInt64Unchecked 0)+                        , (wordPrimTyConKey,    mkLitWordUnchecked 0)+                        , (word64PrimTyConKey,  mkLitWord64Unchecked 0)+                        , (floatPrimTyConKey,   LitFloat 0)+                        , (doublePrimTyConKey,  LitDouble 0)+                        ]++{-+        Comparison+        ~~~~~~~~~~+-}++cmpLit :: Literal -> Literal -> Ordering+cmpLit (LitChar      a)     (LitChar       b)     = a `compare` b+cmpLit (LitString    a)     (LitString     b)     = a `compare` b+cmpLit (LitNullAddr)        (LitNullAddr)         = EQ+cmpLit (LitFloat     a)     (LitFloat      b)     = a `compare` b+cmpLit (LitDouble    a)     (LitDouble     b)     = a `compare` b+cmpLit (LitLabel     a _ _) (LitLabel      b _ _) = a `compare` b+cmpLit (LitNumber nt1 a _)  (LitNumber nt2  b _)+  | nt1 == nt2 = a   `compare` b+  | otherwise  = nt1 `compare` nt2+cmpLit (LitRubbish)         (LitRubbish)          = EQ+cmpLit lit1 lit2+  | litTag lit1 < litTag lit2 = LT+  | otherwise                 = GT++litTag :: Literal -> Int+litTag (LitChar      _)   = 1+litTag (LitString    _)   = 2+litTag (LitNullAddr)      = 3+litTag (LitFloat     _)   = 4+litTag (LitDouble    _)   = 5+litTag (LitLabel _ _ _)   = 6+litTag (LitNumber  {})    = 7+litTag (LitRubbish)       = 8++{-+        Printing+        ~~~~~~~~+* See Note [Printing of literals in Core]+-}++pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc+pprLiteral _       (LitChar c)     = pprPrimChar c+pprLiteral _       (LitString s)   = pprHsBytes s+pprLiteral _       (LitNullAddr)   = text "__NULL"+pprLiteral _       (LitFloat f)    = float (fromRat f) <> primFloatSuffix+pprLiteral _       (LitDouble d)   = double (fromRat d) <> primDoubleSuffix+pprLiteral add_par (LitNumber nt i _)+   = case nt of+       LitNumInteger -> pprIntegerVal add_par i+       LitNumNatural -> pprIntegerVal add_par i+       LitNumInt     -> pprPrimInt i+       LitNumInt64   -> pprPrimInt64 i+       LitNumWord    -> pprPrimWord i+       LitNumWord64  -> pprPrimWord64 i+pprLiteral add_par (LitLabel l mb fod) =+    add_par (text "__label" <+> b <+> ppr fod)+    where b = case mb of+              Nothing -> pprHsString l+              Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))+pprLiteral _       (LitRubbish)     = text "__RUBBISH"++pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc+-- See Note [Printing of literals in Core].+pprIntegerVal add_par i | i < 0     = add_par (integer i)+                        | otherwise = integer i++{-+Note [Printing of literals in Core]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The function `add_par` is used to wrap parenthesis around negative integers+(`LitInteger`) and labels (`LitLabel`), if they occur in a context requiring+an atomic thing (for example function application).++Although not all Core literals would be valid Haskell, we are trying to stay+as close as possible to Haskell syntax in the printing of Core, to make it+easier for a Haskell user to read Core.++To that end:+  * We do print parenthesis around negative `LitInteger`, because we print+  `LitInteger` using plain number literals (no prefix or suffix), and plain+  number literals in Haskell require parenthesis in contexts like function+  application (i.e. `1 - -1` is not valid Haskell).++  * We don't print parenthesis around other (negative) literals, because they+  aren't needed in GHC/Haskell either (i.e. `1# -# -1#` is accepted by GHC's+  parser).++Literal         Output             Output if context requires+                                   an atom (if different)+-------         -------            ----------------------+LitChar         'a'#+LitString       "aaa"#+LitNullAddr     "__NULL"+LitInt          -1#+LitInt64        -1L#+LitWord          1##+LitWord64        1L##+LitFloat        -1.0#+LitDouble       -1.0##+LitInteger      -1                 (-1)+LitLabel        "__label" ...      ("__label" ...)+LitRubbish      "__RUBBISH"++Note [Rubbish literals]+~~~~~~~~~~~~~~~~~~~~~~~+During worker/wrapper after demand analysis, where an argument+is unused (absent) we do the following w/w split (supposing that+y is absent):++  f x y z = e+===>+  f x y z = $wf x z+  $wf x z = let y = <absent value>+            in e++Usually the binding for y is ultimately optimised away, and+even if not it should never be evaluated -- but that's the+way the w/w split starts off.++What is <absent value>?+* For lifted values <absent value> can be a call to 'error'.+* For primitive types like Int# or Word# we can use any random+  value of that type.+* But what about /unlifted/ but /boxed/ types like MutVar# or+  Array#?   We need a literal value of that type.++That is 'LitRubbish'.  Since we need a rubbish literal for+many boxed, unlifted types, we say that LitRubbish has type+  LitRubbish :: forall (a :: TYPE UnliftedRep). a++So we might see a w/w split like+  $wf x z = let y :: Array# Int = LitRubbish @(Array# Int)+            in e++Recall that (TYPE UnliftedRep) is the kind of boxed, unlifted+heap pointers.++Here are the moving parts:++* We define LitRubbish as a constructor in Literal.Literal++* It is given its polymoprhic type by Literal.literalType++* WwLib.mk_absent_let introduces a LitRubbish for absent+  arguments of boxed, unlifted type.++* In CoreToSTG we convert (RubishLit @t) to just ().  STG is+  untyped, so it doesn't matter that it points to a lifted+  value. The important thing is that it is a heap pointer,+  which the garbage collector can follow if it encounters it.++  We considered maintaining LitRubbish in STG, and lowering+  it in the code genreators, but it seems simpler to do it+  once and for all in CoreToSTG.++  In ByteCodeAsm we just lower it as a 0 literal, because+  it's all boxed and lifted to the host GC anyway.+-}
+ compiler/basicTypes/MkId.hs view
@@ -0,0 +1,1666 @@+{-+(c) The University of Glasgow 2006+(c) The AQUA Project, Glasgow University, 1998+++This module contains definitions for the IdInfo for things that+have a standard form, namely:++- data constructors+- record selectors+- method and superclass selectors+- primitive operations+-}++{-# LANGUAGE CPP #-}++module MkId (+        mkDictFunId, mkDictFunTy, mkDictSelId, mkDictSelRhs,++        mkPrimOpId, mkFCallId,++        unwrapNewTypeBody, wrapFamInstBody,+        DataConBoxer(..), mkDataConRep, mkDataConWorkId,++        -- And some particular Ids; see below for why they are wired in+        wiredInIds, ghcPrimIds,+        unsafeCoerceName, unsafeCoerceId, realWorldPrimId,+        voidPrimId, voidArgId,+        nullAddrId, seqId, lazyId, lazyIdKey,+        coercionTokenId, magicDictId, coerceId,+        proxyHashId, noinlineId, noinlineIdName,++        -- Re-export error Ids+        module PrelRules+    ) where++#include "HsVersions.h"++import GhcPrelude++import Rules+import TysPrim+import TysWiredIn+import PrelRules+import Type+import FamInstEnv+import Coercion+import TcType+import MkCore+import CoreUtils        ( exprType, mkCast )+import CoreUnfold+import Literal+import TyCon+import Class+import NameSet+import Name+import PrimOp+import ForeignCall+import DataCon+import Id+import IdInfo+import Demand+import CoreSyn+import Unique+import UniqSupply+import PrelNames+import BasicTypes       hiding ( SuccessFlag(..) )+import Util+import Pair+import DynFlags+import Outputable+import FastString+import ListSetOps+import qualified GHC.LanguageExtensions as LangExt++import Data.Maybe       ( maybeToList )++{-+************************************************************************+*                                                                      *+\subsection{Wired in Ids}+*                                                                      *+************************************************************************++Note [Wired-in Ids]+~~~~~~~~~~~~~~~~~~~+A "wired-in" Id can be referred to directly in GHC (e.g. 'voidPrimId')+rather than by looking it up its name in some environment or fetching+it from an interface file.++There are several reasons why an Id might appear in the wiredInIds:++* ghcPrimIds: see Note [ghcPrimIds (aka pseudoops)]++* magicIds: see Note [magicIds]++* errorIds, defined in coreSyn/MkCore.hs.+  These error functions (e.g. rUNTIME_ERROR_ID) are wired in+  because the desugarer generates code that mentions them directly++In all cases except ghcPrimIds, there is a definition site in a+library module, which may be called (e.g. in higher order situations);+but the wired-in version means that the details are never read from+that module's interface file; instead, the full definition is right+here.++Note [ghcPrimIds (aka pseudoops)]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The ghcPrimIds++  * Are exported from GHC.Prim++  * Can't be defined in Haskell, and hence no Haskell binding site,+    but have perfectly reasonable unfoldings in Core++  * Either have a CompulsoryUnfolding (hence always inlined), or+        of an EvaldUnfolding and void representation (e.g. void#)++  * Are (or should be) defined in primops.txt.pp as 'pseudoop'+    Reason: that's how we generate documentation for them++Note [magicIds]+~~~~~~~~~~~~~~~+The magicIds++  * Are exported from GHC.Magic++  * Can be defined in Haskell (and are, in ghc-prim:GHC/Magic.hs).+    This definition at least generates Haddock documentation for them.++  * May or may not have a CompulsoryUnfolding.++  * But have some special behaviour that can't be done via an+    unfolding from an interface file+-}++wiredInIds :: [Id]+wiredInIds+  =  magicIds+  ++ ghcPrimIds+  ++ errorIds           -- Defined in MkCore++magicIds :: [Id]    -- See Note [magicIds]+magicIds = [lazyId, oneShotId, noinlineId]++ghcPrimIds :: [Id]  -- See Note [ghcPrimIds (aka pseudoops)]+ghcPrimIds+  = [ realWorldPrimId+    , voidPrimId+    , unsafeCoerceId+    , nullAddrId+    , seqId+    , magicDictId+    , coerceId+    , proxyHashId+    ]++{-+************************************************************************+*                                                                      *+\subsection{Data constructors}+*                                                                      *+************************************************************************++The wrapper for a constructor is an ordinary top-level binding that evaluates+any strict args, unboxes any args that are going to be flattened, and calls+the worker.++We're going to build a constructor that looks like:++        data (Data a, C b) =>  T a b = T1 !a !Int b++        T1 = /\ a b ->+             \d1::Data a, d2::C b ->+             \p q r -> case p of { p ->+                       case q of { q ->+                       Con T1 [a,b] [p,q,r]}}++Notice that++* d2 is thrown away --- a context in a data decl is used to make sure+  one *could* construct dictionaries at the site the constructor+  is used, but the dictionary isn't actually used.++* We have to check that we can construct Data dictionaries for+  the types a and Int.  Once we've done that we can throw d1 away too.++* We use (case p of q -> ...) to evaluate p, rather than "seq" because+  all that matters is that the arguments are evaluated.  "seq" is+  very careful to preserve evaluation order, which we don't need+  to be here.++  You might think that we could simply give constructors some strictness+  info, like PrimOps, and let CoreToStg do the let-to-case transformation.+  But we don't do that because in the case of primops and functions strictness+  is a *property* not a *requirement*.  In the case of constructors we need to+  do something active to evaluate the argument.++  Making an explicit case expression allows the simplifier to eliminate+  it in the (common) case where the constructor arg is already evaluated.++Note [Wrappers for data instance tycons]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In the case of data instances, the wrapper also applies the coercion turning+the representation type into the family instance type to cast the result of+the wrapper.  For example, consider the declarations++  data family Map k :: * -> *+  data instance Map (a, b) v = MapPair (Map a (Pair b v))++The tycon to which the datacon MapPair belongs gets a unique internal+name of the form :R123Map, and we call it the representation tycon.+In contrast, Map is the family tycon (accessible via+tyConFamInst_maybe). A coercion allows you to move between+representation and family type.  It is accessible from :R123Map via+tyConFamilyCoercion_maybe and has kind++  Co123Map a b v :: {Map (a, b) v ~ :R123Map a b v}++The wrapper and worker of MapPair get the types++        -- Wrapper+  $WMapPair :: forall a b v. Map a (Map a b v) -> Map (a, b) v+  $WMapPair a b v = MapPair a b v `cast` sym (Co123Map a b v)++        -- Worker+  MapPair :: forall a b v. Map a (Map a b v) -> :R123Map a b v++This coercion is conditionally applied by wrapFamInstBody.++It's a bit more complicated if the data instance is a GADT as well!++   data instance T [a] where+        T1 :: forall b. b -> T [Maybe b]++Hence we translate to++        -- Wrapper+  $WT1 :: forall b. b -> T [Maybe b]+  $WT1 b v = T1 (Maybe b) b (Maybe b) v+                        `cast` sym (Co7T (Maybe b))++        -- Worker+  T1 :: forall c b. (c ~ Maybe b) => b -> :R7T c++        -- Coercion from family type to representation type+  Co7T a :: T [a] ~ :R7T a++Newtype instances through an additional wrinkle into the mix. Consider the+following example (adapted from #15318, comment:2):++  data family T a+  newtype instance T [a] = MkT [a]++Within the newtype instance, there are three distinct types at play:++1. The newtype's underlying type, [a].+2. The instance's representation type, TList a (where TList is the+   representation tycon).+3. The family type, T [a].++We need two coercions in order to cast from (1) to (3):++(a) A newtype coercion axiom:++      axiom coTList a :: TList a ~ [a]++    (Where TList is the representation tycon of the newtype instance.)++(b) A data family instance coercion axiom:++      axiom coT a :: T [a] ~ TList a++When we translate the newtype instance to Core, we obtain:++    -- Wrapper+  $WMkT :: forall a. [a] -> T [a]+  $WMkT a x = MkT a x |> Sym (coT a)++    -- Worker+  MkT :: forall a. [a] -> TList [a]+  MkT a x = x |> Sym (coTList a)++Unlike for data instances, the worker for a newtype instance is actually an+executable function which expands to a cast, but otherwise, the general+strategy is essentially the same as for data instances. Also note that we have+a wrapper, which is unusual for a newtype, but we make GHC produce one anyway+for symmetry with the way data instances are handled.++Note [Newtype datacons]+~~~~~~~~~~~~~~~~~~~~~~~+The "data constructor" for a newtype should always be vanilla.  At one+point this wasn't true, because the newtype arising from+     class C a => D a+looked like+       newtype T:D a = D:D (C a)+so the data constructor for T:C had a single argument, namely the+predicate (C a).  But now we treat that as an ordinary argument, not+part of the theta-type, so all is well.++Note [Compulsory newtype unfolding]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Newtype wrappers, just like workers, have compulsory unfoldings.+This is needed so that two optimizations involving newtypes have the same+effect whether a wrapper is present or not:++(1) Case-of-known constructor.+    See Note [beta-reduction in exprIsConApp_maybe].++(2) Matching against the map/coerce RULE. Suppose we have the RULE++    {-# RULE "map/coerce" map coerce = ... #-}++    As described in Note [Getting the map/coerce RULE to work],+    the occurrence of 'coerce' is transformed into:++    {-# RULE "map/coerce" forall (c :: T1 ~R# T2).+                          map ((\v -> v) `cast` c) = ... #-}++    We'd like 'map Age' to match the LHS. For this to happen, Age+    must be unfolded, otherwise we'll be stuck. This is tested in T16208.++************************************************************************+*                                                                      *+\subsection{Dictionary selectors}+*                                                                      *+************************************************************************++Selecting a field for a dictionary.  If there is just one field, then+there's nothing to do.++Dictionary selectors may get nested forall-types.  Thus:++        class Foo a where+          op :: forall b. Ord b => a -> b -> b++Then the top-level type for op is++        op :: forall a. Foo a =>+              forall b. Ord b =>+              a -> b -> b++-}++mkDictSelId :: Name          -- Name of one of the *value* selectors+                             -- (dictionary superclass or method)+            -> Class -> Id+mkDictSelId name clas+  = mkGlobalId (ClassOpId clas) name sel_ty info+  where+    tycon          = classTyCon clas+    sel_names      = map idName (classAllSelIds clas)+    new_tycon      = isNewTyCon tycon+    [data_con]     = tyConDataCons tycon+    tyvars         = dataConUserTyVarBinders data_con+    n_ty_args      = length tyvars+    arg_tys        = dataConRepArgTys data_con  -- Includes the dictionary superclasses+    val_index      = assoc "MkId.mkDictSelId" (sel_names `zip` [0..]) name++    sel_ty = mkForAllTys tyvars $+             mkInvisFunTy (mkClassPred clas (mkTyVarTys (binderVars tyvars))) $+             getNth arg_tys val_index++    base_info = noCafIdInfo+                `setArityInfo`          1+                `setStrictnessInfo`     strict_sig+                `setLevityInfoWithType` sel_ty++    info | new_tycon+         = base_info `setInlinePragInfo` alwaysInlinePragma+                     `setUnfoldingInfo`  mkInlineUnfoldingWithArity 1+                                           (mkDictSelRhs clas val_index)+                   -- See Note [Single-method classes] in TcInstDcls+                   -- for why alwaysInlinePragma++         | otherwise+         = base_info `setRuleInfo` mkRuleInfo [rule]+                   -- Add a magic BuiltinRule, but no unfolding+                   -- so that the rule is always available to fire.+                   -- See Note [ClassOp/DFun selection] in TcInstDcls++    -- This is the built-in rule that goes+    --      op (dfT d1 d2) --->  opT d1 d2+    rule = BuiltinRule { ru_name = fsLit "Class op " `appendFS`+                                     occNameFS (getOccName name)+                       , ru_fn    = name+                       , ru_nargs = n_ty_args + 1+                       , ru_try   = dictSelRule val_index n_ty_args }++        -- The strictness signature is of the form U(AAAVAAAA) -> T+        -- where the V depends on which item we are selecting+        -- It's worth giving one, so that absence info etc is generated+        -- even if the selector isn't inlined++    strict_sig = mkClosedStrictSig [arg_dmd] topRes+    arg_dmd | new_tycon = evalDmd+            | otherwise = mkManyUsedDmd $+                          mkProdDmd [ if name == sel_name then evalDmd else absDmd+                                    | sel_name <- sel_names ]++mkDictSelRhs :: Class+             -> Int         -- 0-indexed selector among (superclasses ++ methods)+             -> CoreExpr+mkDictSelRhs clas val_index+  = mkLams tyvars (Lam dict_id rhs_body)+  where+    tycon          = classTyCon clas+    new_tycon      = isNewTyCon tycon+    [data_con]     = tyConDataCons tycon+    tyvars         = dataConUnivTyVars data_con+    arg_tys        = dataConRepArgTys data_con  -- Includes the dictionary superclasses++    the_arg_id     = getNth arg_ids val_index+    pred           = mkClassPred clas (mkTyVarTys tyvars)+    dict_id        = mkTemplateLocal 1 pred+    arg_ids        = mkTemplateLocalsNum 2 arg_tys++    rhs_body | new_tycon = unwrapNewTypeBody tycon (mkTyVarTys tyvars)+                                                   (Var dict_id)+             | otherwise = Case (Var dict_id) dict_id (idType the_arg_id)+                                [(DataAlt data_con, arg_ids, varToCoreExpr the_arg_id)]+                                -- varToCoreExpr needed for equality superclass selectors+                                --   sel a b d = case x of { MkC _ (g:a~b) _ -> CO g }++dictSelRule :: Int -> Arity -> RuleFun+-- Tries to persuade the argument to look like a constructor+-- application, using exprIsConApp_maybe, and then selects+-- from it+--       sel_i t1..tk (D t1..tk op1 ... opm) = opi+--+dictSelRule val_index n_ty_args _ id_unf _ args+  | (dict_arg : _) <- drop n_ty_args args+  , Just (_, floats, _, _, con_args) <- exprIsConApp_maybe id_unf dict_arg+  = Just (wrapFloats floats $ getNth con_args val_index)+  | otherwise+  = Nothing++{-+************************************************************************+*                                                                      *+        Data constructors+*                                                                      *+************************************************************************+-}++mkDataConWorkId :: Name -> DataCon -> Id+mkDataConWorkId wkr_name data_con+  | isNewTyCon tycon+  = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info+  | otherwise+  = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info++  where+    tycon  = dataConTyCon data_con  -- The representation TyCon+    wkr_ty = dataConRepType data_con++        ----------- Workers for data types --------------+    alg_wkr_info = noCafIdInfo+                   `setArityInfo`          wkr_arity+                   `setStrictnessInfo`     wkr_sig+                   `setUnfoldingInfo`      evaldUnfolding  -- Record that it's evaluated,+                                                           -- even if arity = 0+                   `setLevityInfoWithType` wkr_ty+                     -- NB: unboxed tuples have workers, so we can't use+                     -- setNeverLevPoly++    wkr_arity = dataConRepArity data_con+    wkr_sig   = mkClosedStrictSig (replicate wkr_arity topDmd) (dataConCPR data_con)+        --      Note [Data-con worker strictness]+        -- Notice that we do *not* say the worker Id is strict+        -- even if the data constructor is declared strict+        --      e.g.    data T = MkT !(Int,Int)+        -- Why?  Because the *wrapper* $WMkT is strict (and its unfolding has+        -- case expressions that do the evals) but the *worker* MkT itself is+        --  not. If we pretend it is strict then when we see+        --      case x of y -> MkT y+        -- the simplifier thinks that y is "sure to be evaluated" (because+        -- the worker MkT is strict) and drops the case.  No, the workerId+        -- MkT is not strict.+        --+        -- However, the worker does have StrictnessMarks.  When the simplifier+        -- sees a pattern+        --      case e of MkT x -> ...+        -- it uses the dataConRepStrictness of MkT to mark x as evaluated;+        -- but that's fine... dataConRepStrictness comes from the data con+        -- not from the worker Id.++        ----------- Workers for newtypes --------------+    univ_tvs = dataConUnivTyVars data_con+    arg_tys  = dataConRepArgTys  data_con  -- Should be same as dataConOrigArgTys+    nt_work_info = noCafIdInfo          -- The NoCaf-ness is set by noCafIdInfo+                  `setArityInfo` 1      -- Arity 1+                  `setInlinePragInfo`     alwaysInlinePragma+                  `setUnfoldingInfo`      newtype_unf+                  `setLevityInfoWithType` wkr_ty+    id_arg1      = mkTemplateLocal 1 (head arg_tys)+    res_ty_args  = mkTyCoVarTys univ_tvs+    newtype_unf  = ASSERT2( isVanillaDataCon data_con &&+                            isSingleton arg_tys+                          , ppr data_con  )+                              -- Note [Newtype datacons]+                   mkCompulsoryUnfolding $+                   mkLams univ_tvs $ Lam id_arg1 $+                   wrapNewTypeBody tycon res_ty_args (Var id_arg1)++dataConCPR :: DataCon -> DmdResult+dataConCPR con+  | isDataTyCon tycon     -- Real data types only; that is,+                          -- not unboxed tuples or newtypes+  , null (dataConExTyCoVars con)  -- No existentials+  , wkr_arity > 0+  , wkr_arity <= mAX_CPR_SIZE+  = if is_prod then vanillaCprProdRes (dataConRepArity con)+               else cprSumRes (dataConTag con)+  | otherwise+  = topRes+  where+    is_prod   = isProductTyCon tycon+    tycon     = dataConTyCon con+    wkr_arity = dataConRepArity con++    mAX_CPR_SIZE :: Arity+    mAX_CPR_SIZE = 10+    -- We do not treat very big tuples as CPR-ish:+    --      a) for a start we get into trouble because there aren't+    --         "enough" unboxed tuple types (a tiresome restriction,+    --         but hard to fix),+    --      b) more importantly, big unboxed tuples get returned mainly+    --         on the stack, and are often then allocated in the heap+    --         by the caller.  So doing CPR for them may in fact make+    --         things worse.++{-+-------------------------------------------------+--         Data constructor representation+--+-- This is where we decide how to wrap/unwrap the+-- constructor fields+--+--------------------------------------------------+-}++type Unboxer = Var -> UniqSM ([Var], CoreExpr -> CoreExpr)+  -- Unbox: bind rep vars by decomposing src var++data Boxer = UnitBox | Boxer (TCvSubst -> UniqSM ([Var], CoreExpr))+  -- Box:   build src arg using these rep vars++-- | Data Constructor Boxer+newtype DataConBoxer = DCB ([Type] -> [Var] -> UniqSM ([Var], [CoreBind]))+                       -- Bind these src-level vars, returning the+                       -- rep-level vars to bind in the pattern++{-+Note [Inline partially-applied constructor wrappers]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++We allow the wrapper to inline when partially applied to avoid+boxing values unnecessarily. For example, consider++   data Foo a = Foo !Int a++   instance Traversable Foo where+     traverse f (Foo i a) = Foo i <$> f a++This desugars to++   traverse f foo = case foo of+        Foo i# a -> let i = I# i#+                    in map ($WFoo i) (f a)++If the wrapper `$WFoo` is not inlined, we get a fruitless reboxing of `i`.+But if we inline the wrapper, we get++   map (\a. case i of I# i# a -> Foo i# a) (f a)++and now case-of-known-constructor eliminates the redundant allocation.+-}++mkDataConRep :: DynFlags+             -> FamInstEnvs+             -> Name+             -> Maybe [HsImplBang]+                -- See Note [Bangs on imported data constructors]+             -> DataCon+             -> UniqSM DataConRep+mkDataConRep dflags fam_envs wrap_name mb_bangs data_con+  | not wrapper_reqd+  = return NoDataConRep++  | otherwise+  = do { wrap_args <- mapM newLocal wrap_arg_tys+       ; wrap_body <- mk_rep_app (wrap_args `zip` dropList eq_spec unboxers)+                                 initial_wrap_app++       ; let wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty wrap_info+             wrap_info = noCafIdInfo+                         `setArityInfo`         wrap_arity+                             -- It's important to specify the arity, so that partial+                             -- applications are treated as values+                         `setInlinePragInfo`    wrap_prag+                         `setUnfoldingInfo`     wrap_unf+                         `setStrictnessInfo`    wrap_sig+                             -- We need to get the CAF info right here because TidyPgm+                             -- does not tidy the IdInfo of implicit bindings (like the wrapper)+                             -- so it not make sure that the CAF info is sane+                         `setNeverLevPoly`      wrap_ty++             wrap_sig = mkClosedStrictSig wrap_arg_dmds (dataConCPR data_con)++             wrap_arg_dmds =+               replicate (length theta) topDmd ++ map mk_dmd arg_ibangs+               -- Don't forget the dictionary arguments when building+               -- the strictness signature (#14290).++             mk_dmd str | isBanged str = evalDmd+                        | otherwise           = topDmd++             wrap_prag = alwaysInlinePragma `setInlinePragmaActivation`+                         activeDuringFinal+                         -- See Note [Activation for data constructor wrappers]++             -- The wrapper will usually be inlined (see wrap_unf), so its+             -- strictness and CPR info is usually irrelevant. But this is+             -- not always the case; GHC may choose not to inline it. In+             -- particular, the wrapper constructor is not inlined inside+             -- an INLINE rhs or when it is not applied to any arguments.+             -- See Note [Inline partially-applied constructor wrappers]+             -- Passing Nothing here allows the wrapper to inline when+             -- unsaturated.+             wrap_unf | isNewTyCon tycon = mkCompulsoryUnfolding wrap_rhs+                        -- See Note [Compulsory newtype unfolding]+                      | otherwise        = mkInlineUnfolding wrap_rhs+             wrap_rhs = mkLams wrap_tvs $+                        mkLams wrap_args $+                        wrapFamInstBody tycon res_ty_args $+                        wrap_body++       ; return (DCR { dcr_wrap_id = wrap_id+                     , dcr_boxer   = mk_boxer boxers+                     , dcr_arg_tys = rep_tys+                     , dcr_stricts = rep_strs+                       -- For newtypes, dcr_bangs is always [HsLazy].+                       -- See Note [HsImplBangs for newtypes].+                     , dcr_bangs   = arg_ibangs }) }++  where+    (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys, _orig_res_ty)+      = dataConFullSig data_con+    wrap_tvs     = dataConUserTyVars data_con+    res_ty_args  = substTyVars (mkTvSubstPrs (map eqSpecPair eq_spec)) univ_tvs++    tycon        = dataConTyCon data_con       -- The representation TyCon (not family)+    wrap_ty      = dataConUserType data_con+    ev_tys       = eqSpecPreds eq_spec ++ theta+    all_arg_tys  = ev_tys ++ orig_arg_tys+    ev_ibangs    = map (const HsLazy) ev_tys+    orig_bangs   = dataConSrcBangs data_con++    wrap_arg_tys = theta ++ orig_arg_tys+    wrap_arity   = count isCoVar ex_tvs + length wrap_arg_tys+             -- The wrap_args are the arguments *other than* the eq_spec+             -- Because we are going to apply the eq_spec args manually in the+             -- wrapper++    new_tycon = isNewTyCon tycon+    arg_ibangs+      | new_tycon+      = ASSERT( isSingleton orig_arg_tys )+        [HsLazy] -- See Note [HsImplBangs for newtypes]+      | otherwise+      = case mb_bangs of+          Nothing    -> zipWith (dataConSrcToImplBang dflags fam_envs)+                                orig_arg_tys orig_bangs+          Just bangs -> bangs++    (rep_tys_w_strs, wrappers)+      = unzip (zipWith dataConArgRep all_arg_tys (ev_ibangs ++ arg_ibangs))++    (unboxers, boxers) = unzip wrappers+    (rep_tys, rep_strs) = unzip (concat rep_tys_w_strs)++    wrapper_reqd =+        (not new_tycon+                     -- (Most) newtypes have only a worker, with the exception+                     -- of some newtypes written with GADT syntax. See below.+         && (any isBanged (ev_ibangs ++ arg_ibangs)+                     -- Some forcing/unboxing (includes eq_spec)+             || (not $ null eq_spec))) -- GADT+      || isFamInstTyCon tycon -- Cast result+      || dataConUserTyVarsArePermuted data_con+                     -- If the data type was written with GADT syntax and+                     -- orders the type variables differently from what the+                     -- worker expects, it needs a data con wrapper to reorder+                     -- the type variables.+                     -- See Note [Data con wrappers and GADT syntax].++    initial_wrap_app = Var (dataConWorkId data_con)+                       `mkTyApps`  res_ty_args+                       `mkVarApps` ex_tvs+                       `mkCoApps`  map (mkReflCo Nominal . eqSpecType) eq_spec++    mk_boxer :: [Boxer] -> DataConBoxer+    mk_boxer boxers = DCB (\ ty_args src_vars ->+                      do { let (ex_vars, term_vars) = splitAtList ex_tvs src_vars+                               subst1 = zipTvSubst univ_tvs ty_args+                               subst2 = extendTCvSubstList subst1 ex_tvs+                                                           (mkTyCoVarTys ex_vars)+                         ; (rep_ids, binds) <- go subst2 boxers term_vars+                         ; return (ex_vars ++ rep_ids, binds) } )++    go _ [] src_vars = ASSERT2( null src_vars, ppr data_con ) return ([], [])+    go subst (UnitBox : boxers) (src_var : src_vars)+      = do { (rep_ids2, binds) <- go subst boxers src_vars+           ; return (src_var : rep_ids2, binds) }+    go subst (Boxer boxer : boxers) (src_var : src_vars)+      = do { (rep_ids1, arg)  <- boxer subst+           ; (rep_ids2, binds) <- go subst boxers src_vars+           ; return (rep_ids1 ++ rep_ids2, NonRec src_var arg : binds) }+    go _ (_:_) [] = pprPanic "mk_boxer" (ppr data_con)++    mk_rep_app :: [(Id,Unboxer)] -> CoreExpr -> UniqSM CoreExpr+    mk_rep_app [] con_app+      = return con_app+    mk_rep_app ((wrap_arg, unboxer) : prs) con_app+      = do { (rep_ids, unbox_fn) <- unboxer wrap_arg+           ; expr <- mk_rep_app prs (mkVarApps con_app rep_ids)+           ; return (unbox_fn expr) }++{- Note [Activation for data constructor wrappers]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The Activation on a data constructor wrapper allows it to inline only in Phase+0. This way rules have a chance to fire if they mention a data constructor on+the left+   RULE "foo"  f (K a b) = ...+Since the LHS of rules are simplified with InitialPhase, we won't+inline the wrapper on the LHS either.++On the other hand, this means that exprIsConApp_maybe must be able to deal+with wrappers so that case-of-constructor is not delayed; see+Note [exprIsConApp_maybe on data constructors with wrappers] for details.++It used to activate in phases 2 (afterInitial) and later, but it makes it+awkward to write a RULE[1] with a constructor on the left: it would work if a+constructor has no wrapper, but whether a constructor has a wrapper depends, for+instance, on the order of type argument of that constructors. Therefore changing+the order of type argument could make previously working RULEs fail.++See also https://gitlab.haskell.org/ghc/ghc/issues/15840 .+++Note [Bangs on imported data constructors]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++We pass Maybe [HsImplBang] to mkDataConRep to make use of HsImplBangs+from imported modules.++- Nothing <=> use HsSrcBangs+- Just bangs <=> use HsImplBangs++For imported types we can't work it all out from the HsSrcBangs,+because we want to be very sure to follow what the original module+(where the data type was declared) decided, and that depends on what+flags were enabled when it was compiled. So we record the decisions in+the interface file.++The HsImplBangs passed are in 1-1 correspondence with the+dataConOrigArgTys of the DataCon.++Note [Data con wrappers and unlifted types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+   data T = MkT !Int#++We certainly do not want to make a wrapper+   $WMkT x = case x of y { DEFAULT -> MkT y }++For a start, it's still to generate a no-op.  But worse, since wrappers+are currently injected at TidyCore, we don't even optimise it away!+So the stupid case expression stays there.  This actually happened for+the Integer data type (see #1600 comment:66)!++Note [Data con wrappers and GADT syntax]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider these two very similar data types:++  data T1 a b = MkT1 b++  data T2 a b where+    MkT2 :: forall b a. b -> T2 a b++Despite their similar appearance, T2 will have a data con wrapper but T1 will+not. What sets them apart? The types of their constructors, which are:++  MkT1 :: forall a b. b -> T1 a b+  MkT2 :: forall b a. b -> T2 a b++MkT2's use of GADT syntax allows it to permute the order in which `a` and `b`+would normally appear. See Note [DataCon user type variable binders] in DataCon+for further discussion on this topic.++The worker data cons for T1 and T2, however, both have types such that `a` is+expected to come before `b` as arguments. Because MkT2 permutes this order, it+needs a data con wrapper to swizzle around the type variables to be in the+order the worker expects.++A somewhat surprising consequence of this is that *newtypes* can have data con+wrappers! After all, a newtype can also be written with GADT syntax:++  newtype T3 a b where+    MkT3 :: forall b a. b -> T3 a b++Again, this needs a wrapper data con to reorder the type variables. It does+mean that this newtype constructor requires another level of indirection when+being called, but the inliner should make swift work of that.++Note [HsImplBangs for newtypes]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Most of the time, we use the dataConSrctoImplBang function to decide what+strictness/unpackedness to use for the fields of a data type constructor. But+there is an exception to this rule: newtype constructors. You might not think+that newtypes would pose a challenge, since newtypes are seemingly forbidden+from having strictness annotations in the first place. But consider this+(from #16141):++  {-# LANGUAGE StrictData #-}+  {-# OPTIONS_GHC -O #-}+  newtype T a b where+    MkT :: forall b a. Int -> T a b++Because StrictData (plus optimization) is enabled, invoking+dataConSrcToImplBang would sneak in and unpack the field of type Int to Int#!+This would be disastrous, since the wrapper for `MkT` uses a coercion involving+Int, not Int#.++Bottom line: dataConSrcToImplBang should never be invoked for newtypes. In the+case of a newtype constructor, we simply hardcode its dcr_bangs field to+[HsLazy].+-}++-------------------------+newLocal :: Type -> UniqSM Var+newLocal ty = do { uniq <- getUniqueM+                 ; return (mkSysLocalOrCoVar (fsLit "dt") uniq ty) }++-- | Unpack/Strictness decisions from source module.+--+-- This function should only ever be invoked for data constructor fields, and+-- never on the field of a newtype constructor.+-- See @Note [HsImplBangs for newtypes]@.+dataConSrcToImplBang+   :: DynFlags+   -> FamInstEnvs+   -> Type+   -> HsSrcBang+   -> HsImplBang++dataConSrcToImplBang dflags fam_envs arg_ty+                     (HsSrcBang ann unpk NoSrcStrict)+  | xopt LangExt.StrictData dflags -- StrictData => strict field+  = dataConSrcToImplBang dflags fam_envs arg_ty+                  (HsSrcBang ann unpk SrcStrict)+  | otherwise -- no StrictData => lazy field+  = HsLazy++dataConSrcToImplBang _ _ _ (HsSrcBang _ _ SrcLazy)+  = HsLazy++dataConSrcToImplBang dflags fam_envs arg_ty+                     (HsSrcBang _ unpk_prag SrcStrict)+  | isUnliftedType arg_ty+  = HsLazy  -- For !Int#, say, use HsLazy+            -- See Note [Data con wrappers and unlifted types]++  | not (gopt Opt_OmitInterfacePragmas dflags) -- Don't unpack if -fomit-iface-pragmas+          -- Don't unpack if we aren't optimising; rather arbitrarily,+          -- we use -fomit-iface-pragmas as the indication+  , let mb_co   = topNormaliseType_maybe fam_envs arg_ty+                     -- Unwrap type families and newtypes+        arg_ty' = case mb_co of { Just (_,ty) -> ty; Nothing -> arg_ty }+  , isUnpackableType dflags fam_envs arg_ty'+  , (rep_tys, _) <- dataConArgUnpack arg_ty'+  , case unpk_prag of+      NoSrcUnpack ->+        gopt Opt_UnboxStrictFields dflags+            || (gopt Opt_UnboxSmallStrictFields dflags+                && rep_tys `lengthAtMost` 1) -- See Note [Unpack one-wide fields]+      srcUnpack -> isSrcUnpacked srcUnpack+  = case mb_co of+      Nothing     -> HsUnpack Nothing+      Just (co,_) -> HsUnpack (Just co)++  | otherwise -- Record the strict-but-no-unpack decision+  = HsStrict+++-- | Wrappers/Workers and representation following Unpack/Strictness+-- decisions+dataConArgRep+  :: Type+  -> HsImplBang+  -> ([(Type,StrictnessMark)] -- Rep types+     ,(Unboxer,Boxer))++dataConArgRep arg_ty HsLazy+  = ([(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer))++dataConArgRep arg_ty HsStrict+  = ([(arg_ty, MarkedStrict)], (seqUnboxer, unitBoxer))++dataConArgRep arg_ty (HsUnpack Nothing)+  | (rep_tys, wrappers) <- dataConArgUnpack arg_ty+  = (rep_tys, wrappers)++dataConArgRep _ (HsUnpack (Just co))+  | let co_rep_ty = pSnd (coercionKind co)+  , (rep_tys, wrappers) <- dataConArgUnpack co_rep_ty+  = (rep_tys, wrapCo co co_rep_ty wrappers)+++-------------------------+wrapCo :: Coercion -> Type -> (Unboxer, Boxer) -> (Unboxer, Boxer)+wrapCo co rep_ty (unbox_rep, box_rep)  -- co :: arg_ty ~ rep_ty+  = (unboxer, boxer)+  where+    unboxer arg_id = do { rep_id <- newLocal rep_ty+                        ; (rep_ids, rep_fn) <- unbox_rep rep_id+                        ; let co_bind = NonRec rep_id (Var arg_id `Cast` co)+                        ; return (rep_ids, Let co_bind . rep_fn) }+    boxer = Boxer $ \ subst ->+            do { (rep_ids, rep_expr)+                    <- case box_rep of+                         UnitBox -> do { rep_id <- newLocal (TcType.substTy subst rep_ty)+                                       ; return ([rep_id], Var rep_id) }+                         Boxer boxer -> boxer subst+               ; let sco = substCoUnchecked subst co+               ; return (rep_ids, rep_expr `Cast` mkSymCo sco) }++------------------------+seqUnboxer :: Unboxer+seqUnboxer v = return ([v], \e -> Case (Var v) v (exprType e) [(DEFAULT, [], e)])++unitUnboxer :: Unboxer+unitUnboxer v = return ([v], \e -> e)++unitBoxer :: Boxer+unitBoxer = UnitBox++-------------------------+dataConArgUnpack+   :: Type+   ->  ( [(Type, StrictnessMark)]   -- Rep types+       , (Unboxer, Boxer) )++dataConArgUnpack arg_ty+  | Just (tc, tc_args) <- splitTyConApp_maybe arg_ty+  , Just con <- tyConSingleAlgDataCon_maybe tc+      -- NB: check for an *algebraic* data type+      -- A recursive newtype might mean that+      -- 'arg_ty' is a newtype+  , let rep_tys = dataConInstArgTys con tc_args+  = ASSERT( null (dataConExTyCoVars con) )+      -- Note [Unpacking GADTs and existentials]+    ( rep_tys `zip` dataConRepStrictness con+    ,( \ arg_id ->+       do { rep_ids <- mapM newLocal rep_tys+          ; let unbox_fn body+                  = Case (Var arg_id) arg_id (exprType body)+                         [(DataAlt con, rep_ids, body)]+          ; return (rep_ids, unbox_fn) }+     , Boxer $ \ subst ->+       do { rep_ids <- mapM (newLocal . TcType.substTyUnchecked subst) rep_tys+          ; return (rep_ids, Var (dataConWorkId con)+                             `mkTyApps` (substTysUnchecked subst tc_args)+                             `mkVarApps` rep_ids ) } ) )+  | otherwise+  = pprPanic "dataConArgUnpack" (ppr arg_ty)+    -- An interface file specified Unpacked, but we couldn't unpack it++isUnpackableType :: DynFlags -> FamInstEnvs -> Type -> Bool+-- True if we can unpack the UNPACK the argument type+-- See Note [Recursive unboxing]+-- We look "deeply" inside rather than relying on the DataCons+-- we encounter on the way, because otherwise we might well+-- end up relying on ourselves!+isUnpackableType dflags fam_envs ty+  | Just data_con <- unpackable_type ty+  = ok_con_args emptyNameSet data_con+  | otherwise+  = False+  where+    ok_con_args dcs con+       | dc_name `elemNameSet` dcs+       = False+       | otherwise+       = all (ok_arg dcs')+             (dataConOrigArgTys con `zip` dataConSrcBangs con)+          -- NB: dataConSrcBangs gives the *user* request;+          -- We'd get a black hole if we used dataConImplBangs+       where+         dc_name = getName con+         dcs' = dcs `extendNameSet` dc_name++    ok_arg dcs (ty, bang)+      = not (attempt_unpack bang) || ok_ty dcs norm_ty+      where+        norm_ty = topNormaliseType fam_envs ty++    ok_ty dcs ty+      | Just data_con <- unpackable_type ty+      = ok_con_args dcs data_con+      | otherwise+      = True        -- NB True here, in contrast to False at top level++    attempt_unpack (HsSrcBang _ SrcUnpack NoSrcStrict)+      = xopt LangExt.StrictData dflags+    attempt_unpack (HsSrcBang _ SrcUnpack SrcStrict)+      = True+    attempt_unpack (HsSrcBang _  NoSrcUnpack SrcStrict)+      = True  -- Be conservative+    attempt_unpack (HsSrcBang _  NoSrcUnpack NoSrcStrict)+      = xopt LangExt.StrictData dflags -- Be conservative+    attempt_unpack _ = False++    unpackable_type :: Type -> Maybe DataCon+    -- Works just on a single level+    unpackable_type ty+      | Just (tc, _) <- splitTyConApp_maybe ty+      , Just data_con <- tyConSingleAlgDataCon_maybe tc+      , null (dataConExTyCoVars data_con)+          -- See Note [Unpacking GADTs and existentials]+      = Just data_con+      | otherwise+      = Nothing++{-+Note [Unpacking GADTs and existentials]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+There is nothing stopping us unpacking a data type with equality+components, like+  data Equal a b where+    Equal :: Equal a a++And it'd be fine to unpack a product type with existential components+too, but that would require a bit more plumbing, so currently we don't.++So for now we require: null (dataConExTyCoVars data_con)+See #14978++Note [Unpack one-wide fields]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The flag UnboxSmallStrictFields ensures that any field that can+(safely) be unboxed to a word-sized unboxed field, should be so unboxed.+For example:++    data A = A Int#+    newtype B = B A+    data C = C !B+    data D = D !C+    data E = E !()+    data F = F !D+    data G = G !F !F++All of these should have an Int# as their representation, except+G which should have two Int#s.++However++    data T = T !(S Int)+    data S = S !a++Here we can represent T with an Int#.++Note [Recursive unboxing]+~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+  data R = MkR {-# UNPACK #-} !S Int+  data S = MkS {-# UNPACK #-} !Int+The representation arguments of MkR are the *representation* arguments+of S (plus Int); the rep args of MkS are Int#.  This is all fine.++But be careful not to try to unbox this!+        data T = MkT {-# UNPACK #-} !T Int+Because then we'd get an infinite number of arguments.++Here is a more complicated case:+        data S = MkS {-# UNPACK #-} !T Int+        data T = MkT {-# UNPACK #-} !S Int+Each of S and T must decide independently whether to unpack+and they had better not both say yes. So they must both say no.++Also behave conservatively when there is no UNPACK pragma+        data T = MkS !T Int+with -funbox-strict-fields or -funbox-small-strict-fields+we need to behave as if there was an UNPACK pragma there.++But it's the *argument* type that matters. This is fine:+        data S = MkS S !Int+because Int is non-recursive.++************************************************************************+*                                                                      *+        Wrapping and unwrapping newtypes and type families+*                                                                      *+************************************************************************+-}++wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr+-- The wrapper for the data constructor for a newtype looks like this:+--      newtype T a = MkT (a,Int)+--      MkT :: forall a. (a,Int) -> T a+--      MkT = /\a. \(x:(a,Int)). x `cast` sym (CoT a)+-- where CoT is the coercion TyCon associated with the newtype+--+-- The call (wrapNewTypeBody T [a] e) returns the+-- body of the wrapper, namely+--      e `cast` (CoT [a])+--+-- If a coercion constructor is provided in the newtype, then we use+-- it, otherwise the wrap/unwrap are both no-ops++wrapNewTypeBody tycon args result_expr+  = ASSERT( isNewTyCon tycon )+    mkCast result_expr (mkSymCo co)+  where+    co = mkUnbranchedAxInstCo Representational (newTyConCo tycon) args []++-- When unwrapping, we do *not* apply any family coercion, because this will+-- be done via a CoPat by the type checker.  We have to do it this way as+-- computing the right type arguments for the coercion requires more than just+-- a spliting operation (cf, TcPat.tcConPat).++unwrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr+unwrapNewTypeBody tycon args result_expr+  = ASSERT( isNewTyCon tycon )+    mkCast result_expr (mkUnbranchedAxInstCo Representational (newTyConCo tycon) args [])++-- If the type constructor is a representation type of a data instance, wrap+-- the expression into a cast adjusting the expression type, which is an+-- instance of the representation type, to the corresponding instance of the+-- family instance type.+-- See Note [Wrappers for data instance tycons]+wrapFamInstBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr+wrapFamInstBody tycon args body+  | Just co_con <- tyConFamilyCoercion_maybe tycon+  = mkCast body (mkSymCo (mkUnbranchedAxInstCo Representational co_con args []))+  | otherwise+  = body++{-+************************************************************************+*                                                                      *+\subsection{Primitive operations}+*                                                                      *+************************************************************************+-}++mkPrimOpId :: PrimOp -> Id+mkPrimOpId prim_op+  = id+  where+    (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op+    ty   = mkSpecForAllTys tyvars (mkVisFunTys arg_tys res_ty)+    name = mkWiredInName gHC_PRIM (primOpOcc prim_op)+                         (mkPrimOpIdUnique (primOpTag prim_op))+                         (AnId id) UserSyntax+    id   = mkGlobalId (PrimOpId prim_op) name ty info++    info = noCafIdInfo+           `setRuleInfo`           mkRuleInfo (maybeToList $ primOpRules name prim_op)+           `setArityInfo`          arity+           `setStrictnessInfo`     strict_sig+           `setInlinePragInfo`     neverInlinePragma+           `setLevityInfoWithType` res_ty+               -- We give PrimOps a NOINLINE pragma so that we don't+               -- get silly warnings from Desugar.dsRule (the inline_shadows_rule+               -- test) about a RULE conflicting with a possible inlining+               -- cf #7287++-- For each ccall we manufacture a separate CCallOpId, giving it+-- a fresh unique, a type that is correct for this particular ccall,+-- and a CCall structure that gives the correct details about calling+-- convention etc.+--+-- The *name* of this Id is a local name whose OccName gives the full+-- details of the ccall, type and all.  This means that the interface+-- file reader can reconstruct a suitable Id++mkFCallId :: DynFlags -> Unique -> ForeignCall -> Type -> Id+mkFCallId dflags uniq fcall ty+  = ASSERT( noFreeVarsOfType ty )+    -- A CCallOpId should have no free type variables;+    -- when doing substitutions won't substitute over it+    mkGlobalId (FCallId fcall) name ty info+  where+    occ_str = showSDoc dflags (braces (ppr fcall <+> ppr ty))+    -- The "occurrence name" of a ccall is the full info about the+    -- ccall; it is encoded, but may have embedded spaces etc!++    name = mkFCallName uniq occ_str++    info = noCafIdInfo+           `setArityInfo`          arity+           `setStrictnessInfo`     strict_sig+           `setLevityInfoWithType` ty++    (bndrs, _) = tcSplitPiTys ty+    arity      = count isAnonTyCoBinder bndrs+    strict_sig = mkClosedStrictSig (replicate arity topDmd) topRes+    -- the call does not claim to be strict in its arguments, since they+    -- may be lifted (foreign import prim) and the called code doesn't+    -- necessarily force them. See #11076.+{-+************************************************************************+*                                                                      *+\subsection{DictFuns and default methods}+*                                                                      *+************************************************************************++Note [Dict funs and default methods]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Dict funs and default methods are *not* ImplicitIds.  Their definition+involves user-written code, so we can't figure out their strictness etc+based on fixed info, as we can for constructors and record selectors (say).++NB: See also Note [Exported LocalIds] in Id+-}++mkDictFunId :: Name      -- Name to use for the dict fun;+            -> [TyVar]+            -> ThetaType+            -> Class+            -> [Type]+            -> Id+-- Implements the DFun Superclass Invariant (see TcInstDcls)+-- See Note [Dict funs and default methods]++mkDictFunId dfun_name tvs theta clas tys+  = mkExportedLocalId (DFunId is_nt)+                      dfun_name+                      dfun_ty+  where+    is_nt = isNewTyCon (classTyCon clas)+    dfun_ty = mkDictFunTy tvs theta clas tys++mkDictFunTy :: [TyVar] -> ThetaType -> Class -> [Type] -> Type+mkDictFunTy tvs theta clas tys+ = mkSpecSigmaTy tvs theta (mkClassPred clas tys)++{-+************************************************************************+*                                                                      *+\subsection{Un-definable}+*                                                                      *+************************************************************************++These Ids can't be defined in Haskell.  They could be defined in+unfoldings in the wired-in GHC.Prim interface file, but we'd have to+ensure that they were definitely, definitely inlined, because there is+no curried identifier for them.  That's what mkCompulsoryUnfolding+does.  If we had a way to get a compulsory unfolding from an interface+file, we could do that, but we don't right now.++unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that+just gets expanded into a type coercion wherever it occurs.  Hence we+add it as a built-in Id with an unfolding here.++The type variables we use here are "open" type variables: this means+they can unify with both unlifted and lifted types.  Hence we provide+another gun with which to shoot yourself in the foot.+-}++unsafeCoerceName, nullAddrName, seqName,+   realWorldName, voidPrimIdName, coercionTokenName,+   magicDictName, coerceName, proxyName :: Name+unsafeCoerceName  = mkWiredInIdName gHC_PRIM  (fsLit "unsafeCoerce#")  unsafeCoerceIdKey  unsafeCoerceId+nullAddrName      = mkWiredInIdName gHC_PRIM  (fsLit "nullAddr#")      nullAddrIdKey      nullAddrId+seqName           = mkWiredInIdName gHC_PRIM  (fsLit "seq")            seqIdKey           seqId+realWorldName     = mkWiredInIdName gHC_PRIM  (fsLit "realWorld#")     realWorldPrimIdKey realWorldPrimId+voidPrimIdName    = mkWiredInIdName gHC_PRIM  (fsLit "void#")          voidPrimIdKey      voidPrimId+coercionTokenName = mkWiredInIdName gHC_PRIM  (fsLit "coercionToken#") coercionTokenIdKey coercionTokenId+magicDictName     = mkWiredInIdName gHC_PRIM  (fsLit "magicDict")      magicDictKey       magicDictId+coerceName        = mkWiredInIdName gHC_PRIM  (fsLit "coerce")         coerceKey          coerceId+proxyName         = mkWiredInIdName gHC_PRIM  (fsLit "proxy#")         proxyHashKey       proxyHashId++lazyIdName, oneShotName, noinlineIdName :: Name+lazyIdName        = mkWiredInIdName gHC_MAGIC (fsLit "lazy")           lazyIdKey          lazyId+oneShotName       = mkWiredInIdName gHC_MAGIC (fsLit "oneShot")        oneShotKey         oneShotId+noinlineIdName    = mkWiredInIdName gHC_MAGIC (fsLit "noinline")       noinlineIdKey      noinlineId++------------------------------------------------+proxyHashId :: Id+proxyHashId+  = pcMiscPrelId proxyName ty+       (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings]+                    `setNeverLevPoly`  ty )+  where+    -- proxy# :: forall {k} (a:k). Proxy# k a+    --+    -- The visibility of the `k` binder is Inferred to match the type of the+    -- Proxy data constructor (#16293).+    [kv,tv] = mkTemplateKiTyVars [liftedTypeKind] id+    kv_ty   = mkTyVarTy kv+    tv_ty   = mkTyVarTy tv+    ty      = mkInvForAllTy kv $ mkSpecForAllTy tv $ mkProxyPrimTy kv_ty tv_ty++------------------------------------------------+unsafeCoerceId :: Id+unsafeCoerceId+  = pcMiscPrelId unsafeCoerceName ty info+  where+    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs++    -- unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)+    --                         (a :: TYPE r1) (b :: TYPE r2).+    --                         a -> b+    bndrs = mkTemplateKiTyVars [runtimeRepTy, runtimeRepTy]+                               (\ks -> map tYPE ks)++    [_, _, a, b] = mkTyVarTys bndrs++    ty  = mkSpecForAllTys bndrs (mkVisFunTy a b)++    [x] = mkTemplateLocals [a]+    rhs = mkLams (bndrs ++ [x]) $+          Cast (Var x) (mkUnsafeCo Representational a b)++------------------------------------------------+nullAddrId :: Id+-- nullAddr# :: Addr#+-- The reason it is here is because we don't provide+-- a way to write this literal in Haskell.+nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info+  where+    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma+                       `setUnfoldingInfo`  mkCompulsoryUnfolding (Lit nullAddrLit)+                       `setNeverLevPoly`   addrPrimTy++------------------------------------------------+seqId :: Id     -- See Note [seqId magic]+seqId = pcMiscPrelId seqName ty info+  where+    info = noCafIdInfo `setInlinePragInfo` inline_prag+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs+                       `setNeverLevPoly`   ty++    inline_prag+         = alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter+                 NoSourceText 0+                  -- Make 'seq' not inline-always, so that simpleOptExpr+                  -- (see CoreSubst.simple_app) won't inline 'seq' on the+                  -- LHS of rules.  That way we can have rules for 'seq';+                  -- see Note [seqId magic]++    ty  = mkSpecForAllTys [alphaTyVar,betaTyVar]+                          (mkVisFunTy alphaTy (mkVisFunTy betaTy betaTy))++    [x,y] = mkTemplateLocals [alphaTy, betaTy]+    rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x betaTy [(DEFAULT, [], Var y)])++------------------------------------------------+lazyId :: Id    -- See Note [lazyId magic]+lazyId = pcMiscPrelId lazyIdName ty info+  where+    info = noCafIdInfo `setNeverLevPoly` ty+    ty  = mkSpecForAllTys [alphaTyVar] (mkVisFunTy alphaTy alphaTy)++noinlineId :: Id -- See Note [noinlineId magic]+noinlineId = pcMiscPrelId noinlineIdName ty info+  where+    info = noCafIdInfo `setNeverLevPoly` ty+    ty  = mkSpecForAllTys [alphaTyVar] (mkVisFunTy alphaTy alphaTy)++oneShotId :: Id -- See Note [The oneShot function]+oneShotId = pcMiscPrelId oneShotName ty info+  where+    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs+    ty  = mkSpecForAllTys [ runtimeRep1TyVar, runtimeRep2TyVar+                          , openAlphaTyVar, openBetaTyVar ]+                          (mkVisFunTy fun_ty fun_ty)+    fun_ty = mkVisFunTy openAlphaTy openBetaTy+    [body, x] = mkTemplateLocals [fun_ty, openAlphaTy]+    x' = setOneShotLambda x  -- Here is the magic bit!+    rhs = mkLams [ runtimeRep1TyVar, runtimeRep2TyVar+                 , openAlphaTyVar, openBetaTyVar+                 , body, x'] $+          Var body `App` Var x++--------------------------------------------------------------------------------+magicDictId :: Id  -- See Note [magicDictId magic]+magicDictId = pcMiscPrelId magicDictName ty info+  where+  info = noCafIdInfo `setInlinePragInfo` neverInlinePragma+                     `setNeverLevPoly`   ty+  ty   = mkSpecForAllTys [alphaTyVar] alphaTy++--------------------------------------------------------------------------------++coerceId :: Id+coerceId = pcMiscPrelId coerceName ty info+  where+    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs+                       `setNeverLevPoly`   ty+    eqRTy     = mkTyConApp coercibleTyCon [ liftedTypeKind+                                          , alphaTy, betaTy ]+    eqRPrimTy = mkTyConApp eqReprPrimTyCon [ liftedTypeKind+                                           , liftedTypeKind+                                           , alphaTy, betaTy ]+    ty        = mkSpecForAllTys [alphaTyVar, betaTyVar] $+                mkInvisFunTy eqRTy                      $+                mkVisFunTy alphaTy betaTy++    [eqR,x,eq] = mkTemplateLocals [eqRTy, alphaTy, eqRPrimTy]+    rhs = mkLams [alphaTyVar, betaTyVar, eqR, x] $+          mkWildCase (Var eqR) eqRTy betaTy $+          [(DataAlt coercibleDataCon, [eq], Cast (Var x) (mkCoVarCo eq))]++{-+Note [Unsafe coerce magic]+~~~~~~~~~~~~~~~~~~~~~~~~~~+We define a *primitive*+   GHC.Prim.unsafeCoerce#+and then in the base library we define the ordinary function+   Unsafe.Coerce.unsafeCoerce :: forall (a:*) (b:*). a -> b+   unsafeCoerce x = unsafeCoerce# x++Notice that unsafeCoerce has a civilized (albeit still dangerous)+polymorphic type, whose type args have kind *.  So you can't use it on+unboxed values (unsafeCoerce 3#).++In contrast unsafeCoerce# is even more dangerous because you *can* use+it on unboxed things, (unsafeCoerce# 3#) :: Int. Its type is+   forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (a: TYPE r1) (b: TYPE r2). a -> b++Note [seqId magic]+~~~~~~~~~~~~~~~~~~+'GHC.Prim.seq' is special in several ways.++a) In source Haskell its second arg can have an unboxed type+      x `seq` (v +# w)+   But see Note [Typing rule for seq] in TcExpr, which+   explains why we give seq itself an ordinary type+         seq :: forall a b. a -> b -> b+   and treat it as a language construct from a typing point of view.++b) Its fixity is set in LoadIface.ghcPrimIface++c) It has quite a bit of desugaring magic.+   See DsUtils.hs Note [Desugaring seq (1)] and (2) and (3)++d) There is some special rule handing: Note [User-defined RULES for seq]++Note [User-defined RULES for seq]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Roman found situations where he had+      case (f n) of _ -> e+where he knew that f (which was strict in n) would terminate if n did.+Notice that the result of (f n) is discarded. So it makes sense to+transform to+      case n of _ -> e++Rather than attempt some general analysis to support this, I've added+enough support that you can do this using a rewrite rule:++  RULE "f/seq" forall n.  seq (f n) = seq n++You write that rule.  When GHC sees a case expression that discards+its result, it mentally transforms it to a call to 'seq' and looks for+a RULE.  (This is done in Simplify.trySeqRules.)  As usual, the+correctness of the rule is up to you.++VERY IMPORTANT: to make this work, we give the RULE an arity of 1, not 2.+If we wrote+  RULE "f/seq" forall n e.  seq (f n) e = seq n e+with rule arity 2, then two bad things would happen:++  - The magical desugaring done in Note [seqId magic] item (c)+    for saturated application of 'seq' would turn the LHS into+    a case expression!++  - The code in Simplify.rebuildCase would need to actually supply+    the value argument, which turns out to be awkward.++Note [lazyId magic]+~~~~~~~~~~~~~~~~~~~+lazy :: forall a?. a? -> a?   (i.e. works for unboxed types too)++'lazy' is used to make sure that a sub-expression, and its free variables,+are truly used call-by-need, with no code motion.  Key examples:++* pseq:    pseq a b = a `seq` lazy b+  We want to make sure that the free vars of 'b' are not evaluated+  before 'a', even though the expression is plainly strict in 'b'.++* catch:   catch a b = catch# (lazy a) b+  Again, it's clear that 'a' will be evaluated strictly (and indeed+  applied to a state token) but we want to make sure that any exceptions+  arising from the evaluation of 'a' are caught by the catch (see+  #11555).++Implementing 'lazy' is a bit tricky:++* It must not have a strictness signature: by being a built-in Id,+  all the info about lazyId comes from here, not from GHC.Base.hi.+  This is important, because the strictness analyser will spot it as+  strict!++* It must not have an unfolding: it gets "inlined" by a HACK in+  CorePrep. It's very important to do this inlining *after* unfoldings+  are exposed in the interface file.  Otherwise, the unfolding for+  (say) pseq in the interface file will not mention 'lazy', so if we+  inline 'pseq' we'll totally miss the very thing that 'lazy' was+  there for in the first place. See #3259 for a real world+  example.++* Suppose CorePrep sees (catch# (lazy e) b).  At all costs we must+  avoid using call by value here:+     case e of r -> catch# r b+  Avoiding that is the whole point of 'lazy'.  So in CorePrep (which+  generate the 'case' expression for a call-by-value call) we must+  spot the 'lazy' on the arg (in CorePrep.cpeApp), and build a 'let'+  instead.++* lazyId is defined in GHC.Base, so we don't *have* to inline it.  If it+  appears un-applied, we'll end up just calling it.++Note [noinlineId magic]+~~~~~~~~~~~~~~~~~~~~~~~+noinline :: forall a. a -> a++'noinline' is used to make sure that a function f is never inlined,+e.g., as in 'noinline f x'.  Ordinarily, the identity function with NOINLINE+could be used to achieve this effect; however, this has the unfortunate+result of leaving a (useless) call to noinline at runtime.  So we have+a little bit of magic to optimize away 'noinline' after we are done+running the simplifier.++'noinline' needs to be wired-in because it gets inserted automatically+when we serialize an expression to the interface format. See+Note [Inlining and hs-boot files] in ToIface++Note [The oneShot function]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+In the context of making left-folds fuse somewhat okish (see ticket #7994+and Note [Left folds via right fold]) it was determined that it would be useful+if library authors could explicitly tell the compiler that a certain lambda is+called at most once. The oneShot function allows that.++'oneShot' is levity-polymorphic, i.e. the type variables can refer to unlifted+types as well (#10744); e.g.+   oneShot (\x:Int# -> x +# 1#)++Like most magic functions it has a compulsory unfolding, so there is no need+for a real definition somewhere. We have one in GHC.Magic for the convenience+of putting the documentation there.++It uses `setOneShotLambda` on the lambda's binder. That is the whole magic:++A typical call looks like+     oneShot (\y. e)+after unfolding the definition `oneShot = \f \x[oneshot]. f x` we get+     (\f \x[oneshot]. f x) (\y. e)+ --> \x[oneshot]. ((\y.e) x)+ --> \x[oneshot] e[x/y]+which is what we want.++It is only effective if the one-shot info survives as long as possible; in+particular it must make it into the interface in unfoldings. See Note [Preserve+OneShotInfo] in CoreTidy.++Also see https://gitlab.haskell.org/ghc/ghc/wikis/one-shot.+++Note [magicDictId magic]+~~~~~~~~~~~~~~~~~~~~~~~~~+The identifier `magicDict` is just a place-holder, which is used to+implement a primitive that we cannot define in Haskell but we can write+in Core.  It is declared with a place-holder type:++    magicDict :: forall a. a++The intention is that the identifier will be used in a very specific way,+to create dictionaries for classes with a single method.  Consider a class+like this:++   class C a where+     f :: T a++We are going to use `magicDict`, in conjunction with a built-in Prelude+rule, to cast values of type `T a` into dictionaries for `C a`.  To do+this, we define a function like this in the library:++  data WrapC a b = WrapC (C a => Proxy a -> b)++  withT :: (C a => Proxy a -> b)+        ->  T a -> Proxy a -> b+  withT f x y = magicDict (WrapC f) x y++The purpose of `WrapC` is to avoid having `f` instantiated.+Also, it avoids impredicativity, because `magicDict`'s type+cannot be instantiated with a forall.  The field of `WrapC` contains+a `Proxy` parameter which is used to link the type of the constraint,+`C a`, with the type of the `Wrap` value being made.++Next, we add a built-in Prelude rule (see prelude/PrelRules.hs),+which will replace the RHS of this definition with the appropriate+definition in Core.  The rewrite rule works as follows:++  magicDict @t (wrap @a @b f) x y+---->+  f (x `cast` co a) y++The `co` coercion is the newtype-coercion extracted from the type-class.+The type class is obtain by looking at the type of wrap.+++-------------------------------------------------------------+@realWorld#@ used to be a magic literal, \tr{void#}.  If things get+nasty as-is, change it back to a literal (@Literal@).++voidArgId is a Local Id used simply as an argument in functions+where we just want an arg to avoid having a thunk of unlifted type.+E.g.+        x = \ void :: Void# -> (# p, q #)++This comes up in strictness analysis++Note [evaldUnfoldings]+~~~~~~~~~~~~~~~~~~~~~~+The evaldUnfolding makes it look that some primitive value is+evaluated, which in turn makes Simplify.interestingArg return True,+which in turn makes INLINE things applied to said value likely to be+inlined.+-}++realWorldPrimId :: Id   -- :: State# RealWorld+realWorldPrimId = pcMiscPrelId realWorldName realWorldStatePrimTy+                     (noCafIdInfo `setUnfoldingInfo` evaldUnfolding    -- Note [evaldUnfoldings]+                                  `setOneShotInfo` stateHackOneShot+                                  `setNeverLevPoly` realWorldStatePrimTy)++voidPrimId :: Id     -- Global constant :: Void#+voidPrimId  = pcMiscPrelId voidPrimIdName voidPrimTy+                (noCafIdInfo `setUnfoldingInfo` evaldUnfolding     -- Note [evaldUnfoldings]+                             `setNeverLevPoly`  voidPrimTy)++voidArgId :: Id       -- Local lambda-bound :: Void#+voidArgId = mkSysLocal (fsLit "void") voidArgIdKey voidPrimTy++coercionTokenId :: Id         -- :: () ~ ()+coercionTokenId -- Used to replace Coercion terms when we go to STG+  = pcMiscPrelId coercionTokenName+                 (mkTyConApp eqPrimTyCon [liftedTypeKind, liftedTypeKind, unitTy, unitTy])+                 noCafIdInfo++pcMiscPrelId :: Name -> Type -> IdInfo -> Id+pcMiscPrelId name ty info+  = mkVanillaGlobalWithInfo name ty info+    -- We lie and say the thing is imported; otherwise, we get into+    -- a mess with dependency analysis; e.g., core2stg may heave in+    -- random calls to GHCbase.unpackPS__.  If GHCbase is the module+    -- being compiled, then it's just a matter of luck if the definition+    -- will be in "the right place" to be in scope.
+ compiler/basicTypes/MkId.hs-boot view
@@ -0,0 +1,15 @@+module MkId where+import Name( Name )+import Var( Id )+import Class( Class )+import {-# SOURCE #-} DataCon( DataCon )+import {-# SOURCE #-} PrimOp( PrimOp )++data DataConBoxer++mkDataConWorkId :: Name -> DataCon -> Id+mkDictSelId     :: Name -> Class   -> Id++mkPrimOpId      :: PrimOp -> Id++magicDictId :: Id
+ compiler/basicTypes/Module.hs view
@@ -0,0 +1,1303 @@+{-+(c) The University of Glasgow, 2004-2006+++Module+~~~~~~~~~~+Simply the name of a module, represented as a FastString.+These are Uniquable, hence we can build Maps with Modules as+the keys.+-}++{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Module+    (+        -- * The ModuleName type+        ModuleName,+        pprModuleName,+        moduleNameFS,+        moduleNameString,+        moduleNameSlashes, moduleNameColons,+        moduleStableString,+        moduleFreeHoles,+        moduleIsDefinite,+        mkModuleName,+        mkModuleNameFS,+        stableModuleNameCmp,++        -- * The UnitId type+        ComponentId(..),+        UnitId(..),+        unitIdFS,+        unitIdKey,+        IndefUnitId(..),+        IndefModule(..),+        indefUnitIdToUnitId,+        indefModuleToModule,+        InstalledUnitId(..),+        toInstalledUnitId,+        ShHoleSubst,++        unitIdIsDefinite,+        unitIdString,+        unitIdFreeHoles,++        newUnitId,+        newIndefUnitId,+        newSimpleUnitId,+        hashUnitId,+        fsToUnitId,+        stringToUnitId,+        stableUnitIdCmp,++        -- * HOLE renaming+        renameHoleUnitId,+        renameHoleModule,+        renameHoleUnitId',+        renameHoleModule',++        -- * Generalization+        splitModuleInsts,+        splitUnitIdInsts,+        generalizeIndefUnitId,+        generalizeIndefModule,++        -- * Parsers+        parseModuleName,+        parseUnitId,+        parseComponentId,+        parseModuleId,+        parseModSubst,++        -- * Wired-in UnitIds+        -- $wired_in_packages+        primUnitId,+        integerUnitId,+        baseUnitId,+        rtsUnitId,+        thUnitId,+        mainUnitId,+        thisGhcUnitId,+        isHoleModule,+        interactiveUnitId, isInteractiveModule,+        wiredInUnitIds,++        -- * The Module type+        Module(Module),+        moduleUnitId, moduleName,+        pprModule,+        mkModule,+        mkHoleModule,+        stableModuleCmp,+        HasModule(..),+        ContainsModule(..),++        -- * Installed unit ids and modules+        InstalledModule(..),+        InstalledModuleEnv,+        installedModuleEq,+        installedUnitIdEq,+        installedUnitIdString,+        fsToInstalledUnitId,+        componentIdToInstalledUnitId,+        stringToInstalledUnitId,+        emptyInstalledModuleEnv,+        lookupInstalledModuleEnv,+        extendInstalledModuleEnv,+        filterInstalledModuleEnv,+        delInstalledModuleEnv,+        DefUnitId(..),++        -- * The ModuleLocation type+        ModLocation(..),+        addBootSuffix, addBootSuffix_maybe,+        addBootSuffixLocn, addBootSuffixLocnOut,++        -- * Module mappings+        ModuleEnv,+        elemModuleEnv, extendModuleEnv, extendModuleEnvList,+        extendModuleEnvList_C, plusModuleEnv_C,+        delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,+        lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,+        moduleEnvKeys, moduleEnvElts, moduleEnvToList,+        unitModuleEnv, isEmptyModuleEnv,+        extendModuleEnvWith, filterModuleEnv,++        -- * ModuleName mappings+        ModuleNameEnv, DModuleNameEnv,++        -- * Sets of Modules+        ModuleSet,+        emptyModuleSet, mkModuleSet, moduleSetElts,+        extendModuleSet, extendModuleSetList, delModuleSet,+        elemModuleSet, intersectModuleSet, minusModuleSet, unionModuleSet,+        unitModuleSet+    ) where++import GhcPrelude++import Outputable+import Unique+import UniqFM+import UniqDFM+import UniqDSet+import FastString+import Binary+import Util+import Data.List+import Data.Ord+import GHC.PackageDb (BinaryStringRep(..), DbUnitIdModuleRep(..), DbModule(..), DbUnitId(..))+import Fingerprint++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS.Char8+import Encoding++import qualified Text.ParserCombinators.ReadP as Parse+import Text.ParserCombinators.ReadP (ReadP, (<++))+import Data.Char (isAlphaNum)+import Control.DeepSeq+import Data.Coerce+import Data.Data+import Data.Function+import Data.Map (Map)+import Data.Set (Set)+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified FiniteMap as Map+import System.FilePath++import {-# SOURCE #-} DynFlags (DynFlags)+import {-# SOURCE #-} Packages (componentIdString, improveUnitId, PackageConfigMap, getPackageConfigMap, displayInstalledUnitId)++-- Note [The identifier lexicon]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- Unit IDs, installed package IDs, ABI hashes, package names,+-- versions, there are a *lot* of different identifiers for closely+-- related things.  What do they all mean? Here's what.  (See also+-- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/packages/concepts )+--+-- THE IMPORTANT ONES+--+-- ComponentId: An opaque identifier provided by Cabal, which should+-- uniquely identify such things as the package name, the package+-- version, the name of the component, the hash of the source code+-- tarball, the selected Cabal flags, GHC flags, direct dependencies of+-- the component.  These are very similar to InstalledPackageId, but+-- an 'InstalledPackageId' implies that it identifies a package, while+-- a package may install multiple components with different+-- 'ComponentId's.+--      - Same as Distribution.Package.ComponentId+--+-- UnitId/InstalledUnitId: A ComponentId + a mapping from hole names+-- (ModuleName) to Modules.  This is how the compiler identifies instantiated+-- components, and also is the main identifier by which GHC identifies things.+--      - When Backpack is not being used, UnitId = ComponentId.+--        this means a useful fiction for end-users is that there are+--        only ever ComponentIds, and some ComponentIds happen to have+--        more information (UnitIds).+--      - Same as Language.Haskell.TH.Syntax:PkgName, see+--          https://gitlab.haskell.org/ghc/ghc/issues/10279+--      - The same as PackageKey in GHC 7.10 (we renamed it because+--        they don't necessarily identify packages anymore.)+--      - Same as -this-package-key/-package-name flags+--      - An InstalledUnitId corresponds to an actual package which+--        we have installed on disk.  It could be definite or indefinite,+--        but if it's indefinite, it has nothing instantiated (we+--        never install partially instantiated units.)+--+-- Module/InstalledModule: A UnitId/InstalledUnitId + ModuleName. This is how+-- the compiler identifies modules (e.g. a Name is a Module + OccName)+--      - Same as Language.Haskell.TH.Syntax:Module+--+-- THE LESS IMPORTANT ONES+--+-- PackageName: The "name" field in a Cabal file, something like "lens".+--      - Same as Distribution.Package.PackageName+--      - DIFFERENT FROM Language.Haskell.TH.Syntax:PkgName, see+--          https://gitlab.haskell.org/ghc/ghc/issues/10279+--      - DIFFERENT FROM -package-name flag+--      - DIFFERENT FROM the 'name' field in an installed package+--        information.  This field could more accurately be described+--        as a munged package name: when it's for the main library+--        it is the same as the package name, but if it's an internal+--        library it's a munged combination of the package name and+--        the component name.+--+-- LEGACY ONES+--+-- InstalledPackageId: This is what we used to call ComponentId.+-- It's a still pretty useful concept for packages that have only+-- one library; in that case the logical InstalledPackageId =+-- ComponentId.  Also, the Cabal nix-local-build continues to+-- compute an InstalledPackageId which is then forcibly used+-- for all components in a package.  This means that if a dependency+-- from one component in a package changes, the InstalledPackageId+-- changes: you don't get as fine-grained dependency tracking,+-- but it means your builds are hermetic.  Eventually, Cabal will+-- deal completely in components and we can get rid of this.+--+-- PackageKey: This is what we used to call UnitId.  We ditched+-- "Package" from the name when we realized that you might want to+-- assign different "PackageKeys" to components from the same package.+-- (For a brief, non-released period of time, we also called these+-- UnitKeys).++{-+************************************************************************+*                                                                      *+\subsection{Module locations}+*                                                                      *+************************************************************************+-}++-- | Module Location+--+-- Where a module lives on the file system: the actual locations+-- of the .hs, .hi and .o files, if we have them+data ModLocation+   = ModLocation {+        ml_hs_file   :: Maybe FilePath,+                -- The source file, if we have one.  Package modules+                -- probably don't have source files.++        ml_hi_file   :: FilePath,+                -- Where the .hi file is, whether or not it exists+                -- yet.  Always of form foo.hi, even if there is an+                -- hi-boot file (we add the -boot suffix later)++        ml_obj_file  :: FilePath,+                -- Where the .o file is, whether or not it exists yet.+                -- (might not exist either because the module hasn't+                -- been compiled yet, or because it is part of a+                -- package with a .a file)+        ml_hie_file  :: FilePath+  } deriving Show++instance Outputable ModLocation where+   ppr = text . show++{-+For a module in another package, the hs_file and obj_file+components of ModLocation are undefined.++The locations specified by a ModLocation may or may not+correspond to actual files yet: for example, even if the object+file doesn't exist, the ModLocation still contains the path to+where the object file will reside if/when it is created.+-}++addBootSuffix :: FilePath -> FilePath+-- ^ Add the @-boot@ suffix to .hs, .hi and .o files+addBootSuffix path = path ++ "-boot"++addBootSuffix_maybe :: Bool -> FilePath -> FilePath+-- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@+addBootSuffix_maybe is_boot path+ | is_boot   = addBootSuffix path+ | otherwise = path++addBootSuffixLocn :: ModLocation -> ModLocation+-- ^ Add the @-boot@ suffix to all file paths associated with the module+addBootSuffixLocn locn+  = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)+         , ml_hi_file  = addBootSuffix (ml_hi_file locn)+         , ml_obj_file = addBootSuffix (ml_obj_file locn)+         , ml_hie_file = addBootSuffix (ml_hie_file locn) }++addBootSuffixLocnOut :: ModLocation -> ModLocation+-- ^ Add the @-boot@ suffix to all output file paths associated with the+-- module, not including the input file itself+addBootSuffixLocnOut locn+  = locn { ml_hi_file  = addBootSuffix (ml_hi_file locn)+         , ml_obj_file = addBootSuffix (ml_obj_file locn)+         , ml_hie_file = addBootSuffix (ml_hie_file locn) }++{-+************************************************************************+*                                                                      *+\subsection{The name of a module}+*                                                                      *+************************************************************************+-}++-- | A ModuleName is essentially a simple string, e.g. @Data.List@.+newtype ModuleName = ModuleName FastString++instance Uniquable ModuleName where+  getUnique (ModuleName nm) = getUnique nm++instance Eq ModuleName where+  nm1 == nm2 = getUnique nm1 == getUnique nm2++instance Ord ModuleName where+  nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2++instance Outputable ModuleName where+  ppr = pprModuleName++instance Binary ModuleName where+  put_ bh (ModuleName fs) = put_ bh fs+  get bh = do fs <- get bh; return (ModuleName fs)++instance BinaryStringRep ModuleName where+  fromStringRep = mkModuleNameFS . mkFastStringByteString+  toStringRep   = bytesFS . moduleNameFS++instance Data ModuleName where+  -- don't traverse?+  toConstr _   = abstractConstr "ModuleName"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "ModuleName"++instance NFData ModuleName where+  rnf x = x `seq` ()++stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering+-- ^ Compares module names lexically, rather than by their 'Unique's+stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2++pprModuleName :: ModuleName -> SDoc+pprModuleName (ModuleName nm) =+    getPprStyle $ \ sty ->+    if codeStyle sty+        then ztext (zEncodeFS nm)+        else ftext nm++moduleNameFS :: ModuleName -> FastString+moduleNameFS (ModuleName mod) = mod++moduleNameString :: ModuleName -> String+moduleNameString (ModuleName mod) = unpackFS mod++-- | Get a string representation of a 'Module' that's unique and stable+-- across recompilations.+-- eg. "$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal"+moduleStableString :: Module -> String+moduleStableString Module{..} =+  "$" ++ unitIdString moduleUnitId ++ "$" ++ moduleNameString moduleName++mkModuleName :: String -> ModuleName+mkModuleName s = ModuleName (mkFastString s)++mkModuleNameFS :: FastString -> ModuleName+mkModuleNameFS s = ModuleName s++-- |Returns the string version of the module name, with dots replaced by slashes.+--+moduleNameSlashes :: ModuleName -> String+moduleNameSlashes = dots_to_slashes . moduleNameString+  where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)++-- |Returns the string version of the module name, with dots replaced by colons.+--+moduleNameColons :: ModuleName -> String+moduleNameColons = dots_to_colons . moduleNameString+  where dots_to_colons = map (\c -> if c == '.' then ':' else c)++{-+************************************************************************+*                                                                      *+\subsection{A fully qualified module}+*                                                                      *+************************************************************************+-}++-- | A Module is a pair of a 'UnitId' and a 'ModuleName'.+--+-- Module variables (i.e. @<H>@) which can be instantiated to a+-- specific module at some later point in time are represented+-- with 'moduleUnitId' set to 'holeUnitId' (this allows us to+-- avoid having to make 'moduleUnitId' a partial operation.)+--+data Module = Module {+   moduleUnitId :: !UnitId,  -- pkg-1.0+   moduleName :: !ModuleName  -- A.B.C+  }+  deriving (Eq, Ord)++-- | Calculate the free holes of a 'Module'.  If this set is non-empty,+-- this module was defined in an indefinite library that had required+-- signatures.+--+-- If a module has free holes, that means that substitutions can operate on it;+-- if it has no free holes, substituting over a module has no effect.+moduleFreeHoles :: Module -> UniqDSet ModuleName+moduleFreeHoles m+    | isHoleModule m = unitUniqDSet (moduleName m)+    | otherwise = unitIdFreeHoles (moduleUnitId m)++-- | A 'Module' is definite if it has no free holes.+moduleIsDefinite :: Module -> Bool+moduleIsDefinite = isEmptyUniqDSet . moduleFreeHoles++-- | Create a module variable at some 'ModuleName'.+-- See Note [Representation of module/name variables]+mkHoleModule :: ModuleName -> Module+mkHoleModule = mkModule holeUnitId++instance Uniquable Module where+  getUnique (Module p n) = getUnique (unitIdFS p `appendFS` moduleNameFS n)++instance Outputable Module where+  ppr = pprModule++instance Binary Module where+  put_ bh (Module p n) = put_ bh p >> put_ bh n+  get bh = do p <- get bh; n <- get bh; return (Module p n)++instance Data Module where+  -- don't traverse?+  toConstr _   = abstractConstr "Module"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "Module"++instance NFData Module where+  rnf x = x `seq` ()++-- | This gives a stable ordering, as opposed to the Ord instance which+-- gives an ordering based on the 'Unique's of the components, which may+-- not be stable from run to run of the compiler.+stableModuleCmp :: Module -> Module -> Ordering+stableModuleCmp (Module p1 n1) (Module p2 n2)+   = (p1 `stableUnitIdCmp`  p2) `thenCmp`+     (n1 `stableModuleNameCmp` n2)++mkModule :: UnitId -> ModuleName -> Module+mkModule = Module++pprModule :: Module -> SDoc+pprModule mod@(Module p n)  = getPprStyle doc+ where+  doc sty+    | codeStyle sty =+        (if p == mainUnitId+                then empty -- never qualify the main package in code+                else ztext (zEncodeFS (unitIdFS p)) <> char '_')+            <> pprModuleName n+    | qualModule sty mod =+        if isHoleModule mod+            then angleBrackets (pprModuleName n)+            else ppr (moduleUnitId mod) <> char ':' <> pprModuleName n+    | otherwise =+        pprModuleName n++class ContainsModule t where+    extractModule :: t -> Module++class HasModule m where+    getModule :: m Module++instance DbUnitIdModuleRep InstalledUnitId ComponentId UnitId ModuleName Module where+  fromDbModule (DbModule uid mod_name)  = mkModule uid mod_name+  fromDbModule (DbModuleVar mod_name)   = mkHoleModule mod_name+  fromDbUnitId (DbUnitId cid insts)     = newUnitId cid insts+  fromDbUnitId (DbInstalledUnitId iuid) = DefiniteUnitId (DefUnitId iuid)+  -- GHC never writes to the database, so it's not needed+  toDbModule = error "toDbModule: not implemented"+  toDbUnitId = error "toDbUnitId: not implemented"++{-+************************************************************************+*                                                                      *+\subsection{ComponentId}+*                                                                      *+************************************************************************+-}++-- | A 'ComponentId' consists of the package name, package version, component+-- ID, the transitive dependencies of the component, and other information to+-- uniquely identify the source code and build configuration of a component.+--+-- This used to be known as an 'InstalledPackageId', but a package can contain+-- multiple components and a 'ComponentId' uniquely identifies a component+-- within a package.  When a package only has one component, the 'ComponentId'+-- coincides with the 'InstalledPackageId'+newtype ComponentId        = ComponentId        FastString deriving (Eq, Ord)++instance BinaryStringRep ComponentId where+  fromStringRep = ComponentId . mkFastStringByteString+  toStringRep (ComponentId s) = bytesFS s++instance Uniquable ComponentId where+  getUnique (ComponentId n) = getUnique n++instance Outputable ComponentId where+  ppr cid@(ComponentId fs) =+    getPprStyle $ \sty ->+    sdocWithDynFlags $ \dflags ->+      case componentIdString dflags cid of+        Just str | not (debugStyle sty) -> text str+        _ -> ftext fs++{-+************************************************************************+*                                                                      *+\subsection{UnitId}+*                                                                      *+************************************************************************+-}++-- | A unit identifier identifies a (possibly partially) instantiated+-- library.  It is primarily used as part of 'Module', which in turn+-- is used in 'Name', which is used to give names to entities when+-- typechecking.+--+-- There are two possible forms for a 'UnitId'.  It can be a+-- 'DefiniteUnitId', in which case we just have a string that uniquely+-- identifies some fully compiled, installed library we have on disk.+-- However, when we are typechecking a library with missing holes,+-- we may need to instantiate a library on the fly (in which case+-- we don't have any on-disk representation.)  In that case, you+-- have an 'IndefiniteUnitId', which explicitly records the+-- instantiation, so that we can substitute over it.+data UnitId+    = IndefiniteUnitId {-# UNPACK #-} !IndefUnitId+    |   DefiniteUnitId {-# UNPACK #-} !DefUnitId++unitIdFS :: UnitId -> FastString+unitIdFS (IndefiniteUnitId x) = indefUnitIdFS x+unitIdFS (DefiniteUnitId (DefUnitId x)) = installedUnitIdFS x++unitIdKey :: UnitId -> Unique+unitIdKey (IndefiniteUnitId x) = indefUnitIdKey x+unitIdKey (DefiniteUnitId (DefUnitId x)) = installedUnitIdKey x++-- | A unit identifier which identifies an indefinite+-- library (with holes) that has been *on-the-fly* instantiated+-- with a substitution 'indefUnitIdInsts'.  In fact, an indefinite+-- unit identifier could have no holes, but we haven't gotten+-- around to compiling the actual library yet.+--+-- An indefinite unit identifier pretty-prints to something like+-- @p[H=<H>,A=aimpl:A>]@ (@p@ is the 'ComponentId', and the+-- brackets enclose the module substitution).+data IndefUnitId+    = IndefUnitId {+        -- | A private, uniquely identifying representation of+        -- a UnitId.  This string is completely private to GHC+        -- and is just used to get a unique; in particular, we don't use it for+        -- symbols (indefinite libraries are not compiled).+        indefUnitIdFS :: FastString,+        -- | Cached unique of 'unitIdFS'.+        indefUnitIdKey :: Unique,+        -- | The component identity of the indefinite library that+        -- is being instantiated.+        indefUnitIdComponentId :: !ComponentId,+        -- | The sorted (by 'ModuleName') instantiations of this library.+        indefUnitIdInsts :: ![(ModuleName, Module)],+        -- | A cache of the free module variables of 'unitIdInsts'.+        -- This lets us efficiently tell if a 'UnitId' has been+        -- fully instantiated (free module variables are empty)+        -- and whether or not a substitution can have any effect.+        indefUnitIdFreeHoles :: UniqDSet ModuleName+    }++instance Eq IndefUnitId where+  u1 == u2 = indefUnitIdKey u1 == indefUnitIdKey u2++instance Ord IndefUnitId where+  u1 `compare` u2 = indefUnitIdFS u1 `compare` indefUnitIdFS u2++instance Binary IndefUnitId where+  put_ bh indef = do+    put_ bh (indefUnitIdComponentId indef)+    put_ bh (indefUnitIdInsts indef)+  get bh = do+    cid   <- get bh+    insts <- get bh+    let fs = hashUnitId cid insts+    return IndefUnitId {+            indefUnitIdComponentId = cid,+            indefUnitIdInsts = insts,+            indefUnitIdFreeHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),+            indefUnitIdFS = fs,+            indefUnitIdKey = getUnique fs+           }++-- | Create a new 'IndefUnitId' given an explicit module substitution.+newIndefUnitId :: ComponentId -> [(ModuleName, Module)] -> IndefUnitId+newIndefUnitId cid insts =+    IndefUnitId {+        indefUnitIdComponentId = cid,+        indefUnitIdInsts = sorted_insts,+        indefUnitIdFreeHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),+        indefUnitIdFS = fs,+        indefUnitIdKey = getUnique fs+    }+  where+     fs = hashUnitId cid sorted_insts+     sorted_insts = sortBy (stableModuleNameCmp `on` fst) insts++-- | Injects an 'IndefUnitId' (indefinite library which+-- was on-the-fly instantiated) to a 'UnitId' (either+-- an indefinite or definite library).+indefUnitIdToUnitId :: DynFlags -> IndefUnitId -> UnitId+indefUnitIdToUnitId dflags iuid =+    -- NB: suppose that we want to compare the indefinite+    -- unit id p[H=impl:H] against p+abcd (where p+abcd+    -- happens to be the existing, installed version of+    -- p[H=impl:H].  If we *only* wrap in p[H=impl:H]+    -- IndefiniteUnitId, they won't compare equal; only+    -- after improvement will the equality hold.+    improveUnitId (getPackageConfigMap dflags) $+        IndefiniteUnitId iuid++data IndefModule = IndefModule {+        indefModuleUnitId :: IndefUnitId,+        indefModuleName   :: ModuleName+    } deriving (Eq, Ord)++instance Outputable IndefModule where+  ppr (IndefModule uid m) =+    ppr uid <> char ':' <> ppr m++-- | Injects an 'IndefModule' to 'Module' (see also+-- 'indefUnitIdToUnitId'.+indefModuleToModule :: DynFlags -> IndefModule -> Module+indefModuleToModule dflags (IndefModule iuid mod_name) =+    mkModule (indefUnitIdToUnitId dflags iuid) mod_name++-- | An installed unit identifier identifies a library which has+-- been installed to the package database.  These strings are+-- provided to us via the @-this-unit-id@ flag.  The library+-- in question may be definite or indefinite; if it is indefinite,+-- none of the holes have been filled (we never install partially+-- instantiated libraries.)  Put another way, an installed unit id+-- is either fully instantiated, or not instantiated at all.+--+-- Installed unit identifiers look something like @p+af23SAj2dZ219@,+-- or maybe just @p@ if they don't use Backpack.+newtype InstalledUnitId =+    InstalledUnitId {+      -- | The full hashed unit identifier, including the component id+      -- and the hash.+      installedUnitIdFS :: FastString+    }++instance Binary InstalledUnitId where+  put_ bh (InstalledUnitId fs) = put_ bh fs+  get bh = do fs <- get bh; return (InstalledUnitId fs)++instance BinaryStringRep InstalledUnitId where+  fromStringRep bs = InstalledUnitId (mkFastStringByteString bs)+  -- GHC doesn't write to database+  toStringRep   = error "BinaryStringRep InstalledUnitId: not implemented"++instance Eq InstalledUnitId where+    uid1 == uid2 = installedUnitIdKey uid1 == installedUnitIdKey uid2++instance Ord InstalledUnitId where+    u1 `compare` u2 = installedUnitIdFS u1 `compare` installedUnitIdFS u2++instance Uniquable InstalledUnitId where+    getUnique = installedUnitIdKey++instance Outputable InstalledUnitId where+    ppr uid@(InstalledUnitId fs) =+        getPprStyle $ \sty ->+        sdocWithDynFlags $ \dflags ->+          case displayInstalledUnitId dflags uid of+            Just str | not (debugStyle sty) -> text str+            _ -> ftext fs++installedUnitIdKey :: InstalledUnitId -> Unique+installedUnitIdKey = getUnique . installedUnitIdFS++-- | Lossy conversion to the on-disk 'InstalledUnitId' for a component.+toInstalledUnitId :: UnitId -> InstalledUnitId+toInstalledUnitId (DefiniteUnitId (DefUnitId iuid)) = iuid+toInstalledUnitId (IndefiniteUnitId indef) =+    componentIdToInstalledUnitId (indefUnitIdComponentId indef)++installedUnitIdString :: InstalledUnitId -> String+installedUnitIdString = unpackFS . installedUnitIdFS++instance Outputable IndefUnitId where+    ppr uid =+      -- getPprStyle $ \sty ->+      ppr cid <>+        (if not (null insts) -- pprIf+          then+            brackets (hcat+                (punctuate comma $+                    [ ppr modname <> text "=" <> ppr m+                    | (modname, m) <- insts]))+          else empty)+     where+      cid   = indefUnitIdComponentId uid+      insts = indefUnitIdInsts uid++-- | A 'InstalledModule' is a 'Module' which contains a 'InstalledUnitId'.+data InstalledModule = InstalledModule {+   installedModuleUnitId :: !InstalledUnitId,+   installedModuleName :: !ModuleName+  }+  deriving (Eq, Ord)++instance Outputable InstalledModule where+  ppr (InstalledModule p n) =+    ppr p <> char ':' <> pprModuleName n++fsToInstalledUnitId :: FastString -> InstalledUnitId+fsToInstalledUnitId fs = InstalledUnitId fs++componentIdToInstalledUnitId :: ComponentId -> InstalledUnitId+componentIdToInstalledUnitId (ComponentId fs) = fsToInstalledUnitId fs++stringToInstalledUnitId :: String -> InstalledUnitId+stringToInstalledUnitId = fsToInstalledUnitId . mkFastString++-- | Test if a 'Module' corresponds to a given 'InstalledModule',+-- modulo instantiation.+installedModuleEq :: InstalledModule -> Module -> Bool+installedModuleEq imod mod =+    fst (splitModuleInsts mod) == imod++-- | Test if a 'UnitId' corresponds to a given 'InstalledUnitId',+-- modulo instantiation.+installedUnitIdEq :: InstalledUnitId -> UnitId -> Bool+installedUnitIdEq iuid uid =+    fst (splitUnitIdInsts uid) == iuid++-- | A 'DefUnitId' is an 'InstalledUnitId' with the invariant that+-- it only refers to a definite library; i.e., one we have generated+-- code for.+newtype DefUnitId = DefUnitId { unDefUnitId :: InstalledUnitId }+    deriving (Eq, Ord)++instance Outputable DefUnitId where+    ppr (DefUnitId uid) = ppr uid++instance Binary DefUnitId where+    put_ bh (DefUnitId uid) = put_ bh uid+    get bh = do uid <- get bh; return (DefUnitId uid)++-- | A map keyed off of 'InstalledModule'+newtype InstalledModuleEnv elt = InstalledModuleEnv (Map InstalledModule elt)++emptyInstalledModuleEnv :: InstalledModuleEnv a+emptyInstalledModuleEnv = InstalledModuleEnv Map.empty++lookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a+lookupInstalledModuleEnv (InstalledModuleEnv e) m = Map.lookup m e++extendInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> a -> InstalledModuleEnv a+extendInstalledModuleEnv (InstalledModuleEnv e) m x = InstalledModuleEnv (Map.insert m x e)++filterInstalledModuleEnv :: (InstalledModule -> a -> Bool) -> InstalledModuleEnv a -> InstalledModuleEnv a+filterInstalledModuleEnv f (InstalledModuleEnv e) =+  InstalledModuleEnv (Map.filterWithKey f e)++delInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a+delInstalledModuleEnv (InstalledModuleEnv e) m = InstalledModuleEnv (Map.delete m e)++-- Note [UnitId to InstalledUnitId improvement]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- Just because a UnitId is definite (has no holes) doesn't+-- mean it's necessarily a InstalledUnitId; it could just be+-- that over the course of renaming UnitIds on the fly+-- while typechecking an indefinite library, we+-- ended up with a fully instantiated unit id with no hash,+-- since we haven't built it yet.  This is fine.+--+-- However, if there is a hashed unit id for this instantiation+-- in the package database, we *better use it*, because+-- that hashed unit id may be lurking in another interface,+-- and chaos will ensue if we attempt to compare the two+-- (the unitIdFS for a UnitId never corresponds to a Cabal-provided+-- hash of a compiled instantiated library).+--+-- There is one last niggle: improvement based on the package database means+-- that we might end up developing on a package that is not transitively+-- depended upon by the packages the user specified directly via command line+-- flags.  This could lead to strange and difficult to understand bugs if those+-- instantiations are out of date.  The solution is to only improve a+-- unit id if the new unit id is part of the 'preloadClosure'; i.e., the+-- closure of all the packages which were explicitly specified.++-- | Retrieve the set of free holes of a 'UnitId'.+unitIdFreeHoles :: UnitId -> UniqDSet ModuleName+unitIdFreeHoles (IndefiniteUnitId x) = indefUnitIdFreeHoles x+-- Hashed unit ids are always fully instantiated+unitIdFreeHoles (DefiniteUnitId _) = emptyUniqDSet++instance Show UnitId where+    show = unitIdString++-- | A 'UnitId' is definite if it has no free holes.+unitIdIsDefinite :: UnitId -> Bool+unitIdIsDefinite = isEmptyUniqDSet . unitIdFreeHoles++-- | Generate a uniquely identifying 'FastString' for a unit+-- identifier.  This is a one-way function.  You can rely on one special+-- property: if a unit identifier is in most general form, its 'FastString'+-- coincides with its 'ComponentId'.  This hash is completely internal+-- to GHC and is not used for symbol names or file paths.+hashUnitId :: ComponentId -> [(ModuleName, Module)] -> FastString+hashUnitId cid sorted_holes =+    mkFastStringByteString+  . fingerprintUnitId (toStringRep cid)+  $ rawHashUnitId sorted_holes++-- | Generate a hash for a sorted module substitution.+rawHashUnitId :: [(ModuleName, Module)] -> Fingerprint+rawHashUnitId sorted_holes =+    fingerprintByteString+  . BS.concat $ do+        (m, b) <- sorted_holes+        [ toStringRep m,                BS.Char8.singleton ' ',+          bytesFS (unitIdFS (moduleUnitId b)), BS.Char8.singleton ':',+          toStringRep (moduleName b),   BS.Char8.singleton '\n']++fingerprintUnitId :: BS.ByteString -> Fingerprint -> BS.ByteString+fingerprintUnitId prefix (Fingerprint a b)+    = BS.concat+    $ [ prefix+      , BS.Char8.singleton '-'+      , BS.Char8.pack (toBase62Padded a)+      , BS.Char8.pack (toBase62Padded b) ]++-- | Create a new, un-hashed unit identifier.+newUnitId :: ComponentId -> [(ModuleName, Module)] -> UnitId+newUnitId cid [] = newSimpleUnitId cid -- TODO: this indicates some latent bug...+newUnitId cid insts = IndefiniteUnitId $ newIndefUnitId cid insts++pprUnitId :: UnitId -> SDoc+pprUnitId (DefiniteUnitId uid) = ppr uid+pprUnitId (IndefiniteUnitId uid) = ppr uid++instance Eq UnitId where+  uid1 == uid2 = unitIdKey uid1 == unitIdKey uid2++instance Uniquable UnitId where+  getUnique = unitIdKey++instance Ord UnitId where+  nm1 `compare` nm2 = stableUnitIdCmp nm1 nm2++instance Data UnitId where+  -- don't traverse?+  toConstr _   = abstractConstr "UnitId"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "UnitId"++instance NFData UnitId where+  rnf x = x `seq` ()++stableUnitIdCmp :: UnitId -> UnitId -> Ordering+-- ^ Compares package ids lexically, rather than by their 'Unique's+stableUnitIdCmp p1 p2 = unitIdFS p1 `compare` unitIdFS p2++instance Outputable UnitId where+   ppr pk = pprUnitId pk++-- Performance: would prefer to have a NameCache like thing+instance Binary UnitId where+  put_ bh (DefiniteUnitId def_uid) = do+    putByte bh 0+    put_ bh def_uid+  put_ bh (IndefiniteUnitId indef_uid) = do+    putByte bh 1+    put_ bh indef_uid+  get bh = do b <- getByte bh+              case b of+                0 -> fmap DefiniteUnitId   (get bh)+                _ -> fmap IndefiniteUnitId (get bh)++instance Binary ComponentId where+  put_ bh (ComponentId fs) = put_ bh fs+  get bh = do { fs <- get bh; return (ComponentId fs) }++-- | Create a new simple unit identifier (no holes) from a 'ComponentId'.+newSimpleUnitId :: ComponentId -> UnitId+newSimpleUnitId (ComponentId fs) = fsToUnitId fs++-- | Create a new simple unit identifier from a 'FastString'.  Internally,+-- this is primarily used to specify wired-in unit identifiers.+fsToUnitId :: FastString -> UnitId+fsToUnitId = DefiniteUnitId . DefUnitId . InstalledUnitId++stringToUnitId :: String -> UnitId+stringToUnitId = fsToUnitId . mkFastString++unitIdString :: UnitId -> String+unitIdString = unpackFS . unitIdFS++{-+************************************************************************+*                                                                      *+                        Hole substitutions+*                                                                      *+************************************************************************+-}++-- | Substitution on module variables, mapping module names to module+-- identifiers.+type ShHoleSubst = ModuleNameEnv Module++-- | Substitutes holes in a 'Module'.  NOT suitable for being called+-- directly on a 'nameModule', see Note [Representation of module/name variable].+-- @p[A=<A>]:B@ maps to @p[A=q():A]:B@ with @A=q():A@;+-- similarly, @<A>@ maps to @q():A@.+renameHoleModule :: DynFlags -> ShHoleSubst -> Module -> Module+renameHoleModule dflags = renameHoleModule' (getPackageConfigMap dflags)++-- | Substitutes holes in a 'UnitId', suitable for renaming when+-- an include occurs; see Note [Representation of module/name variable].+--+-- @p[A=<A>]@ maps to @p[A=<B>]@ with @A=<B>@.+renameHoleUnitId :: DynFlags -> ShHoleSubst -> UnitId -> UnitId+renameHoleUnitId dflags = renameHoleUnitId' (getPackageConfigMap dflags)++-- | Like 'renameHoleModule', but requires only 'PackageConfigMap'+-- so it can be used by "Packages".+renameHoleModule' :: PackageConfigMap -> ShHoleSubst -> Module -> Module+renameHoleModule' pkg_map env m+  | not (isHoleModule m) =+        let uid = renameHoleUnitId' pkg_map env (moduleUnitId m)+        in mkModule uid (moduleName m)+  | Just m' <- lookupUFM env (moduleName m) = m'+  -- NB m = <Blah>, that's what's in scope.+  | otherwise = m++-- | Like 'renameHoleUnitId, but requires only 'PackageConfigMap'+-- so it can be used by "Packages".+renameHoleUnitId' :: PackageConfigMap -> ShHoleSubst -> UnitId -> UnitId+renameHoleUnitId' pkg_map env uid =+    case uid of+      (IndefiniteUnitId+        IndefUnitId{ indefUnitIdComponentId = cid+                   , indefUnitIdInsts       = insts+                   , indefUnitIdFreeHoles   = fh })+          -> if isNullUFM (intersectUFM_C const (udfmToUfm (getUniqDSet fh)) env)+                then uid+                -- Functorially apply the substitution to the instantiation,+                -- then check the 'PackageConfigMap' to see if there is+                -- a compiled version of this 'UnitId' we can improve to.+                -- See Note [UnitId to InstalledUnitId] improvement+                else improveUnitId pkg_map $+                        newUnitId cid+                            (map (\(k,v) -> (k, renameHoleModule' pkg_map env v)) insts)+      _ -> uid++-- | Given a possibly on-the-fly instantiated module, split it into+-- a 'Module' that we definitely can find on-disk, as well as an+-- instantiation if we need to instantiate it on the fly.  If the+-- instantiation is @Nothing@ no on-the-fly renaming is needed.+splitModuleInsts :: Module -> (InstalledModule, Maybe IndefModule)+splitModuleInsts m =+    let (uid, mb_iuid) = splitUnitIdInsts (moduleUnitId m)+    in (InstalledModule uid (moduleName m),+        fmap (\iuid -> IndefModule iuid (moduleName m)) mb_iuid)++-- | See 'splitModuleInsts'.+splitUnitIdInsts :: UnitId -> (InstalledUnitId, Maybe IndefUnitId)+splitUnitIdInsts (IndefiniteUnitId iuid) =+    (componentIdToInstalledUnitId (indefUnitIdComponentId iuid), Just iuid)+splitUnitIdInsts (DefiniteUnitId (DefUnitId uid)) = (uid, Nothing)++generalizeIndefUnitId :: IndefUnitId -> IndefUnitId+generalizeIndefUnitId IndefUnitId{ indefUnitIdComponentId = cid+                                 , indefUnitIdInsts = insts } =+    newIndefUnitId cid (map (\(m,_) -> (m, mkHoleModule m)) insts)++generalizeIndefModule :: IndefModule -> IndefModule+generalizeIndefModule (IndefModule uid n) = IndefModule (generalizeIndefUnitId uid) n++parseModuleName :: ReadP ModuleName+parseModuleName = fmap mkModuleName+                $ Parse.munch1 (\c -> isAlphaNum c || c `elem` "_.")++parseUnitId :: ReadP UnitId+parseUnitId = parseFullUnitId <++ parseDefiniteUnitId <++ parseSimpleUnitId+  where+    parseFullUnitId = do+        cid <- parseComponentId+        insts <- parseModSubst+        return (newUnitId cid insts)+    parseDefiniteUnitId = do+        s <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "-_.+")+        return (stringToUnitId s)+    parseSimpleUnitId = do+        cid <- parseComponentId+        return (newSimpleUnitId cid)++parseComponentId :: ReadP ComponentId+parseComponentId = (ComponentId . mkFastString)  `fmap` Parse.munch1 abi_char+   where abi_char c = isAlphaNum c || c `elem` "-_."++parseModuleId :: ReadP Module+parseModuleId = parseModuleVar <++ parseModule+    where+      parseModuleVar = do+        _ <- Parse.char '<'+        modname <- parseModuleName+        _ <- Parse.char '>'+        return (mkHoleModule modname)+      parseModule = do+        uid <- parseUnitId+        _ <- Parse.char ':'+        modname <- parseModuleName+        return (mkModule uid modname)++parseModSubst :: ReadP [(ModuleName, Module)]+parseModSubst = Parse.between (Parse.char '[') (Parse.char ']')+      . flip Parse.sepBy (Parse.char ',')+      $ do k <- parseModuleName+           _ <- Parse.char '='+           v <- parseModuleId+           return (k, v)+++{-+Note [Wired-in packages]+~~~~~~~~~~~~~~~~~~~~~~~~++Certain packages are known to the compiler, in that we know about certain+entities that reside in these packages, and the compiler needs to+declare static Modules and Names that refer to these packages.  Hence+the wired-in packages can't include version numbers in their package UnitId,+since we don't want to bake the version numbers of these packages into GHC.++So here's the plan.  Wired-in packages are still versioned as+normal in the packages database, and you can still have multiple+versions of them installed. To the user, everything looks normal.++However, for each invocation of GHC, only a single instance of each wired-in+package will be recognised (the desired one is selected via+@-package@\/@-hide-package@), and GHC will internall pretend that it has the+*unversioned* 'UnitId', including in .hi files and object file symbols.++Unselected versions of wired-in packages will be ignored, as will any other+package that depends directly or indirectly on it (much as if you+had used @-ignore-package@).++The affected packages are compiled with, e.g., @-this-unit-id base@, so that+the symbols in the object files have the unversioned unit id in their name.++Make sure you change 'Packages.findWiredInPackages' if you add an entry here.++For `integer-gmp`/`integer-simple` we also change the base name to+`integer-wired-in`, but this is fundamentally no different.+See Note [The integer library] in PrelNames.+-}++integerUnitId, primUnitId,+  baseUnitId, rtsUnitId,+  thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId  :: UnitId+primUnitId        = fsToUnitId (fsLit "ghc-prim")+integerUnitId     = fsToUnitId (fsLit "integer-wired-in")+   -- See Note [The integer library] in PrelNames+baseUnitId        = fsToUnitId (fsLit "base")+rtsUnitId         = fsToUnitId (fsLit "rts")+thUnitId          = fsToUnitId (fsLit "template-haskell")+thisGhcUnitId     = fsToUnitId (fsLit "ghc")+interactiveUnitId = fsToUnitId (fsLit "interactive")++-- | This is the package Id for the current program.  It is the default+-- package Id if you don't specify a package name.  We don't add this prefix+-- to symbol names, since there can be only one main package per program.+mainUnitId      = fsToUnitId (fsLit "main")++-- | This is a fake package id used to provide identities to any un-implemented+-- signatures.  The set of hole identities is global over an entire compilation.+-- Don't use this directly: use 'mkHoleModule' or 'isHoleModule' instead.+-- See Note [Representation of module/name variables]+holeUnitId :: UnitId+holeUnitId      = fsToUnitId (fsLit "hole")++isInteractiveModule :: Module -> Bool+isInteractiveModule mod = moduleUnitId mod == interactiveUnitId++-- Note [Representation of module/name variables]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- In our ICFP'16, we use <A> to represent module holes, and {A.T} to represent+-- name holes.  This could have been represented by adding some new cases+-- to the core data types, but this would have made the existing 'nameModule'+-- and 'moduleUnitId' partial, which would have required a lot of modifications+-- to existing code.+--+-- Instead, we adopted the following encoding scheme:+--+--      <A>   ===> hole:A+--      {A.T} ===> hole:A.T+--+-- This encoding is quite convenient, but it is also a bit dangerous too,+-- because if you have a 'hole:A' you need to know if it's actually a+-- 'Module' or just a module stored in a 'Name'; these two cases must be+-- treated differently when doing substitutions.  'renameHoleModule'+-- and 'renameHoleUnitId' assume they are NOT operating on a+-- 'Name'; 'NameShape' handles name substitutions exclusively.++isHoleModule :: Module -> Bool+isHoleModule mod = moduleUnitId mod == holeUnitId++wiredInUnitIds :: [UnitId]+wiredInUnitIds = [ primUnitId,+                       integerUnitId,+                       baseUnitId,+                       rtsUnitId,+                       thUnitId,+                       thisGhcUnitId ]++{-+************************************************************************+*                                                                      *+\subsection{@ModuleEnv@s}+*                                                                      *+************************************************************************+-}++-- | A map keyed off of 'Module's+newtype ModuleEnv elt = ModuleEnv (Map NDModule elt)++{-+Note [ModuleEnv performance and determinism]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+To prevent accidental reintroduction of nondeterminism the Ord instance+for Module was changed to not depend on Unique ordering and to use the+lexicographic order. This is potentially expensive, but when measured+there was no difference in performance.++To be on the safe side and not pessimize ModuleEnv uses nondeterministic+ordering on Module and normalizes by doing the lexicographic sort when+turning the env to a list.+See Note [Unique Determinism] for more information about the source of+nondeterminismand and Note [Deterministic UniqFM] for explanation of why+it matters for maps.+-}++newtype NDModule = NDModule { unNDModule :: Module }+  deriving Eq+  -- A wrapper for Module with faster nondeterministic Ord.+  -- Don't export, See [ModuleEnv performance and determinism]++instance Ord NDModule where+  compare (NDModule (Module p1 n1)) (NDModule (Module p2 n2)) =+    (getUnique p1 `nonDetCmpUnique` getUnique p2) `thenCmp`+    (getUnique n1 `nonDetCmpUnique` getUnique n2)++filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a+filterModuleEnv f (ModuleEnv e) =+  ModuleEnv (Map.filterWithKey (f . unNDModule) e)++elemModuleEnv :: Module -> ModuleEnv a -> Bool+elemModuleEnv m (ModuleEnv e) = Map.member (NDModule m) e++extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a+extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert (NDModule m) x e)++extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a+                    -> ModuleEnv a+extendModuleEnvWith f (ModuleEnv e) m x =+  ModuleEnv (Map.insertWith f (NDModule m) x e)++extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a+extendModuleEnvList (ModuleEnv e) xs =+  ModuleEnv (Map.insertList [(NDModule k, v) | (k,v) <- xs] e)++extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]+                      -> ModuleEnv a+extendModuleEnvList_C f (ModuleEnv e) xs =+  ModuleEnv (Map.insertListWith f [(NDModule k, v) | (k,v) <- xs] e)++plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a+plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) =+  ModuleEnv (Map.unionWith f e1 e2)++delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a+delModuleEnvList (ModuleEnv e) ms =+  ModuleEnv (Map.deleteList (map NDModule ms) e)++delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a+delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete (NDModule m) e)++plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a+plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)++lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a+lookupModuleEnv (ModuleEnv e) m = Map.lookup (NDModule m) e++lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a+lookupWithDefaultModuleEnv (ModuleEnv e) x m =+  Map.findWithDefault x (NDModule m) e++mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b+mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)++mkModuleEnv :: [(Module, a)] -> ModuleEnv a+mkModuleEnv xs = ModuleEnv (Map.fromList [(NDModule k, v) | (k,v) <- xs])++emptyModuleEnv :: ModuleEnv a+emptyModuleEnv = ModuleEnv Map.empty++moduleEnvKeys :: ModuleEnv a -> [Module]+moduleEnvKeys (ModuleEnv e) = sort $ map unNDModule $ Map.keys e+  -- See Note [ModuleEnv performance and determinism]++moduleEnvElts :: ModuleEnv a -> [a]+moduleEnvElts e = map snd $ moduleEnvToList e+  -- See Note [ModuleEnv performance and determinism]++moduleEnvToList :: ModuleEnv a -> [(Module, a)]+moduleEnvToList (ModuleEnv e) =+  sortBy (comparing fst) [(m, v) | (NDModule m, v) <- Map.toList e]+  -- See Note [ModuleEnv performance and determinism]++unitModuleEnv :: Module -> a -> ModuleEnv a+unitModuleEnv m x = ModuleEnv (Map.singleton (NDModule m) x)++isEmptyModuleEnv :: ModuleEnv a -> Bool+isEmptyModuleEnv (ModuleEnv e) = Map.null e++-- | A set of 'Module's+type ModuleSet = Set NDModule++mkModuleSet :: [Module] -> ModuleSet+mkModuleSet = Set.fromList . coerce++extendModuleSet :: ModuleSet -> Module -> ModuleSet+extendModuleSet s m = Set.insert (NDModule m) s++extendModuleSetList :: ModuleSet -> [Module] -> ModuleSet+extendModuleSetList s ms = foldl' (coerce . flip Set.insert) s ms++emptyModuleSet :: ModuleSet+emptyModuleSet = Set.empty++moduleSetElts :: ModuleSet -> [Module]+moduleSetElts = sort . coerce . Set.toList++elemModuleSet :: Module -> ModuleSet -> Bool+elemModuleSet = Set.member . coerce++intersectModuleSet :: ModuleSet -> ModuleSet -> ModuleSet+intersectModuleSet = coerce Set.intersection++minusModuleSet :: ModuleSet -> ModuleSet -> ModuleSet+minusModuleSet = coerce Set.difference++delModuleSet :: ModuleSet -> Module -> ModuleSet+delModuleSet = coerce (flip Set.delete)++unionModuleSet :: ModuleSet -> ModuleSet -> ModuleSet+unionModuleSet = coerce Set.union++unitModuleSet :: Module -> ModuleSet+unitModuleSet = coerce Set.singleton++{-+A ModuleName has a Unique, so we can build mappings of these using+UniqFM.+-}++-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)+type ModuleNameEnv elt = UniqFM elt+++-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)+-- Has deterministic folds and can be deterministically converted to a list+type DModuleNameEnv elt = UniqDFM elt
+ compiler/basicTypes/Module.hs-boot view
@@ -0,0 +1,14 @@+module Module where++import GhcPrelude+import FastString++data Module+data ModuleName+data UnitId+data InstalledUnitId+newtype ComponentId = ComponentId FastString++moduleName :: Module -> ModuleName+moduleUnitId :: Module -> UnitId+unitIdString :: UnitId -> String
+ compiler/basicTypes/Name.hs view
@@ -0,0 +1,701 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[Name]{@Name@: to transmit name info from renamer to typechecker}+-}++{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PatternSynonyms #-}++-- |+-- #name_types#+-- GHC uses several kinds of name internally:+--+-- * 'OccName.OccName': see "OccName#name_types"+--+-- * 'RdrName.RdrName': see "RdrName#name_types"+--+-- *  'Name.Name' is the type of names that have had their scoping and binding resolved. They+--   have an 'OccName.OccName' but also a 'Unique.Unique' that disambiguates Names that have+--   the same 'OccName.OccName' and indeed is used for all 'Name.Name' comparison. Names+--   also contain information about where they originated from, see "Name#name_sorts"+--+-- * 'Id.Id': see "Id#name_types"+--+-- * 'Var.Var': see "Var#name_types"+--+-- #name_sorts#+-- Names are one of:+--+--  * External, if they name things declared in other modules. Some external+--    Names are wired in, i.e. they name primitives defined in the compiler itself+--+--  * Internal, if they name things in the module being compiled. Some internal+--    Names are system names, if they are names manufactured by the compiler++module Name (+        -- * The main types+        Name,                                   -- Abstract+        BuiltInSyntax(..),++        -- ** Creating 'Name's+        mkSystemName, mkSystemNameAt,+        mkInternalName, mkClonedInternalName, mkDerivedInternalName,+        mkSystemVarName, mkSysTvName,+        mkFCallName,+        mkExternalName, mkWiredInName,++        -- ** Manipulating and deconstructing 'Name's+        nameUnique, setNameUnique,+        nameOccName, nameModule, nameModule_maybe,+        setNameLoc,+        tidyNameOcc,+        localiseName,++        nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt,++        -- ** Predicates on 'Name's+        isSystemName, isInternalName, isExternalName,+        isTyVarName, isTyConName, isDataConName,+        isValName, isVarName,+        isWiredInName, isBuiltInSyntax,+        isHoleName,+        wiredInNameTyThing_maybe,+        nameIsLocalOrFrom, nameIsHomePackage,+        nameIsHomePackageImport, nameIsFromExternalPackage,+        stableNameCmp,++        -- * Class 'NamedThing' and overloaded friends+        NamedThing(..),+        getSrcLoc, getSrcSpan, getOccString, getOccFS,++        pprInfixName, pprPrefixName, pprModulePrefix, pprNameUnqualified,+        nameStableString,++        -- Re-export the OccName stuff+        module OccName+    ) where++import GhcPrelude++import {-# SOURCE #-} TyCoRep( TyThing )++import OccName+import Module+import SrcLoc+import Unique+import Util+import Maybes+import Binary+import DynFlags+import FastString+import Outputable++import Control.DeepSeq+import Data.Data++{-+************************************************************************+*                                                                      *+\subsection[Name-datatype]{The @Name@ datatype, and name construction}+*                                                                      *+************************************************************************+-}++-- | A unique, unambiguous name for something, containing information about where+-- that thing originated.+data Name = Name {+                n_sort :: NameSort,     -- What sort of name it is+                n_occ  :: !OccName,     -- Its occurrence name+                n_uniq :: {-# UNPACK #-} !Unique,+                n_loc  :: !SrcSpan      -- Definition site+            }++-- NOTE: we make the n_loc field strict to eliminate some potential+-- (and real!) space leaks, due to the fact that we don't look at+-- the SrcLoc in a Name all that often.++-- See Note [About the NameSorts]+data NameSort+  = External Module++  | WiredIn Module TyThing BuiltInSyntax+        -- A variant of External, for wired-in things++  | Internal            -- A user-defined Id or TyVar+                        -- defined in the module being compiled++  | System              -- A system-defined Id or TyVar.  Typically the+                        -- OccName is very uninformative (like 's')++instance Outputable NameSort where+  ppr (External _)    = text "external"+  ppr (WiredIn _ _ _) = text "wired-in"+  ppr  Internal       = text "internal"+  ppr  System         = text "system"++instance NFData Name where+  rnf Name{..} = rnf n_sort++instance NFData NameSort where+  rnf (External m) = rnf m+  rnf (WiredIn m t b) = rnf m `seq` t `seq` b `seq` ()+    -- XXX this is a *lie*, we're not going to rnf the TyThing, but+    -- since the TyThings for WiredIn Names are all static they can't+    -- be hiding space leaks or errors.+  rnf Internal = ()+  rnf System = ()++-- | BuiltInSyntax is for things like @(:)@, @[]@ and tuples,+-- which have special syntactic forms.  They aren't in scope+-- as such.+data BuiltInSyntax = BuiltInSyntax | UserSyntax++{-+Note [About the NameSorts]++1.  Initially, top-level Ids (including locally-defined ones) get External names,+    and all other local Ids get Internal names++2.  In any invocation of GHC, an External Name for "M.x" has one and only one+    unique.  This unique association is ensured via the Name Cache;+    see Note [The Name Cache] in IfaceEnv.++3.  Things with a External name are given C static labels, so they finally+    appear in the .o file's symbol table.  They appear in the symbol table+    in the form M.n.  If originally-local things have this property they+    must be made @External@ first.++4.  In the tidy-core phase, a External that is not visible to an importer+    is changed to Internal, and a Internal that is visible is changed to External++5.  A System Name differs in the following ways:+        a) has unique attached when printing dumps+        b) unifier eliminates sys tyvars in favour of user provs where possible++    Before anything gets printed in interface files or output code, it's+    fed through a 'tidy' processor, which zaps the OccNames to have+    unique names; and converts all sys-locals to user locals+    If any desugarer sys-locals have survived that far, they get changed to+    "ds1", "ds2", etc.++Built-in syntax => It's a syntactic form, not "in scope" (e.g. [])++Wired-in thing  => The thing (Id, TyCon) is fully known to the compiler,+                   not read from an interface file.+                   E.g. Bool, True, Int, Float, and many others++All built-in syntax is for wired-in things.+-}++instance HasOccName Name where+  occName = nameOccName++nameUnique              :: Name -> Unique+nameOccName             :: Name -> OccName+nameModule              :: HasDebugCallStack => Name -> Module+nameSrcLoc              :: Name -> SrcLoc+nameSrcSpan             :: Name -> SrcSpan++nameUnique  name = n_uniq name+nameOccName name = n_occ  name+nameSrcLoc  name = srcSpanStart (n_loc name)+nameSrcSpan name = n_loc  name++type instance SrcSpanLess Name = Name+instance HasSrcSpan Name where+  composeSrcSpan   (L sp  n) = n {n_loc = sp}+  decomposeSrcSpan n         = L (n_loc n) n+++{-+************************************************************************+*                                                                      *+\subsection{Predicates on names}+*                                                                      *+************************************************************************+-}++isInternalName    :: Name -> Bool+isExternalName    :: Name -> Bool+isSystemName      :: Name -> Bool+isWiredInName     :: Name -> Bool++isWiredInName (Name {n_sort = WiredIn _ _ _}) = True+isWiredInName _                               = False++wiredInNameTyThing_maybe :: Name -> Maybe TyThing+wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ thing _}) = Just thing+wiredInNameTyThing_maybe _                                   = Nothing++isBuiltInSyntax :: Name -> Bool+isBuiltInSyntax (Name {n_sort = WiredIn _ _ BuiltInSyntax}) = True+isBuiltInSyntax _                                           = False++isExternalName (Name {n_sort = External _})    = True+isExternalName (Name {n_sort = WiredIn _ _ _}) = True+isExternalName _                               = False++isInternalName name = not (isExternalName name)++isHoleName :: Name -> Bool+isHoleName = isHoleModule . nameModule++nameModule name =+  nameModule_maybe name `orElse`+  pprPanic "nameModule" (ppr (n_sort name) <+> ppr name)++nameModule_maybe :: Name -> Maybe Module+nameModule_maybe (Name { n_sort = External mod})    = Just mod+nameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod+nameModule_maybe _                                  = Nothing++nameIsLocalOrFrom :: Module -> Name -> Bool+-- ^ Returns True if the name is+--   (a) Internal+--   (b) External but from the specified module+--   (c) External but from the 'interactive' package+--+-- The key idea is that+--    False means: the entity is defined in some other module+--                 you can find the details (type, fixity, instances)+--                     in some interface file+--                 those details will be stored in the EPT or HPT+--+--    True means:  the entity is defined in this module or earlier in+--                     the GHCi session+--                 you can find details (type, fixity, instances) in the+--                     TcGblEnv or TcLclEnv+--+-- The isInteractiveModule part is because successive interactions of a GHCi session+-- each give rise to a fresh module (Ghci1, Ghci2, etc), but they all come+-- from the magic 'interactive' package; and all the details are kept in the+-- TcLclEnv, TcGblEnv, NOT in the HPT or EPT.+-- See Note [The interactive package] in HscTypes++nameIsLocalOrFrom from name+  | Just mod <- nameModule_maybe name = from == mod || isInteractiveModule mod+  | otherwise                         = True++nameIsHomePackage :: Module -> Name -> Bool+-- True if the Name is defined in module of this package+nameIsHomePackage this_mod+  = \nm -> case n_sort nm of+              External nm_mod    -> moduleUnitId nm_mod == this_pkg+              WiredIn nm_mod _ _ -> moduleUnitId nm_mod == this_pkg+              Internal -> True+              System   -> False+  where+    this_pkg = moduleUnitId this_mod++nameIsHomePackageImport :: Module -> Name -> Bool+-- True if the Name is defined in module of this package+-- /other than/ the this_mod+nameIsHomePackageImport this_mod+  = \nm -> case nameModule_maybe nm of+              Nothing -> False+              Just nm_mod -> nm_mod /= this_mod+                          && moduleUnitId nm_mod == this_pkg+  where+    this_pkg = moduleUnitId this_mod++-- | Returns True if the Name comes from some other package: neither this+-- package nor the interactive package.+nameIsFromExternalPackage :: UnitId -> Name -> Bool+nameIsFromExternalPackage this_pkg name+  | Just mod <- nameModule_maybe name+  , moduleUnitId mod /= this_pkg    -- Not this package+  , not (isInteractiveModule mod)       -- Not the 'interactive' package+  = True+  | otherwise+  = False++isTyVarName :: Name -> Bool+isTyVarName name = isTvOcc (nameOccName name)++isTyConName :: Name -> Bool+isTyConName name = isTcOcc (nameOccName name)++isDataConName :: Name -> Bool+isDataConName name = isDataOcc (nameOccName name)++isValName :: Name -> Bool+isValName name = isValOcc (nameOccName name)++isVarName :: Name -> Bool+isVarName = isVarOcc . nameOccName++isSystemName (Name {n_sort = System}) = True+isSystemName _                        = False++{-+************************************************************************+*                                                                      *+\subsection{Making names}+*                                                                      *+************************************************************************+-}++-- | Create a name which is (for now at least) local to the current module and hence+-- does not need a 'Module' to disambiguate it from other 'Name's+mkInternalName :: Unique -> OccName -> SrcSpan -> Name+mkInternalName uniq occ loc = Name { n_uniq = uniq+                                   , n_sort = Internal+                                   , n_occ = occ+                                   , n_loc = loc }+        -- NB: You might worry that after lots of huffing and+        -- puffing we might end up with two local names with distinct+        -- uniques, but the same OccName.  Indeed we can, but that's ok+        --      * the insides of the compiler don't care: they use the Unique+        --      * when printing for -ddump-xxx you can switch on -dppr-debug to get the+        --        uniques if you get confused+        --      * for interface files we tidyCore first, which makes+        --        the OccNames distinct when they need to be++mkClonedInternalName :: Unique -> Name -> Name+mkClonedInternalName uniq (Name { n_occ = occ, n_loc = loc })+  = Name { n_uniq = uniq, n_sort = Internal+         , n_occ = occ, n_loc = loc }++mkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name+mkDerivedInternalName derive_occ uniq (Name { n_occ = occ, n_loc = loc })+  = Name { n_uniq = uniq, n_sort = Internal+         , n_occ = derive_occ occ, n_loc = loc }++-- | Create a name which definitely originates in the given module+mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name+-- WATCH OUT! External Names should be in the Name Cache+-- (see Note [The Name Cache] in IfaceEnv), so don't just call mkExternalName+-- with some fresh unique without populating the Name Cache+mkExternalName uniq mod occ loc+  = Name { n_uniq = uniq, n_sort = External mod,+           n_occ = occ, n_loc = loc }++-- | Create a name which is actually defined by the compiler itself+mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name+mkWiredInName mod occ uniq thing built_in+  = Name { n_uniq = uniq,+           n_sort = WiredIn mod thing built_in,+           n_occ = occ, n_loc = wiredInSrcSpan }++-- | Create a name brought into being by the compiler+mkSystemName :: Unique -> OccName -> Name+mkSystemName uniq occ = mkSystemNameAt uniq occ noSrcSpan++mkSystemNameAt :: Unique -> OccName -> SrcSpan -> Name+mkSystemNameAt uniq occ loc = Name { n_uniq = uniq, n_sort = System+                                   , n_occ = occ, n_loc = loc }++mkSystemVarName :: Unique -> FastString -> Name+mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)++mkSysTvName :: Unique -> FastString -> Name+mkSysTvName uniq fs = mkSystemName uniq (mkTyVarOccFS fs)++-- | Make a name for a foreign call+mkFCallName :: Unique -> String -> Name+mkFCallName uniq str = mkInternalName uniq (mkVarOcc str) noSrcSpan+   -- The encoded string completely describes the ccall++-- When we renumber/rename things, we need to be+-- able to change a Name's Unique to match the cached+-- one in the thing it's the name of.  If you know what I mean.+setNameUnique :: Name -> Unique -> Name+setNameUnique name uniq = name {n_uniq = uniq}++-- This is used for hsigs: we want to use the name of the originally exported+-- entity, but edit the location to refer to the reexport site+setNameLoc :: Name -> SrcSpan -> Name+setNameLoc name loc = name {n_loc = loc}++tidyNameOcc :: Name -> OccName -> Name+-- We set the OccName of a Name when tidying+-- In doing so, we change System --> Internal, so that when we print+-- it we don't get the unique by default.  It's tidy now!+tidyNameOcc name@(Name { n_sort = System }) occ = name { n_occ = occ, n_sort = Internal}+tidyNameOcc name                            occ = name { n_occ = occ }++-- | Make the 'Name' into an internal name, regardless of what it was to begin with+localiseName :: Name -> Name+localiseName n = n { n_sort = Internal }++{-+************************************************************************+*                                                                      *+\subsection{Hashing and comparison}+*                                                                      *+************************************************************************+-}++cmpName :: Name -> Name -> Ordering+cmpName n1 n2 = n_uniq n1 `nonDetCmpUnique` n_uniq n2++-- | Compare Names lexicographically+-- This only works for Names that originate in the source code or have been+-- tidied.+stableNameCmp :: Name -> Name -> Ordering+stableNameCmp (Name { n_sort = s1, n_occ = occ1 })+              (Name { n_sort = s2, n_occ = occ2 })+  = (s1 `sort_cmp` s2) `thenCmp` (occ1 `compare` occ2)+    -- The ordinary compare on OccNames is lexicographic+  where+    -- Later constructors are bigger+    sort_cmp (External m1) (External m2)       = m1 `stableModuleCmp` m2+    sort_cmp (External {}) _                   = LT+    sort_cmp (WiredIn {}) (External {})        = GT+    sort_cmp (WiredIn m1 _ _) (WiredIn m2 _ _) = m1 `stableModuleCmp` m2+    sort_cmp (WiredIn {})     _                = LT+    sort_cmp Internal         (External {})    = GT+    sort_cmp Internal         (WiredIn {})     = GT+    sort_cmp Internal         Internal         = EQ+    sort_cmp Internal         System           = LT+    sort_cmp System           System           = EQ+    sort_cmp System           _                = GT++{-+************************************************************************+*                                                                      *+\subsection[Name-instances]{Instance declarations}+*                                                                      *+************************************************************************+-}++-- | The same comments as for `Name`'s `Ord` instance apply.+instance Eq Name where+    a == b = case (a `compare` b) of { EQ -> True;  _ -> False }+    a /= b = case (a `compare` b) of { EQ -> False; _ -> True }++-- | __Caution__: This instance is implemented via `nonDetCmpUnique`, which+-- means that the ordering is not stable across deserialization or rebuilds.+--+-- See `nonDetCmpUnique` for further information, and trac #15240 for a bug+-- caused by improper use of this instance.++-- For a deterministic lexicographic ordering, use `stableNameCmp`.+instance Ord Name where+    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }+    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }+    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }+    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }+    compare a b = cmpName a b++instance Uniquable Name where+    getUnique = nameUnique++instance NamedThing Name where+    getName n = n++instance Data Name where+  -- don't traverse?+  toConstr _   = abstractConstr "Name"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "Name"++{-+************************************************************************+*                                                                      *+\subsection{Binary}+*                                                                      *+************************************************************************+-}++-- | Assumes that the 'Name' is a non-binding one. See+-- 'IfaceSyn.putIfaceTopBndr' and 'IfaceSyn.getIfaceTopBndr' for serializing+-- binding 'Name's. See 'UserData' for the rationale for this distinction.+instance Binary Name where+   put_ bh name =+      case getUserData bh of+        UserData{ ud_put_nonbinding_name = put_name } -> put_name bh name++   get bh =+      case getUserData bh of+        UserData { ud_get_name = get_name } -> get_name bh++{-+************************************************************************+*                                                                      *+\subsection{Pretty printing}+*                                                                      *+************************************************************************+-}++instance Outputable Name where+    ppr name = pprName name++instance OutputableBndr Name where+    pprBndr _ name = pprName name+    pprInfixOcc  = pprInfixName+    pprPrefixOcc = pprPrefixName++pprName :: Name -> SDoc+pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})+  = getPprStyle $ \ sty ->+    case sort of+      WiredIn mod _ builtin   -> pprExternal sty uniq mod occ True  builtin+      External mod            -> pprExternal sty uniq mod occ False UserSyntax+      System                  -> pprSystem sty uniq occ+      Internal                -> pprInternal sty uniq occ++-- | Print the string of Name unqualifiedly directly.+pprNameUnqualified :: Name -> SDoc+pprNameUnqualified Name { n_occ = occ } = ppr_occ_name occ++pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc+pprExternal sty uniq mod occ is_wired is_builtin+  | codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ+        -- In code style, always qualify+        -- ToDo: maybe we could print all wired-in things unqualified+        --       in code style, to reduce symbol table bloat?+  | debugStyle sty = pp_mod <> ppr_occ_name occ+                     <> braces (hsep [if is_wired then text "(w)" else empty,+                                      pprNameSpaceBrief (occNameSpace occ),+                                      pprUnique uniq])+  | BuiltInSyntax <- is_builtin = ppr_occ_name occ  -- Never qualify builtin syntax+  | otherwise                   =+        if isHoleModule mod+            then case qualName sty mod occ of+                    NameUnqual -> ppr_occ_name occ+                    _ -> braces (ppr (moduleName mod) <> dot <> ppr_occ_name occ)+            else pprModulePrefix sty mod occ <> ppr_occ_name occ+  where+    pp_mod = sdocWithDynFlags $ \dflags ->+             if gopt Opt_SuppressModulePrefixes dflags+             then empty+             else ppr mod <> dot++pprInternal :: PprStyle -> Unique -> OccName -> SDoc+pprInternal sty uniq occ+  | codeStyle sty  = pprUniqueAlways uniq+  | debugStyle sty = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace occ),+                                                       pprUnique uniq])+  | dumpStyle sty  = ppr_occ_name occ <> ppr_underscore_unique uniq+                        -- For debug dumps, we're not necessarily dumping+                        -- tidied code, so we need to print the uniques.+  | otherwise      = ppr_occ_name occ   -- User style++-- Like Internal, except that we only omit the unique in Iface style+pprSystem :: PprStyle -> Unique -> OccName -> SDoc+pprSystem sty uniq occ+  | codeStyle sty  = pprUniqueAlways uniq+  | debugStyle sty = ppr_occ_name occ <> ppr_underscore_unique uniq+                     <> braces (pprNameSpaceBrief (occNameSpace occ))+  | otherwise      = ppr_occ_name occ <> ppr_underscore_unique uniq+                                -- If the tidy phase hasn't run, the OccName+                                -- is unlikely to be informative (like 's'),+                                -- so print the unique+++pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc+-- Print the "M." part of a name, based on whether it's in scope or not+-- See Note [Printing original names] in HscTypes+pprModulePrefix sty mod occ = sdocWithDynFlags $ \dflags ->+  if gopt Opt_SuppressModulePrefixes dflags+  then empty+  else+    case qualName sty mod occ of              -- See Outputable.QualifyName:+      NameQual modname -> ppr modname <> dot       -- Name is in scope+      NameNotInScope1  -> ppr mod <> dot           -- Not in scope+      NameNotInScope2  -> ppr (moduleUnitId mod) <> colon     -- Module not in+                          <> ppr (moduleName mod) <> dot          -- scope either+      NameUnqual       -> empty                   -- In scope unqualified++pprUnique :: Unique -> SDoc+-- Print a unique unless we are suppressing them+pprUnique uniq+  = sdocWithDynFlags $ \dflags ->+    ppUnless (gopt Opt_SuppressUniques dflags) $+    pprUniqueAlways uniq++ppr_underscore_unique :: Unique -> SDoc+-- Print an underscore separating the name from its unique+-- But suppress it if we aren't printing the uniques anyway+ppr_underscore_unique uniq+  = sdocWithDynFlags $ \dflags ->+    ppUnless (gopt Opt_SuppressUniques dflags) $+    char '_' <> pprUniqueAlways uniq++ppr_occ_name :: OccName -> SDoc+ppr_occ_name occ = ftext (occNameFS occ)+        -- Don't use pprOccName; instead, just print the string of the OccName;+        -- we print the namespace in the debug stuff above++-- In code style, we Z-encode the strings.  The results of Z-encoding each FastString are+-- cached behind the scenes in the FastString implementation.+ppr_z_occ_name :: OccName -> SDoc+ppr_z_occ_name occ = ztext (zEncodeFS (occNameFS occ))++-- Prints (if mod information is available) "Defined at <loc>" or+--  "Defined in <mod>" information for a Name.+pprDefinedAt :: Name -> SDoc+pprDefinedAt name = text "Defined" <+> pprNameDefnLoc name++pprNameDefnLoc :: Name -> SDoc+-- Prints "at <loc>" or+--     or "in <mod>" depending on what info is available+pprNameDefnLoc name+  = case nameSrcLoc name of+         -- nameSrcLoc rather than nameSrcSpan+         -- It seems less cluttered to show a location+         -- rather than a span for the definition point+       RealSrcLoc s -> text "at" <+> ppr s+       UnhelpfulLoc s+         | isInternalName name || isSystemName name+         -> text "at" <+> ftext s+         | otherwise+         -> text "in" <+> quotes (ppr (nameModule name))+++-- | Get a string representation of a 'Name' that's unique and stable+-- across recompilations. Used for deterministic generation of binds for+-- derived instances.+-- eg. "$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal$String"+nameStableString :: Name -> String+nameStableString Name{..} =+  nameSortStableString n_sort ++ "$" ++ occNameString n_occ++nameSortStableString :: NameSort -> String+nameSortStableString System = "$_sys"+nameSortStableString Internal = "$_in"+nameSortStableString (External mod) = moduleStableString mod+nameSortStableString (WiredIn mod _ _) = moduleStableString mod++{-+************************************************************************+*                                                                      *+\subsection{Overloaded functions related to Names}+*                                                                      *+************************************************************************+-}++-- | A class allowing convenient access to the 'Name' of various datatypes+class NamedThing a where+    getOccName :: a -> OccName+    getName    :: a -> Name++    getOccName n = nameOccName (getName n)      -- Default method++instance NamedThing e => NamedThing (Located e) where+    getName = getName . unLoc++getSrcLoc           :: NamedThing a => a -> SrcLoc+getSrcSpan          :: NamedThing a => a -> SrcSpan+getOccString        :: NamedThing a => a -> String+getOccFS            :: NamedThing a => a -> FastString++getSrcLoc           = nameSrcLoc           . getName+getSrcSpan          = nameSrcSpan          . getName+getOccString        = occNameString        . getOccName+getOccFS            = occNameFS            . getOccName++pprInfixName :: (Outputable a, NamedThing a) => a -> SDoc+-- See Outputable.pprPrefixVar, pprInfixVar;+-- add parens or back-quotes as appropriate+pprInfixName  n = pprInfixVar (isSymOcc (getOccName n)) (ppr n)++pprPrefixName :: NamedThing a => a -> SDoc+pprPrefixName thing = pprPrefixVar (isSymOcc (nameOccName name)) (ppr name)+ where+   name = getName thing
+ compiler/basicTypes/Name.hs-boot view
@@ -0,0 +1,5 @@+module Name where++import GhcPrelude ()++data Name
+ compiler/basicTypes/NameCache.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}++-- | The Name Cache+module NameCache+    ( lookupOrigNameCache+    , extendOrigNameCache+    , extendNameCache+    , initNameCache+    , NameCache(..), OrigNameCache+    ) where++import GhcPrelude++import Module+import Name+import UniqSupply+import TysWiredIn+import Util+import Outputable+import PrelNames++#include "HsVersions.h"++{-++Note [The Name Cache]+~~~~~~~~~~~~~~~~~~~~~+The Name Cache makes sure that, during any invocation of GHC, each+External Name "M.x" has one, and only one globally-agreed Unique.++* The first time we come across M.x we make up a Unique and record that+  association in the Name Cache.++* When we come across "M.x" again, we look it up in the Name Cache,+  and get a hit.++The functions newGlobalBinder, allocateGlobalBinder do the main work.+When you make an External name, you should probably be calling one+of them.+++Note [Built-in syntax and the OrigNameCache]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Built-in syntax like tuples and unboxed sums are quite ubiquitous. To lower+their cost we use two tricks,++  a. We specially encode tuple and sum Names in interface files' symbol tables+     to avoid having to look up their names while loading interface files.+     Namely these names are encoded as by their Uniques. We know how to get from+     a Unique back to the Name which it represents via the mapping defined in+     the SumTupleUniques module. See Note [Symbol table representation of names]+     in BinIface and for details.++  b. We don't include them in the Orig name cache but instead parse their+     OccNames (in isBuiltInOcc_maybe) to avoid bloating the name cache with+     them.++Why is the second measure necessary? Good question; afterall, 1) the parser+emits built-in syntax directly as Exact RdrNames, and 2) built-in syntax never+needs to looked-up during interface loading due to (a). It turns out that there+are two reasons why we might look up an Orig RdrName for built-in syntax,++  * If you use setRdrNameSpace on an Exact RdrName it may be+    turned into an Orig RdrName.++  * Template Haskell turns a BuiltInSyntax Name into a TH.NameG+    (DsMeta.globalVar), and parses a NameG into an Orig RdrName+    (Convert.thRdrName).  So, e.g. $(do { reify '(,); ... }) will+    go this route (#8954).++-}++-- | Per-module cache of original 'OccName's given 'Name's+type OrigNameCache   = ModuleEnv (OccEnv Name)++lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name+lookupOrigNameCache nc mod occ+  | mod == gHC_TYPES || mod == gHC_PRIM || mod == gHC_TUPLE+  , Just name <- isBuiltInOcc_maybe occ+  =     -- See Note [Known-key names], 3(c) in PrelNames+        -- Special case for tuples; there are too many+        -- of them to pre-populate the original-name cache+    Just name++  | otherwise+  = case lookupModuleEnv nc mod of+        Nothing      -> Nothing+        Just occ_env -> lookupOccEnv occ_env occ++extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache+extendOrigNameCache nc name+  = ASSERT2( isExternalName name, ppr name )+    extendNameCache nc (nameModule name) (nameOccName name) name++extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache+extendNameCache nc mod occ name+  = extendModuleEnvWith combine nc mod (unitOccEnv occ name)+  where+    combine _ occ_env = extendOccEnv occ_env occ name++-- | The NameCache makes sure that there is just one Unique assigned for+-- each original name; i.e. (module-name, occ-name) pair and provides+-- something of a lookup mechanism for those names.+data NameCache+ = NameCache {  nsUniqs :: !UniqSupply,+                -- ^ Supply of uniques+                nsNames :: !OrigNameCache+                -- ^ Ensures that one original name gets one unique+   }++-- | Return a function to atomically update the name cache.+initNameCache :: UniqSupply -> [Name] -> NameCache+initNameCache us names+  = NameCache { nsUniqs = us,+                nsNames = initOrigNames names }++initOrigNames :: [Name] -> OrigNameCache+initOrigNames names = foldl' extendOrigNameCache emptyModuleEnv names
+ compiler/basicTypes/NameEnv.hs view
@@ -0,0 +1,154 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[NameEnv]{@NameEnv@: name environments}+-}++{-# LANGUAGE CPP #-}+module NameEnv (+        -- * Var, Id and TyVar environments (maps)+        NameEnv,++        -- ** Manipulating these environments+        mkNameEnv,+        emptyNameEnv, isEmptyNameEnv,+        unitNameEnv, nameEnvElts,+        extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,+        extendNameEnvList, extendNameEnvList_C,+        filterNameEnv, anyNameEnv,+        plusNameEnv, plusNameEnv_C, alterNameEnv,+        lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,+        elemNameEnv, mapNameEnv, disjointNameEnv,++        DNameEnv,++        emptyDNameEnv,+        lookupDNameEnv,+        mapDNameEnv,+        alterDNameEnv,+        -- ** Dependency analysis+        depAnal+    ) where++#include "HsVersions.h"++import GhcPrelude++import Digraph+import Name+import UniqFM+import UniqDFM+import Maybes++{-+************************************************************************+*                                                                      *+\subsection{Name environment}+*                                                                      *+************************************************************************+-}++{-+Note [depAnal determinism]+~~~~~~~~~~~~~~~~~~~~~~~~~~+depAnal is deterministic provided it gets the nodes in a deterministic order.+The order of lists that get_defs and get_uses return doesn't matter, as these+are only used to construct the edges, and stronglyConnCompFromEdgedVertices is+deterministic even when the edges are not in deterministic order as explained+in Note [Deterministic SCC] in Digraph.+-}++depAnal :: (node -> [Name])      -- Defs+        -> (node -> [Name])      -- Uses+        -> [node]+        -> [SCC node]+-- Perform dependency analysis on a group of definitions,+-- where each definition may define more than one Name+--+-- The get_defs and get_uses functions are called only once per node+depAnal get_defs get_uses nodes+  = stronglyConnCompFromEdgedVerticesUniq (map mk_node keyed_nodes)+  where+    keyed_nodes = nodes `zip` [(1::Int)..]+    mk_node (node, key) =+      DigraphNode node key (mapMaybe (lookupNameEnv key_map) (get_uses node))++    key_map :: NameEnv Int   -- Maps a Name to the key of the decl that defines it+    key_map = mkNameEnv [(name,key) | (node, key) <- keyed_nodes, name <- get_defs node]++{-+************************************************************************+*                                                                      *+\subsection{Name environment}+*                                                                      *+************************************************************************+-}++-- | Name Environment+type NameEnv a = UniqFM a       -- Domain is Name++emptyNameEnv       :: NameEnv a+isEmptyNameEnv     :: NameEnv a -> Bool+mkNameEnv          :: [(Name,a)] -> NameEnv a+nameEnvElts        :: NameEnv a -> [a]+alterNameEnv       :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a+extendNameEnv_C    :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a+extendNameEnv_Acc  :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b+extendNameEnv      :: NameEnv a -> Name -> a -> NameEnv a+plusNameEnv        :: NameEnv a -> NameEnv a -> NameEnv a+plusNameEnv_C      :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a+extendNameEnvList  :: NameEnv a -> [(Name,a)] -> NameEnv a+extendNameEnvList_C :: (a->a->a) -> NameEnv a -> [(Name,a)] -> NameEnv a+delFromNameEnv     :: NameEnv a -> Name -> NameEnv a+delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a+elemNameEnv        :: Name -> NameEnv a -> Bool+unitNameEnv        :: Name -> a -> NameEnv a+lookupNameEnv      :: NameEnv a -> Name -> Maybe a+lookupNameEnv_NF   :: NameEnv a -> Name -> a+filterNameEnv      :: (elt -> Bool) -> NameEnv elt -> NameEnv elt+anyNameEnv         :: (elt -> Bool) -> NameEnv elt -> Bool+mapNameEnv         :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2+disjointNameEnv    :: NameEnv a -> NameEnv a -> Bool++nameEnvElts x         = eltsUFM x+emptyNameEnv          = emptyUFM+isEmptyNameEnv        = isNullUFM+unitNameEnv x y       = unitUFM x y+extendNameEnv x y z   = addToUFM x y z+extendNameEnvList x l = addListToUFM x l+lookupNameEnv x y     = lookupUFM x y+alterNameEnv          = alterUFM+mkNameEnv     l       = listToUFM l+elemNameEnv x y          = elemUFM x y+plusNameEnv x y          = plusUFM x y+plusNameEnv_C f x y      = plusUFM_C f x y+extendNameEnv_C f x y z  = addToUFM_C f x y z+mapNameEnv f x           = mapUFM f x+extendNameEnv_Acc x y z a b  = addToUFM_Acc x y z a b+extendNameEnvList_C x y z = addListToUFM_C x y z+delFromNameEnv x y      = delFromUFM x y+delListFromNameEnv x y  = delListFromUFM x y+filterNameEnv x y       = filterUFM x y+anyNameEnv f x          = foldUFM ((||) . f) False x+disjointNameEnv x y     = isNullUFM (intersectUFM x y)++lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)++-- | Deterministic Name Environment+--+-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need+-- DNameEnv.+type DNameEnv a = UniqDFM a++emptyDNameEnv :: DNameEnv a+emptyDNameEnv = emptyUDFM++lookupDNameEnv :: DNameEnv a -> Name -> Maybe a+lookupDNameEnv = lookupUDFM++mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b+mapDNameEnv = mapUDFM++alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a+alterDNameEnv = alterUDFM
+ compiler/basicTypes/NameSet.hs view
@@ -0,0 +1,214 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1998+-}++{-# LANGUAGE CPP #-}+module NameSet (+        -- * Names set type+        NameSet,++        -- ** Manipulating these sets+        emptyNameSet, unitNameSet, mkNameSet, unionNameSet, unionNameSets,+        minusNameSet, elemNameSet, extendNameSet, extendNameSetList,+        delFromNameSet, delListFromNameSet, isEmptyNameSet, filterNameSet,+        intersectsNameSet, intersectNameSet,+        nameSetAny, nameSetAll, nameSetElemsStable,++        -- * Free variables+        FreeVars,++        -- ** Manipulating sets of free variables+        isEmptyFVs, emptyFVs, plusFVs, plusFV,+        mkFVs, addOneFV, unitFV, delFV, delFVs,+        intersectFVs,++        -- * Defs and uses+        Defs, Uses, DefUse, DefUses,++        -- ** Manipulating defs and uses+        emptyDUs, usesOnly, mkDUs, plusDU,+        findUses, duDefs, duUses, allUses+    ) where++#include "HsVersions.h"++import GhcPrelude++import Name+import UniqSet+import Data.List (sortBy)++{-+************************************************************************+*                                                                      *+\subsection[Sets of names}+*                                                                      *+************************************************************************+-}++type NameSet = UniqSet Name++emptyNameSet       :: NameSet+unitNameSet        :: Name -> NameSet+extendNameSetList   :: NameSet -> [Name] -> NameSet+extendNameSet    :: NameSet -> Name -> NameSet+mkNameSet          :: [Name] -> NameSet+unionNameSet      :: NameSet -> NameSet -> NameSet+unionNameSets  :: [NameSet] -> NameSet+minusNameSet       :: NameSet -> NameSet -> NameSet+elemNameSet        :: Name -> NameSet -> Bool+isEmptyNameSet     :: NameSet -> Bool+delFromNameSet     :: NameSet -> Name -> NameSet+delListFromNameSet :: NameSet -> [Name] -> NameSet+filterNameSet      :: (Name -> Bool) -> NameSet -> NameSet+intersectNameSet   :: NameSet -> NameSet -> NameSet+intersectsNameSet  :: NameSet -> NameSet -> Bool+-- ^ True if there is a non-empty intersection.+-- @s1 `intersectsNameSet` s2@ doesn't compute @s2@ if @s1@ is empty++isEmptyNameSet    = isEmptyUniqSet+emptyNameSet      = emptyUniqSet+unitNameSet       = unitUniqSet+mkNameSet         = mkUniqSet+extendNameSetList  = addListToUniqSet+extendNameSet   = addOneToUniqSet+unionNameSet     = unionUniqSets+unionNameSets = unionManyUniqSets+minusNameSet      = minusUniqSet+elemNameSet       = elementOfUniqSet+delFromNameSet    = delOneFromUniqSet+filterNameSet     = filterUniqSet+intersectNameSet  = intersectUniqSets++delListFromNameSet set ns = foldl' delFromNameSet set ns++intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))++nameSetAny :: (Name -> Bool) -> NameSet -> Bool+nameSetAny = uniqSetAny++nameSetAll :: (Name -> Bool) -> NameSet -> Bool+nameSetAll = uniqSetAll++-- | Get the elements of a NameSet with some stable ordering.+-- This only works for Names that originate in the source code or have been+-- tidied.+-- See Note [Deterministic UniqFM] to learn about nondeterminism+nameSetElemsStable :: NameSet -> [Name]+nameSetElemsStable ns =+  sortBy stableNameCmp $ nonDetEltsUniqSet ns+  -- It's OK to use nonDetEltsUniqSet here because we immediately sort+  -- with stableNameCmp++{-+************************************************************************+*                                                                      *+\subsection{Free variables}+*                                                                      *+************************************************************************++These synonyms are useful when we are thinking of free variables+-}++type FreeVars   = NameSet++plusFV   :: FreeVars -> FreeVars -> FreeVars+addOneFV :: FreeVars -> Name -> FreeVars+unitFV   :: Name -> FreeVars+emptyFVs :: FreeVars+plusFVs  :: [FreeVars] -> FreeVars+mkFVs    :: [Name] -> FreeVars+delFV    :: Name -> FreeVars -> FreeVars+delFVs   :: [Name] -> FreeVars -> FreeVars+intersectFVs :: FreeVars -> FreeVars -> FreeVars++isEmptyFVs :: NameSet -> Bool+isEmptyFVs  = isEmptyNameSet+emptyFVs    = emptyNameSet+plusFVs     = unionNameSets+plusFV      = unionNameSet+mkFVs       = mkNameSet+addOneFV    = extendNameSet+unitFV      = unitNameSet+delFV n s   = delFromNameSet s n+delFVs ns s = delListFromNameSet s ns+intersectFVs = intersectNameSet++{-+************************************************************************+*                                                                      *+                Defs and uses+*                                                                      *+************************************************************************+-}++-- | A set of names that are defined somewhere+type Defs = NameSet++-- | A set of names that are used somewhere+type Uses = NameSet++-- | @(Just ds, us) =>@ The use of any member of the @ds@+--                      implies that all the @us@ are used too.+--                      Also, @us@ may mention @ds@.+--+-- @Nothing =>@ Nothing is defined in this group, but+--              nevertheless all the uses are essential.+--              Used for instance declarations, for example+type DefUse  = (Maybe Defs, Uses)++-- | A number of 'DefUse's in dependency order: earlier 'Defs' scope over later 'Uses'+--   In a single (def, use) pair, the defs also scope over the uses+type DefUses = [DefUse]++emptyDUs :: DefUses+emptyDUs = []++usesOnly :: Uses -> DefUses+usesOnly uses = [(Nothing, uses)]++mkDUs :: [(Defs,Uses)] -> DefUses+mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]++plusDU :: DefUses -> DefUses -> DefUses+plusDU = (++)++duDefs :: DefUses -> Defs+duDefs dus = foldr get emptyNameSet dus+  where+    get (Nothing, _u1) d2 = d2+    get (Just d1, _u1) d2 = d1 `unionNameSet` d2++allUses :: DefUses -> Uses+-- ^ Just like 'duUses', but 'Defs' are not eliminated from the 'Uses' returned+allUses dus = foldr get emptyNameSet dus+  where+    get (_d1, u1) u2 = u1 `unionNameSet` u2++duUses :: DefUses -> Uses+-- ^ Collect all 'Uses', regardless of whether the group is itself used,+-- but remove 'Defs' on the way+duUses dus = foldr get emptyNameSet dus+  where+    get (Nothing,   rhs_uses) uses = rhs_uses `unionNameSet` uses+    get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSet` uses)+                                     `minusNameSet` defs++findUses :: DefUses -> Uses -> Uses+-- ^ Given some 'DefUses' and some 'Uses', find all the uses, transitively.+-- The result is a superset of the input 'Uses'; and includes things defined+-- in the input 'DefUses' (but only if they are used)+findUses dus uses+  = foldr get uses dus+  where+    get (Nothing, rhs_uses) uses+        = rhs_uses `unionNameSet` uses+    get (Just defs, rhs_uses) uses+        | defs `intersectsNameSet` uses         -- Used+        || nameSetAny (startsWithUnderscore . nameOccName) defs+                -- At least one starts with an "_",+                -- so treat the group as used+        = rhs_uses `unionNameSet` uses+        | otherwise     -- No def is used+        = uses
+ compiler/basicTypes/OccName.hs view
@@ -0,0 +1,925 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- #name_types#+-- GHC uses several kinds of name internally:+--+-- * 'OccName.OccName' represents names as strings with just a little more information:+--   the \"namespace\" that the name came from, e.g. the namespace of value, type constructors or+--   data constructors+--+-- * 'RdrName.RdrName': see "RdrName#name_types"+--+-- * 'Name.Name': see "Name#name_types"+--+-- * 'Id.Id': see "Id#name_types"+--+-- * 'Var.Var': see "Var#name_types"++module OccName (+        -- * The 'NameSpace' type+        NameSpace, -- Abstract++        nameSpacesRelated,++        -- ** Construction+        -- $real_vs_source_data_constructors+        tcName, clsName, tcClsName, dataName, varName,+        tvName, srcDataName,++        -- ** Pretty Printing+        pprNameSpace, pprNonVarNameSpace, pprNameSpaceBrief,++        -- * The 'OccName' type+        OccName,        -- Abstract, instance of Outputable+        pprOccName,++        -- ** Construction+        mkOccName, mkOccNameFS,+        mkVarOcc, mkVarOccFS,+        mkDataOcc, mkDataOccFS,+        mkTyVarOcc, mkTyVarOccFS,+        mkTcOcc, mkTcOccFS,+        mkClsOcc, mkClsOccFS,+        mkDFunOcc,+        setOccNameSpace,+        demoteOccName,+        HasOccName(..),++        -- ** Derived 'OccName's+        isDerivedOccName,+        mkDataConWrapperOcc, mkWorkerOcc,+        mkMatcherOcc, mkBuilderOcc,+        mkDefaultMethodOcc, isDefaultMethodOcc, isTypeableBindOcc,+        mkNewTyCoOcc, mkClassOpAuxOcc,+        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,+        mkClassDataConOcc, mkDictOcc, mkIPOcc,+        mkSpecOcc, mkForeignExportOcc, mkRepEqOcc,+        mkGenR, mkGen1R,+        mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,+        mkSuperDictSelOcc, mkSuperDictAuxOcc,+        mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,+        mkInstTyCoOcc, mkEqPredCoOcc,+        mkRecFldSelOcc,+        mkTyConRepOcc,++        -- ** Deconstruction+        occNameFS, occNameString, occNameSpace,++        isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,+        parenSymOcc, startsWithUnderscore,++        isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace,++        -- * The 'OccEnv' type+        OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv,+        lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,+        occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,+        extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv,+        alterOccEnv, pprOccEnv,++        -- * The 'OccSet' type+        OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,+        extendOccSetList,+        unionOccSets, unionManyOccSets, minusOccSet, elemOccSet,+        isEmptyOccSet, intersectOccSet, intersectsOccSet,+        filterOccSet,++        -- * Tidying up+        TidyOccEnv, emptyTidyOccEnv, initTidyOccEnv,+        tidyOccName, avoidClashesOccEnv,++        -- FsEnv+        FastStringEnv, emptyFsEnv, lookupFsEnv, extendFsEnv, mkFsEnv+    ) where++import GhcPrelude++import Util+import Unique+import DynFlags+import UniqFM+import UniqSet+import FastString+import FastStringEnv+import Outputable+import Lexeme+import Binary+import Control.DeepSeq+import Data.Char+import Data.Data++{-+************************************************************************+*                                                                      *+\subsection{Name space}+*                                                                      *+************************************************************************+-}++data NameSpace = VarName        -- Variables, including "real" data constructors+               | DataName       -- "Source" data constructors+               | TvName         -- Type variables+               | TcClsName      -- Type constructors and classes; Haskell has them+                                -- in the same name space for now.+               deriving( Eq, Ord )++-- Note [Data Constructors]+-- see also: Note [Data Constructor Naming] in DataCon.hs+--+-- $real_vs_source_data_constructors+-- There are two forms of data constructor:+--+--      [Source data constructors] The data constructors mentioned in Haskell source code+--+--      [Real data constructors] The data constructors of the representation type, which may not be the same as the source type+--+-- For example:+--+-- > data T = T !(Int, Int)+--+-- The source datacon has type @(Int, Int) -> T@+-- The real   datacon has type @Int -> Int -> T@+--+-- GHC chooses a representation based on the strictness etc.++tcName, clsName, tcClsName :: NameSpace+dataName, srcDataName      :: NameSpace+tvName, varName            :: NameSpace++-- Though type constructors and classes are in the same name space now,+-- the NameSpace type is abstract, so we can easily separate them later+tcName    = TcClsName           -- Type constructors+clsName   = TcClsName           -- Classes+tcClsName = TcClsName           -- Not sure which!++dataName    = DataName+srcDataName = DataName  -- Haskell-source data constructors should be+                        -- in the Data name space++tvName      = TvName+varName     = VarName++isDataConNameSpace :: NameSpace -> Bool+isDataConNameSpace DataName = True+isDataConNameSpace _        = False++isTcClsNameSpace :: NameSpace -> Bool+isTcClsNameSpace TcClsName = True+isTcClsNameSpace _         = False++isTvNameSpace :: NameSpace -> Bool+isTvNameSpace TvName = True+isTvNameSpace _      = False++isVarNameSpace :: NameSpace -> Bool     -- Variables or type variables, but not constructors+isVarNameSpace TvName  = True+isVarNameSpace VarName = True+isVarNameSpace _       = False++isValNameSpace :: NameSpace -> Bool+isValNameSpace DataName = True+isValNameSpace VarName  = True+isValNameSpace _        = False++pprNameSpace :: NameSpace -> SDoc+pprNameSpace DataName  = text "data constructor"+pprNameSpace VarName   = text "variable"+pprNameSpace TvName    = text "type variable"+pprNameSpace TcClsName = text "type constructor or class"++pprNonVarNameSpace :: NameSpace -> SDoc+pprNonVarNameSpace VarName = empty+pprNonVarNameSpace ns = pprNameSpace ns++pprNameSpaceBrief :: NameSpace -> SDoc+pprNameSpaceBrief DataName  = char 'd'+pprNameSpaceBrief VarName   = char 'v'+pprNameSpaceBrief TvName    = text "tv"+pprNameSpaceBrief TcClsName = text "tc"++-- demoteNameSpace lowers the NameSpace if possible.  We can not know+-- in advance, since a TvName can appear in an HsTyVar.+-- See Note [Demotion] in RnEnv+demoteNameSpace :: NameSpace -> Maybe NameSpace+demoteNameSpace VarName = Nothing+demoteNameSpace DataName = Nothing+demoteNameSpace TvName = Nothing+demoteNameSpace TcClsName = Just DataName++{-+************************************************************************+*                                                                      *+\subsection[Name-pieces-datatypes]{The @OccName@ datatypes}+*                                                                      *+************************************************************************+-}++-- | Occurrence Name+--+-- In this context that means:+-- "classified (i.e. as a type name, value name, etc) but not qualified+-- and not yet resolved"+data OccName = OccName+    { occNameSpace  :: !NameSpace+    , occNameFS     :: !FastString+    }++instance Eq OccName where+    (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2++instance Ord OccName where+        -- Compares lexicographically, *not* by Unique of the string+    compare (OccName sp1 s1) (OccName sp2 s2)+        = (s1  `compare` s2) `thenCmp` (sp1 `compare` sp2)++instance Data OccName where+  -- don't traverse?+  toConstr _   = abstractConstr "OccName"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "OccName"++instance HasOccName OccName where+  occName = id++instance NFData OccName where+  rnf x = x `seq` ()++{-+************************************************************************+*                                                                      *+\subsection{Printing}+*                                                                      *+************************************************************************+-}++instance Outputable OccName where+    ppr = pprOccName++instance OutputableBndr OccName where+    pprBndr _ = ppr+    pprInfixOcc n = pprInfixVar (isSymOcc n) (ppr n)+    pprPrefixOcc n = pprPrefixVar (isSymOcc n) (ppr n)++pprOccName :: OccName -> SDoc+pprOccName (OccName sp occ)+  = getPprStyle $ \ sty ->+    if codeStyle sty+    then ztext (zEncodeFS occ)+    else pp_occ <> pp_debug sty+  where+    pp_debug sty | debugStyle sty = braces (pprNameSpaceBrief sp)+                 | otherwise      = empty++    pp_occ = sdocWithDynFlags $ \dflags ->+             if gopt Opt_SuppressUniques dflags+             then text (strip_th_unique (unpackFS occ))+             else ftext occ++        -- See Note [Suppressing uniques in OccNames]+    strip_th_unique ('[' : c : _) | isAlphaNum c = []+    strip_th_unique (c : cs) = c : strip_th_unique cs+    strip_th_unique []       = []++{-+Note [Suppressing uniques in OccNames]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+This is a hack to de-wobblify the OccNames that contain uniques from+Template Haskell that have been turned into a string in the OccName.+See Note [Unique OccNames from Template Haskell] in Convert.hs++************************************************************************+*                                                                      *+\subsection{Construction}+*                                                                      *+************************************************************************+-}++mkOccName :: NameSpace -> String -> OccName+mkOccName occ_sp str = OccName occ_sp (mkFastString str)++mkOccNameFS :: NameSpace -> FastString -> OccName+mkOccNameFS occ_sp fs = OccName occ_sp fs++mkVarOcc :: String -> OccName+mkVarOcc s = mkOccName varName s++mkVarOccFS :: FastString -> OccName+mkVarOccFS fs = mkOccNameFS varName fs++mkDataOcc :: String -> OccName+mkDataOcc = mkOccName dataName++mkDataOccFS :: FastString -> OccName+mkDataOccFS = mkOccNameFS dataName++mkTyVarOcc :: String -> OccName+mkTyVarOcc = mkOccName tvName++mkTyVarOccFS :: FastString -> OccName+mkTyVarOccFS fs = mkOccNameFS tvName fs++mkTcOcc :: String -> OccName+mkTcOcc = mkOccName tcName++mkTcOccFS :: FastString -> OccName+mkTcOccFS = mkOccNameFS tcName++mkClsOcc :: String -> OccName+mkClsOcc = mkOccName clsName++mkClsOccFS :: FastString -> OccName+mkClsOccFS = mkOccNameFS clsName++-- demoteOccName lowers the Namespace of OccName.+-- see Note [Demotion]+demoteOccName :: OccName -> Maybe OccName+demoteOccName (OccName space name) = do+  space' <- demoteNameSpace space+  return $ OccName space' name++-- Name spaces are related if there is a chance to mean the one when one writes+-- the other, i.e. variables <-> data constructors and type variables <-> type constructors+nameSpacesRelated :: NameSpace -> NameSpace -> Bool+nameSpacesRelated ns1 ns2 = ns1 == ns2 || otherNameSpace ns1 == ns2++otherNameSpace :: NameSpace -> NameSpace+otherNameSpace VarName = DataName+otherNameSpace DataName = VarName+otherNameSpace TvName = TcClsName+otherNameSpace TcClsName = TvName++++{- | Other names in the compiler add additional information to an OccName.+This class provides a consistent way to access the underlying OccName. -}+class HasOccName name where+  occName :: name -> OccName++{-+************************************************************************+*                                                                      *+                Environments+*                                                                      *+************************************************************************++OccEnvs are used mainly for the envts in ModIfaces.++Note [The Unique of an OccName]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+They are efficient, because FastStrings have unique Int# keys.  We assume+this key is less than 2^24, and indeed FastStrings are allocated keys+sequentially starting at 0.++So we can make a Unique using+        mkUnique ns key  :: Unique+where 'ns' is a Char representing the name space.  This in turn makes it+easy to build an OccEnv.+-}++instance Uniquable OccName where+      -- See Note [The Unique of an OccName]+  getUnique (OccName VarName   fs) = mkVarOccUnique  fs+  getUnique (OccName DataName  fs) = mkDataOccUnique fs+  getUnique (OccName TvName    fs) = mkTvOccUnique   fs+  getUnique (OccName TcClsName fs) = mkTcOccUnique   fs++newtype OccEnv a = A (UniqFM a)+  deriving Data++emptyOccEnv :: OccEnv a+unitOccEnv  :: OccName -> a -> OccEnv a+extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a+extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a+lookupOccEnv :: OccEnv a -> OccName -> Maybe a+mkOccEnv     :: [(OccName,a)] -> OccEnv a+mkOccEnv_C   :: (a -> a -> a) -> [(OccName,a)] -> OccEnv a+elemOccEnv   :: OccName -> OccEnv a -> Bool+foldOccEnv   :: (a -> b -> b) -> b -> OccEnv a -> b+occEnvElts   :: OccEnv a -> [a]+extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a+extendOccEnv_Acc :: (a->b->b) -> (a->b) -> OccEnv b -> OccName -> a -> OccEnv b+plusOccEnv     :: OccEnv a -> OccEnv a -> OccEnv a+plusOccEnv_C   :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a+mapOccEnv      :: (a->b) -> OccEnv a -> OccEnv b+delFromOccEnv      :: OccEnv a -> OccName -> OccEnv a+delListFromOccEnv :: OccEnv a -> [OccName] -> OccEnv a+filterOccEnv       :: (elt -> Bool) -> OccEnv elt -> OccEnv elt+alterOccEnv        :: (Maybe elt -> Maybe elt) -> OccEnv elt -> OccName -> OccEnv elt++emptyOccEnv      = A emptyUFM+unitOccEnv x y = A $ unitUFM x y+extendOccEnv (A x) y z = A $ addToUFM x y z+extendOccEnvList (A x) l = A $ addListToUFM x l+lookupOccEnv (A x) y = lookupUFM x y+mkOccEnv     l    = A $ listToUFM l+elemOccEnv x (A y)       = elemUFM x y+foldOccEnv a b (A c)     = foldUFM a b c+occEnvElts (A x)         = eltsUFM x+plusOccEnv (A x) (A y)   = A $ plusUFM x y+plusOccEnv_C f (A x) (A y)       = A $ plusUFM_C f x y+extendOccEnv_C f (A x) y z   = A $ addToUFM_C f x y z+extendOccEnv_Acc f g (A x) y z   = A $ addToUFM_Acc f g x y z+mapOccEnv f (A x)        = A $ mapUFM f x+mkOccEnv_C comb l = A $ addListToUFM_C comb emptyUFM l+delFromOccEnv (A x) y    = A $ delFromUFM x y+delListFromOccEnv (A x) y  = A $ delListFromUFM x y+filterOccEnv x (A y)       = A $ filterUFM x y+alterOccEnv fn (A y) k     = A $ alterUFM fn y k++instance Outputable a => Outputable (OccEnv a) where+    ppr x = pprOccEnv ppr x++pprOccEnv :: (a -> SDoc) -> OccEnv a -> SDoc+pprOccEnv ppr_elt (A env) = pprUniqFM ppr_elt env++type OccSet = UniqSet OccName++emptyOccSet       :: OccSet+unitOccSet        :: OccName -> OccSet+mkOccSet          :: [OccName] -> OccSet+extendOccSet      :: OccSet -> OccName -> OccSet+extendOccSetList  :: OccSet -> [OccName] -> OccSet+unionOccSets      :: OccSet -> OccSet -> OccSet+unionManyOccSets  :: [OccSet] -> OccSet+minusOccSet       :: OccSet -> OccSet -> OccSet+elemOccSet        :: OccName -> OccSet -> Bool+isEmptyOccSet     :: OccSet -> Bool+intersectOccSet   :: OccSet -> OccSet -> OccSet+intersectsOccSet  :: OccSet -> OccSet -> Bool+filterOccSet      :: (OccName -> Bool) -> OccSet -> OccSet++emptyOccSet       = emptyUniqSet+unitOccSet        = unitUniqSet+mkOccSet          = mkUniqSet+extendOccSet      = addOneToUniqSet+extendOccSetList  = addListToUniqSet+unionOccSets      = unionUniqSets+unionManyOccSets  = unionManyUniqSets+minusOccSet       = minusUniqSet+elemOccSet        = elementOfUniqSet+isEmptyOccSet     = isEmptyUniqSet+intersectOccSet   = intersectUniqSets+intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2))+filterOccSet      = filterUniqSet++{-+************************************************************************+*                                                                      *+\subsection{Predicates and taking them apart}+*                                                                      *+************************************************************************+-}++occNameString :: OccName -> String+occNameString (OccName _ s) = unpackFS s++setOccNameSpace :: NameSpace -> OccName -> OccName+setOccNameSpace sp (OccName _ occ) = OccName sp occ++isVarOcc, isTvOcc, isTcOcc, isDataOcc :: OccName -> Bool++isVarOcc (OccName VarName _) = True+isVarOcc _                   = False++isTvOcc (OccName TvName _) = True+isTvOcc _                  = False++isTcOcc (OccName TcClsName _) = True+isTcOcc _                     = False++-- | /Value/ 'OccNames's are those that are either in+-- the variable or data constructor namespaces+isValOcc :: OccName -> Bool+isValOcc (OccName VarName  _) = True+isValOcc (OccName DataName _) = True+isValOcc _                    = False++isDataOcc (OccName DataName _) = True+isDataOcc _                    = False++-- | Test if the 'OccName' is a data constructor that starts with+-- a symbol (e.g. @:@, or @[]@)+isDataSymOcc :: OccName -> Bool+isDataSymOcc (OccName DataName s) = isLexConSym s+isDataSymOcc _                    = False+-- Pretty inefficient!++-- | Test if the 'OccName' is that for any operator (whether+-- it is a data constructor or variable or whatever)+isSymOcc :: OccName -> Bool+isSymOcc (OccName DataName s)  = isLexConSym s+isSymOcc (OccName TcClsName s) = isLexSym s+isSymOcc (OccName VarName s)   = isLexSym s+isSymOcc (OccName TvName s)    = isLexSym s+-- Pretty inefficient!++parenSymOcc :: OccName -> SDoc -> SDoc+-- ^ Wrap parens around an operator+parenSymOcc occ doc | isSymOcc occ = parens doc+                    | otherwise    = doc++startsWithUnderscore :: OccName -> Bool+-- ^ Haskell 98 encourages compilers to suppress warnings about unsed+-- names in a pattern if they start with @_@: this implements that test+startsWithUnderscore occ = headFS (occNameFS occ) == '_'++{-+************************************************************************+*                                                                      *+\subsection{Making system names}+*                                                                      *+************************************************************************++Here's our convention for splitting up the interface file name space:++   d...         dictionary identifiers+                (local variables, so no name-clash worries)++All of these other OccNames contain a mixture of alphabetic+and symbolic characters, and hence cannot possibly clash with+a user-written type or function name++   $f...        Dict-fun identifiers (from inst decls)+   $dmop        Default method for 'op'+   $pnC         n'th superclass selector for class C+   $wf          Worker for function 'f'+   $sf..        Specialised version of f+   D:C          Data constructor for dictionary for class C+   NTCo:T       Coercion connecting newtype T with its representation type+   TFCo:R       Coercion connecting a data family to its representation type R++In encoded form these appear as Zdfxxx etc++        :...            keywords (export:, letrec: etc.)+--- I THINK THIS IS WRONG!++This knowledge is encoded in the following functions.++@mk_deriv@ generates an @OccName@ from the prefix and a string.+NB: The string must already be encoded!+-}++-- | Build an 'OccName' derived from another 'OccName'.+--+-- Note that the pieces of the name are passed in as a @[FastString]@ so that+-- the whole name can be constructed with a single 'concatFS', minimizing+-- unnecessary intermediate allocations.+mk_deriv :: NameSpace+         -> FastString      -- ^ A prefix which distinguishes one sort of+                            -- derived name from another+         -> [FastString]    -- ^ The name we are deriving from in pieces which+                            -- will be concatenated.+         -> OccName+mk_deriv occ_sp sys_prefix str =+    mkOccNameFS occ_sp (concatFS $ sys_prefix : str)++isDerivedOccName :: OccName -> Bool+-- ^ Test for definitions internally generated by GHC.  This predicte+-- is used to suppress printing of internal definitions in some debug prints+isDerivedOccName occ =+   case occNameString occ of+     '$':c:_ | isAlphaNum c -> True   -- E.g.  $wfoo+     c:':':_ | isAlphaNum c -> True   -- E.g.  N:blah   newtype coercions+     _other                 -> False++isDefaultMethodOcc :: OccName -> Bool+isDefaultMethodOcc occ =+   case occNameString occ of+     '$':'d':'m':_ -> True+     _ -> False++-- | Is an 'OccName' one of a Typeable @TyCon@ or @Module@ binding?+-- This is needed as these bindings are renamed differently.+-- See Note [Grand plan for Typeable] in TcTypeable.+isTypeableBindOcc :: OccName -> Bool+isTypeableBindOcc occ =+   case occNameString occ of+     '$':'t':'c':_ -> True  -- mkTyConRepOcc+     '$':'t':'r':_ -> True  -- Module binding+     _ -> False++mkDataConWrapperOcc, mkWorkerOcc,+        mkMatcherOcc, mkBuilderOcc,+        mkDefaultMethodOcc,+        mkClassDataConOcc, mkDictOcc,+        mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkRepEqOcc,+        mkGenR, mkGen1R,+        mkDataConWorkerOcc, mkNewTyCoOcc,+        mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,+        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,+        mkTyConRepOcc+   :: OccName -> OccName++-- These derived variables have a prefix that no Haskell value could have+mkDataConWrapperOcc = mk_simple_deriv varName  "$W"+mkWorkerOcc         = mk_simple_deriv varName  "$w"+mkMatcherOcc        = mk_simple_deriv varName  "$m"+mkBuilderOcc        = mk_simple_deriv varName  "$b"+mkDefaultMethodOcc  = mk_simple_deriv varName  "$dm"+mkClassOpAuxOcc     = mk_simple_deriv varName  "$c"+mkDictOcc           = mk_simple_deriv varName  "$d"+mkIPOcc             = mk_simple_deriv varName  "$i"+mkSpecOcc           = mk_simple_deriv varName  "$s"+mkForeignExportOcc  = mk_simple_deriv varName  "$f"+mkRepEqOcc          = mk_simple_deriv tvName   "$r"   -- In RULES involving Coercible+mkClassDataConOcc   = mk_simple_deriv dataName "C:"     -- Data con for a class+mkNewTyCoOcc        = mk_simple_deriv tcName   "N:"   -- Coercion for newtypes+mkInstTyCoOcc       = mk_simple_deriv tcName   "D:"   -- Coercion for type functions+mkEqPredCoOcc       = mk_simple_deriv tcName   "$co"++-- Used in derived instances+mkCon2TagOcc        = mk_simple_deriv varName  "$con2tag_"+mkTag2ConOcc        = mk_simple_deriv varName  "$tag2con_"+mkMaxTagOcc         = mk_simple_deriv varName  "$maxtag_"++-- TyConRepName stuff; see Note [Grand plan for Typeable] in TcTypeable+mkTyConRepOcc occ = mk_simple_deriv varName prefix occ+  where+    prefix | isDataOcc occ = "$tc'"+           | otherwise     = "$tc"++-- Generic deriving mechanism+mkGenR   = mk_simple_deriv tcName "Rep_"+mkGen1R  = mk_simple_deriv tcName "Rep1_"++-- Overloaded record field selectors+mkRecFldSelOcc :: String -> OccName+mkRecFldSelOcc s = mk_deriv varName "$sel" [fsLit s]++mk_simple_deriv :: NameSpace -> FastString -> OccName -> OccName+mk_simple_deriv sp px occ = mk_deriv sp px [occNameFS occ]++-- Data constructor workers are made by setting the name space+-- of the data constructor OccName (which should be a DataName)+-- to VarName+mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ++mkSuperDictAuxOcc :: Int -> OccName -> OccName+mkSuperDictAuxOcc index cls_tc_occ+  = mk_deriv varName "$cp" [fsLit $ show index, occNameFS cls_tc_occ]++mkSuperDictSelOcc :: Int        -- ^ Index of superclass, e.g. 3+                  -> OccName    -- ^ Class, e.g. @Ord@+                  -> OccName    -- ^ Derived 'Occname', e.g. @$p3Ord@+mkSuperDictSelOcc index cls_tc_occ+  = mk_deriv varName "$p" [fsLit $ show index, occNameFS cls_tc_occ]++mkLocalOcc :: Unique            -- ^ Unique to combine with the 'OccName'+           -> OccName           -- ^ Local name, e.g. @sat@+           -> OccName           -- ^ Nice unique version, e.g. @$L23sat@+mkLocalOcc uniq occ+   = mk_deriv varName "$L" [fsLit $ show uniq, occNameFS occ]+        -- The Unique might print with characters+        -- that need encoding (e.g. 'z'!)++-- | Derive a name for the representation type constructor of a+-- @data@\/@newtype@ instance.+mkInstTyTcOcc :: String                 -- ^ Family name, e.g. @Map@+              -> OccSet                 -- ^ avoid these Occs+              -> OccName                -- ^ @R:Map@+mkInstTyTcOcc str = chooseUniqueOcc tcName ('R' : ':' : str)++mkDFunOcc :: String             -- ^ Typically the class and type glommed together e.g. @OrdMaybe@.+                                -- Only used in debug mode, for extra clarity+          -> Bool               -- ^ Is this a hs-boot instance DFun?+          -> OccSet             -- ^ avoid these Occs+          -> OccName            -- ^ E.g. @$f3OrdMaybe@++-- In hs-boot files we make dict funs like $fx7ClsTy, which get bound to the real+-- thing when we compile the mother module. Reason: we don't know exactly+-- what the  mother module will call it.++mkDFunOcc info_str is_boot set+  = chooseUniqueOcc VarName (prefix ++ info_str) set+  where+    prefix | is_boot   = "$fx"+           | otherwise = "$f"++mkDataTOcc, mkDataCOcc+  :: OccName            -- ^ TyCon or data con string+  -> OccSet             -- ^ avoid these Occs+  -> OccName            -- ^ E.g. @$f3OrdMaybe@+-- data T = MkT ... deriving( Data ) needs definitions for+--      $tT   :: Data.Generics.Basics.DataType+--      $cMkT :: Data.Generics.Basics.Constr+mkDataTOcc occ = chooseUniqueOcc VarName ("$t" ++ occNameString occ)+mkDataCOcc occ = chooseUniqueOcc VarName ("$c" ++ occNameString occ)++{-+Sometimes we need to pick an OccName that has not already been used,+given a set of in-use OccNames.+-}++chooseUniqueOcc :: NameSpace -> String -> OccSet -> OccName+chooseUniqueOcc ns str set = loop (mkOccName ns str) (0::Int)+  where+  loop occ n+   | occ `elemOccSet` set = loop (mkOccName ns (str ++ show n)) (n+1)+   | otherwise            = occ++{-+We used to add a '$m' to indicate a method, but that gives rise to bad+error messages from the type checker when we print the function name or pattern+of an instance-decl binding.  Why? Because the binding is zapped+to use the method name in place of the selector name.+(See TcClassDcl.tcMethodBind)++The way it is now, -ddump-xx output may look confusing, but+you can always say -dppr-debug to get the uniques.++However, we *do* have to zap the first character to be lower case,+because overloaded constructors (blarg) generate methods too.+And convert to VarName space++e.g. a call to constructor MkFoo where+        data (Ord a) => Foo a = MkFoo a++If this is necessary, we do it by prefixing '$m'.  These+guys never show up in error messages.  What a hack.+-}++mkMethodOcc :: OccName -> OccName+mkMethodOcc occ@(OccName VarName _) = occ+mkMethodOcc occ                     = mk_simple_deriv varName "$m" occ++{-+************************************************************************+*                                                                      *+\subsection{Tidying them up}+*                                                                      *+************************************************************************++Before we print chunks of code we like to rename it so that+we don't have to print lots of silly uniques in it.  But we mustn't+accidentally introduce name clashes!  So the idea is that we leave the+OccName alone unless it accidentally clashes with one that is already+in scope; if so, we tack on '1' at the end and try again, then '2', and+so on till we find a unique one.++There's a wrinkle for operators.  Consider '>>='.  We can't use '>>=1'+because that isn't a single lexeme.  So we encode it to 'lle' and *then*+tack on the '1', if necessary.++Note [TidyOccEnv]+~~~~~~~~~~~~~~~~~+type TidyOccEnv = UniqFM Int++* Domain = The OccName's FastString. These FastStrings are "taken";+           make sure that we don't re-use++* Int, n = A plausible starting point for new guesses+           There is no guarantee that "FSn" is available;+           you must look that up in the TidyOccEnv.  But+           it's a good place to start looking.++* When looking for a renaming for "foo2" we strip off the "2" and start+  with "foo".  Otherwise if we tidy twice we get silly names like foo23.++  However, if it started with digits at the end, we always make a name+  with digits at the end, rather than shortening "foo2" to just "foo",+  even if "foo" is unused.  Reasons:+     - Plain "foo" might be used later+     - We use trailing digits to subtly indicate a unification variable+       in typechecker error message; see TypeRep.tidyTyVarBndr++We have to take care though! Consider a machine-generated module (#10370)+  module Foo where+     a1 = e1+     a2 = e2+     ...+     a2000 = e2000+Then "a1", "a2" etc are all marked taken.  But now if we come across "a7" again,+we have to do a linear search to find a free one, "a2001".  That might just be+acceptable once.  But if we now come across "a8" again, we don't want to repeat+that search.++So we use the TidyOccEnv mapping for "a" (not "a7" or "a8") as our base for+starting the search; and we make sure to update the starting point for "a"+after we allocate a new one.+++Note [Tidying multiple names at once]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Consider++    > :t (id,id,id)++Every id contributes a type variable to the type signature, and all of them are+"a". If we tidy them one by one, we get++    (id,id,id) :: (a2 -> a2, a1 -> a1, a -> a)++which is a bit unfortunate, as it unfairly renames only one of them. What we+would like to see is++    (id,id,id) :: (a3 -> a3, a2 -> a2, a1 -> a1)++To achieve this, the function avoidClashesOccEnv can be used to prepare the+TidyEnv, by “blocking” every name that occurs twice in the map. This way, none+of the "a"s will get the privilege of keeping this name, and all of them will+get a suitable number by tidyOccName.++This prepared TidyEnv can then be used with tidyOccName. See tidyTyCoVarBndrs+for an example where this is used.++This is #12382.++-}++type TidyOccEnv = UniqFM Int    -- The in-scope OccNames+  -- See Note [TidyOccEnv]++emptyTidyOccEnv :: TidyOccEnv+emptyTidyOccEnv = emptyUFM++initTidyOccEnv :: [OccName] -> TidyOccEnv       -- Initialise with names to avoid!+initTidyOccEnv = foldl' add emptyUFM+  where+    add env (OccName _ fs) = addToUFM env fs 1++-- see Note [Tidying multiple names at once]+avoidClashesOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv+avoidClashesOccEnv env occs = go env emptyUFM occs+  where+    go env _        [] = env+    go env seenOnce ((OccName _ fs):occs)+      | fs `elemUFM` env      = go env seenOnce                  occs+      | fs `elemUFM` seenOnce = go (addToUFM env fs 1) seenOnce  occs+      | otherwise             = go env (addToUFM seenOnce fs ()) occs++tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)+tidyOccName env occ@(OccName occ_sp fs)+  | not (fs `elemUFM` env)+  = -- Desired OccName is free, so use it,+    -- and record in 'env' that it's no longer available+    (addToUFM env fs 1, occ)++  | otherwise+  = case lookupUFM env base1 of+       Nothing -> (addToUFM env base1 2, OccName occ_sp base1)+       Just n  -> find 1 n+  where+    base :: String  -- Drop trailing digits (see Note [TidyOccEnv])+    base  = dropWhileEndLE isDigit (unpackFS fs)+    base1 = mkFastString (base ++ "1")++    find !k !n+      = case lookupUFM env new_fs of+          Just {} -> find (k+1 :: Int) (n+k)+                       -- By using n+k, the n argument to find goes+                       --    1, add 1, add 2, add 3, etc which+                       -- moves at quadratic speed through a dense patch++          Nothing -> (new_env, OccName occ_sp new_fs)+       where+         new_fs = mkFastString (base ++ show n)+         new_env = addToUFM (addToUFM env new_fs 1) base1 (n+1)+                     -- Update:  base1,  so that next time we'll start where we left off+                     --          new_fs, so that we know it is taken+                     -- If they are the same (n==1), the former wins+                     -- See Note [TidyOccEnv]+++{-+************************************************************************+*                                                                      *+                Binary instance+    Here rather than BinIface because OccName is abstract+*                                                                      *+************************************************************************+-}++instance Binary NameSpace where+    put_ bh VarName = do+            putByte bh 0+    put_ bh DataName = do+            putByte bh 1+    put_ bh TvName = do+            putByte bh 2+    put_ bh TcClsName = do+            putByte bh 3+    get bh = do+            h <- getByte bh+            case h of+              0 -> do return VarName+              1 -> do return DataName+              2 -> do return TvName+              _ -> do return TcClsName++instance Binary OccName where+    put_ bh (OccName aa ab) = do+            put_ bh aa+            put_ bh ab+    get bh = do+          aa <- get bh+          ab <- get bh+          return (OccName aa ab)
+ compiler/basicTypes/OccName.hs-boot view
@@ -0,0 +1,5 @@+module OccName where++import GhcPrelude ()++data OccName
+ compiler/basicTypes/PatSyn.hs view
@@ -0,0 +1,469 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1998++\section[PatSyn]{@PatSyn@: Pattern synonyms}+-}++{-# LANGUAGE CPP #-}++module PatSyn (+        -- * Main data types+        PatSyn, mkPatSyn,++        -- ** Type deconstruction+        patSynName, patSynArity, patSynIsInfix,+        patSynArgs,+        patSynMatcher, patSynBuilder,+        patSynUnivTyVarBinders, patSynExTyVars, patSynExTyVarBinders, patSynSig,+        patSynInstArgTys, patSynInstResTy, patSynFieldLabels,+        patSynFieldType,++        tidyPatSynIds, pprPatSynType+    ) where++#include "HsVersions.h"++import GhcPrelude++import Type+import Name+import Outputable+import Unique+import Util+import BasicTypes+import Var+import FieldLabel++import qualified Data.Data as Data+import Data.Function+import Data.List++{-+************************************************************************+*                                                                      *+\subsection{Pattern synonyms}+*                                                                      *+************************************************************************+-}++-- | Pattern Synonym+--+-- See Note [Pattern synonym representation]+-- See Note [Pattern synonym signature contexts]+data PatSyn+  = MkPatSyn {+        psName        :: Name,+        psUnique      :: Unique,       -- Cached from Name++        psArgs        :: [Type],+        psArity       :: Arity,        -- == length psArgs+        psInfix       :: Bool,         -- True <=> declared infix+        psFieldLabels :: [FieldLabel], -- List of fields for a+                                       -- record pattern synonym+                                       -- INVARIANT: either empty if no+                                       -- record pat syn or same length as+                                       -- psArgs++        -- Universally-quantified type variables+        psUnivTyVars  :: [TyVarBinder],++        -- Required dictionaries (may mention psUnivTyVars)+        psReqTheta    :: ThetaType,++        -- Existentially-quantified type vars+        psExTyVars    :: [TyVarBinder],++        -- Provided dictionaries (may mention psUnivTyVars or psExTyVars)+        psProvTheta   :: ThetaType,++        -- Result type+        psResultTy   :: Type,  -- Mentions only psUnivTyVars+                               -- See Note [Pattern synonym result type]++        -- See Note [Matchers and builders for pattern synonyms]+        psMatcher     :: (Id, Bool),+             -- Matcher function.+             -- If Bool is True then prov_theta and arg_tys are empty+             -- and type is+             --   forall (p :: RuntimeRep) (r :: TYPE p) univ_tvs.+             --                          req_theta+             --                       => res_ty+             --                       -> (forall ex_tvs. Void# -> r)+             --                       -> (Void# -> r)+             --                       -> r+             --+             -- Otherwise type is+             --   forall (p :: RuntimeRep) (r :: TYPE r) univ_tvs.+             --                          req_theta+             --                       => res_ty+             --                       -> (forall ex_tvs. prov_theta => arg_tys -> r)+             --                       -> (Void# -> r)+             --                       -> r++        psBuilder     :: Maybe (Id, Bool)+             -- Nothing  => uni-directional pattern synonym+             -- Just (builder, is_unlifted) => bi-directional+             -- Builder function, of type+             --  forall univ_tvs, ex_tvs. (req_theta, prov_theta)+             --                       =>  arg_tys -> res_ty+             -- See Note [Builder for pattern synonyms with unboxed type]+  }++{- Note [Pattern synonym signature contexts]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In a pattern synonym signature we write+   pattern P :: req => prov => t1 -> ... tn -> res_ty++Note that the "required" context comes first, then the "provided"+context.  Moreover, the "required" context must not mention+existentially-bound type variables; that is, ones not mentioned in+res_ty.  See lots of discussion in #10928.++If there is no "provided" context, you can omit it; but you+can't omit the "required" part (unless you omit both).++Example 1:+      pattern P1 :: (Num a, Eq a) => b -> Maybe (a,b)+      pattern P1 x = Just (3,x)++  We require (Num a, Eq a) to match the 3; there is no provided+  context.++Example 2:+      data T2 where+        MkT2 :: (Num a, Eq a) => a -> a -> T2++      pattern P2 :: () => (Num a, Eq a) => a -> T2+      pattern P2 x = MkT2 3 x++  When we match against P2 we get a Num dictionary provided.+  We can use that to check the match against 3.++Example 3:+      pattern P3 :: Eq a => a -> b -> T3 b++   This signature is illegal because the (Eq a) is a required+   constraint, but it mentions the existentially-bound variable 'a'.+   You can see it's existential because it doesn't appear in the+   result type (T3 b).++Note [Pattern synonym result type]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+   data T a b = MkT b a++   pattern P :: a -> T [a] Bool+   pattern P x = MkT True [x]++P's psResultTy is (T a Bool), and it really only matches values of+type (T [a] Bool).  For example, this is ill-typed++   f :: T p q -> String+   f (P x) = "urk"++This is different to the situation with GADTs:++   data S a where+     MkS :: Int -> S Bool++Now MkS (and pattern synonyms coming from MkS) can match a+value of type (S a), not just (S Bool); we get type refinement.++That in turn means that if you have a pattern++   P x :: T [ty] Bool++it's not entirely straightforward to work out the instantiation of+P's universal tyvars. You have to /match/+  the type of the pattern, (T [ty] Bool)+against+  the psResultTy for the pattern synonym, T [a] Bool+to get the instantiation a := ty.++This is very unlike DataCons, where univ tyvars match 1-1 the+arguments of the TyCon.+++Note [Pattern synonym representation]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider the following pattern synonym declaration++        pattern P x = MkT [x] (Just 42)++where+        data T a where+              MkT :: (Show a, Ord b) => [b] -> a -> T a++so pattern P has type++        b -> T (Maybe t)++with the following typeclass constraints:++        requires: (Eq t, Num t)+        provides: (Show (Maybe t), Ord b)++In this case, the fields of MkPatSyn will be set as follows:++  psArgs       = [b]+  psArity      = 1+  psInfix      = False++  psUnivTyVars = [t]+  psExTyVars   = [b]+  psProvTheta  = (Show (Maybe t), Ord b)+  psReqTheta   = (Eq t, Num t)+  psResultTy  = T (Maybe t)++Note [Matchers and builders for pattern synonyms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For each pattern synonym P, we generate++  * a "matcher" function, used to desugar uses of P in patterns,+    which implements pattern matching++  * A "builder" function (for bidirectional pattern synonyms only),+    used to desugar uses of P in expressions, which constructs P-values.++For the above example, the matcher function has type:++        $mP :: forall (r :: ?) t. (Eq t, Num t)+            => T (Maybe t)+            -> (forall b. (Show (Maybe t), Ord b) => b -> r)+            -> (Void# -> r)+            -> r++with the following implementation:++        $mP @r @t $dEq $dNum scrut cont fail+          = case scrut of+              MkT @b $dShow $dOrd [x] (Just 42) -> cont @b $dShow $dOrd x+              _                                 -> fail Void#++Notice that the return type 'r' has an open kind, so that it can+be instantiated by an unboxed type; for example where we see+     f (P x) = 3#++The extra Void# argument for the failure continuation is needed so that+it is lazy even when the result type is unboxed.++For the same reason, if the pattern has no arguments, an extra Void#+argument is added to the success continuation as well.++For *bidirectional* pattern synonyms, we also generate a "builder"+function which implements the pattern synonym in an expression+context. For our running example, it will be:++        $bP :: forall t b. (Eq t, Num t, Show (Maybe t), Ord b)+            => b -> T (Maybe t)+        $bP x = MkT [x] (Just 42)++NB: the existential/universal and required/provided split does not+apply to the builder since you are only putting stuff in, not getting+stuff out.++Injectivity of bidirectional pattern synonyms is checked in+tcPatToExpr which walks the pattern and returns its corresponding+expression when available.++Note [Builder for pattern synonyms with unboxed type]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For bidirectional pattern synonyms that have no arguments and have an+unboxed type, we add an extra Void# argument to the builder, else it+would be a top-level declaration with an unboxed type.++        pattern P = 0#++        $bP :: Void# -> Int#+        $bP _ = 0#++This means that when typechecking an occurrence of P in an expression,+we must remember that the builder has this void argument. This is+done by TcPatSyn.patSynBuilderOcc.++Note [Pattern synonyms and the data type Type]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The type of a pattern synonym is of the form (See Note+[Pattern synonym signatures] in TcSigs):++    forall univ_tvs. req => forall ex_tvs. prov => ...++We cannot in general represent this by a value of type Type:++ - if ex_tvs is empty, then req and prov cannot be distinguished from+   each other+ - if req is empty, then univ_tvs and ex_tvs cannot be distinguished+   from each other, and moreover, prov is seen as the "required" context+   (as it is the only context)+++************************************************************************+*                                                                      *+\subsection{Instances}+*                                                                      *+************************************************************************+-}++instance Eq PatSyn where+    (==) = (==) `on` getUnique+    (/=) = (/=) `on` getUnique++instance Uniquable PatSyn where+    getUnique = psUnique++instance NamedThing PatSyn where+    getName = patSynName++instance Outputable PatSyn where+    ppr = ppr . getName++instance OutputableBndr PatSyn where+    pprInfixOcc = pprInfixName . getName+    pprPrefixOcc = pprPrefixName . getName++instance Data.Data PatSyn where+    -- don't traverse?+    toConstr _   = abstractConstr "PatSyn"+    gunfold _ _  = error "gunfold"+    dataTypeOf _ = mkNoRepType "PatSyn"++{-+************************************************************************+*                                                                      *+\subsection{Construction}+*                                                                      *+************************************************************************+-}++-- | Build a new pattern synonym+mkPatSyn :: Name+         -> Bool                 -- ^ Is the pattern synonym declared infix?+         -> ([TyVarBinder], ThetaType) -- ^ Universially-quantified type+                                       -- variables and required dicts+         -> ([TyVarBinder], ThetaType) -- ^ Existentially-quantified type+                                       -- variables and provided dicts+         -> [Type]               -- ^ Original arguments+         -> Type                 -- ^ Original result type+         -> (Id, Bool)           -- ^ Name of matcher+         -> Maybe (Id, Bool)     -- ^ Name of builder+         -> [FieldLabel]         -- ^ Names of fields for+                                 --   a record pattern synonym+         -> PatSyn+ -- NB: The univ and ex vars are both in TyBinder form and TyVar form for+ -- convenience. All the TyBinders should be Named!+mkPatSyn name declared_infix+         (univ_tvs, req_theta)+         (ex_tvs, prov_theta)+         orig_args+         orig_res_ty+         matcher builder field_labels+    = MkPatSyn {psName = name, psUnique = getUnique name,+                psUnivTyVars = univ_tvs,+                psExTyVars = ex_tvs,+                psProvTheta = prov_theta, psReqTheta = req_theta,+                psInfix = declared_infix,+                psArgs = orig_args,+                psArity = length orig_args,+                psResultTy = orig_res_ty,+                psMatcher = matcher,+                psBuilder = builder,+                psFieldLabels = field_labels+                }++-- | The 'Name' of the 'PatSyn', giving it a unique, rooted identification+patSynName :: PatSyn -> Name+patSynName = psName++-- | Should the 'PatSyn' be presented infix?+patSynIsInfix :: PatSyn -> Bool+patSynIsInfix = psInfix++-- | Arity of the pattern synonym+patSynArity :: PatSyn -> Arity+patSynArity = psArity++patSynArgs :: PatSyn -> [Type]+patSynArgs = psArgs++patSynFieldLabels :: PatSyn -> [FieldLabel]+patSynFieldLabels = psFieldLabels++-- | Extract the type for any given labelled field of the 'DataCon'+patSynFieldType :: PatSyn -> FieldLabelString -> Type+patSynFieldType ps label+  = case find ((== label) . flLabel . fst) (psFieldLabels ps `zip` psArgs ps) of+      Just (_, ty) -> ty+      Nothing -> pprPanic "dataConFieldType" (ppr ps <+> ppr label)++patSynUnivTyVarBinders :: PatSyn -> [TyVarBinder]+patSynUnivTyVarBinders = psUnivTyVars++patSynExTyVars :: PatSyn -> [TyVar]+patSynExTyVars ps = binderVars (psExTyVars ps)++patSynExTyVarBinders :: PatSyn -> [TyVarBinder]+patSynExTyVarBinders = psExTyVars++patSynSig :: PatSyn -> ([TyVar], ThetaType, [TyVar], ThetaType, [Type], Type)+patSynSig (MkPatSyn { psUnivTyVars = univ_tvs, psExTyVars = ex_tvs+                    , psProvTheta = prov, psReqTheta = req+                    , psArgs = arg_tys, psResultTy = res_ty })+  = (binderVars univ_tvs, req, binderVars ex_tvs, prov, arg_tys, res_ty)++patSynMatcher :: PatSyn -> (Id,Bool)+patSynMatcher = psMatcher++patSynBuilder :: PatSyn -> Maybe (Id, Bool)+patSynBuilder = psBuilder++tidyPatSynIds :: (Id -> Id) -> PatSyn -> PatSyn+tidyPatSynIds tidy_fn ps@(MkPatSyn { psMatcher = matcher, psBuilder = builder })+  = ps { psMatcher = tidy_pr matcher, psBuilder = fmap tidy_pr builder }+  where+    tidy_pr (id, dummy) = (tidy_fn id, dummy)++patSynInstArgTys :: PatSyn -> [Type] -> [Type]+-- Return the types of the argument patterns+-- e.g.  data D a = forall b. MkD a b (b->a)+--       pattern P f x y = MkD (x,True) y f+--          D :: forall a. forall b. a -> b -> (b->a) -> D a+--          P :: forall c. forall b. (b->(c,Bool)) -> c -> b -> P c+--   patSynInstArgTys P [Int,bb] = [bb->(Int,Bool), Int, bb]+-- NB: the inst_tys should be both universal and existential+patSynInstArgTys (MkPatSyn { psName = name, psUnivTyVars = univ_tvs+                           , psExTyVars = ex_tvs, psArgs = arg_tys })+                 inst_tys+  = ASSERT2( tyvars `equalLength` inst_tys+          , text "patSynInstArgTys" <+> ppr name $$ ppr tyvars $$ ppr inst_tys )+    map (substTyWith tyvars inst_tys) arg_tys+  where+    tyvars = binderVars (univ_tvs ++ ex_tvs)++patSynInstResTy :: PatSyn -> [Type] -> Type+-- Return the type of whole pattern+-- E.g.  pattern P x y = Just (x,x,y)+--         P :: a -> b -> Just (a,a,b)+--         (patSynInstResTy P [Int,Bool] = Maybe (Int,Int,Bool)+-- NB: unlike patSynInstArgTys, the inst_tys should be just the *universal* tyvars+patSynInstResTy (MkPatSyn { psName = name, psUnivTyVars = univ_tvs+                          , psResultTy = res_ty })+                inst_tys+  = ASSERT2( univ_tvs `equalLength` inst_tys+           , text "patSynInstResTy" <+> ppr name $$ ppr univ_tvs $$ ppr inst_tys )+    substTyWith (binderVars univ_tvs) inst_tys res_ty++-- | Print the type of a pattern synonym. The foralls are printed explicitly+pprPatSynType :: PatSyn -> SDoc+pprPatSynType (MkPatSyn { psUnivTyVars = univ_tvs,  psReqTheta  = req_theta+                        , psExTyVars   = ex_tvs,    psProvTheta = prov_theta+                        , psArgs       = orig_args, psResultTy = orig_res_ty })+  = sep [ pprForAll univ_tvs+        , pprThetaArrowTy req_theta+        , ppWhen insert_empty_ctxt $ parens empty <+> darrow+        , pprType sigma_ty ]+  where+    sigma_ty = mkForAllTys ex_tvs  $+               mkInvisFunTys prov_theta $+               mkVisFunTys orig_args orig_res_ty+    insert_empty_ctxt = null req_theta && not (null prov_theta && null ex_tvs)
+ compiler/basicTypes/PatSyn.hs-boot view
@@ -0,0 +1,13 @@+module PatSyn where++import BasicTypes (Arity)+import {-# SOURCE #-} TyCoRep (Type)+import Var (TyVar)+import Name (Name)++data PatSyn++patSynArity :: PatSyn -> Arity+patSynInstArgTys :: PatSyn -> [Type] -> [Type]+patSynExTyVars :: PatSyn -> [TyVar]+patSynName :: PatSyn -> Name
+ compiler/basicTypes/RdrName.hs view
@@ -0,0 +1,1406 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}++{-# LANGUAGE CPP, DeriveDataTypeable #-}++-- |+-- #name_types#+-- GHC uses several kinds of name internally:+--+-- * 'OccName.OccName': see "OccName#name_types"+--+-- * 'RdrName.RdrName' is the type of names that come directly from the parser. They+--   have not yet had their scoping and binding resolved by the renamer and can be+--   thought of to a first approximation as an 'OccName.OccName' with an optional module+--   qualifier+--+-- * 'Name.Name': see "Name#name_types"+--+-- * 'Id.Id': see "Id#name_types"+--+-- * 'Var.Var': see "Var#name_types"++module RdrName (+        -- * The main type+        RdrName(..),    -- Constructors exported only to BinIface++        -- ** Construction+        mkRdrUnqual, mkRdrQual,+        mkUnqual, mkVarUnqual, mkQual, mkOrig,+        nameRdrName, getRdrName,++        -- ** Destruction+        rdrNameOcc, rdrNameSpace, demoteRdrName,+        isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual,+        isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,++        -- * Local mapping of 'RdrName' to 'Name.Name'+        LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,+        lookupLocalRdrEnv, lookupLocalRdrOcc,+        elemLocalRdrEnv, inLocalRdrEnvScope,+        localRdrEnvElts, delLocalRdrEnvList,++        -- * Global mapping of 'RdrName' to 'GlobalRdrElt's+        GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,+        lookupGlobalRdrEnv, extendGlobalRdrEnv, greOccName, shadowNames,+        pprGlobalRdrEnv, globalRdrEnvElts,+        lookupGRE_RdrName, lookupGRE_Name, lookupGRE_FieldLabel,+        lookupGRE_Name_OccName,+        getGRE_NameQualifier_maybes,+        transformGREs, pickGREs, pickGREsModExp,++        -- * GlobalRdrElts+        gresFromAvails, gresFromAvail, localGREsFromAvail, availFromGRE,+        greRdrNames, greSrcSpan, greQualModName,+        gresToAvailInfo,++        -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'+        GlobalRdrElt(..), isLocalGRE, isRecFldGRE, greLabel,+        unQualOK, qualSpecOK, unQualSpecOK,+        pprNameProvenance,+        Parent(..), greParent_maybe,+        ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),+        importSpecLoc, importSpecModule, isExplicitItem, bestImport,++        -- * Utils for StarIsType+        starInfo+  ) where++#include "HsVersions.h"++import GhcPrelude++import Module+import Name+import Avail+import NameSet+import Maybes+import SrcLoc+import FastString+import FieldLabel+import Outputable+import Unique+import UniqFM+import UniqSet+import Util+import NameEnv++import Data.Data+import Data.List( sortBy )++{-+************************************************************************+*                                                                      *+\subsection{The main data type}+*                                                                      *+************************************************************************+-}++-- | Reader Name+--+-- Do not use the data constructors of RdrName directly: prefer the family+-- of functions that creates them, such as 'mkRdrUnqual'+--+-- - Note: A Located RdrName will only have API Annotations if it is a+--         compound one,+--   e.g.+--+-- > `bar`+-- > ( ~ )+--+-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',+--           'ApiAnnotation.AnnOpen'  @'('@ or @'['@ or @'[:'@,+--           'ApiAnnotation.AnnClose' @')'@ or @']'@ or @':]'@,,+--           'ApiAnnotation.AnnBackquote' @'`'@,+--           'ApiAnnotation.AnnVal'+--           'ApiAnnotation.AnnTilde',++-- For details on above see note [Api annotations] in ApiAnnotation+data RdrName+  = Unqual OccName+        -- ^ Unqualified  name+        --+        -- Used for ordinary, unqualified occurrences, e.g. @x@, @y@ or @Foo@.+        -- Create such a 'RdrName' with 'mkRdrUnqual'++  | Qual ModuleName OccName+        -- ^ Qualified name+        --+        -- A qualified name written by the user in+        -- /source/ code.  The module isn't necessarily+        -- the module where the thing is defined;+        -- just the one from which it is imported.+        -- Examples are @Bar.x@, @Bar.y@ or @Bar.Foo@.+        -- Create such a 'RdrName' with 'mkRdrQual'++  | Orig Module OccName+        -- ^ Original name+        --+        -- An original name; the module is the /defining/ module.+        -- This is used when GHC generates code that will be fed+        -- into the renamer (e.g. from deriving clauses), but where+        -- we want to say \"Use Prelude.map dammit\". One of these+        -- can be created with 'mkOrig'++  | Exact Name+        -- ^ Exact name+        --+        -- We know exactly the 'Name'. This is used:+        --+        --  (1) When the parser parses built-in syntax like @[]@+        --      and @(,)@, but wants a 'RdrName' from it+        --+        --  (2) By Template Haskell, when TH has generated a unique name+        --+        -- Such a 'RdrName' can be created by using 'getRdrName' on a 'Name'+  deriving Data++{-+************************************************************************+*                                                                      *+\subsection{Simple functions}+*                                                                      *+************************************************************************+-}++instance HasOccName RdrName where+  occName = rdrNameOcc++rdrNameOcc :: RdrName -> OccName+rdrNameOcc (Qual _ occ) = occ+rdrNameOcc (Unqual occ) = occ+rdrNameOcc (Orig _ occ) = occ+rdrNameOcc (Exact name) = nameOccName name++rdrNameSpace :: RdrName -> NameSpace+rdrNameSpace = occNameSpace . rdrNameOcc++-- demoteRdrName lowers the NameSpace of RdrName.+-- see Note [Demotion] in OccName+demoteRdrName :: RdrName -> Maybe RdrName+demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ)+demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ)+demoteRdrName (Orig _ _) = panic "demoteRdrName"+demoteRdrName (Exact _) = panic "demoteRdrName"++        -- These two are the basic constructors+mkRdrUnqual :: OccName -> RdrName+mkRdrUnqual occ = Unqual occ++mkRdrQual :: ModuleName -> OccName -> RdrName+mkRdrQual mod occ = Qual mod occ++mkOrig :: Module -> OccName -> RdrName+mkOrig mod occ = Orig mod occ++---------------+        -- These two are used when parsing source files+        -- They do encode the module and occurrence names+mkUnqual :: NameSpace -> FastString -> RdrName+mkUnqual sp n = Unqual (mkOccNameFS sp n)++mkVarUnqual :: FastString -> RdrName+mkVarUnqual n = Unqual (mkVarOccFS n)++-- | Make a qualified 'RdrName' in the given namespace and where the 'ModuleName' and+-- the 'OccName' are taken from the first and second elements of the tuple respectively+mkQual :: NameSpace -> (FastString, FastString) -> RdrName+mkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccNameFS sp n)++getRdrName :: NamedThing thing => thing -> RdrName+getRdrName name = nameRdrName (getName name)++nameRdrName :: Name -> RdrName+nameRdrName name = Exact name+-- Keep the Name even for Internal names, so that the+-- unique is still there for debug printing, particularly+-- of Types (which are converted to IfaceTypes before printing)++nukeExact :: Name -> RdrName+nukeExact n+  | isExternalName n = Orig (nameModule n) (nameOccName n)+  | otherwise        = Unqual (nameOccName n)++isRdrDataCon :: RdrName -> Bool+isRdrTyVar   :: RdrName -> Bool+isRdrTc      :: RdrName -> Bool++isRdrDataCon rn = isDataOcc (rdrNameOcc rn)+isRdrTyVar   rn = isTvOcc   (rdrNameOcc rn)+isRdrTc      rn = isTcOcc   (rdrNameOcc rn)++isSrcRdrName :: RdrName -> Bool+isSrcRdrName (Unqual _) = True+isSrcRdrName (Qual _ _) = True+isSrcRdrName _          = False++isUnqual :: RdrName -> Bool+isUnqual (Unqual _) = True+isUnqual _          = False++isQual :: RdrName -> Bool+isQual (Qual _ _) = True+isQual _          = False++isQual_maybe :: RdrName -> Maybe (ModuleName, OccName)+isQual_maybe (Qual m n) = Just (m,n)+isQual_maybe _          = Nothing++isOrig :: RdrName -> Bool+isOrig (Orig _ _) = True+isOrig _          = False++isOrig_maybe :: RdrName -> Maybe (Module, OccName)+isOrig_maybe (Orig m n) = Just (m,n)+isOrig_maybe _          = Nothing++isExact :: RdrName -> Bool+isExact (Exact _) = True+isExact _         = False++isExact_maybe :: RdrName -> Maybe Name+isExact_maybe (Exact n) = Just n+isExact_maybe _         = Nothing++{-+************************************************************************+*                                                                      *+\subsection{Instances}+*                                                                      *+************************************************************************+-}++instance Outputable RdrName where+    ppr (Exact name)   = ppr name+    ppr (Unqual occ)   = ppr occ+    ppr (Qual mod occ) = ppr mod <> dot <> ppr occ+    ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ)++instance OutputableBndr RdrName where+    pprBndr _ n+        | isTvOcc (rdrNameOcc n) = char '@' <+> ppr n+        | otherwise              = ppr n++    pprInfixOcc  rdr = pprInfixVar  (isSymOcc (rdrNameOcc rdr)) (ppr rdr)+    pprPrefixOcc rdr+      | Just name <- isExact_maybe rdr = pprPrefixName name+             -- pprPrefixName has some special cases, so+             -- we delegate to them rather than reproduce them+      | otherwise = pprPrefixVar (isSymOcc (rdrNameOcc rdr)) (ppr rdr)++instance Eq RdrName where+    (Exact n1)    == (Exact n2)    = n1==n2+        -- Convert exact to orig+    (Exact n1)    == r2@(Orig _ _) = nukeExact n1 == r2+    r1@(Orig _ _) == (Exact n2)    = r1 == nukeExact n2++    (Orig m1 o1)  == (Orig m2 o2)  = m1==m2 && o1==o2+    (Qual m1 o1)  == (Qual m2 o2)  = m1==m2 && o1==o2+    (Unqual o1)   == (Unqual o2)   = o1==o2+    _             == _             = False++instance Ord RdrName where+    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }+    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }+    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }+    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }++        -- Exact < Unqual < Qual < Orig+        -- [Note: Apr 2004] We used to use nukeExact to convert Exact to Orig+        --      before comparing so that Prelude.map == the exact Prelude.map, but+        --      that meant that we reported duplicates when renaming bindings+        --      generated by Template Haskell; e.g+        --      do { n1 <- newName "foo"; n2 <- newName "foo";+        --           <decl involving n1,n2> }+        --      I think we can do without this conversion+    compare (Exact n1) (Exact n2) = n1 `compare` n2+    compare (Exact _)  _          = LT++    compare (Unqual _)   (Exact _)    = GT+    compare (Unqual o1)  (Unqual  o2) = o1 `compare` o2+    compare (Unqual _)   _            = LT++    compare (Qual _ _)   (Exact _)    = GT+    compare (Qual _ _)   (Unqual _)   = GT+    compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)+    compare (Qual _ _)   (Orig _ _)   = LT++    compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)+    compare (Orig _ _)   _            = GT++{-+************************************************************************+*                                                                      *+                        LocalRdrEnv+*                                                                      *+************************************************************************+-}++-- | Local Reader Environment+--+-- This environment is used to store local bindings+-- (@let@, @where@, lambda, @case@).+-- It is keyed by OccName, because we never use it for qualified names+-- We keep the current mapping, *and* the set of all Names in scope+-- Reason: see Note [Splicing Exact names] in RnEnv+data LocalRdrEnv = LRE { lre_env      :: OccEnv Name+                       , lre_in_scope :: NameSet }++instance Outputable LocalRdrEnv where+  ppr (LRE {lre_env = env, lre_in_scope = ns})+    = hang (text "LocalRdrEnv {")+         2 (vcat [ text "env =" <+> pprOccEnv ppr_elt env+                 , text "in_scope ="+                    <+> pprUFM (getUniqSet ns) (braces . pprWithCommas ppr)+                 ] <+> char '}')+    where+      ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name+                     -- So we can see if the keys line up correctly++emptyLocalRdrEnv :: LocalRdrEnv+emptyLocalRdrEnv = LRE { lre_env = emptyOccEnv+                       , lre_in_scope = emptyNameSet }++extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv+-- The Name should be a non-top-level thing+extendLocalRdrEnv lre@(LRE { lre_env = env, lre_in_scope = ns }) name+  = WARN( isExternalName name, ppr name )+    lre { lre_env      = extendOccEnv env (nameOccName name) name+        , lre_in_scope = extendNameSet ns name }++extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv+extendLocalRdrEnvList lre@(LRE { lre_env = env, lre_in_scope = ns }) names+  = WARN( any isExternalName names, ppr names )+    lre { lre_env = extendOccEnvList env [(nameOccName n, n) | n <- names]+        , lre_in_scope = extendNameSetList ns names }++lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name+lookupLocalRdrEnv (LRE { lre_env = env, lre_in_scope = ns }) rdr+  | Unqual occ <- rdr+  = lookupOccEnv env occ++  -- See Note [Local bindings with Exact Names]+  | Exact name <- rdr+  , name `elemNameSet` ns+  = Just name++  | otherwise+  = Nothing++lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name+lookupLocalRdrOcc (LRE { lre_env = env }) occ = lookupOccEnv env occ++elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool+elemLocalRdrEnv rdr_name (LRE { lre_env = env, lre_in_scope = ns })+  = case rdr_name of+      Unqual occ -> occ  `elemOccEnv` env+      Exact name -> name `elemNameSet` ns  -- See Note [Local bindings with Exact Names]+      Qual {} -> False+      Orig {} -> False++localRdrEnvElts :: LocalRdrEnv -> [Name]+localRdrEnvElts (LRE { lre_env = env }) = occEnvElts env++inLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool+-- This is the point of the NameSet+inLocalRdrEnvScope name (LRE { lre_in_scope = ns }) = name `elemNameSet` ns++delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv+delLocalRdrEnvList lre@(LRE { lre_env = env }) occs+  = lre { lre_env = delListFromOccEnv env occs }++{-+Note [Local bindings with Exact Names]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+With Template Haskell we can make local bindings that have Exact Names.+Computing shadowing etc may use elemLocalRdrEnv (at least it certainly+does so in RnTpes.bindHsQTyVars), so for an Exact Name we must consult+the in-scope-name-set.+++************************************************************************+*                                                                      *+                        GlobalRdrEnv+*                                                                      *+************************************************************************+-}++-- | Global Reader Environment+type GlobalRdrEnv = OccEnv [GlobalRdrElt]+-- ^ Keyed by 'OccName'; when looking up a qualified name+-- we look up the 'OccName' part, and then check the 'Provenance'+-- to see if the appropriate qualification is valid.  This+-- saves routinely doubling the size of the env by adding both+-- qualified and unqualified names to the domain.+--+-- The list in the codomain is required because there may be name clashes+-- These only get reported on lookup, not on construction+--+-- INVARIANT 1: All the members of the list have distinct+--              'gre_name' fields; that is, no duplicate Names+--+-- INVARIANT 2: Imported provenance => Name is an ExternalName+--              However LocalDefs can have an InternalName.  This+--              happens only when type-checking a [d| ... |] Template+--              Haskell quotation; see this note in RnNames+--              Note [Top-level Names in Template Haskell decl quotes]+--+-- INVARIANT 3: If the GlobalRdrEnv maps [occ -> gre], then+--                 greOccName gre = occ+--+--              NB: greOccName gre is usually the same as+--                  nameOccName (gre_name gre), but not always in the+--                  case of record seectors; see greOccName++-- | Global Reader Element+--+-- An element of the 'GlobalRdrEnv'+data GlobalRdrElt+  = GRE { gre_name :: Name+        , gre_par  :: Parent+        , gre_lcl :: Bool          -- ^ True <=> the thing was defined locally+        , gre_imp :: [ImportSpec]  -- ^ In scope through these imports+    } deriving (Data, Eq)+         -- INVARIANT: either gre_lcl = True or gre_imp is non-empty+         -- See Note [GlobalRdrElt provenance]++-- | The children of a Name are the things that are abbreviated by the ".."+--   notation in export lists.  See Note [Parents]+data Parent = NoParent+            | ParentIs  { par_is :: Name }+            | FldParent { par_is :: Name, par_lbl :: Maybe FieldLabelString }+              -- ^ See Note [Parents for record fields]+            deriving (Eq, Data)++instance Outputable Parent where+   ppr NoParent        = empty+   ppr (ParentIs n)    = text "parent:" <> ppr n+   ppr (FldParent n f) = text "fldparent:"+                             <> ppr n <> colon <> ppr f++plusParent :: Parent -> Parent -> Parent+-- See Note [Combining parents]+plusParent p1@(ParentIs _)    p2 = hasParent p1 p2+plusParent p1@(FldParent _ _) p2 = hasParent p1 p2+plusParent p1 p2@(ParentIs _)    = hasParent p2 p1+plusParent p1 p2@(FldParent _ _) = hasParent p2 p1+plusParent _ _                   = NoParent++hasParent :: Parent -> Parent -> Parent+#if defined(DEBUG)+hasParent p NoParent = p+hasParent p p'+  | p /= p' = pprPanic "hasParent" (ppr p <+> ppr p')  -- Parents should agree+#endif+hasParent p _  = p+++{- Note [GlobalRdrElt provenance]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The gre_lcl and gre_imp fields of a GlobalRdrElt describe its "provenance",+i.e. how the Name came to be in scope.  It can be in scope two ways:+  - gre_lcl = True: it is bound in this module+  - gre_imp: a list of all the imports that brought it into scope++It's an INVARIANT that you have one or the other; that is, either+gre_lcl is True, or gre_imp is non-empty.++It is just possible to have *both* if there is a module loop: a Name+is defined locally in A, and also brought into scope by importing a+module that SOURCE-imported A.  Exapmle (#7672):++ A.hs-boot   module A where+               data T++ B.hs        module B(Decl.T) where+               import {-# SOURCE #-} qualified A as Decl++ A.hs        module A where+               import qualified B+               data T = Z | S B.T++In A.hs, 'T' is locally bound, *and* imported as B.T.++Note [Parents]+~~~~~~~~~~~~~~~~~+  Parent           Children+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+  data T           Data constructors+                   Record-field ids++  data family T    Data constructors and record-field ids+                   of all visible data instances of T++  class C          Class operations+                   Associated type constructors++~~~~~~~~~~~~~~~~~~~~~~~~~+ Constructor      Meaning+ ~~~~~~~~~~~~~~~~~~~~~~~~+  NoParent        Can not be bundled with a type constructor.+  ParentIs n      Can be bundled with the type constructor corresponding to+                  n.+  FldParent       See Note [Parents for record fields]+++++Note [Parents for record fields]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For record fields, in addition to the Name of the type constructor+(stored in par_is), we use FldParent to store the field label.  This+extra information is used for identifying overloaded record fields+during renaming.++In a definition arising from a normal module (without+-XDuplicateRecordFields), par_lbl will be Nothing, meaning that the+field's label is the same as the OccName of the selector's Name.  The+GlobalRdrEnv will contain an entry like this:++    "x" |->  GRE x (FldParent T Nothing) LocalDef++When -XDuplicateRecordFields is enabled for the module that contains+T, the selector's Name will be mangled (see comments in FieldLabel).+Thus we store the actual field label in par_lbl, and the GlobalRdrEnv+entry looks like this:++    "x" |->  GRE $sel:x:MkT (FldParent T (Just "x")) LocalDef++Note that the OccName used when adding a GRE to the environment+(greOccName) now depends on the parent field: for FldParent it is the+field label, if present, rather than the selector name.++~~++Record pattern synonym selectors are treated differently. Their parent+information is `NoParent` in the module in which they are defined. This is because+a pattern synonym `P` has no parent constructor either.++However, if `f` is bundled with a type constructor `T` then whenever `f` is+imported the parent will use the `Parent` constructor so the parent of `f` is+now `T`.+++Note [Combining parents]+~~~~~~~~~~~~~~~~~~~~~~~~+With an associated type we might have+   module M where+     class C a where+       data T a+       op :: T a -> a+     instance C Int where+       data T Int = TInt+     instance C Bool where+       data T Bool = TBool++Then:   C is the parent of T+        T is the parent of TInt and TBool+So: in an export list+    C(..) is short for C( op, T )+    T(..) is short for T( TInt, TBool )++Module M exports everything, so its exports will be+   AvailTC C [C,T,op]+   AvailTC T [T,TInt,TBool]+On import we convert to GlobalRdrElt and then combine+those.  For T that will mean we have+  one GRE with Parent C+  one GRE with NoParent+That's why plusParent picks the "best" case.+-}++-- | make a 'GlobalRdrEnv' where all the elements point to the same+-- Provenance (useful for "hiding" imports, or imports with no details).+gresFromAvails :: Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]+-- prov = Nothing   => locally bound+--        Just spec => imported as described by spec+gresFromAvails prov avails+  = concatMap (gresFromAvail (const prov)) avails++localGREsFromAvail :: AvailInfo -> [GlobalRdrElt]+-- Turn an Avail into a list of LocalDef GlobalRdrElts+localGREsFromAvail = gresFromAvail (const Nothing)++gresFromAvail :: (Name -> Maybe ImportSpec) -> AvailInfo -> [GlobalRdrElt]+gresFromAvail prov_fn avail+  = map mk_gre (availNonFldNames avail) ++ map mk_fld_gre (availFlds avail)+  where+    mk_gre n+      = case prov_fn n of  -- Nothing => bound locally+                           -- Just is => imported from 'is'+          Nothing -> GRE { gre_name = n, gre_par = mkParent n avail+                         , gre_lcl = True, gre_imp = [] }+          Just is -> GRE { gre_name = n, gre_par = mkParent n avail+                         , gre_lcl = False, gre_imp = [is] }++    mk_fld_gre (FieldLabel { flLabel = lbl, flIsOverloaded = is_overloaded+                           , flSelector = n })+      = case prov_fn n of  -- Nothing => bound locally+                           -- Just is => imported from 'is'+          Nothing -> GRE { gre_name = n, gre_par = FldParent (availName avail) mb_lbl+                         , gre_lcl = True, gre_imp = [] }+          Just is -> GRE { gre_name = n, gre_par = FldParent (availName avail) mb_lbl+                         , gre_lcl = False, gre_imp = [is] }+      where+        mb_lbl | is_overloaded = Just lbl+               | otherwise     = Nothing+++greQualModName :: GlobalRdrElt -> ModuleName+-- Get a suitable module qualifier for the GRE+-- (used in mkPrintUnqualified)+-- Prerecondition: the gre_name is always External+greQualModName gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss })+ | lcl, Just mod <- nameModule_maybe name = moduleName mod+ | (is:_) <- iss                          = is_as (is_decl is)+ | otherwise                              = pprPanic "greQualModName" (ppr gre)++greRdrNames :: GlobalRdrElt -> [RdrName]+greRdrNames gre@GRE{ gre_lcl = lcl, gre_imp = iss }+  = (if lcl then [unqual] else []) ++ concatMap do_spec (map is_decl iss)+  where+    occ    = greOccName gre+    unqual = Unqual occ+    do_spec decl_spec+        | is_qual decl_spec = [qual]+        | otherwise         = [unqual,qual]+        where qual = Qual (is_as decl_spec) occ++-- the SrcSpan that pprNameProvenance prints out depends on whether+-- the Name is defined locally or not: for a local definition the+-- definition site is used, otherwise the location of the import+-- declaration.  We want to sort the export locations in+-- exportClashErr by this SrcSpan, we need to extract it:+greSrcSpan :: GlobalRdrElt -> SrcSpan+greSrcSpan gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss } )+  | lcl           = nameSrcSpan name+  | (is:_) <- iss = is_dloc (is_decl is)+  | otherwise     = pprPanic "greSrcSpan" (ppr gre)++mkParent :: Name -> AvailInfo -> Parent+mkParent _ (Avail _)           = NoParent+mkParent n (AvailTC m _ _) | n == m    = NoParent+                         | otherwise = ParentIs m++greParent_maybe :: GlobalRdrElt -> Maybe Name+greParent_maybe gre = case gre_par gre of+                        NoParent      -> Nothing+                        ParentIs n    -> Just n+                        FldParent n _ -> Just n++-- | Takes a list of distinct GREs and folds them+-- into AvailInfos. This is more efficient than mapping each individual+-- GRE to an AvailInfo and the folding using `plusAvail` but needs the+-- uniqueness assumption.+gresToAvailInfo :: [GlobalRdrElt] -> [AvailInfo]+gresToAvailInfo gres+  = nameEnvElts avail_env+  where+    avail_env :: NameEnv AvailInfo -- Keyed by the parent+    (avail_env, _) = foldl' add (emptyNameEnv, emptyNameSet) gres++    add :: (NameEnv AvailInfo, NameSet)+        -> GlobalRdrElt+        -> (NameEnv AvailInfo, NameSet)+    add (env, done) gre+      | name `elemNameSet` done+      = (env, done)  -- Don't insert twice into the AvailInfo+      | otherwise+      = ( extendNameEnv_Acc comb availFromGRE env key gre+        , done `extendNameSet` name )+      where+        name = gre_name gre+        key = case greParent_maybe gre of+                 Just parent -> parent+                 Nothing     -> gre_name gre++        -- We want to insert the child `k` into a list of children but+        -- need to maintain the invariant that the parent is first.+        --+        -- We also use the invariant that `k` is not already in `ns`.+        insertChildIntoChildren :: Name -> [Name] -> Name -> [Name]+        insertChildIntoChildren _ [] k = [k]+        insertChildIntoChildren p (n:ns) k+          | p == k = k:n:ns+          | otherwise = n:k:ns++        comb :: GlobalRdrElt -> AvailInfo -> AvailInfo+        comb _ (Avail n) = Avail n -- Duplicated name, should not happen+        comb gre (AvailTC m ns fls)+          = case gre_par gre of+              NoParent    -> AvailTC m (name:ns) fls -- Not sure this ever happens+              ParentIs {} -> AvailTC m (insertChildIntoChildren m ns name) fls+              FldParent _ mb_lbl -> AvailTC m ns (mkFieldLabel name mb_lbl : fls)++availFromGRE :: GlobalRdrElt -> AvailInfo+availFromGRE (GRE { gre_name = me, gre_par = parent })+  = case parent of+      ParentIs p                  -> AvailTC p [me] []+      NoParent   | isTyConName me -> AvailTC me [me] []+                 | otherwise      -> avail   me+      FldParent p mb_lbl -> AvailTC p [] [mkFieldLabel me mb_lbl]++mkFieldLabel :: Name -> Maybe FastString -> FieldLabel+mkFieldLabel me mb_lbl =+          case mb_lbl of+                 Nothing  -> FieldLabel { flLabel = occNameFS (nameOccName me)+                                        , flIsOverloaded = False+                                        , flSelector = me }+                 Just lbl -> FieldLabel { flLabel = lbl+                                        , flIsOverloaded = True+                                        , flSelector = me }++emptyGlobalRdrEnv :: GlobalRdrEnv+emptyGlobalRdrEnv = emptyOccEnv++globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]+globalRdrEnvElts env = foldOccEnv (++) [] env++instance Outputable GlobalRdrElt where+  ppr gre = hang (ppr (gre_name gre) <+> ppr (gre_par gre))+               2 (pprNameProvenance gre)++pprGlobalRdrEnv :: Bool -> GlobalRdrEnv -> SDoc+pprGlobalRdrEnv locals_only env+  = vcat [ text "GlobalRdrEnv" <+> ppWhen locals_only (ptext (sLit "(locals only)"))+             <+> lbrace+         , nest 2 (vcat [ pp (remove_locals gre_list) | gre_list <- occEnvElts env ]+             <+> rbrace) ]+  where+    remove_locals gres | locals_only = filter isLocalGRE gres+                       | otherwise   = gres+    pp []   = empty+    pp gres = hang (ppr occ+                     <+> parens (text "unique" <+> ppr (getUnique occ))+                     <> colon)+                 2 (vcat (map ppr gres))+      where+        occ = nameOccName (gre_name (head gres))++lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]+lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of+                                  Nothing   -> []+                                  Just gres -> gres++greOccName :: GlobalRdrElt -> OccName+greOccName (GRE{gre_par = FldParent{par_lbl = Just lbl}}) = mkVarOccFS lbl+greOccName gre                                            = nameOccName (gre_name gre)++lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]+lookupGRE_RdrName rdr_name env+  = case lookupOccEnv env (rdrNameOcc rdr_name) of+    Nothing   -> []+    Just gres -> pickGREs rdr_name gres++lookupGRE_Name :: GlobalRdrEnv -> Name -> Maybe GlobalRdrElt+-- ^ Look for precisely this 'Name' in the environment.  This tests+-- whether it is in scope, ignoring anything else that might be in+-- scope with the same 'OccName'.+lookupGRE_Name env name+  = lookupGRE_Name_OccName env name (nameOccName name)++lookupGRE_FieldLabel :: GlobalRdrEnv -> FieldLabel -> Maybe GlobalRdrElt+-- ^ Look for a particular record field selector in the environment, where the+-- selector name and field label may be different: the GlobalRdrEnv is keyed on+-- the label.  See Note [Parents for record fields] for why this happens.+lookupGRE_FieldLabel env fl+  = lookupGRE_Name_OccName env (flSelector fl) (mkVarOccFS (flLabel fl))++lookupGRE_Name_OccName :: GlobalRdrEnv -> Name -> OccName -> Maybe GlobalRdrElt+-- ^ Look for precisely this 'Name' in the environment, but with an 'OccName'+-- that might differ from that of the 'Name'.  See 'lookupGRE_FieldLabel' and+-- Note [Parents for record fields].+lookupGRE_Name_OccName env name occ+  = case [ gre | gre <- lookupGlobalRdrEnv env occ+               , gre_name gre == name ] of+      []    -> Nothing+      [gre] -> Just gre+      gres  -> pprPanic "lookupGRE_Name_OccName"+                        (ppr name $$ ppr occ $$ ppr gres)+               -- See INVARIANT 1 on GlobalRdrEnv+++getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]+-- Returns all the qualifiers by which 'x' is in scope+-- Nothing means "the unqualified version is in scope"+-- [] means the thing is not in scope at all+getGRE_NameQualifier_maybes env name+  = case lookupGRE_Name env name of+      Just gre -> [qualifier_maybe gre]+      Nothing  -> []+  where+    qualifier_maybe (GRE { gre_lcl = lcl, gre_imp = iss })+      | lcl       = Nothing+      | otherwise = Just $ map (is_as . is_decl) iss++isLocalGRE :: GlobalRdrElt -> Bool+isLocalGRE (GRE {gre_lcl = lcl }) = lcl++isRecFldGRE :: GlobalRdrElt -> Bool+isRecFldGRE (GRE {gre_par = FldParent{}}) = True+isRecFldGRE _                             = False++-- Returns the field label of this GRE, if it has one+greLabel :: GlobalRdrElt -> Maybe FieldLabelString+greLabel (GRE{gre_par = FldParent{par_lbl = Just lbl}}) = Just lbl+greLabel (GRE{gre_name = n, gre_par = FldParent{}})     = Just (occNameFS (nameOccName n))+greLabel _                                              = Nothing++unQualOK :: GlobalRdrElt -> Bool+-- ^ Test if an unqualified version of this thing would be in scope+unQualOK (GRE {gre_lcl = lcl, gre_imp = iss })+  | lcl = True+  | otherwise = any unQualSpecOK iss++{- Note [GRE filtering]+~~~~~~~~~~~~~~~~~~~~~~~+(pickGREs rdr gres) takes a list of GREs which have the same OccName+as 'rdr', say "x".  It does two things:++(a) filters the GREs to a subset that are in scope+    * Qualified,   as 'M.x'  if want_qual    is Qual M _+    * Unqualified, as 'x'    if want_unqual  is Unqual _++(b) for that subset, filter the provenance field (gre_lcl and gre_imp)+    to ones that brought it into scope qualified or unqualified resp.++Example:+      module A ( f ) where+      import qualified Foo( f )+      import Baz( f )+      f = undefined++Let's suppose that Foo.f and Baz.f are the same entity really, but the local+'f' is different, so there will be two GREs matching "f":+   gre1:  gre_lcl = True,  gre_imp = []+   gre2:  gre_lcl = False, gre_imp = [ imported from Foo, imported from Bar ]++The use of "f" in the export list is ambiguous because it's in scope+from the local def and the import Baz(f); but *not* the import qualified Foo.+pickGREs returns two GRE+   gre1:   gre_lcl = True,  gre_imp = []+   gre2:   gre_lcl = False, gre_imp = [ imported from Bar ]++Now the "ambiguous occurrence" message can correctly report how the+ambiguity arises.+-}++pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]+-- ^ Takes a list of GREs which have the right OccName 'x'+-- Pick those GREs that are in scope+--    * Qualified,   as 'M.x'  if want_qual    is Qual M _+--    * Unqualified, as 'x'    if want_unqual  is Unqual _+--+-- Return each such GRE, with its ImportSpecs filtered, to reflect+-- how it is in scope qualified or unqualified respectively.+-- See Note [GRE filtering]+pickGREs (Unqual {})  gres = mapMaybe pickUnqualGRE     gres+pickGREs (Qual mod _) gres = mapMaybe (pickQualGRE mod) gres+pickGREs _            _    = []  -- I don't think this actually happens++pickUnqualGRE :: GlobalRdrElt -> Maybe GlobalRdrElt+pickUnqualGRE gre@(GRE { gre_lcl = lcl, gre_imp = iss })+  | not lcl, null iss' = Nothing+  | otherwise          = Just (gre { gre_imp = iss' })+  where+    iss' = filter unQualSpecOK iss++pickQualGRE :: ModuleName -> GlobalRdrElt -> Maybe GlobalRdrElt+pickQualGRE mod gre@(GRE { gre_name = n, gre_lcl = lcl, gre_imp = iss })+  | not lcl', null iss' = Nothing+  | otherwise           = Just (gre { gre_lcl = lcl', gre_imp = iss' })+  where+    iss' = filter (qualSpecOK mod) iss+    lcl' = lcl && name_is_from mod n++    name_is_from :: ModuleName -> Name -> Bool+    name_is_from mod name = case nameModule_maybe name of+                              Just n_mod -> moduleName n_mod == mod+                              Nothing    -> False++pickGREsModExp :: ModuleName -> [GlobalRdrElt] -> [(GlobalRdrElt,GlobalRdrElt)]+-- ^ Pick GREs that are in scope *both* qualified *and* unqualified+-- Return each GRE that is, as a pair+--    (qual_gre, unqual_gre)+-- These two GREs are the original GRE with imports filtered to express how+-- it is in scope qualified an unqualified respectively+--+-- Used only for the 'module M' item in export list;+--   see RnNames.exports_from_avail+pickGREsModExp mod gres = mapMaybe (pickBothGRE mod) gres++pickBothGRE :: ModuleName -> GlobalRdrElt -> Maybe (GlobalRdrElt, GlobalRdrElt)+pickBothGRE mod gre@(GRE { gre_name = n })+  | isBuiltInSyntax n                = Nothing+  | Just gre1 <- pickQualGRE mod gre+  , Just gre2 <- pickUnqualGRE   gre = Just (gre1, gre2)+  | otherwise                        = Nothing+  where+        -- isBuiltInSyntax filter out names for built-in syntax They+        -- just clutter up the environment (esp tuples), and the+        -- parser will generate Exact RdrNames for them, so the+        -- cluttered envt is no use.  Really, it's only useful for+        -- GHC.Base and GHC.Tuple.++-- Building GlobalRdrEnvs++plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv+plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2++mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv+mkGlobalRdrEnv gres+  = foldr add emptyGlobalRdrEnv gres+  where+    add gre env = extendOccEnv_Acc insertGRE singleton env+                                   (greOccName gre)+                                   gre++insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]+insertGRE new_g [] = [new_g]+insertGRE new_g (old_g : old_gs)+        | gre_name new_g == gre_name old_g+        = new_g `plusGRE` old_g : old_gs+        | otherwise+        = old_g : insertGRE new_g old_gs++plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt+-- Used when the gre_name fields match+plusGRE g1 g2+  = GRE { gre_name = gre_name g1+        , gre_lcl  = gre_lcl g1 || gre_lcl g2+        , gre_imp  = gre_imp g1 ++ gre_imp g2+        , gre_par  = gre_par  g1 `plusParent` gre_par  g2 }++transformGREs :: (GlobalRdrElt -> GlobalRdrElt)+              -> [OccName]+              -> GlobalRdrEnv -> GlobalRdrEnv+-- ^ Apply a transformation function to the GREs for these OccNames+transformGREs trans_gre occs rdr_env+  = foldr trans rdr_env occs+  where+    trans occ env+      = case lookupOccEnv env occ of+           Just gres -> extendOccEnv env occ (map trans_gre gres)+           Nothing   -> env++extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv+extendGlobalRdrEnv env gre+  = extendOccEnv_Acc insertGRE singleton env+                     (greOccName gre) gre++shadowNames :: GlobalRdrEnv -> [Name] -> GlobalRdrEnv+shadowNames = foldl' shadowName++{- Note [GlobalRdrEnv shadowing]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Before adding new names to the GlobalRdrEnv we nuke some existing entries;+this is "shadowing".  The actual work is done by RdrEnv.shadowName.+Suppose+   env' = shadowName env M.f++Then:+   * Looking up (Unqual f) in env' should succeed, returning M.f,+     even if env contains existing unqualified bindings for f.+     They are shadowed++   * Looking up (Qual M.f) in env' should succeed, returning M.f++   * Looking up (Qual X.f) in env', where X /= M, should be the same as+     looking up (Qual X.f) in env.+     That is, shadowName does /not/ delete earlier qualified bindings++There are two reasons for shadowing:++* The GHCi REPL++  - Ids bought into scope on the command line (eg let x = True) have+    External Names, like Ghci4.x.  We want a new binding for 'x' (say)+    to override the existing binding for 'x'.  Example:++           ghci> :load M    -- Brings `x` and `M.x` into scope+           ghci> x+           ghci> "Hello"+           ghci> M.x+           ghci> "hello"+           ghci> let x = True  -- Shadows `x`+           ghci> x             -- The locally bound `x`+                               -- NOT an ambiguous reference+           ghci> True+           ghci> M.x           -- M.x is still in scope!+           ghci> "Hello"+    So when we add `x = True` we must not delete the `M.x` from the+    `GlobalRdrEnv`; rather we just want to make it "qualified only";+    hence the `mk_fake-imp_spec` in `shadowName`.  See also Note+    [Interactively-bound Ids in GHCi] in HscTypes++  - Data types also have External Names, like Ghci4.T; but we still want+    'T' to mean the newly-declared 'T', not an old one.++* Nested Template Haskell declaration brackets+  See Note [Top-level Names in Template Haskell decl quotes] in RnNames++  Consider a TH decl quote:+      module M where+        f x = h [d| f = ...f...M.f... |]+  We must shadow the outer unqualified binding of 'f', else we'll get+  a complaint when extending the GlobalRdrEnv, saying that there are+  two bindings for 'f'.  There are several tricky points:++    - This shadowing applies even if the binding for 'f' is in a+      where-clause, and hence is in the *local* RdrEnv not the *global*+      RdrEnv.  This is done in lcl_env_TH in extendGlobalRdrEnvRn.++    - The External Name M.f from the enclosing module must certainly+      still be available.  So we don't nuke it entirely; we just make+      it seem like qualified import.++    - We only shadow *External* names (which come from the main module),+      or from earlier GHCi commands. Do not shadow *Internal* names+      because in the bracket+          [d| class C a where f :: a+              f = 4 |]+      rnSrcDecls will first call extendGlobalRdrEnvRn with C[f] from the+      class decl, and *separately* extend the envt with the value binding.+      At that stage, the class op 'f' will have an Internal name.+-}++shadowName :: GlobalRdrEnv -> Name -> GlobalRdrEnv+-- Remove certain old GREs that share the same OccName as this new Name.+-- See Note [GlobalRdrEnv shadowing] for details+shadowName env name+  = alterOccEnv (fmap alter_fn) env (nameOccName name)+  where+    alter_fn :: [GlobalRdrElt] -> [GlobalRdrElt]+    alter_fn gres = mapMaybe (shadow_with name) gres++    shadow_with :: Name -> GlobalRdrElt -> Maybe GlobalRdrElt+    shadow_with new_name+       old_gre@(GRE { gre_name = old_name, gre_lcl = lcl, gre_imp = iss })+       = case nameModule_maybe old_name of+           Nothing -> Just old_gre   -- Old name is Internal; do not shadow+           Just old_mod+              | Just new_mod <- nameModule_maybe new_name+              , new_mod == old_mod   -- Old name same as new name; shadow completely+              -> Nothing++              | null iss'            -- Nothing remains+              -> Nothing++              | otherwise+              -> Just (old_gre { gre_lcl = False, gre_imp = iss' })++              where+                iss' = lcl_imp ++ mapMaybe (shadow_is new_name) iss+                lcl_imp | lcl       = [mk_fake_imp_spec old_name old_mod]+                        | otherwise = []++    mk_fake_imp_spec old_name old_mod    -- Urgh!+      = ImpSpec id_spec ImpAll+      where+        old_mod_name = moduleName old_mod+        id_spec      = ImpDeclSpec { is_mod = old_mod_name+                                   , is_as = old_mod_name+                                   , is_qual = True+                                   , is_dloc = nameSrcSpan old_name }++    shadow_is :: Name -> ImportSpec -> Maybe ImportSpec+    shadow_is new_name is@(ImpSpec { is_decl = id_spec })+       | Just new_mod <- nameModule_maybe new_name+       , is_as id_spec == moduleName new_mod+       = Nothing   -- Shadow both qualified and unqualified+       | otherwise -- Shadow unqualified only+       = Just (is { is_decl = id_spec { is_qual = True } })+++{-+************************************************************************+*                                                                      *+                        ImportSpec+*                                                                      *+************************************************************************+-}++-- | Import Specification+--+-- The 'ImportSpec' of something says how it came to be imported+-- It's quite elaborate so that we can give accurate unused-name warnings.+data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,+                            is_item :: ImpItemSpec }+                deriving( Eq, Ord, Data )++-- | Import Declaration Specification+--+-- Describes a particular import declaration and is+-- shared among all the 'Provenance's for that decl+data ImpDeclSpec+  = ImpDeclSpec {+        is_mod      :: ModuleName, -- ^ Module imported, e.g. @import Muggle@+                                   -- Note the @Muggle@ may well not be+                                   -- the defining module for this thing!++                                   -- TODO: either should be Module, or there+                                   -- should be a Maybe UnitId here too.+        is_as       :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)+        is_qual     :: Bool,       -- ^ Was this import qualified?+        is_dloc     :: SrcSpan     -- ^ The location of the entire import declaration+    } deriving Data++-- | Import Item Specification+--+-- Describes import info a particular Name+data ImpItemSpec+  = ImpAll              -- ^ The import had no import list,+                        -- or had a hiding list++  | ImpSome {+        is_explicit :: Bool,+        is_iloc     :: SrcSpan  -- Location of the import item+    }   -- ^ The import had an import list.+        -- The 'is_explicit' field is @True@ iff the thing was named+        -- /explicitly/ in the import specs rather+        -- than being imported as part of a "..." group. Consider:+        --+        -- > import C( T(..) )+        --+        -- Here the constructors of @T@ are not named explicitly;+        -- only @T@ is named explicitly.+  deriving Data++instance Eq ImpDeclSpec where+  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False++instance Ord ImpDeclSpec where+   compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp`+                     (is_dloc is1 `compare` is_dloc is2)++instance Eq ImpItemSpec where+  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False++instance Ord ImpItemSpec where+   compare is1 is2 =+    case (is1, is2) of+      (ImpAll, ImpAll) -> EQ+      (ImpAll, _)      -> GT+      (_, ImpAll)      -> LT+      (ImpSome _ l1, ImpSome _ l2) -> l1 `compare` l2+++bestImport :: [ImportSpec] -> ImportSpec+-- See Note [Choosing the best import declaration]+bestImport iss+  = case sortBy best iss of+      (is:_) -> is+      []     -> pprPanic "bestImport" (ppr iss)+  where+    best :: ImportSpec -> ImportSpec -> Ordering+    -- Less means better+    -- Unqualified always wins over qualified; then+    -- import-all wins over import-some; then+    -- earlier declaration wins over later+    best (ImpSpec { is_item = item1, is_decl = d1 })+         (ImpSpec { is_item = item2, is_decl = d2 })+      = (is_qual d1 `compare` is_qual d2) `thenCmp`+        (best_item item1 item2)           `thenCmp`+        (is_dloc d1 `compare` is_dloc d2)++    best_item :: ImpItemSpec -> ImpItemSpec -> Ordering+    best_item ImpAll ImpAll = EQ+    best_item ImpAll (ImpSome {}) = LT+    best_item (ImpSome {}) ImpAll = GT+    best_item (ImpSome { is_explicit = e1 })+              (ImpSome { is_explicit = e2 }) = e1 `compare` e2+     -- False < True, so if e1 is explicit and e2 is not, we get GT++{- Note [Choosing the best import declaration]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When reporting unused import declarations we use the following rules.+   (see [wiki:commentary/compiler/unused-imports])++Say that an import-item is either+  * an entire import-all decl (eg import Foo), or+  * a particular item in an import list (eg import Foo( ..., x, ...)).+The general idea is that for each /occurrence/ of an imported name, we will+attribute that use to one import-item. Once we have processed all the+occurrences, any import items with no uses attributed to them are unused,+and are warned about. More precisely:++1. For every RdrName in the program text, find its GlobalRdrElt.++2. Then, from the [ImportSpec] (gre_imp) of that GRE, choose one+   the "chosen import-item", and mark it "used". This is done+   by 'bestImport'++3. After processing all the RdrNames, bleat about any+   import-items that are unused.+   This is done in RnNames.warnUnusedImportDecls.++The function 'bestImport' returns the dominant import among the+ImportSpecs it is given, implementing Step 2.  We say import-item A+dominates import-item B if we choose A over B. In general, we try to+choose the import that is most likely to render other imports+unnecessary.  Here is the dominance relationship we choose:++    a) import Foo dominates import qualified Foo.++    b) import Foo dominates import Foo(x).++    c) Otherwise choose the textually first one.++Rationale for (a).  Consider+   import qualified M  -- Import #1+   import M( x )       -- Import #2+   foo = M.x + x++The unqualified 'x' can only come from import #2.  The qualified 'M.x'+could come from either, but bestImport picks import #2, because it is+more likely to be useful in other imports, as indeed it is in this+case (see #5211 for a concrete example).++But the rules are not perfect; consider+   import qualified M  -- Import #1+   import M( x )       -- Import #2+   foo = M.x + M.y++The M.x will use import #2, but M.y can only use import #1.+-}+++unQualSpecOK :: ImportSpec -> Bool+-- ^ Is in scope unqualified?+unQualSpecOK is = not (is_qual (is_decl is))++qualSpecOK :: ModuleName -> ImportSpec -> Bool+-- ^ Is in scope qualified with the given module?+qualSpecOK mod is = mod == is_as (is_decl is)++importSpecLoc :: ImportSpec -> SrcSpan+importSpecLoc (ImpSpec decl ImpAll) = is_dloc decl+importSpecLoc (ImpSpec _    item)   = is_iloc item++importSpecModule :: ImportSpec -> ModuleName+importSpecModule is = is_mod (is_decl is)++isExplicitItem :: ImpItemSpec -> Bool+isExplicitItem ImpAll                        = False+isExplicitItem (ImpSome {is_explicit = exp}) = exp++pprNameProvenance :: GlobalRdrElt -> SDoc+-- ^ Print out one place where the name was define/imported+-- (With -dppr-debug, print them all)+pprNameProvenance (GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss })+  = ifPprDebug (vcat pp_provs)+               (head pp_provs)+  where+    pp_provs = pp_lcl ++ map pp_is iss+    pp_lcl = if lcl then [text "defined at" <+> ppr (nameSrcLoc name)]+                    else []+    pp_is is = sep [ppr is, ppr_defn_site is name]++-- If we know the exact definition point (which we may do with GHCi)+-- then show that too.  But not if it's just "imported from X".+ppr_defn_site :: ImportSpec -> Name -> SDoc+ppr_defn_site imp_spec name+  | same_module && not (isGoodSrcSpan loc)+  = empty              -- Nothing interesting to say+  | otherwise+  = parens $ hang (text "and originally defined" <+> pp_mod)+                2 (pprLoc loc)+  where+    loc = nameSrcSpan name+    defining_mod = ASSERT2( isExternalName name, ppr name ) nameModule name+    same_module = importSpecModule imp_spec == moduleName defining_mod+    pp_mod | same_module = empty+           | otherwise   = text "in" <+> quotes (ppr defining_mod)+++instance Outputable ImportSpec where+   ppr imp_spec+     = text "imported" <+> qual+        <+> text "from" <+> quotes (ppr (importSpecModule imp_spec))+        <+> pprLoc (importSpecLoc imp_spec)+     where+       qual | is_qual (is_decl imp_spec) = text "qualified"+            | otherwise                  = empty++pprLoc :: SrcSpan -> SDoc+pprLoc (RealSrcSpan s)    = text "at" <+> ppr s+pprLoc (UnhelpfulSpan {}) = empty++-- | Display info about the treatment of '*' under NoStarIsType.+--+-- With StarIsType, three properties of '*' hold:+--+--   (a) it is not an infix operator+--   (b) it is always in scope+--   (c) it is a synonym for Data.Kind.Type+--+-- However, the user might not know that he's working on a module with+-- NoStarIsType and write code that still assumes (a), (b), and (c), which+-- actually do not hold in that module.+--+-- Violation of (a) shows up in the parser. For instance, in the following+-- examples, we have '*' not applied to enough arguments:+--+--   data A :: *+--   data F :: * -> *+--+-- Violation of (b) or (c) show up in the renamer and the typechecker+-- respectively. For instance:+--+--   type K = Either * Bool+--+-- This will parse differently depending on whether StarIsType is enabled,+-- but it will parse nonetheless. With NoStarIsType it is parsed as a type+-- operator, thus we have ((*) Either Bool). Now there are two cases to+-- consider:+--+--   1. There is no definition of (*) in scope. In this case the renamer will+--      fail to look it up. This is a violation of assumption (b).+--+--   2. There is a definition of the (*) type operator in scope (for example+--      coming from GHC.TypeNats). In this case the user will get a kind+--      mismatch error. This is a violation of assumption (c).+--+-- The user might unknowingly be working on a module with NoStarIsType+-- or use '*' as 'Data.Kind.Type' out of habit. So it is important to give a+-- hint whenever an assumption about '*' is violated. Unfortunately, it is+-- somewhat difficult to deal with (c), so we limit ourselves to (a) and (b).+--+-- 'starInfo' generates an appropriate hint to the user depending on the+-- extensions enabled in the module and the name that triggered the error.+-- That is, if we have NoStarIsType and the error is related to '*' or its+-- Unicode variant, the resulting SDoc will contain a helpful suggestion.+-- Otherwise it is empty.+--+starInfo :: Bool -> RdrName -> SDoc+starInfo star_is_type rdr_name =+  -- One might ask: if can use sdocWithDynFlags here, why bother to take+  -- star_is_type as input? Why not refactor?+  --+  -- The reason is that sdocWithDynFlags would provide DynFlags that are active+  -- in the module that tries to load the problematic definition, not+  -- in the module that is being loaded.+  --+  -- So if we have 'data T :: *' in a module with NoStarIsType, then the hint+  -- must be displayed even if we load this definition from a module (or GHCi)+  -- with StarIsType enabled!+  --+  if isUnqualStar && not star_is_type+     then text "With NoStarIsType, " <>+          quotes (ppr rdr_name) <>+          text " is treated as a regular type operator. "+        $$+          text "Did you mean to use " <> quotes (text "Type") <>+          text " from Data.Kind instead?"+      else empty+  where+    -- Does rdr_name look like the user might have meant the '*' kind by it?+    -- We focus on unqualified stars specifically, because qualified stars are+    -- treated as type operators even under StarIsType.+    isUnqualStar+      | Unqual occName <- rdr_name+      = let fs = occNameFS occName+        in fs == fsLit "*" || fs == fsLit "★"+      | otherwise = False
+ compiler/basicTypes/SrcLoc.hs view
@@ -0,0 +1,696 @@+-- (c) The University of Glasgow, 1992-2006++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveFunctor      #-}+{-# LANGUAGE DeriveFoldable     #-}+{-# LANGUAGE DeriveTraversable  #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE TypeFamilies       #-}+{-# LANGUAGE ViewPatterns       #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE PatternSynonyms    #-}+++-- | This module contains types that relate to the positions of things+-- in source files, and allow tagging of those things with locations+module SrcLoc (+        -- * SrcLoc+        RealSrcLoc,             -- Abstract+        SrcLoc(..),++        -- ** Constructing SrcLoc+        mkSrcLoc, mkRealSrcLoc, mkGeneralSrcLoc,++        noSrcLoc,               -- "I'm sorry, I haven't a clue"+        generatedSrcLoc,        -- Code generated within the compiler+        interactiveSrcLoc,      -- Code from an interactive session++        advanceSrcLoc,++        -- ** Unsafely deconstructing SrcLoc+        -- These are dubious exports, because they crash on some inputs+        srcLocFile,             -- return the file name part+        srcLocLine,             -- return the line part+        srcLocCol,              -- return the column part++        -- * SrcSpan+        RealSrcSpan,            -- Abstract+        SrcSpan(..),++        -- ** Constructing SrcSpan+        mkGeneralSrcSpan, mkSrcSpan, mkRealSrcSpan,+        noSrcSpan,+        wiredInSrcSpan,         -- Something wired into the compiler+        interactiveSrcSpan,+        srcLocSpan, realSrcLocSpan,+        combineSrcSpans,+        srcSpanFirstCharacter,++        -- ** Deconstructing SrcSpan+        srcSpanStart, srcSpanEnd,+        realSrcSpanStart, realSrcSpanEnd,+        srcSpanFileName_maybe,+        pprUserRealSpan,++        -- ** Unsafely deconstructing SrcSpan+        -- These are dubious exports, because they crash on some inputs+        srcSpanFile,+        srcSpanStartLine, srcSpanEndLine,+        srcSpanStartCol, srcSpanEndCol,++        -- ** Predicates on SrcSpan+        isGoodSrcSpan, isOneLineSpan,+        containsSpan,++        -- * Located+        Located,+        RealLocated,+        GenLocated(..),++        -- ** Constructing Located+        noLoc,+        mkGeneralLocated,++        -- ** Deconstructing Located+        getLoc, unLoc,+        unRealSrcSpan, getRealSrcSpan,++        -- ** Modifying Located+        mapLoc,++        -- ** Combining and comparing Located values+        eqLocated, cmpLocated, combineLocs, addCLoc,+        leftmost_smallest, leftmost_largest, rightmost,+        spans, isSubspanOf, sortLocated,++        -- ** HasSrcSpan+        HasSrcSpan(..), SrcSpanLess, dL, cL,+        pattern LL, onHasSrcSpan, liftL+    ) where++import GhcPrelude++import Util+import Json+import Outputable+import FastString++import Control.DeepSeq+import Data.Bits+import Data.Data+import Data.List+import Data.Ord++{-+************************************************************************+*                                                                      *+\subsection[SrcLoc-SrcLocations]{Source-location information}+*                                                                      *+************************************************************************++We keep information about the {\em definition} point for each entity;+this is the obvious stuff:+-}++-- | Real Source Location+--+-- Represents a single point within a file+data RealSrcLoc+  = SrcLoc      FastString              -- A precise location (file name)+                {-# UNPACK #-} !Int     -- line number, begins at 1+                {-# UNPACK #-} !Int     -- column number, begins at 1+  deriving (Eq, Ord)++-- | Source Location+data SrcLoc+  = RealSrcLoc {-# UNPACK #-}!RealSrcLoc+  | UnhelpfulLoc FastString     -- Just a general indication+  deriving (Eq, Ord, Show)++{-+************************************************************************+*                                                                      *+\subsection[SrcLoc-access-fns]{Access functions}+*                                                                      *+************************************************************************+-}++mkSrcLoc :: FastString -> Int -> Int -> SrcLoc+mkSrcLoc x line col = RealSrcLoc (mkRealSrcLoc x line col)++mkRealSrcLoc :: FastString -> Int -> Int -> RealSrcLoc+mkRealSrcLoc x line col = SrcLoc x line col++-- | Built-in "bad" 'SrcLoc' values for particular locations+noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc+noSrcLoc          = UnhelpfulLoc (fsLit "<no location info>")+generatedSrcLoc   = UnhelpfulLoc (fsLit "<compiler-generated code>")+interactiveSrcLoc = UnhelpfulLoc (fsLit "<interactive>")++-- | Creates a "bad" 'SrcLoc' that has no detailed information about its location+mkGeneralSrcLoc :: FastString -> SrcLoc+mkGeneralSrcLoc = UnhelpfulLoc++-- | Gives the filename of the 'RealSrcLoc'+srcLocFile :: RealSrcLoc -> FastString+srcLocFile (SrcLoc fname _ _) = fname++-- | Raises an error when used on a "bad" 'SrcLoc'+srcLocLine :: RealSrcLoc -> Int+srcLocLine (SrcLoc _ l _) = l++-- | Raises an error when used on a "bad" 'SrcLoc'+srcLocCol :: RealSrcLoc -> Int+srcLocCol (SrcLoc _ _ c) = c++-- | Move the 'SrcLoc' down by one line if the character is a newline,+-- to the next 8-char tabstop if it is a tab, and across by one+-- character in any other case+advanceSrcLoc :: RealSrcLoc -> Char -> RealSrcLoc+advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f  (l + 1) 1+advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f  l (((((c - 1) `shiftR` 3) + 1)+                                                  `shiftL` 3) + 1)+advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)++{-+************************************************************************+*                                                                      *+\subsection[SrcLoc-instances]{Instance declarations for various names}+*                                                                      *+************************************************************************+-}++sortLocated :: HasSrcSpan a => [a] -> [a]+sortLocated things = sortBy (comparing getLoc) things++instance Outputable RealSrcLoc where+    ppr (SrcLoc src_path src_line src_col)+      = hcat [ pprFastFilePath src_path <> colon+             , int src_line <> colon+             , int src_col ]++-- I don't know why there is this style-based difference+--        if userStyle sty || debugStyle sty then+--            hcat [ pprFastFilePath src_path, char ':',+--                   int src_line,+--                   char ':', int src_col+--                 ]+--        else+--            hcat [text "{-# LINE ", int src_line, space,+--                  char '\"', pprFastFilePath src_path, text " #-}"]++instance Outputable SrcLoc where+    ppr (RealSrcLoc l) = ppr l+    ppr (UnhelpfulLoc s)  = ftext s++instance Data RealSrcSpan where+  -- don't traverse?+  toConstr _   = abstractConstr "RealSrcSpan"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "RealSrcSpan"++instance Data SrcSpan where+  -- don't traverse?+  toConstr _   = abstractConstr "SrcSpan"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "SrcSpan"++{-+************************************************************************+*                                                                      *+\subsection[SrcSpan]{Source Spans}+*                                                                      *+************************************************************************+-}++{- |+A 'RealSrcSpan' delimits a portion of a text file.  It could be represented+by a pair of (line,column) coordinates, but in fact we optimise+slightly by using more compact representations for single-line and+zero-length spans, both of which are quite common.++The end position is defined to be the column /after/ the end of the+span.  That is, a span of (1,1)-(1,2) is one character long, and a+span of (1,1)-(1,1) is zero characters long.+-}++-- | Real Source Span+data RealSrcSpan+  = RealSrcSpan'+        { srcSpanFile     :: !FastString,+          srcSpanSLine    :: {-# UNPACK #-} !Int,+          srcSpanSCol     :: {-# UNPACK #-} !Int,+          srcSpanELine    :: {-# UNPACK #-} !Int,+          srcSpanECol     :: {-# UNPACK #-} !Int+        }+  deriving Eq++-- | Source Span+--+-- A 'SrcSpan' identifies either a specific portion of a text file+-- or a human-readable description of a location.+data SrcSpan =+    RealSrcSpan !RealSrcSpan+  | UnhelpfulSpan !FastString   -- Just a general indication+                                -- also used to indicate an empty span++  deriving (Eq, Ord, Show) -- Show is used by Lexer.x, because we+                           -- derive Show for Token++instance ToJson SrcSpan where+  json (UnhelpfulSpan {} ) = JSNull --JSObject [( "type", "unhelpful")]+  json (RealSrcSpan rss)  = json rss++instance ToJson RealSrcSpan where+  json (RealSrcSpan'{..}) = JSObject [ ("file", JSString (unpackFS srcSpanFile))+                                     , ("startLine", JSInt srcSpanSLine)+                                     , ("startCol", JSInt srcSpanSCol)+                                     , ("endLine", JSInt srcSpanELine)+                                     , ("endCol", JSInt srcSpanECol)+                                     ]++instance NFData SrcSpan where+  rnf x = x `seq` ()++-- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty+noSrcSpan, wiredInSrcSpan, interactiveSrcSpan :: SrcSpan+noSrcSpan          = UnhelpfulSpan (fsLit "<no location info>")+wiredInSrcSpan     = UnhelpfulSpan (fsLit "<wired into compiler>")+interactiveSrcSpan = UnhelpfulSpan (fsLit "<interactive>")++-- | Create a "bad" 'SrcSpan' that has not location information+mkGeneralSrcSpan :: FastString -> SrcSpan+mkGeneralSrcSpan = UnhelpfulSpan++-- | Create a 'SrcSpan' corresponding to a single point+srcLocSpan :: SrcLoc -> SrcSpan+srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str+srcLocSpan (RealSrcLoc l) = RealSrcSpan (realSrcLocSpan l)++realSrcLocSpan :: RealSrcLoc -> RealSrcSpan+realSrcLocSpan (SrcLoc file line col) = RealSrcSpan' file line col line col++-- | Create a 'SrcSpan' between two points in a file+mkRealSrcSpan :: RealSrcLoc -> RealSrcLoc -> RealSrcSpan+mkRealSrcSpan loc1 loc2 = RealSrcSpan' file line1 col1 line2 col2+  where+        line1 = srcLocLine loc1+        line2 = srcLocLine loc2+        col1 = srcLocCol loc1+        col2 = srcLocCol loc2+        file = srcLocFile loc1++-- | 'True' if the span is known to straddle only one line.+isOneLineRealSpan :: RealSrcSpan -> Bool+isOneLineRealSpan (RealSrcSpan' _ line1 _ line2 _)+  = line1 == line2++-- | 'True' if the span is a single point+isPointRealSpan :: RealSrcSpan -> Bool+isPointRealSpan (RealSrcSpan' _ line1 col1 line2 col2)+  = line1 == line2 && col1 == col2++-- | Create a 'SrcSpan' between two points in a file+mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan+mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str+mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str+mkSrcSpan (RealSrcLoc loc1) (RealSrcLoc loc2)+    = RealSrcSpan (mkRealSrcSpan loc1 loc2)++-- | Combines two 'SrcSpan' into one that spans at least all the characters+-- within both spans. Returns UnhelpfulSpan if the files differ.+combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan+combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful+combineSrcSpans l (UnhelpfulSpan _) = l+combineSrcSpans (RealSrcSpan span1) (RealSrcSpan span2)+  | srcSpanFile span1 == srcSpanFile span2+      = RealSrcSpan (combineRealSrcSpans span1 span2)+  | otherwise = UnhelpfulSpan (fsLit "<combineSrcSpans: files differ>")++-- | Combines two 'SrcSpan' into one that spans at least all the characters+-- within both spans. Assumes the "file" part is the same in both inputs+combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan+combineRealSrcSpans span1 span2+  = RealSrcSpan' file line_start col_start line_end col_end+  where+    (line_start, col_start) = min (srcSpanStartLine span1, srcSpanStartCol span1)+                                  (srcSpanStartLine span2, srcSpanStartCol span2)+    (line_end, col_end)     = max (srcSpanEndLine span1, srcSpanEndCol span1)+                                  (srcSpanEndLine span2, srcSpanEndCol span2)+    file = srcSpanFile span1++-- | Convert a SrcSpan into one that represents only its first character+srcSpanFirstCharacter :: SrcSpan -> SrcSpan+srcSpanFirstCharacter l@(UnhelpfulSpan {}) = l+srcSpanFirstCharacter (RealSrcSpan span) = RealSrcSpan $ mkRealSrcSpan loc1 loc2+  where+    loc1@(SrcLoc f l c) = realSrcSpanStart span+    loc2 = SrcLoc f l (c+1)++{-+************************************************************************+*                                                                      *+\subsection[SrcSpan-predicates]{Predicates}+*                                                                      *+************************************************************************+-}++-- | Test if a 'SrcSpan' is "good", i.e. has precise location information+isGoodSrcSpan :: SrcSpan -> Bool+isGoodSrcSpan (RealSrcSpan _) = True+isGoodSrcSpan (UnhelpfulSpan _) = False++isOneLineSpan :: SrcSpan -> Bool+-- ^ True if the span is known to straddle only one line.+-- For "bad" 'SrcSpan', it returns False+isOneLineSpan (RealSrcSpan s) = srcSpanStartLine s == srcSpanEndLine s+isOneLineSpan (UnhelpfulSpan _) = False++-- | Tests whether the first span "contains" the other span, meaning+-- that it covers at least as much source code. True where spans are equal.+containsSpan :: RealSrcSpan -> RealSrcSpan -> Bool+containsSpan s1 s2+  = (srcSpanStartLine s1, srcSpanStartCol s1)+       <= (srcSpanStartLine s2, srcSpanStartCol s2)+    && (srcSpanEndLine s1, srcSpanEndCol s1)+       >= (srcSpanEndLine s2, srcSpanEndCol s2)+    && (srcSpanFile s1 == srcSpanFile s2)+    -- We check file equality last because it is (presumably?) least+    -- likely to fail.+{-+%************************************************************************+%*                                                                      *+\subsection[SrcSpan-unsafe-access-fns]{Unsafe access functions}+*                                                                      *+************************************************************************+-}++srcSpanStartLine :: RealSrcSpan -> Int+srcSpanEndLine :: RealSrcSpan -> Int+srcSpanStartCol :: RealSrcSpan -> Int+srcSpanEndCol :: RealSrcSpan -> Int++srcSpanStartLine RealSrcSpan'{ srcSpanSLine=l } = l+srcSpanEndLine RealSrcSpan'{ srcSpanELine=l } = l+srcSpanStartCol RealSrcSpan'{ srcSpanSCol=l } = l+srcSpanEndCol RealSrcSpan'{ srcSpanECol=c } = c++{-+************************************************************************+*                                                                      *+\subsection[SrcSpan-access-fns]{Access functions}+*                                                                      *+************************************************************************+-}++-- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable+srcSpanStart :: SrcSpan -> SrcLoc+srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str+srcSpanStart (RealSrcSpan s) = RealSrcLoc (realSrcSpanStart s)++-- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable+srcSpanEnd :: SrcSpan -> SrcLoc+srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str+srcSpanEnd (RealSrcSpan s) = RealSrcLoc (realSrcSpanEnd s)++realSrcSpanStart :: RealSrcSpan -> RealSrcLoc+realSrcSpanStart s = mkRealSrcLoc (srcSpanFile s)+                                  (srcSpanStartLine s)+                                  (srcSpanStartCol s)++realSrcSpanEnd :: RealSrcSpan -> RealSrcLoc+realSrcSpanEnd s = mkRealSrcLoc (srcSpanFile s)+                                (srcSpanEndLine s)+                                (srcSpanEndCol s)++-- | Obtains the filename for a 'SrcSpan' if it is "good"+srcSpanFileName_maybe :: SrcSpan -> Maybe FastString+srcSpanFileName_maybe (RealSrcSpan s)   = Just (srcSpanFile s)+srcSpanFileName_maybe (UnhelpfulSpan _) = Nothing++{-+************************************************************************+*                                                                      *+\subsection[SrcSpan-instances]{Instances}+*                                                                      *+************************************************************************+-}++-- We want to order RealSrcSpans first by the start point, then by the+-- end point.+instance Ord RealSrcSpan where+  a `compare` b =+     (realSrcSpanStart a `compare` realSrcSpanStart b) `thenCmp`+     (realSrcSpanEnd   a `compare` realSrcSpanEnd   b)++instance Show RealSrcLoc where+  show (SrcLoc filename row col)+      = "SrcLoc " ++ show filename ++ " " ++ show row ++ " " ++ show col++-- Show is used by Lexer.x, because we derive Show for Token+instance Show RealSrcSpan where+  show span@(RealSrcSpan' file sl sc el ec)+    | isPointRealSpan span+    = "SrcSpanPoint " ++ show file ++ " " ++ intercalate " " (map show [sl,sc])++    | isOneLineRealSpan span+    = "SrcSpanOneLine " ++ show file ++ " "+                        ++ intercalate " " (map show [sl,sc,ec])++    | otherwise+    = "SrcSpanMultiLine " ++ show file ++ " "+                          ++ intercalate " " (map show [sl,sc,el,ec])+++instance Outputable RealSrcSpan where+    ppr span = pprUserRealSpan True span++-- I don't know why there is this style-based difference+--      = getPprStyle $ \ sty ->+--        if userStyle sty || debugStyle sty then+--           text (showUserRealSpan True span)+--        else+--           hcat [text "{-# LINE ", int (srcSpanStartLine span), space,+--                 char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]++instance Outputable SrcSpan where+    ppr span = pprUserSpan True span++-- I don't know why there is this style-based difference+--      = getPprStyle $ \ sty ->+--        if userStyle sty || debugStyle sty then+--           pprUserSpan True span+--        else+--           case span of+--           UnhelpfulSpan _ -> panic "Outputable UnhelpfulSpan"+--           RealSrcSpan s -> ppr s++pprUserSpan :: Bool -> SrcSpan -> SDoc+pprUserSpan _         (UnhelpfulSpan s) = ftext s+pprUserSpan show_path (RealSrcSpan s)   = pprUserRealSpan show_path s++pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc+pprUserRealSpan show_path span@(RealSrcSpan' src_path line col _ _)+  | isPointRealSpan span+  = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)+         , int line <> colon+         , int col ]++pprUserRealSpan show_path span@(RealSrcSpan' src_path line scol _ ecol)+  | isOneLineRealSpan span+  = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)+         , int line <> colon+         , int scol+         , ppUnless (ecol - scol <= 1) (char '-' <> int (ecol - 1)) ]+            -- For single-character or point spans, we just+            -- output the starting column number++pprUserRealSpan show_path (RealSrcSpan' src_path sline scol eline ecol)+  = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)+         , parens (int sline <> comma <> int scol)+         , char '-'+         , parens (int eline <> comma <> int ecol') ]+ where+   ecol' = if ecol == 0 then ecol else ecol - 1++{-+************************************************************************+*                                                                      *+\subsection[Located]{Attaching SrcSpans to things}+*                                                                      *+************************************************************************+-}++-- | We attach SrcSpans to lots of things, so let's have a datatype for it.+data GenLocated l e = L l e+  deriving (Eq, Ord, Data, Functor, Foldable, Traversable)++type Located = GenLocated SrcSpan+type RealLocated = GenLocated RealSrcSpan++mapLoc :: (a -> b) -> GenLocated l a -> GenLocated l b+mapLoc = fmap++unLoc :: HasSrcSpan a => a -> SrcSpanLess a+unLoc (dL->L _ e) = e++getLoc :: HasSrcSpan a => a -> SrcSpan+getLoc (dL->L l _) = l++noLoc :: HasSrcSpan a => SrcSpanLess a -> a+noLoc e = cL noSrcSpan e++mkGeneralLocated :: HasSrcSpan e => String -> SrcSpanLess e -> e+mkGeneralLocated s e = cL (mkGeneralSrcSpan (fsLit s)) e++combineLocs :: (HasSrcSpan a , HasSrcSpan b) => a -> b -> SrcSpan+combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)++-- | Combine locations from two 'Located' things and add them to a third thing+addCLoc :: (HasSrcSpan a , HasSrcSpan b , HasSrcSpan c) =>+           a -> b -> SrcSpanLess c -> c+addCLoc a b c = cL (combineSrcSpans (getLoc a) (getLoc b)) c++-- not clear whether to add a general Eq instance, but this is useful sometimes:++-- | Tests whether the two located things are equal+eqLocated :: (HasSrcSpan a , Eq (SrcSpanLess a)) => a -> a -> Bool+eqLocated a b = unLoc a == unLoc b++-- not clear whether to add a general Ord instance, but this is useful sometimes:++-- | Tests the ordering of the two located things+cmpLocated :: (HasSrcSpan a , Ord (SrcSpanLess a)) => a -> a -> Ordering+cmpLocated a b = unLoc a `compare` unLoc b++instance (Outputable l, Outputable e) => Outputable (GenLocated l e) where+  ppr (L l e) = -- TODO: We can't do this since Located was refactored into+                -- GenLocated:+                -- Print spans without the file name etc+                -- ifPprDebug (braces (pprUserSpan False l))+                whenPprDebug (braces (ppr l))+             $$ ppr e++{-+************************************************************************+*                                                                      *+\subsection{Ordering SrcSpans for InteractiveUI}+*                                                                      *+************************************************************************+-}++-- | Alternative strategies for ordering 'SrcSpan's+leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering+rightmost            = flip compare+leftmost_smallest    = compare+leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)+                                `thenCmp`+                       (srcSpanEnd b `compare` srcSpanEnd a)++-- | Determines whether a span encloses a given line and column index+spans :: SrcSpan -> (Int, Int) -> Bool+spans (UnhelpfulSpan _) _ = panic "spans UnhelpfulSpan"+spans (RealSrcSpan span) (l,c) = realSrcSpanStart span <= loc && loc <= realSrcSpanEnd span+   where loc = mkRealSrcLoc (srcSpanFile span) l c++-- | Determines whether a span is enclosed by another one+isSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other+            -> SrcSpan -- ^ The span it may be enclosed by+            -> Bool+isSubspanOf src parent+    | srcSpanFileName_maybe parent /= srcSpanFileName_maybe src = False+    | otherwise = srcSpanStart parent <= srcSpanStart src &&+                  srcSpanEnd parent   >= srcSpanEnd src+++{-+************************************************************************+*                                                                      *+\subsection{HasSrcSpan Typeclass to Set/Get Source Location Spans}+*                                                                      *+************************************************************************+-}++{-+Note [HasSrcSpan Typeclass]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++To be able to uniformly set/get source location spans (of `SrcSpan`) in+syntactic entities (`HsSyn`), we use the typeclass `HasSrcSpan`.+More details can be found at the following wiki page+  ImplementingTreesThatGrow/HandlingSourceLocations++For most syntactic entities, the source location spans are stored in+a syntactic entity by a wapper constuctor (introduced by TTG's+new constructor extension), e.g., by `NewPat (WrapperPat sp pat)`+for a source location span `sp` and a pattern `pat`.+-}++-- | Determines the type of undecorated syntactic entities+-- For most syntactic entities `E`, where source location spans are+-- introduced by a wrapper construtor of the same syntactic entity,+-- we have `SrcSpanLess E = E`.+-- However, some syntactic entities have a different type compared to+-- a syntactic entity `e :: E` may have the type `Located E` when+-- decorated by wrapping it with `L sp e` for a source span `sp`.+type family SrcSpanLess a++-- | A typeclass to set/get SrcSpans+class HasSrcSpan a where+  -- | Composes a `SrcSpan` decoration with an undecorated syntactic+  --   entity to form its decorated variant+  composeSrcSpan   :: Located (SrcSpanLess a) -> a++  -- | Decomposes a decorated syntactic entity into its `SrcSpan`+  --   decoration and its undecorated variant+  decomposeSrcSpan :: a -> Located (SrcSpanLess a)+  {- laws:+       composeSrcSpan . decomposeSrcSpan = id+       decomposeSrcSpan . composeSrcSpan = id++     in other words, `HasSrcSpan` defines an iso relation between+     a `SrcSpan`-decorated syntactic entity and its undecorated variant+     (together with the `SrcSpan`).+  -}++type instance SrcSpanLess (GenLocated l e) = e+instance HasSrcSpan (Located a) where+  composeSrcSpan   = id+  decomposeSrcSpan = id+++-- | An abbreviated form of decomposeSrcSpan,+--   mainly to be used in ViewPatterns+dL :: HasSrcSpan a => a -> Located (SrcSpanLess a)+dL = decomposeSrcSpan++-- | An abbreviated form of composeSrcSpan,+--   mainly to replace the hardcoded `L`+cL :: HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a+cL sp e = composeSrcSpan (L sp e)++-- | A Pattern Synonym to Set/Get SrcSpans+pattern LL :: HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a+pattern LL sp e <- (dL->L sp e)+  where+        LL sp e = cL sp e++-- | Lifts a function of undecorated entities to one of decorated ones+onHasSrcSpan :: (HasSrcSpan a , HasSrcSpan b) =>+                (SrcSpanLess a -> SrcSpanLess b) -> a -> b+onHasSrcSpan f (dL->L l e) = cL l (f e)++liftL :: (HasSrcSpan a, HasSrcSpan b, Monad m) =>+         (SrcSpanLess a -> m (SrcSpanLess b)) -> a -> m b+liftL f (dL->L loc a) = do+  a' <- f a+  return $ cL loc a'+++getRealSrcSpan :: RealLocated a -> RealSrcSpan+getRealSrcSpan (L l _) = l++unRealSrcSpan :: RealLocated a -> a+unRealSrcSpan  (L _ e) = e
+ compiler/basicTypes/UniqSupply.hs view
@@ -0,0 +1,240 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}++{-# LANGUAGE CPP, UnboxedTuples #-}++module UniqSupply (+        -- * Main data type+        UniqSupply, -- Abstractly++        -- ** Operations on supplies+        uniqFromSupply, uniqsFromSupply, -- basic ops+        takeUniqFromSupply,++        mkSplitUniqSupply,+        splitUniqSupply, listSplitUniqSupply,+        splitUniqSupply3, splitUniqSupply4,++        -- * Unique supply monad and its abstraction+        UniqSM, MonadUnique(..), liftUs,++        -- ** Operations on the monad+        initUs, initUs_,+        lazyThenUs, lazyMapUs,+        getUniqueSupplyM3,++        -- * Set supply strategy+        initUniqSupply+  ) where++import GhcPrelude++import Unique+import Panic (panic)++import GHC.IO++import MonadUtils+import Control.Monad+import Data.Bits+import Data.Char+import Control.Monad.Fail as Fail++#include "Unique.h"++{-+************************************************************************+*                                                                      *+\subsection{Splittable Unique supply: @UniqSupply@}+*                                                                      *+************************************************************************+-}++-- | Unique Supply+--+-- A value of type 'UniqSupply' is unique, and it can+-- supply /one/ distinct 'Unique'.  Also, from the supply, one can+-- also manufacture an arbitrary number of further 'UniqueSupply' values,+-- which will be distinct from the first and from all others.+data UniqSupply+  = MkSplitUniqSupply {-# UNPACK #-} !Int -- make the Unique with this+                   UniqSupply UniqSupply+                                -- when split => these two supplies++mkSplitUniqSupply :: Char -> IO UniqSupply+-- ^ Create a unique supply out of thin air. The character given must+-- be distinct from those of all calls to this function in the compiler+-- for the values generated to be truly unique.++splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply)+-- ^ Build two 'UniqSupply' from a single one, each of which+-- can supply its own 'Unique'.+listSplitUniqSupply :: UniqSupply -> [UniqSupply]+-- ^ Create an infinite list of 'UniqSupply' from a single one+uniqFromSupply  :: UniqSupply -> Unique+-- ^ Obtain the 'Unique' from this particular 'UniqSupply'+uniqsFromSupply :: UniqSupply -> [Unique] -- Infinite+-- ^ Obtain an infinite list of 'Unique' that can be generated by constant splitting of the supply+takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)+-- ^ Obtain the 'Unique' from this particular 'UniqSupply', and a new supply++mkSplitUniqSupply c+  = case ord c `shiftL` uNIQUE_BITS of+     mask -> let+        -- here comes THE MAGIC:++        -- This is one of the most hammered bits in the whole compiler+        mk_supply+          -- NB: Use unsafeInterleaveIO for thread-safety.+          = unsafeInterleaveIO (+                genSym      >>= \ u ->+                mk_supply   >>= \ s1 ->+                mk_supply   >>= \ s2 ->+                return (MkSplitUniqSupply (mask .|. u) s1 s2)+            )+       in+       mk_supply++foreign import ccall unsafe "genSym" genSym :: IO Int+foreign import ccall unsafe "initGenSym" initUniqSupply :: Int -> Int -> IO ()++splitUniqSupply (MkSplitUniqSupply _ s1 s2) = (s1, s2)+listSplitUniqSupply  (MkSplitUniqSupply _ s1 s2) = s1 : listSplitUniqSupply s2++uniqFromSupply  (MkSplitUniqSupply n _ _)  = mkUniqueGrimily n+uniqsFromSupply (MkSplitUniqSupply n _ s2) = mkUniqueGrimily n : uniqsFromSupply s2+takeUniqFromSupply (MkSplitUniqSupply n s1 _) = (mkUniqueGrimily n, s1)++-- | Build three 'UniqSupply' from a single one,+-- each of which can supply its own unique+splitUniqSupply3 :: UniqSupply -> (UniqSupply, UniqSupply, UniqSupply)+splitUniqSupply3 us = (us1, us2, us3)+  where+    (us1, us') = splitUniqSupply us+    (us2, us3) = splitUniqSupply us'++-- | Build four 'UniqSupply' from a single one,+-- each of which can supply its own unique+splitUniqSupply4 :: UniqSupply -> (UniqSupply, UniqSupply, UniqSupply, UniqSupply)+splitUniqSupply4 us = (us1, us2, us3, us4)+  where+    (us1, us2, us') = splitUniqSupply3 us+    (us3, us4)      = splitUniqSupply us'++{-+************************************************************************+*                                                                      *+\subsubsection[UniqSupply-monad]{@UniqSupply@ monad: @UniqSM@}+*                                                                      *+************************************************************************+-}++-- | A monad which just gives the ability to obtain 'Unique's+newtype UniqSM result = USM { unUSM :: UniqSupply -> (# result, UniqSupply #) }++instance Monad UniqSM where+  (>>=) = thenUs+  (>>)  = (*>)++instance Functor UniqSM where+    fmap f (USM x) = USM (\us -> case x us of+                                 (# r, us' #) -> (# f r, us' #))++instance Applicative UniqSM where+    pure = returnUs+    (USM f) <*> (USM x) = USM $ \us -> case f us of+                            (# ff, us' #)  -> case x us' of+                              (# xx, us'' #) -> (# ff xx, us'' #)+    (*>) = thenUs_++-- TODO: try to get rid of this instance+instance Fail.MonadFail UniqSM where+    fail = panic++-- | Run the 'UniqSM' action, returning the final 'UniqSupply'+initUs :: UniqSupply -> UniqSM a -> (a, UniqSupply)+initUs init_us m = case unUSM m init_us of { (# r, us #) -> (r,us) }++-- | Run the 'UniqSM' action, discarding the final 'UniqSupply'+initUs_ :: UniqSupply -> UniqSM a -> a+initUs_ init_us m = case unUSM m init_us of { (# r, _ #) -> r }++{-# INLINE thenUs #-}+{-# INLINE lazyThenUs #-}+{-# INLINE returnUs #-}+{-# INLINE splitUniqSupply #-}++-- @thenUs@ is where we split the @UniqSupply@.++liftUSM :: UniqSM a -> UniqSupply -> (a, UniqSupply)+liftUSM (USM m) us = case m us of (# a, us' #) -> (a, us')++instance MonadFix UniqSM where+    mfix m = USM (\us -> let (r,us') = liftUSM (m r) us in (# r,us' #))++thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b+thenUs (USM expr) cont+  = USM (\us -> case (expr us) of+                   (# result, us' #) -> unUSM (cont result) us')++lazyThenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b+lazyThenUs expr cont+  = USM (\us -> let (result, us') = liftUSM expr us in unUSM (cont result) us')++thenUs_ :: UniqSM a -> UniqSM b -> UniqSM b+thenUs_ (USM expr) (USM cont)+  = USM (\us -> case (expr us) of { (# _, us' #) -> cont us' })++returnUs :: a -> UniqSM a+returnUs result = USM (\us -> (# result, us #))++getUs :: UniqSM UniqSupply+getUs = USM (\us -> case splitUniqSupply us of (us1,us2) -> (# us1, us2 #))++-- | A monad for generating unique identifiers+class Monad m => MonadUnique m where+    -- | Get a new UniqueSupply+    getUniqueSupplyM :: m UniqSupply+    -- | Get a new unique identifier+    getUniqueM  :: m Unique+    -- | Get an infinite list of new unique identifiers+    getUniquesM :: m [Unique]++    -- This default definition of getUniqueM, while correct, is not as+    -- efficient as it could be since it needlessly generates and throws away+    -- an extra Unique. For your instances consider providing an explicit+    -- definition for 'getUniqueM' which uses 'takeUniqFromSupply' directly.+    getUniqueM  = liftM uniqFromSupply  getUniqueSupplyM+    getUniquesM = liftM uniqsFromSupply getUniqueSupplyM++instance MonadUnique UniqSM where+    getUniqueSupplyM = getUs+    getUniqueM  = getUniqueUs+    getUniquesM = getUniquesUs++getUniqueSupplyM3 :: MonadUnique m => m (UniqSupply, UniqSupply, UniqSupply)+getUniqueSupplyM3 = liftM3 (,,) getUniqueSupplyM getUniqueSupplyM getUniqueSupplyM++liftUs :: MonadUnique m => UniqSM a -> m a+liftUs m = getUniqueSupplyM >>= return . flip initUs_ m++getUniqueUs :: UniqSM Unique+getUniqueUs = USM (\us -> case takeUniqFromSupply us of+                          (u,us') -> (# u, us' #))++getUniquesUs :: UniqSM [Unique]+getUniquesUs = USM (\us -> case splitUniqSupply us of+                           (us1,us2) -> (# uniqsFromSupply us1, us2 #))++-- {-# SPECIALIZE mapM          :: (a -> UniqSM b) -> [a] -> UniqSM [b] #-}+-- {-# SPECIALIZE mapAndUnzipM  :: (a -> UniqSM (b,c))   -> [a] -> UniqSM ([b],[c]) #-}+-- {-# SPECIALIZE mapAndUnzip3M :: (a -> UniqSM (b,c,d)) -> [a] -> UniqSM ([b],[c],[d]) #-}++lazyMapUs :: (a -> UniqSM b) -> [a] -> UniqSM [b]+lazyMapUs _ []     = returnUs []+lazyMapUs f (x:xs)+  = f x             `lazyThenUs` \ r  ->+    lazyMapUs f xs  `lazyThenUs` \ rs ->+    returnUs (r:rs)
+ compiler/basicTypes/Unique.hs view
@@ -0,0 +1,442 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+++@Uniques@ are used to distinguish entities in the compiler (@Ids@,+@Classes@, etc.) from each other.  Thus, @Uniques@ are the basic+comparison key in the compiler.++If there is any single operation that needs to be fast, it is @Unique@++comparison.  Unsurprisingly, there is quite a bit of huff-and-puff+directed to that end.++Some of the other hair in this code is to be able to use a+``splittable @UniqueSupply@'' if requested/possible (not standard+Haskell).+-}++{-# LANGUAGE CPP, BangPatterns, MagicHash #-}++module Unique (+        -- * Main data types+        Unique, Uniquable(..),+        uNIQUE_BITS,++        -- ** Constructors, destructors and operations on 'Unique's+        hasKey,++        pprUniqueAlways,++        mkUniqueGrimily,                -- Used in UniqSupply only!+        getKey,                         -- Used in Var, UniqFM, Name only!+        mkUnique, unpkUnique,           -- Used in BinIface only+        eqUnique, ltUnique,++        deriveUnique,                   -- Ditto+        newTagUnique,                   -- Used in CgCase+        initTyVarUnique,+        initExitJoinUnique,+        nonDetCmpUnique,+        isValidKnownKeyUnique,          -- Used in PrelInfo.knownKeyNamesOkay++        -- ** Making built-in uniques++        -- now all the built-in Uniques (and functions to make them)+        -- [the Oh-So-Wonderful Haskell module system wins again...]+        mkAlphaTyVarUnique,+        mkPrimOpIdUnique,+        mkPreludeMiscIdUnique, mkPreludeDataConUnique,+        mkPreludeTyConUnique, mkPreludeClassUnique,+        mkCoVarUnique,++        mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,+        mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,+        mkCostCentreUnique,++        mkBuiltinUnique,+        mkPseudoUniqueD,+        mkPseudoUniqueE,+        mkPseudoUniqueH,++        -- ** Deriving uniques+        -- *** From TyCon name uniques+        tyConRepNameUnique,+        -- *** From DataCon name uniques+        dataConWorkerUnique, dataConTyRepNameUnique+    ) where++#include "HsVersions.h"+#include "Unique.h"++import GhcPrelude++import BasicTypes+import FastString+import Outputable+import Util++-- just for implementing a fast [0,61) -> Char function+import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))++import Data.Char        ( chr, ord )+import Data.Bits++{-+************************************************************************+*                                                                      *+\subsection[Unique-type]{@Unique@ type and operations}+*                                                                      *+************************************************************************++The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.+Fast comparison is everything on @Uniques@:+-}++-- | Unique identifier.+--+-- The type of unique identifiers that are used in many places in GHC+-- for fast ordering and equality tests. You should generate these with+-- the functions from the 'UniqSupply' module+--+-- These are sometimes also referred to as \"keys\" in comments in GHC.+newtype Unique = MkUnique Int++{-# INLINE uNIQUE_BITS #-}+uNIQUE_BITS :: Int+uNIQUE_BITS = finiteBitSize (0 :: Int) - UNIQUE_TAG_BITS++{-+Now come the functions which construct uniques from their pieces, and vice versa.+The stuff about unique *supplies* is handled further down this module.+-}++unpkUnique      :: Unique -> (Char, Int)        -- The reverse++mkUniqueGrimily :: Int -> Unique                -- A trap-door for UniqSupply+getKey          :: Unique -> Int                -- for Var++incrUnique   :: Unique -> Unique+stepUnique   :: Unique -> Int -> Unique+deriveUnique :: Unique -> Int -> Unique+newTagUnique :: Unique -> Char -> Unique++mkUniqueGrimily = MkUnique++{-# INLINE getKey #-}+getKey (MkUnique x) = x++incrUnique (MkUnique i) = MkUnique (i + 1)+stepUnique (MkUnique i) n = MkUnique (i + n)++-- deriveUnique uses an 'X' tag so that it won't clash with+-- any of the uniques produced any other way+-- SPJ says: this looks terribly smelly to me!+deriveUnique (MkUnique i) delta = mkUnique 'X' (i + delta)++-- newTagUnique changes the "domain" of a unique to a different char+newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u++-- | How many bits are devoted to the unique index (as opposed to the class+-- character).+uniqueMask :: Int+uniqueMask = (1 `shiftL` uNIQUE_BITS) - 1++-- pop the Char in the top 8 bits of the Unique(Supply)++-- No 64-bit bugs here, as long as we have at least 32 bits. --JSM++-- and as long as the Char fits in 8 bits, which we assume anyway!++mkUnique :: Char -> Int -> Unique       -- Builds a unique from pieces+-- NOT EXPORTED, so that we can see all the Chars that+--               are used in this one module+mkUnique c i+  = MkUnique (tag .|. bits)+  where+    tag  = ord c `shiftL` uNIQUE_BITS+    bits = i .&. uniqueMask++unpkUnique (MkUnique u)+  = let+        -- as long as the Char may have its eighth bit set, we+        -- really do need the logical right-shift here!+        tag = chr (u `shiftR` uNIQUE_BITS)+        i   = u .&. uniqueMask+    in+    (tag, i)++-- | The interface file symbol-table encoding assumes that known-key uniques fit+-- in 30-bits; verify this.+--+-- See Note [Symbol table representation of names] in BinIface for details.+isValidKnownKeyUnique :: Unique -> Bool+isValidKnownKeyUnique u =+    case unpkUnique u of+      (c, x) -> ord c < 0xff && x <= (1 `shiftL` 22)++{-+************************************************************************+*                                                                      *+\subsection[Uniquable-class]{The @Uniquable@ class}+*                                                                      *+************************************************************************+-}++-- | Class of things that we can obtain a 'Unique' from+class Uniquable a where+    getUnique :: a -> Unique++hasKey          :: Uniquable a => a -> Unique -> Bool+x `hasKey` k    = getUnique x == k++instance Uniquable FastString where+ getUnique fs = mkUniqueGrimily (uniqueOfFS fs)++instance Uniquable Int where+ getUnique i = mkUniqueGrimily i++{-+************************************************************************+*                                                                      *+\subsection[Unique-instances]{Instance declarations for @Unique@}+*                                                                      *+************************************************************************++And the whole point (besides uniqueness) is fast equality.  We don't+use `deriving' because we want {\em precise} control of ordering+(equality on @Uniques@ is v common).+-}++-- Note [Unique Determinism]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~+-- The order of allocated @Uniques@ is not stable across rebuilds.+-- The main reason for that is that typechecking interface files pulls+-- @Uniques@ from @UniqSupply@ and the interface file for the module being+-- currently compiled can, but doesn't have to exist.+--+-- It gets more complicated if you take into account that the interface+-- files are loaded lazily and that building multiple files at once has to+-- work for any subset of interface files present. When you add parallelism+-- this makes @Uniques@ hopelessly random.+--+-- As such, to get deterministic builds, the order of the allocated+-- @Uniques@ should not affect the final result.+-- see also wiki/deterministic-builds+--+-- Note [Unique Determinism and code generation]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- The goal of the deterministic builds (wiki/deterministic-builds, #4012)+-- is to get ABI compatible binaries given the same inputs and environment.+-- The motivation behind that is that if the ABI doesn't change the+-- binaries can be safely reused.+-- Note that this is weaker than bit-for-bit identical binaries and getting+-- bit-for-bit identical binaries is not a goal for now.+-- This means that we don't care about nondeterminism that happens after+-- the interface files are created, in particular we don't care about+-- register allocation and code generation.+-- To track progress on bit-for-bit determinism see #12262.++eqUnique :: Unique -> Unique -> Bool+eqUnique (MkUnique u1) (MkUnique u2) = u1 == u2++ltUnique :: Unique -> Unique -> Bool+ltUnique (MkUnique u1) (MkUnique u2) = u1 < u2++-- Provided here to make it explicit at the call-site that it can+-- introduce non-determinism.+-- See Note [Unique Determinism]+-- See Note [No Ord for Unique]+nonDetCmpUnique :: Unique -> Unique -> Ordering+nonDetCmpUnique (MkUnique u1) (MkUnique u2)+  = if u1 == u2 then EQ else if u1 < u2 then LT else GT++{-+Note [No Ord for Unique]+~~~~~~~~~~~~~~~~~~~~~~~~~~+As explained in Note [Unique Determinism] the relative order of Uniques+is nondeterministic. To prevent from accidental use the Ord Unique+instance has been removed.+This makes it easier to maintain deterministic builds, but comes with some+drawbacks.+The biggest drawback is that Maps keyed by Uniques can't directly be used.+The alternatives are:++  1) Use UniqFM or UniqDFM, see Note [Deterministic UniqFM] to decide which+  2) Create a newtype wrapper based on Unique ordering where nondeterminism+     is controlled. See Module.ModuleEnv+  3) Change the algorithm to use nonDetCmpUnique and document why it's still+     deterministic+  4) Use TrieMap as done in CmmCommonBlockElim.groupByLabel+-}++instance Eq Unique where+    a == b = eqUnique a b+    a /= b = not (eqUnique a b)++instance Uniquable Unique where+    getUnique u = u++-- We do sometimes make strings with @Uniques@ in them:++showUnique :: Unique -> String+showUnique uniq+  = case unpkUnique uniq of+      (tag, u) -> finish_show tag u (iToBase62 u)++finish_show :: Char -> Int -> String -> String+finish_show 't' u _pp_u | u < 26+  = -- Special case to make v common tyvars, t1, t2, ...+    -- come out as a, b, ... (shorter, easier to read)+    [chr (ord 'a' + u)]+finish_show tag _ pp_u = tag : pp_u++pprUniqueAlways :: Unique -> SDoc+-- The "always" means regardless of -dsuppress-uniques+-- It replaces the old pprUnique to remind callers that+-- they should consider whether they want to consult+-- Opt_SuppressUniques+pprUniqueAlways u+  = text (showUnique u)++instance Outputable Unique where+    ppr = pprUniqueAlways++instance Show Unique where+    show uniq = showUnique uniq++{-+************************************************************************+*                                                                      *+\subsection[Utils-base62]{Base-62 numbers}+*                                                                      *+************************************************************************++A character-stingy way to read/write numbers (notably Uniques).+The ``62-its'' are \tr{[0-9a-zA-Z]}.  We don't handle negative Ints.+Code stolen from Lennart.+-}++iToBase62 :: Int -> String+iToBase62 n_+  = ASSERT(n_ >= 0) go n_ ""+  where+    go n cs | n < 62+            = let !c = chooseChar62 n in c : cs+            | otherwise+            = go q (c : cs) where (!q, r) = quotRem n 62+                                  !c = chooseChar62 r++    chooseChar62 :: Int -> Char+    {-# INLINE chooseChar62 #-}+    chooseChar62 (I# n) = C# (indexCharOffAddr# chars62 n)+    chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#++{-+************************************************************************+*                                                                      *+\subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}+*                                                                      *+************************************************************************++Allocation of unique supply characters:+        v,t,u : for renumbering value-, type- and usage- vars.+        B:   builtin+        C-E: pseudo uniques     (used in native-code generator)+        X:   uniques derived by deriveUnique+        _:   unifiable tyvars   (above)+        0-9: prelude things below+             (no numbers left any more..)+        ::   (prelude) parallel array data constructors++        other a-z: lower case chars for unique supplies.  Used so far:++        d       desugarer+        f       AbsC flattener+        g       SimplStg+        k       constraint tuple tycons+        m       constraint tuple datacons+        n       Native codegen+        r       Hsc name cache+        s       simplifier+        z       anonymous sums+-}++mkAlphaTyVarUnique     :: Int -> Unique+mkPreludeClassUnique   :: Int -> Unique+mkPreludeTyConUnique   :: Int -> Unique+mkPreludeDataConUnique :: Arity -> Unique+mkPrimOpIdUnique       :: Int -> Unique+mkPreludeMiscIdUnique  :: Int -> Unique+mkCoVarUnique          :: Int -> Unique++mkAlphaTyVarUnique   i = mkUnique '1' i+mkCoVarUnique        i = mkUnique 'g' i+mkPreludeClassUnique i = mkUnique '2' i++--------------------------------------------------+-- Wired-in type constructor keys occupy *two* slots:+--    * u: the TyCon itself+--    * u+1: the TyConRepName of the TyCon+mkPreludeTyConUnique i                = mkUnique '3' (2*i)++tyConRepNameUnique :: Unique -> Unique+tyConRepNameUnique  u = incrUnique u++-- Data constructor keys occupy *two* slots.  The first is used for the+-- data constructor itself and its wrapper function (the function that+-- evaluates arguments as necessary and calls the worker). The second is+-- used for the worker function (the function that builds the constructor+-- representation).++--------------------------------------------------+-- Wired-in data constructor keys occupy *three* slots:+--    * u: the DataCon itself+--    * u+1: its worker Id+--    * u+2: the TyConRepName of the promoted TyCon+-- Prelude data constructors are too simple to need wrappers.++mkPreludeDataConUnique i              = mkUnique '6' (3*i)    -- Must be alphabetic++--------------------------------------------------+dataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique+dataConWorkerUnique  u = incrUnique u+dataConTyRepNameUnique u = stepUnique u 2++--------------------------------------------------+mkPrimOpIdUnique op         = mkUnique '9' op+mkPreludeMiscIdUnique  i    = mkUnique '0' i++-- The "tyvar uniques" print specially nicely: a, b, c, etc.+-- See pprUnique for details++initTyVarUnique :: Unique+initTyVarUnique = mkUnique 't' 0++mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,+   mkBuiltinUnique :: Int -> Unique++mkBuiltinUnique i = mkUnique 'B' i+mkPseudoUniqueD i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs+mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs+mkPseudoUniqueH i = mkUnique 'H' i -- used in NCG spiller to create spill VirtualRegs++mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique+mkRegSingleUnique = mkUnique 'R'+mkRegSubUnique    = mkUnique 'S'+mkRegPairUnique   = mkUnique 'P'+mkRegClassUnique  = mkUnique 'L'++mkCostCentreUnique :: Int -> Unique+mkCostCentreUnique = mkUnique 'C'++mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique+-- See Note [The Unique of an OccName] in OccName+mkVarOccUnique  fs = mkUnique 'i' (uniqueOfFS fs)+mkDataOccUnique fs = mkUnique 'd' (uniqueOfFS fs)+mkTvOccUnique   fs = mkUnique 'v' (uniqueOfFS fs)+mkTcOccUnique   fs = mkUnique 'c' (uniqueOfFS fs)++initExitJoinUnique :: Unique+initExitJoinUnique = mkUnique 's' 0
+ compiler/basicTypes/Var.hs view
@@ -0,0 +1,755 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section{@Vars@: Variables}+-}++{-# LANGUAGE CPP, FlexibleContexts, MultiWayIf, FlexibleInstances, DeriveDataTypeable #-}++-- |+-- #name_types#+-- GHC uses several kinds of name internally:+--+-- * 'OccName.OccName': see "OccName#name_types"+--+-- * 'RdrName.RdrName': see "RdrName#name_types"+--+-- * 'Name.Name': see "Name#name_types"+--+-- * 'Id.Id': see "Id#name_types"+--+-- * 'Var.Var' is a synonym for the 'Id.Id' type but it may additionally+--   potentially contain type variables, which have a 'TyCoRep.Kind'+--   rather than a 'TyCoRep.Type' and only contain some extra+--   details during typechecking.+--+--   These 'Var.Var' names may either be global or local, see "Var#globalvslocal"+--+-- #globalvslocal#+-- Global 'Id's and 'Var's are those that are imported or correspond+--    to a data constructor, primitive operation, or record selectors.+-- Local 'Id's and 'Var's are those bound within an expression+--    (e.g. by a lambda) or at the top level of the module being compiled.++module Var (+        -- * The main data type and synonyms+        Var, CoVar, Id, NcId, DictId, DFunId, EvVar, EqVar, EvId, IpId, JoinId,+        TyVar, TcTyVar, TypeVar, KindVar, TKVar, TyCoVar,++        -- * In and Out variants+        InVar,  InCoVar,  InId,  InTyVar,+        OutVar, OutCoVar, OutId, OutTyVar,++        -- ** Taking 'Var's apart+        varName, varUnique, varType,++        -- ** Modifying 'Var's+        setVarName, setVarUnique, setVarType, updateVarType,+        updateVarTypeM,++        -- ** Constructing, taking apart, modifying 'Id's+        mkGlobalVar, mkLocalVar, mkExportedLocalVar, mkCoVar,+        idInfo, idDetails,+        lazySetIdInfo, setIdDetails, globaliseId,+        setIdExported, setIdNotExported,++        -- ** Predicates+        isId, isTyVar, isTcTyVar,+        isLocalVar, isLocalId, isCoVar, isNonCoVarId, isTyCoVar,+        isGlobalId, isExportedId,+        mustHaveLocalBinding,++        -- * ArgFlags+        ArgFlag(..), isVisibleArgFlag, isInvisibleArgFlag, sameVis,+        AnonArgFlag(..), ForallVisFlag(..), argToForallVisFlag,++        -- * TyVar's+        VarBndr(..), TyCoVarBinder, TyVarBinder,+        binderVar, binderVars, binderArgFlag, binderType,+        mkTyCoVarBinder, mkTyCoVarBinders,+        mkTyVarBinder, mkTyVarBinders,+        isTyVarBinder,++        -- ** Constructing TyVar's+        mkTyVar, mkTcTyVar,++        -- ** Taking 'TyVar's apart+        tyVarName, tyVarKind, tcTyVarDetails, setTcTyVarDetails,++        -- ** Modifying 'TyVar's+        setTyVarName, setTyVarUnique, setTyVarKind, updateTyVarKind,+        updateTyVarKindM,++        nonDetCmpVar++    ) where++#include "HsVersions.h"++import GhcPrelude++import {-# SOURCE #-}   TyCoRep( Type, Kind, pprKind )+import {-# SOURCE #-}   TcType( TcTyVarDetails, pprTcTyVarDetails, vanillaSkolemTv )+import {-# SOURCE #-}   IdInfo( IdDetails, IdInfo, coVarDetails, isCoVarDetails,+                                vanillaIdInfo, pprIdDetails )++import Name hiding (varName)+import Unique ( Uniquable, Unique, getKey, getUnique+              , mkUniqueGrimily, nonDetCmpUnique )+import Util+import Binary+import DynFlags+import Outputable++import Data.Data++{-+************************************************************************+*                                                                      *+                     Synonyms+*                                                                      *+************************************************************************+-- These synonyms are here and not in Id because otherwise we need a very+-- large number of SOURCE imports of Id.hs :-(+-}++-- | Identifier+type Id    = Var       -- A term-level identifier+                       --  predicate: isId++-- | Coercion Variable+type CoVar = Id        -- See Note [Evidence: EvIds and CoVars]+                       --   predicate: isCoVar++-- |+type NcId  = Id        -- A term-level (value) variable that is+                       -- /not/ an (unlifted) coercion+                       --    predicate: isNonCoVarId++-- | Type or kind Variable+type TyVar   = Var     -- Type *or* kind variable (historical)++-- | Type or Kind Variable+type TKVar   = Var     -- Type *or* kind variable (historical)++-- | Type variable that might be a metavariable+type TcTyVar = Var++-- | Type Variable+type TypeVar = Var     -- Definitely a type variable++-- | Kind Variable+type KindVar = Var     -- Definitely a kind variable+                       -- See Note [Kind and type variables]++-- See Note [Evidence: EvIds and CoVars]+-- | Evidence Identifier+type EvId   = Id        -- Term-level evidence: DictId, IpId, or EqVar++-- | Evidence Variable+type EvVar  = EvId      -- ...historical name for EvId++-- | Dictionary Function Identifier+type DFunId = Id        -- A dictionary function++-- | Dictionary Identifier+type DictId = EvId      -- A dictionary variable++-- | Implicit parameter Identifier+type IpId   = EvId      -- A term-level implicit parameter++-- | Equality Variable+type EqVar  = EvId      -- Boxed equality evidence+type JoinId = Id        -- A join variable++-- | Type or Coercion Variable+type TyCoVar = Id       -- Type, *or* coercion variable+                        --   predicate: isTyCoVar+++{- Many passes apply a substitution, and it's very handy to have type+   synonyms to remind us whether or not the substitution has been applied -}++type InVar      = Var+type InTyVar    = TyVar+type InCoVar    = CoVar+type InId       = Id+type OutVar     = Var+type OutTyVar   = TyVar+type OutCoVar   = CoVar+type OutId      = Id++++{- Note [Evidence: EvIds and CoVars]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+* An EvId (evidence Id) is a term-level evidence variable+  (dictionary, implicit parameter, or equality). Could be boxed or unboxed.++* DictId, IpId, and EqVar are synonyms when we know what kind of+  evidence we are talking about.  For example, an EqVar has type (t1 ~ t2).++* A CoVar is always an un-lifted coercion, of type (t1 ~# t2) or (t1 ~R# t2)++Note [Kind and type variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Before kind polymorphism, TyVar were used to mean type variables. Now+they are used to mean kind *or* type variables. KindVar is used when we+know for sure that it is a kind variable. In future, we might want to+go over the whole compiler code to use:+   - TKVar   to mean kind or type variables+   - TypeVar to mean         type variables only+   - KindVar to mean kind         variables+++************************************************************************+*                                                                      *+\subsection{The main data type declarations}+*                                                                      *+************************************************************************+++Every @Var@ has a @Unique@, to uniquify it and for fast comparison, a+@Type@, and an @IdInfo@ (non-essential info about it, e.g.,+strictness).  The essential info about different kinds of @Vars@ is+in its @VarDetails@.+-}++-- | Variable+--+-- Essentially a typed 'Name', that may also contain some additional information+-- about the 'Var' and its use sites.+data Var+  = TyVar {  -- Type and kind variables+             -- see Note [Kind and type variables]+        varName    :: !Name,+        realUnique :: {-# UNPACK #-} !Int,+                                     -- ^ Key for fast comparison+                                     -- Identical to the Unique in the name,+                                     -- cached here for speed+        varType    :: Kind           -- ^ The type or kind of the 'Var' in question+ }++  | TcTyVar {                           -- Used only during type inference+                                        -- Used for kind variables during+                                        -- inference, as well+        varName        :: !Name,+        realUnique     :: {-# UNPACK #-} !Int,+        varType        :: Kind,+        tc_tv_details  :: TcTyVarDetails+  }++  | Id {+        varName    :: !Name,+        realUnique :: {-# UNPACK #-} !Int,+        varType    :: Type,+        idScope    :: IdScope,+        id_details :: IdDetails,        -- Stable, doesn't change+        id_info    :: IdInfo }          -- Unstable, updated by simplifier++-- | Identifier Scope+data IdScope    -- See Note [GlobalId/LocalId]+  = GlobalId+  | LocalId ExportFlag++data ExportFlag   -- See Note [ExportFlag on binders]+  = NotExported   -- ^ Not exported: may be discarded as dead code.+  | Exported      -- ^ Exported: kept alive++{- Note [ExportFlag on binders]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+An ExportFlag of "Exported" on a top-level binder says "keep this+binding alive; do not drop it as dead code".  This transitively+keeps alive all the other top-level bindings that this binding refers+to.  This property is persisted all the way down the pipeline, so that+the binding will be compiled all the way to object code, and its+symbols will appear in the linker symbol table.++However, note that this use of "exported" is quite different to the+export list on a Haskell module.  Setting the ExportFlag on an Id does+/not/ mean that if you import the module (in Haskell source code) you+will see this Id.  Of course, things that appear in the export list+of the source Haskell module do indeed have their ExportFlag set.+But many other things, such as dictionary functions, are kept alive+by having their ExportFlag set, even though they are not exported+in the source-code sense.++We should probably use a different term for ExportFlag, like+KeepAlive.++Note [GlobalId/LocalId]+~~~~~~~~~~~~~~~~~~~~~~~+A GlobalId is+  * always a constant (top-level)+  * imported, or data constructor, or primop, or record selector+  * has a Unique that is globally unique across the whole+    GHC invocation (a single invocation may compile multiple modules)+  * never treated as a candidate by the free-variable finder;+        it's a constant!++A LocalId is+  * bound within an expression (lambda, case, local let(rec))+  * or defined at top level in the module being compiled+  * always treated as a candidate by the free-variable finder++After CoreTidy, top-level LocalIds are turned into GlobalIds+-}++instance Outputable Var where+  ppr var = sdocWithDynFlags $ \dflags ->+            getPprStyle $ \ppr_style ->+            if |  debugStyle ppr_style && (not (gopt Opt_SuppressVarKinds dflags))+                 -> parens (ppr (varName var) <+> ppr_debug var ppr_style <+>+                          dcolon <+> pprKind (tyVarKind var))+               |  otherwise+                 -> ppr (varName var) <> ppr_debug var ppr_style++ppr_debug :: Var -> PprStyle -> SDoc+ppr_debug (TyVar {}) sty+  | debugStyle sty = brackets (text "tv")+ppr_debug (TcTyVar {tc_tv_details = d}) sty+  | dumpStyle sty || debugStyle sty = brackets (pprTcTyVarDetails d)+ppr_debug (Id { idScope = s, id_details = d }) sty+  | debugStyle sty = brackets (ppr_id_scope s <> pprIdDetails d)+ppr_debug _ _ = empty++ppr_id_scope :: IdScope -> SDoc+ppr_id_scope GlobalId              = text "gid"+ppr_id_scope (LocalId Exported)    = text "lidx"+ppr_id_scope (LocalId NotExported) = text "lid"++instance NamedThing Var where+  getName = varName++instance Uniquable Var where+  getUnique = varUnique++instance Eq Var where+    a == b = realUnique a == realUnique b++instance Ord Var where+    a <= b = realUnique a <= realUnique b+    a <  b = realUnique a <  realUnique b+    a >= b = realUnique a >= realUnique b+    a >  b = realUnique a >  realUnique b+    a `compare` b = a `nonDetCmpVar` b++-- | Compare Vars by their Uniques.+-- This is what Ord Var does, provided here to make it explicit at the+-- call-site that it can introduce non-determinism.+-- See Note [Unique Determinism]+nonDetCmpVar :: Var -> Var -> Ordering+nonDetCmpVar a b = varUnique a `nonDetCmpUnique` varUnique b++instance Data Var where+  -- don't traverse?+  toConstr _   = abstractConstr "Var"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "Var"++instance HasOccName Var where+  occName = nameOccName . varName++varUnique :: Var -> Unique+varUnique var = mkUniqueGrimily (realUnique var)++setVarUnique :: Var -> Unique -> Var+setVarUnique var uniq+  = var { realUnique = getKey uniq,+          varName = setNameUnique (varName var) uniq }++setVarName :: Var -> Name -> Var+setVarName var new_name+  = var { realUnique = getKey (getUnique new_name),+          varName = new_name }++setVarType :: Id -> Type -> Id+setVarType id ty = id { varType = ty }++updateVarType :: (Type -> Type) -> Id -> Id+updateVarType f id = id { varType = f (varType id) }++updateVarTypeM :: Monad m => (Type -> m Type) -> Id -> m Id+updateVarTypeM f id = do { ty' <- f (varType id)+                         ; return (id { varType = ty' }) }++{- *********************************************************************+*                                                                      *+*                   ArgFlag+*                                                                      *+********************************************************************* -}++-- | Argument Flag+--+-- Is something required to appear in source Haskell ('Required'),+-- permitted by request ('Specified') (visible type application), or+-- prohibited entirely from appearing in source Haskell ('Inferred')?+-- See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep+data ArgFlag = Inferred | Specified | Required+  deriving (Eq, Ord, Data)+  -- (<) on ArgFlag means "is less visible than"++-- | Does this 'ArgFlag' classify an argument that is written in Haskell?+isVisibleArgFlag :: ArgFlag -> Bool+isVisibleArgFlag Required = True+isVisibleArgFlag _        = False++-- | Does this 'ArgFlag' classify an argument that is not written in Haskell?+isInvisibleArgFlag :: ArgFlag -> Bool+isInvisibleArgFlag = not . isVisibleArgFlag++-- | Do these denote the same level of visibility? 'Required'+-- arguments are visible, others are not. So this function+-- equates 'Specified' and 'Inferred'. Used for printing.+sameVis :: ArgFlag -> ArgFlag -> Bool+sameVis Required Required = True+sameVis Required _        = False+sameVis _        Required = False+sameVis _        _        = True++instance Outputable ArgFlag where+  ppr Required  = text "[req]"+  ppr Specified = text "[spec]"+  ppr Inferred  = text "[infrd]"++instance Binary ArgFlag where+  put_ bh Required  = putByte bh 0+  put_ bh Specified = putByte bh 1+  put_ bh Inferred  = putByte bh 2++  get bh = do+    h <- getByte bh+    case h of+      0 -> return Required+      1 -> return Specified+      _ -> return Inferred++-- | The non-dependent version of 'ArgFlag'.++-- Appears here partly so that it's together with its friend ArgFlag,+-- but also because it is used in IfaceType, rather early in the+-- compilation chain+-- See Note [AnonArgFlag vs. ForallVisFlag]+data AnonArgFlag+  = VisArg    -- ^ Used for @(->)@: an ordinary non-dependent arrow.+              --   The argument is visible in source code.+  | InvisArg  -- ^ Used for @(=>)@: a non-dependent predicate arrow.+              --   The argument is invisible in source code.+  deriving (Eq, Ord, Data)++instance Outputable AnonArgFlag where+  ppr VisArg   = text "[vis]"+  ppr InvisArg = text "[invis]"++instance Binary AnonArgFlag where+  put_ bh VisArg   = putByte bh 0+  put_ bh InvisArg = putByte bh 1++  get bh = do+    h <- getByte bh+    case h of+      0 -> return VisArg+      _ -> return InvisArg++-- | Is a @forall@ invisible (e.g., @forall a b. {...}@, with a dot) or visible+-- (e.g., @forall a b -> {...}@, with an arrow)?++-- See Note [AnonArgFlag vs. ForallVisFlag]+data ForallVisFlag+  = ForallVis   -- ^ A visible @forall@ (with an arrow)+  | ForallInvis -- ^ An invisible @forall@ (with a dot)+  deriving (Eq, Ord, Data)++instance Outputable ForallVisFlag where+  ppr f = text $ case f of+                   ForallVis   -> "ForallVis"+                   ForallInvis -> "ForallInvis"++-- | Convert an 'ArgFlag' to its corresponding 'ForallVisFlag'.+argToForallVisFlag :: ArgFlag -> ForallVisFlag+argToForallVisFlag Required  = ForallVis+argToForallVisFlag Specified = ForallInvis+argToForallVisFlag Inferred  = ForallInvis++{-+Note [AnonArgFlag vs. ForallVisFlag]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The AnonArgFlag and ForallVisFlag data types are quite similar at a first+glance:++  data AnonArgFlag   = VisArg    | InvisArg+  data ForallVisFlag = ForallVis | ForallInvis++Both data types keep track of visibility of some sort. AnonArgFlag tracks+whether a FunTy has a visible argument (->) or an invisible predicate argument+(=>). ForallVisFlag tracks whether a `forall` quantifier is visible+(forall a -> {...}) or invisible (forall a. {...}).++Given their similarities, it's tempting to want to combine these two data types+into one, but they actually represent distinct concepts. AnonArgFlag reflects a+property of *Core* types, whereas ForallVisFlag reflects a property of the GHC+AST. In other words, AnonArgFlag is all about internals, whereas ForallVisFlag+is all about surface syntax. Therefore, they are kept as separate data types.+-}++{- *********************************************************************+*                                                                      *+*                   VarBndr, TyCoVarBinder+*                                                                      *+********************************************************************* -}++-- Variable Binder+--+-- VarBndr is polymorphic in both var and visibility fields.+-- Currently there are six different uses of 'VarBndr':+--   * Var.TyVarBinder   = VarBndr TyVar ArgFlag+--   * Var.TyCoVarBinder = VarBndr TyCoVar ArgFlag+--   * TyCon.TyConBinder     = VarBndr TyVar TyConBndrVis+--   * TyCon.TyConTyCoBinder = VarBndr TyCoVar TyConBndrVis+--   * IfaceType.IfaceForAllBndr  = VarBndr IfaceBndr ArgFlag+--   * IfaceType.IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis+data VarBndr var argf = Bndr var argf+  deriving( Data )++-- | Variable Binder+--+-- A 'TyCoVarBinder' is the binder of a ForAllTy+-- It's convenient to define this synonym here rather its natural+-- home in TyCoRep, because it's used in DataCon.hs-boot+--+-- A 'TyVarBinder' is a binder with only TyVar+type TyCoVarBinder = VarBndr TyCoVar ArgFlag+type TyVarBinder   = VarBndr TyVar ArgFlag++binderVar :: VarBndr tv argf -> tv+binderVar (Bndr v _) = v++binderVars :: [VarBndr tv argf] -> [tv]+binderVars tvbs = map binderVar tvbs++binderArgFlag :: VarBndr tv argf -> argf+binderArgFlag (Bndr _ argf) = argf++binderType :: VarBndr TyCoVar argf -> Type+binderType (Bndr tv _) = varType tv++-- | Make a named binder+mkTyCoVarBinder :: ArgFlag -> TyCoVar -> TyCoVarBinder+mkTyCoVarBinder vis var = Bndr var vis++-- | Make a named binder+-- 'var' should be a type variable+mkTyVarBinder :: ArgFlag -> TyVar -> TyVarBinder+mkTyVarBinder vis var+  = ASSERT( isTyVar var )+    Bndr var vis++-- | Make many named binders+mkTyCoVarBinders :: ArgFlag -> [TyCoVar] -> [TyCoVarBinder]+mkTyCoVarBinders vis = map (mkTyCoVarBinder vis)++-- | Make many named binders+-- Input vars should be type variables+mkTyVarBinders :: ArgFlag -> [TyVar] -> [TyVarBinder]+mkTyVarBinders vis = map (mkTyVarBinder vis)++isTyVarBinder :: TyCoVarBinder -> Bool+isTyVarBinder (Bndr v _) = isTyVar v++instance Outputable tv => Outputable (VarBndr tv ArgFlag) where+  ppr (Bndr v Required)  = ppr v+  ppr (Bndr v Specified) = char '@' <> ppr v+  ppr (Bndr v Inferred)  = braces (ppr v)++instance (Binary tv, Binary vis) => Binary (VarBndr tv vis) where+  put_ bh (Bndr tv vis) = do { put_ bh tv; put_ bh vis }++  get bh = do { tv <- get bh; vis <- get bh; return (Bndr tv vis) }++instance NamedThing tv => NamedThing (VarBndr tv flag) where+  getName (Bndr tv _) = getName tv++{-+************************************************************************+*                                                                      *+*                 Type and kind variables                              *+*                                                                      *+************************************************************************+-}++tyVarName :: TyVar -> Name+tyVarName = varName++tyVarKind :: TyVar -> Kind+tyVarKind = varType++setTyVarUnique :: TyVar -> Unique -> TyVar+setTyVarUnique = setVarUnique++setTyVarName :: TyVar -> Name -> TyVar+setTyVarName   = setVarName++setTyVarKind :: TyVar -> Kind -> TyVar+setTyVarKind tv k = tv {varType = k}++updateTyVarKind :: (Kind -> Kind) -> TyVar -> TyVar+updateTyVarKind update tv = tv {varType = update (tyVarKind tv)}++updateTyVarKindM :: (Monad m) => (Kind -> m Kind) -> TyVar -> m TyVar+updateTyVarKindM update tv+  = do { k' <- update (tyVarKind tv)+       ; return $ tv {varType = k'} }++mkTyVar :: Name -> Kind -> TyVar+mkTyVar name kind = TyVar { varName    = name+                          , realUnique = getKey (nameUnique name)+                          , varType  = kind+                          }++mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar+mkTcTyVar name kind details+  = -- NB: 'kind' may be a coercion kind; cf, 'TcMType.newMetaCoVar'+    TcTyVar {   varName    = name,+                realUnique = getKey (nameUnique name),+                varType  = kind,+                tc_tv_details = details+        }++tcTyVarDetails :: TyVar -> TcTyVarDetails+-- See Note [TcTyVars in the typechecker] in TcType+tcTyVarDetails (TcTyVar { tc_tv_details = details }) = details+tcTyVarDetails (TyVar {})                            = vanillaSkolemTv+tcTyVarDetails var = pprPanic "tcTyVarDetails" (ppr var <+> dcolon <+> pprKind (tyVarKind var))++setTcTyVarDetails :: TyVar -> TcTyVarDetails -> TyVar+setTcTyVarDetails tv details = tv { tc_tv_details = details }++{-+%************************************************************************+%*                                                                      *+\subsection{Ids}+*                                                                      *+************************************************************************+-}++idInfo :: HasDebugCallStack => Id -> IdInfo+idInfo (Id { id_info = info }) = info+idInfo other                   = pprPanic "idInfo" (ppr other)++idDetails :: Id -> IdDetails+idDetails (Id { id_details = details }) = details+idDetails other                         = pprPanic "idDetails" (ppr other)++-- The next three have a 'Var' suffix even though they always build+-- Ids, because Id.hs uses 'mkGlobalId' etc with different types+mkGlobalVar :: IdDetails -> Name -> Type -> IdInfo -> Id+mkGlobalVar details name ty info+  = mk_id name ty GlobalId details info++mkLocalVar :: IdDetails -> Name -> Type -> IdInfo -> Id+mkLocalVar details name ty info+  = mk_id name ty (LocalId NotExported) details  info++mkCoVar :: Name -> Type -> CoVar+-- Coercion variables have no IdInfo+mkCoVar name ty = mk_id name ty (LocalId NotExported) coVarDetails vanillaIdInfo++-- | Exported 'Var's will not be removed as dead code+mkExportedLocalVar :: IdDetails -> Name -> Type -> IdInfo -> Id+mkExportedLocalVar details name ty info+  = mk_id name ty (LocalId Exported) details info++mk_id :: Name -> Type -> IdScope -> IdDetails -> IdInfo -> Id+mk_id name ty scope details info+  = Id { varName    = name,+         realUnique = getKey (nameUnique name),+         varType    = ty,+         idScope    = scope,+         id_details = details,+         id_info    = info }++-------------------+lazySetIdInfo :: Id -> IdInfo -> Var+lazySetIdInfo id info = id { id_info = info }++setIdDetails :: Id -> IdDetails -> Id+setIdDetails id details = id { id_details = details }++globaliseId :: Id -> Id+-- ^ If it's a local, make it global+globaliseId id = id { idScope = GlobalId }++setIdExported :: Id -> Id+-- ^ Exports the given local 'Id'. Can also be called on global 'Id's, such as data constructors+-- and class operations, which are born as global 'Id's and automatically exported+setIdExported id@(Id { idScope = LocalId {} }) = id { idScope = LocalId Exported }+setIdExported id@(Id { idScope = GlobalId })   = id+setIdExported tv                               = pprPanic "setIdExported" (ppr tv)++setIdNotExported :: Id -> Id+-- ^ We can only do this to LocalIds+setIdNotExported id = ASSERT( isLocalId id )+                      id { idScope = LocalId NotExported }++{-+************************************************************************+*                                                                      *+\subsection{Predicates over variables}+*                                                                      *+************************************************************************+-}++isTyVar :: Var -> Bool        -- True of both TyVar and TcTyVar+isTyVar (TyVar {})   = True+isTyVar (TcTyVar {}) = True+isTyVar _            = False++isTcTyVar :: Var -> Bool      -- True of TcTyVar only+isTcTyVar (TcTyVar {}) = True+isTcTyVar _            = False++isTyCoVar :: Var -> Bool+isTyCoVar v = isTyVar v || isCoVar v++isId :: Var -> Bool+isId (Id {}) = True+isId _       = False++isCoVar :: Var -> Bool+-- A coercion variable+isCoVar (Id { id_details = details }) = isCoVarDetails details+isCoVar _                             = False++isNonCoVarId :: Var -> Bool+-- A term variable (Id) that is /not/ a coercion variable+isNonCoVarId (Id { id_details = details }) = not (isCoVarDetails details)+isNonCoVarId _                             = False++isLocalId :: Var -> Bool+isLocalId (Id { idScope = LocalId _ }) = True+isLocalId _                            = False++-- | 'isLocalVar' returns @True@ for type variables as well as local 'Id's+-- These are the variables that we need to pay attention to when finding free+-- variables, or doing dependency analysis.+isLocalVar :: Var -> Bool+isLocalVar v = not (isGlobalId v)++isGlobalId :: Var -> Bool+isGlobalId (Id { idScope = GlobalId }) = True+isGlobalId _                           = False++-- | 'mustHaveLocalBinding' returns @True@ of 'Id's and 'TyVar's+-- that must have a binding in this module.  The converse+-- is not quite right: there are some global 'Id's that must have+-- bindings, such as record selectors.  But that doesn't matter,+-- because it's only used for assertions+mustHaveLocalBinding        :: Var -> Bool+mustHaveLocalBinding var = isLocalVar var++-- | 'isExportedIdVar' means \"don't throw this away\"+isExportedId :: Var -> Bool+isExportedId (Id { idScope = GlobalId })        = True+isExportedId (Id { idScope = LocalId Exported}) = True+isExportedId _ = False
+ compiler/basicTypes/Var.hs-boot view
@@ -0,0 +1,15 @@+-- Var.hs-boot is Imported (only) by TyCoRep.hs-boot+module Var where++import GhcPrelude ()+  -- We compile this module with -XNoImplicitPrelude (for some+  -- reason), so if there are no imports it does not seem to+  -- depend on anything.  But it does! We must, for example,+  -- compile GHC.Types in the ghc-prim library first.+  -- So this otherwise-unnecessary import tells the build system+  -- that this module depends on GhcPrelude, which ensures+  -- that GHC.Type is built first.++data ArgFlag+data AnonArgFlag+data Var
+ compiler/basicTypes/VarEnv.hs view
@@ -0,0 +1,606 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}++module VarEnv (+        -- * Var, Id and TyVar environments (maps)+        VarEnv, IdEnv, TyVarEnv, CoVarEnv, TyCoVarEnv,++        -- ** Manipulating these environments+        emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly,+        elemVarEnv, disjointVarEnv,+        extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnv_Directly,+        extendVarEnvList,+        plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C,+        plusVarEnvList, alterVarEnv,+        delVarEnvList, delVarEnv, delVarEnv_Directly,+        minusVarEnv, intersectsVarEnv,+        lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,+        mapVarEnv, zipVarEnv,+        modifyVarEnv, modifyVarEnv_Directly,+        isEmptyVarEnv,+        elemVarEnvByKey, lookupVarEnv_Directly,+        filterVarEnv, filterVarEnv_Directly, restrictVarEnv,+        partitionVarEnv,++        -- * Deterministic Var environments (maps)+        DVarEnv, DIdEnv, DTyVarEnv,++        -- ** Manipulating these environments+        emptyDVarEnv, mkDVarEnv,+        dVarEnvElts,+        extendDVarEnv, extendDVarEnv_C,+        extendDVarEnvList,+        lookupDVarEnv, elemDVarEnv,+        isEmptyDVarEnv, foldDVarEnv,+        mapDVarEnv, filterDVarEnv,+        modifyDVarEnv,+        alterDVarEnv,+        plusDVarEnv, plusDVarEnv_C,+        unitDVarEnv,+        delDVarEnv,+        delDVarEnvList,+        minusDVarEnv,+        partitionDVarEnv,+        anyDVarEnv,++        -- * The InScopeSet type+        InScopeSet,++        -- ** Operations on InScopeSets+        emptyInScopeSet, mkInScopeSet, delInScopeSet,+        extendInScopeSet, extendInScopeSetList, extendInScopeSetSet,+        getInScopeVars, lookupInScope, lookupInScope_Directly,+        unionInScope, elemInScopeSet, uniqAway,+        varSetInScope,++        -- * The RnEnv2 type+        RnEnv2,++        -- ** Operations on RnEnv2s+        mkRnEnv2, rnBndr2, rnBndrs2, rnBndr2_var,+        rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe,+        rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, rnSwap,+        delBndrL, delBndrR, delBndrsL, delBndrsR,+        addRnInScopeSet,+        rnEtaL, rnEtaR,+        rnInScope, rnInScopeSet, lookupRnInScope,+        rnEnvL, rnEnvR,++        -- * TidyEnv and its operation+        TidyEnv,+        emptyTidyEnv, mkEmptyTidyEnv+    ) where++import GhcPrelude++import OccName+import Var+import VarSet+import UniqSet+import UniqFM+import UniqDFM+import Unique+import Util+import Maybes+import Outputable++{-+************************************************************************+*                                                                      *+                In-scope sets+*                                                                      *+************************************************************************+-}++-- | A set of variables that are in scope at some point+-- "Secrets of the Glasgow Haskell Compiler inliner" Section 3.2 provides+-- the motivation for this abstraction.+data InScopeSet = InScope VarSet {-# UNPACK #-} !Int+        -- We store a VarSet here, but we use this for lookups rather than+        -- just membership tests. Typically the InScopeSet contains the+        -- canonical version of the variable (e.g. with an informative+        -- unfolding), so this lookup is useful.+        --+        -- The Int is a kind of hash-value used by uniqAway+        -- For example, it might be the size of the set+        -- INVARIANT: it's not zero; we use it as a multiplier in uniqAway++instance Outputable InScopeSet where+  ppr (InScope s _) =+    text "InScope" <+>+    braces (fsep (map (ppr . Var.varName) (nonDetEltsUniqSet s)))+                      -- It's OK to use nonDetEltsUniqSet here because it's+                      -- only for pretty printing+                      -- In-scope sets get big, and with -dppr-debug+                      -- the output is overwhelming++emptyInScopeSet :: InScopeSet+emptyInScopeSet = InScope emptyVarSet 1++getInScopeVars ::  InScopeSet -> VarSet+getInScopeVars (InScope vs _) = vs++mkInScopeSet :: VarSet -> InScopeSet+mkInScopeSet in_scope = InScope in_scope 1++extendInScopeSet :: InScopeSet -> Var -> InScopeSet+extendInScopeSet (InScope in_scope n) v+   = InScope (extendVarSet in_scope v) (n + 1)++extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet+extendInScopeSetList (InScope in_scope n) vs+   = InScope (foldl' (\s v -> extendVarSet s v) in_scope vs)+                    (n + length vs)++extendInScopeSetSet :: InScopeSet -> VarSet -> InScopeSet+extendInScopeSetSet (InScope in_scope n) vs+   = InScope (in_scope `unionVarSet` vs) (n + sizeUniqSet vs)++delInScopeSet :: InScopeSet -> Var -> InScopeSet+delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarSet` v) n++elemInScopeSet :: Var -> InScopeSet -> Bool+elemInScopeSet v (InScope in_scope _) = v `elemVarSet` in_scope++-- | Look up a variable the 'InScopeSet'.  This lets you map from+-- the variable's identity (unique) to its full value.+lookupInScope :: InScopeSet -> Var -> Maybe Var+lookupInScope (InScope in_scope _) v  = lookupVarSet in_scope v++lookupInScope_Directly :: InScopeSet -> Unique -> Maybe Var+lookupInScope_Directly (InScope in_scope _) uniq+  = lookupVarSet_Directly in_scope uniq++unionInScope :: InScopeSet -> InScopeSet -> InScopeSet+unionInScope (InScope s1 _) (InScope s2 n2)+  = InScope (s1 `unionVarSet` s2) n2++varSetInScope :: VarSet -> InScopeSet -> Bool+varSetInScope vars (InScope s1 _) = vars `subVarSet` s1++-- | @uniqAway in_scope v@ finds a unique that is not used in the+-- in-scope set, and gives that to v.+uniqAway :: InScopeSet -> Var -> Var+-- It starts with v's current unique, of course, in the hope that it won't+-- have to change, and thereafter uses a combination of that and the hash-code+-- found in the in-scope set+uniqAway in_scope var+  | var `elemInScopeSet` in_scope = uniqAway' in_scope var      -- Make a new one+  | otherwise                     = var                         -- Nothing to do++uniqAway' :: InScopeSet -> Var -> Var+-- This one *always* makes up a new variable+uniqAway' (InScope set n) var+  = try 1+  where+    orig_unique = getUnique var+    try k+          | debugIsOn && (k > 1000)+          = pprPanic "uniqAway loop:" msg+          | uniq `elemVarSetByKey` set = try (k + 1)+          | k > 3+          = pprTraceDebug "uniqAway:" msg+            setVarUnique var uniq+          | otherwise = setVarUnique var uniq+          where+            msg  = ppr k <+> text "tries" <+> ppr var <+> int n+            uniq = deriveUnique orig_unique (n * k)++{-+************************************************************************+*                                                                      *+                Dual renaming+*                                                                      *+************************************************************************+-}++-- | Rename Environment 2+--+-- When we are comparing (or matching) types or terms, we are faced with+-- \"going under\" corresponding binders.  E.g. when comparing:+--+-- > \x. e1     ~   \y. e2+--+-- Basically we want to rename [@x@ -> @y@] or [@y@ -> @x@], but there are lots of+-- things we must be careful of.  In particular, @x@ might be free in @e2@, or+-- y in @e1@.  So the idea is that we come up with a fresh binder that is free+-- in neither, and rename @x@ and @y@ respectively.  That means we must maintain:+--+-- 1. A renaming for the left-hand expression+--+-- 2. A renaming for the right-hand expressions+--+-- 3. An in-scope set+--+-- Furthermore, when matching, we want to be able to have an 'occurs check',+-- to prevent:+--+-- > \x. f   ~   \y. y+--+-- matching with [@f@ -> @y@].  So for each expression we want to know that set of+-- locally-bound variables. That is precisely the domain of the mappings 1.+-- and 2., but we must ensure that we always extend the mappings as we go in.+--+-- All of this information is bundled up in the 'RnEnv2'+data RnEnv2+  = RV2 { envL     :: VarEnv Var        -- Renaming for Left term+        , envR     :: VarEnv Var        -- Renaming for Right term+        , in_scope :: InScopeSet }      -- In scope in left or right terms++-- The renamings envL and envR are *guaranteed* to contain a binding+-- for every variable bound as we go into the term, even if it is not+-- renamed.  That way we can ask what variables are locally bound+-- (inRnEnvL, inRnEnvR)++mkRnEnv2 :: InScopeSet -> RnEnv2+mkRnEnv2 vars = RV2     { envL     = emptyVarEnv+                        , envR     = emptyVarEnv+                        , in_scope = vars }++addRnInScopeSet :: RnEnv2 -> VarSet -> RnEnv2+addRnInScopeSet env vs+  | isEmptyVarSet vs = env+  | otherwise        = env { in_scope = extendInScopeSetSet (in_scope env) vs }++rnInScope :: Var -> RnEnv2 -> Bool+rnInScope x env = x `elemInScopeSet` in_scope env++rnInScopeSet :: RnEnv2 -> InScopeSet+rnInScopeSet = in_scope++-- | Retrieve the left mapping+rnEnvL :: RnEnv2 -> VarEnv Var+rnEnvL = envL++-- | Retrieve the right mapping+rnEnvR :: RnEnv2 -> VarEnv Var+rnEnvR = envR++rnBndrs2 :: RnEnv2 -> [Var] -> [Var] -> RnEnv2+-- ^ Applies 'rnBndr2' to several variables: the two variable lists must be of equal length+rnBndrs2 env bsL bsR = foldl2 rnBndr2 env bsL bsR++rnBndr2 :: RnEnv2 -> Var -> Var -> RnEnv2+-- ^ @rnBndr2 env bL bR@ goes under a binder @bL@ in the Left term,+--                       and binder @bR@ in the Right term.+-- It finds a new binder, @new_b@,+-- and returns an environment mapping @bL -> new_b@ and @bR -> new_b@+rnBndr2 env bL bR = fst $ rnBndr2_var env bL bR++rnBndr2_var :: RnEnv2 -> Var -> Var -> (RnEnv2, Var)+-- ^ Similar to 'rnBndr2' but returns the new variable as well as the+-- new environment+rnBndr2_var (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL bR+  = (RV2 { envL            = extendVarEnv envL bL new_b   -- See Note+         , envR            = extendVarEnv envR bR new_b   -- [Rebinding]+         , in_scope = extendInScopeSet in_scope new_b }, new_b)+  where+        -- Find a new binder not in scope in either term+    new_b | not (bL `elemInScopeSet` in_scope) = bL+          | not (bR `elemInScopeSet` in_scope) = bR+          | otherwise                          = uniqAway' in_scope bL++        -- Note [Rebinding]+        -- If the new var is the same as the old one, note that+        -- the extendVarEnv *deletes* any current renaming+        -- E.g.   (\x. \x. ...)  ~  (\y. \z. ...)+        --+        --   Inside \x  \y      { [x->y], [y->y],       {y} }+        --       \x  \z         { [x->x], [y->y, z->x], {y,x} }++rnBndrL :: RnEnv2 -> Var -> (RnEnv2, Var)+-- ^ Similar to 'rnBndr2' but used when there's a binder on the left+-- side only.+rnBndrL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL+  = (RV2 { envL     = extendVarEnv envL bL new_b+         , envR     = envR+         , in_scope = extendInScopeSet in_scope new_b }, new_b)+  where+    new_b = uniqAway in_scope bL++rnBndrR :: RnEnv2 -> Var -> (RnEnv2, Var)+-- ^ Similar to 'rnBndr2' but used when there's a binder on the right+-- side only.+rnBndrR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR+  = (RV2 { envR     = extendVarEnv envR bR new_b+         , envL     = envL+         , in_scope = extendInScopeSet in_scope new_b }, new_b)+  where+    new_b = uniqAway in_scope bR++rnEtaL :: RnEnv2 -> Var -> (RnEnv2, Var)+-- ^ Similar to 'rnBndrL' but used for eta expansion+-- See Note [Eta expansion]+rnEtaL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL+  = (RV2 { envL     = extendVarEnv envL bL new_b+         , envR     = extendVarEnv envR new_b new_b     -- Note [Eta expansion]+         , in_scope = extendInScopeSet in_scope new_b }, new_b)+  where+    new_b = uniqAway in_scope bL++rnEtaR :: RnEnv2 -> Var -> (RnEnv2, Var)+-- ^ Similar to 'rnBndr2' but used for eta expansion+-- See Note [Eta expansion]+rnEtaR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR+  = (RV2 { envL     = extendVarEnv envL new_b new_b     -- Note [Eta expansion]+         , envR     = extendVarEnv envR bR new_b+         , in_scope = extendInScopeSet in_scope new_b }, new_b)+  where+    new_b = uniqAway in_scope bR++delBndrL, delBndrR :: RnEnv2 -> Var -> RnEnv2+delBndrL rn@(RV2 { envL = env, in_scope = in_scope }) v+  = rn { envL = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }+delBndrR rn@(RV2 { envR = env, in_scope = in_scope }) v+  = rn { envR = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }++delBndrsL, delBndrsR :: RnEnv2 -> [Var] -> RnEnv2+delBndrsL rn@(RV2 { envL = env, in_scope = in_scope }) v+  = rn { envL = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }+delBndrsR rn@(RV2 { envR = env, in_scope = in_scope }) v+  = rn { envR = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }++rnOccL, rnOccR :: RnEnv2 -> Var -> Var+-- ^ Look up the renaming of an occurrence in the left or right term+rnOccL (RV2 { envL = env }) v = lookupVarEnv env v `orElse` v+rnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v++rnOccL_maybe, rnOccR_maybe :: RnEnv2 -> Var -> Maybe Var+-- ^ Look up the renaming of an occurrence in the left or right term+rnOccL_maybe (RV2 { envL = env }) v = lookupVarEnv env v+rnOccR_maybe (RV2 { envR = env }) v = lookupVarEnv env v++inRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool+-- ^ Tells whether a variable is locally bound+inRnEnvL (RV2 { envL = env }) v = v `elemVarEnv` env+inRnEnvR (RV2 { envR = env }) v = v `elemVarEnv` env++lookupRnInScope :: RnEnv2 -> Var -> Var+lookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v++nukeRnEnvL, nukeRnEnvR :: RnEnv2 -> RnEnv2+-- ^ Wipe the left or right side renaming+nukeRnEnvL env = env { envL = emptyVarEnv }+nukeRnEnvR env = env { envR = emptyVarEnv }++rnSwap :: RnEnv2 -> RnEnv2+-- ^ swap the meaning of left and right+rnSwap (RV2 { envL = envL, envR = envR, in_scope = in_scope })+  = RV2 { envL = envR, envR = envL, in_scope = in_scope }++{-+Note [Eta expansion]+~~~~~~~~~~~~~~~~~~~~+When matching+     (\x.M) ~ N+we rename x to x' with, where x' is not in scope in+either term.  Then we want to behave as if we'd seen+     (\x'.M) ~ (\x'.N x')+Since x' isn't in scope in N, the form (\x'. N x') doesn't+capture any variables in N.  But we must nevertheless extend+the envR with a binding [x' -> x'], to support the occurs check.+For example, if we don't do this, we can get silly matches like+        forall a.  (\y.a)  ~   v+succeeding with [a -> v y], which is bogus of course.+++************************************************************************+*                                                                      *+                Tidying+*                                                                      *+************************************************************************+-}++-- | Tidy Environment+--+-- When tidying up print names, we keep a mapping of in-scope occ-names+-- (the 'TidyOccEnv') and a Var-to-Var of the current renamings+type TidyEnv = (TidyOccEnv, VarEnv Var)++emptyTidyEnv :: TidyEnv+emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)++mkEmptyTidyEnv :: TidyOccEnv -> TidyEnv+mkEmptyTidyEnv occ_env = (occ_env, emptyVarEnv)++{-+************************************************************************+*                                                                      *+\subsection{@VarEnv@s}+*                                                                      *+************************************************************************+-}++-- | Variable Environment+type VarEnv elt     = UniqFM elt++-- | Identifier Environment+type IdEnv elt      = VarEnv elt++-- | Type Variable Environment+type TyVarEnv elt   = VarEnv elt++-- | Type or Coercion Variable Environment+type TyCoVarEnv elt = VarEnv elt++-- | Coercion Variable Environment+type CoVarEnv elt   = VarEnv elt++emptyVarEnv       :: VarEnv a+mkVarEnv          :: [(Var, a)] -> VarEnv a+mkVarEnv_Directly :: [(Unique, a)] -> VarEnv a+zipVarEnv         :: [Var] -> [a] -> VarEnv a+unitVarEnv        :: Var -> a -> VarEnv a+alterVarEnv       :: (Maybe a -> Maybe a) -> VarEnv a -> Var -> VarEnv a+extendVarEnv      :: VarEnv a -> Var -> a -> VarEnv a+extendVarEnv_C    :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a+extendVarEnv_Acc  :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b+extendVarEnv_Directly :: VarEnv a -> Unique -> a -> VarEnv a+plusVarEnv        :: VarEnv a -> VarEnv a -> VarEnv a+plusVarEnvList    :: [VarEnv a] -> VarEnv a+extendVarEnvList  :: VarEnv a -> [(Var, a)] -> VarEnv a++lookupVarEnv_Directly :: VarEnv a -> Unique -> Maybe a+filterVarEnv_Directly :: (Unique -> a -> Bool) -> VarEnv a -> VarEnv a+delVarEnv_Directly    :: VarEnv a -> Unique -> VarEnv a+partitionVarEnv   :: (a -> Bool) -> VarEnv a -> (VarEnv a, VarEnv a)+restrictVarEnv    :: VarEnv a -> VarSet -> VarEnv a+delVarEnvList     :: VarEnv a -> [Var] -> VarEnv a+delVarEnv         :: VarEnv a -> Var -> VarEnv a+minusVarEnv       :: VarEnv a -> VarEnv b -> VarEnv a+intersectsVarEnv  :: VarEnv a -> VarEnv a -> Bool+plusVarEnv_C      :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a+plusVarEnv_CD     :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a+plusMaybeVarEnv_C :: (a -> a -> Maybe a) -> VarEnv a -> VarEnv a -> VarEnv a+mapVarEnv         :: (a -> b) -> VarEnv a -> VarEnv b+modifyVarEnv      :: (a -> a) -> VarEnv a -> Var -> VarEnv a++isEmptyVarEnv     :: VarEnv a -> Bool+lookupVarEnv      :: VarEnv a -> Var -> Maybe a+filterVarEnv      :: (a -> Bool) -> VarEnv a -> VarEnv a+lookupVarEnv_NF   :: VarEnv a -> Var -> a+lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a+elemVarEnv        :: Var -> VarEnv a -> Bool+elemVarEnvByKey   :: Unique -> VarEnv a -> Bool+disjointVarEnv    :: VarEnv a -> VarEnv a -> Bool++elemVarEnv       = elemUFM+elemVarEnvByKey  = elemUFM_Directly+disjointVarEnv   = disjointUFM+alterVarEnv      = alterUFM+extendVarEnv     = addToUFM+extendVarEnv_C   = addToUFM_C+extendVarEnv_Acc = addToUFM_Acc+extendVarEnv_Directly = addToUFM_Directly+extendVarEnvList = addListToUFM+plusVarEnv_C     = plusUFM_C+plusVarEnv_CD    = plusUFM_CD+plusMaybeVarEnv_C = plusMaybeUFM_C+delVarEnvList    = delListFromUFM+delVarEnv        = delFromUFM+minusVarEnv      = minusUFM+intersectsVarEnv e1 e2 = not (isEmptyVarEnv (e1 `intersectUFM` e2))+plusVarEnv       = plusUFM+plusVarEnvList   = plusUFMList+lookupVarEnv     = lookupUFM+filterVarEnv     = filterUFM+lookupWithDefaultVarEnv = lookupWithDefaultUFM+mapVarEnv        = mapUFM+mkVarEnv         = listToUFM+mkVarEnv_Directly= listToUFM_Directly+emptyVarEnv      = emptyUFM+unitVarEnv       = unitUFM+isEmptyVarEnv    = isNullUFM+lookupVarEnv_Directly = lookupUFM_Directly+filterVarEnv_Directly = filterUFM_Directly+delVarEnv_Directly    = delFromUFM_Directly+partitionVarEnv       = partitionUFM++restrictVarEnv env vs = filterVarEnv_Directly keep env+  where+    keep u _ = u `elemVarSetByKey` vs++zipVarEnv tyvars tys   = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)+lookupVarEnv_NF env id = case lookupVarEnv env id of+                         Just xx -> xx+                         Nothing -> panic "lookupVarEnv_NF: Nothing"++{-+@modifyVarEnv@: Look up a thing in the VarEnv,+then mash it with the modify function, and put it back.+-}++modifyVarEnv mangle_fn env key+  = case (lookupVarEnv env key) of+      Nothing -> env+      Just xx -> extendVarEnv env key (mangle_fn xx)++modifyVarEnv_Directly :: (a -> a) -> UniqFM a -> Unique -> UniqFM a+modifyVarEnv_Directly mangle_fn env key+  = case (lookupUFM_Directly env key) of+      Nothing -> env+      Just xx -> addToUFM_Directly env key (mangle_fn xx)++-- Deterministic VarEnv+-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need+-- DVarEnv.++-- | Deterministic Variable Environment+type DVarEnv elt = UniqDFM elt++-- | Deterministic Identifier Environment+type DIdEnv elt = DVarEnv elt++-- | Deterministic Type Variable Environment+type DTyVarEnv elt = DVarEnv elt++emptyDVarEnv :: DVarEnv a+emptyDVarEnv = emptyUDFM++dVarEnvElts :: DVarEnv a -> [a]+dVarEnvElts = eltsUDFM++mkDVarEnv :: [(Var, a)] -> DVarEnv a+mkDVarEnv = listToUDFM++extendDVarEnv :: DVarEnv a -> Var -> a -> DVarEnv a+extendDVarEnv = addToUDFM++minusDVarEnv :: DVarEnv a -> DVarEnv a' -> DVarEnv a+minusDVarEnv = minusUDFM++lookupDVarEnv :: DVarEnv a -> Var -> Maybe a+lookupDVarEnv = lookupUDFM++foldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b+foldDVarEnv = foldUDFM++mapDVarEnv :: (a -> b) -> DVarEnv a -> DVarEnv b+mapDVarEnv = mapUDFM++filterDVarEnv      :: (a -> Bool) -> DVarEnv a -> DVarEnv a+filterDVarEnv = filterUDFM++alterDVarEnv :: (Maybe a -> Maybe a) -> DVarEnv a -> Var -> DVarEnv a+alterDVarEnv = alterUDFM++plusDVarEnv :: DVarEnv a -> DVarEnv a -> DVarEnv a+plusDVarEnv = plusUDFM++plusDVarEnv_C :: (a -> a -> a) -> DVarEnv a -> DVarEnv a -> DVarEnv a+plusDVarEnv_C = plusUDFM_C++unitDVarEnv :: Var -> a -> DVarEnv a+unitDVarEnv = unitUDFM++delDVarEnv :: DVarEnv a -> Var -> DVarEnv a+delDVarEnv = delFromUDFM++delDVarEnvList :: DVarEnv a -> [Var] -> DVarEnv a+delDVarEnvList = delListFromUDFM++isEmptyDVarEnv :: DVarEnv a -> Bool+isEmptyDVarEnv = isNullUDFM++elemDVarEnv :: Var -> DVarEnv a -> Bool+elemDVarEnv = elemUDFM++extendDVarEnv_C :: (a -> a -> a) -> DVarEnv a -> Var -> a -> DVarEnv a+extendDVarEnv_C = addToUDFM_C++modifyDVarEnv :: (a -> a) -> DVarEnv a -> Var -> DVarEnv a+modifyDVarEnv mangle_fn env key+  = case (lookupDVarEnv env key) of+      Nothing -> env+      Just xx -> extendDVarEnv env key (mangle_fn xx)++partitionDVarEnv :: (a -> Bool) -> DVarEnv a -> (DVarEnv a, DVarEnv a)+partitionDVarEnv = partitionUDFM++extendDVarEnvList :: DVarEnv a -> [(Var, a)] -> DVarEnv a+extendDVarEnvList = addListToUDFM++anyDVarEnv :: (a -> Bool) -> DVarEnv a -> Bool+anyDVarEnv = anyUDFM
+ compiler/basicTypes/VarSet.hs view
@@ -0,0 +1,350 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}++{-# LANGUAGE CPP #-}++module VarSet (+        -- * Var, Id and TyVar set types+        VarSet, IdSet, TyVarSet, CoVarSet, TyCoVarSet,++        -- ** Manipulating these sets+        emptyVarSet, unitVarSet, mkVarSet,+        extendVarSet, extendVarSetList,+        elemVarSet, subVarSet,+        unionVarSet, unionVarSets, mapUnionVarSet,+        intersectVarSet, intersectsVarSet, disjointVarSet,+        isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,+        minusVarSet, filterVarSet, mapVarSet,+        anyVarSet, allVarSet,+        transCloVarSet, fixVarSet,+        lookupVarSet_Directly, lookupVarSet, lookupVarSetByName,+        sizeVarSet, seqVarSet,+        elemVarSetByKey, partitionVarSet,+        pluralVarSet, pprVarSet,++        -- * Deterministic Var set types+        DVarSet, DIdSet, DTyVarSet, DTyCoVarSet,++        -- ** Manipulating these sets+        emptyDVarSet, unitDVarSet, mkDVarSet,+        extendDVarSet, extendDVarSetList,+        elemDVarSet, dVarSetElems, subDVarSet,+        unionDVarSet, unionDVarSets, mapUnionDVarSet,+        intersectDVarSet, dVarSetIntersectVarSet,+        intersectsDVarSet, disjointDVarSet,+        isEmptyDVarSet, delDVarSet, delDVarSetList,+        minusDVarSet, foldDVarSet, filterDVarSet, mapDVarSet,+        dVarSetMinusVarSet, anyDVarSet, allDVarSet,+        transCloDVarSet,+        sizeDVarSet, seqDVarSet,+        partitionDVarSet,+        dVarSetToVarSet,+    ) where++#include "HsVersions.h"++import GhcPrelude++import Var      ( Var, TyVar, CoVar, TyCoVar, Id )+import Unique+import Name     ( Name )+import UniqSet+import UniqDSet+import UniqFM( disjointUFM, pluralUFM, pprUFM )+import UniqDFM( disjointUDFM, udfmToUfm, anyUDFM, allUDFM )+import Outputable (SDoc)++-- | A non-deterministic Variable Set+--+-- A non-deterministic set of variables.+-- See Note [Deterministic UniqFM] in UniqDFM for explanation why it's not+-- deterministic and why it matters. Use DVarSet if the set eventually+-- gets converted into a list or folded over in a way where the order+-- changes the generated code, for example when abstracting variables.+type VarSet       = UniqSet Var++-- | Identifier Set+type IdSet        = UniqSet Id++-- | Type Variable Set+type TyVarSet     = UniqSet TyVar++-- | Coercion Variable Set+type CoVarSet     = UniqSet CoVar++-- | Type or Coercion Variable Set+type TyCoVarSet   = UniqSet TyCoVar++emptyVarSet     :: VarSet+intersectVarSet :: VarSet -> VarSet -> VarSet+unionVarSet     :: VarSet -> VarSet -> VarSet+unionVarSets    :: [VarSet] -> VarSet++mapUnionVarSet  :: (a -> VarSet) -> [a] -> VarSet+-- ^ map the function over the list, and union the results++unitVarSet      :: Var -> VarSet+extendVarSet    :: VarSet -> Var -> VarSet+extendVarSetList:: VarSet -> [Var] -> VarSet+elemVarSet      :: Var -> VarSet -> Bool+delVarSet       :: VarSet -> Var -> VarSet+delVarSetList   :: VarSet -> [Var] -> VarSet+minusVarSet     :: VarSet -> VarSet -> VarSet+isEmptyVarSet   :: VarSet -> Bool+mkVarSet        :: [Var] -> VarSet+lookupVarSet_Directly :: VarSet -> Unique -> Maybe Var+lookupVarSet    :: VarSet -> Var -> Maybe Var+                        -- Returns the set element, which may be+                        -- (==) to the argument, but not the same as+lookupVarSetByName :: VarSet -> Name -> Maybe Var+sizeVarSet      :: VarSet -> Int+filterVarSet    :: (Var -> Bool) -> VarSet -> VarSet++delVarSetByKey  :: VarSet -> Unique -> VarSet+elemVarSetByKey :: Unique -> VarSet -> Bool+partitionVarSet :: (Var -> Bool) -> VarSet -> (VarSet, VarSet)++emptyVarSet     = emptyUniqSet+unitVarSet      = unitUniqSet+extendVarSet    = addOneToUniqSet+extendVarSetList= addListToUniqSet+intersectVarSet = intersectUniqSets++intersectsVarSet:: VarSet -> VarSet -> Bool     -- True if non-empty intersection+disjointVarSet  :: VarSet -> VarSet -> Bool     -- True if empty intersection+subVarSet       :: VarSet -> VarSet -> Bool     -- True if first arg is subset of second+        -- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty;+        -- ditto disjointVarSet, subVarSet++unionVarSet     = unionUniqSets+unionVarSets    = unionManyUniqSets+elemVarSet      = elementOfUniqSet+minusVarSet     = minusUniqSet+delVarSet       = delOneFromUniqSet+delVarSetList   = delListFromUniqSet+isEmptyVarSet   = isEmptyUniqSet+mkVarSet        = mkUniqSet+lookupVarSet_Directly = lookupUniqSet_Directly+lookupVarSet    = lookupUniqSet+lookupVarSetByName = lookupUniqSet+sizeVarSet      = sizeUniqSet+filterVarSet    = filterUniqSet+delVarSetByKey  = delOneFromUniqSet_Directly+elemVarSetByKey = elemUniqSet_Directly+partitionVarSet = partitionUniqSet++mapUnionVarSet get_set xs = foldr (unionVarSet . get_set) emptyVarSet xs++-- See comments with type signatures+intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)+disjointVarSet   s1 s2 = disjointUFM (getUniqSet s1) (getUniqSet s2)+subVarSet        s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2)++anyVarSet :: (Var -> Bool) -> VarSet -> Bool+anyVarSet = uniqSetAny++allVarSet :: (Var -> Bool) -> VarSet -> Bool+allVarSet = uniqSetAll++mapVarSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b+mapVarSet = mapUniqSet++fixVarSet :: (VarSet -> VarSet)   -- Map the current set to a new set+          -> VarSet -> VarSet+-- (fixVarSet f s) repeatedly applies f to the set s,+-- until it reaches a fixed point.+fixVarSet fn vars+  | new_vars `subVarSet` vars = vars+  | otherwise                 = fixVarSet fn new_vars+  where+    new_vars = fn vars++transCloVarSet :: (VarSet -> VarSet)+                  -- Map some variables in the set to+                  -- extra variables that should be in it+               -> VarSet -> VarSet+-- (transCloVarSet f s) repeatedly applies f to new candidates, adding any+-- new variables to s that it finds thereby, until it reaches a fixed point.+--+-- The function fn could be (Var -> VarSet), but we use (VarSet -> VarSet)+-- for efficiency, so that the test can be batched up.+-- It's essential that fn will work fine if given new candidates+-- one at at time; ie  fn {v1,v2} = fn v1 `union` fn v2+-- Use fixVarSet if the function needs to see the whole set all at once+transCloVarSet fn seeds+  = go seeds seeds+  where+    go :: VarSet  -- Accumulating result+       -> VarSet  -- Work-list; un-processed subset of accumulating result+       -> VarSet+    -- Specification: go acc vs = acc `union` transClo fn vs++    go acc candidates+       | isEmptyVarSet new_vs = acc+       | otherwise            = go (acc `unionVarSet` new_vs) new_vs+       where+         new_vs = fn candidates `minusVarSet` acc++seqVarSet :: VarSet -> ()+seqVarSet s = sizeVarSet s `seq` ()++-- | Determines the pluralisation suffix appropriate for the length of a set+-- in the same way that plural from Outputable does for lists.+pluralVarSet :: VarSet -> SDoc+pluralVarSet = pluralUFM . getUniqSet++-- | Pretty-print a non-deterministic set.+-- The order of variables is non-deterministic and for pretty-printing that+-- shouldn't be a problem.+-- Having this function helps contain the non-determinism created with+-- nonDetEltsUFM.+-- Passing a list to the pretty-printing function allows the caller+-- to decide on the order of Vars (eg. toposort them) without them having+-- to use nonDetEltsUFM at the call site. This prevents from let-binding+-- non-deterministically ordered lists and reusing them where determinism+-- matters.+pprVarSet :: VarSet          -- ^ The things to be pretty printed+          -> ([Var] -> SDoc) -- ^ The pretty printing function to use on the+                             -- elements+          -> SDoc            -- ^ 'SDoc' where the things have been pretty+                             -- printed+pprVarSet = pprUFM . getUniqSet++-- Deterministic VarSet+-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need+-- DVarSet.++-- | Deterministic Variable Set+type DVarSet     = UniqDSet Var++-- | Deterministic Identifier Set+type DIdSet      = UniqDSet Id++-- | Deterministic Type Variable Set+type DTyVarSet   = UniqDSet TyVar++-- | Deterministic Type or Coercion Variable Set+type DTyCoVarSet = UniqDSet TyCoVar++emptyDVarSet :: DVarSet+emptyDVarSet = emptyUniqDSet++unitDVarSet :: Var -> DVarSet+unitDVarSet = unitUniqDSet++mkDVarSet :: [Var] -> DVarSet+mkDVarSet = mkUniqDSet++-- The new element always goes to the right of existing ones.+extendDVarSet :: DVarSet -> Var -> DVarSet+extendDVarSet = addOneToUniqDSet++elemDVarSet :: Var -> DVarSet -> Bool+elemDVarSet = elementOfUniqDSet++dVarSetElems :: DVarSet -> [Var]+dVarSetElems = uniqDSetToList++subDVarSet :: DVarSet -> DVarSet -> Bool+subDVarSet s1 s2 = isEmptyDVarSet (s1 `minusDVarSet` s2)++unionDVarSet :: DVarSet -> DVarSet -> DVarSet+unionDVarSet = unionUniqDSets++unionDVarSets :: [DVarSet] -> DVarSet+unionDVarSets = unionManyUniqDSets++-- | Map the function over the list, and union the results+mapUnionDVarSet  :: (a -> DVarSet) -> [a] -> DVarSet+mapUnionDVarSet get_set xs = foldr (unionDVarSet . get_set) emptyDVarSet xs++intersectDVarSet :: DVarSet -> DVarSet -> DVarSet+intersectDVarSet = intersectUniqDSets++dVarSetIntersectVarSet :: DVarSet -> VarSet -> DVarSet+dVarSetIntersectVarSet = uniqDSetIntersectUniqSet++-- | True if empty intersection+disjointDVarSet :: DVarSet -> DVarSet -> Bool+disjointDVarSet s1 s2 = disjointUDFM (getUniqDSet s1) (getUniqDSet s2)++-- | True if non-empty intersection+intersectsDVarSet :: DVarSet -> DVarSet -> Bool+intersectsDVarSet s1 s2 = not (s1 `disjointDVarSet` s2)++isEmptyDVarSet :: DVarSet -> Bool+isEmptyDVarSet = isEmptyUniqDSet++delDVarSet :: DVarSet -> Var -> DVarSet+delDVarSet = delOneFromUniqDSet++minusDVarSet :: DVarSet -> DVarSet -> DVarSet+minusDVarSet = minusUniqDSet++dVarSetMinusVarSet :: DVarSet -> VarSet -> DVarSet+dVarSetMinusVarSet = uniqDSetMinusUniqSet++foldDVarSet :: (Var -> a -> a) -> a -> DVarSet -> a+foldDVarSet = foldUniqDSet++anyDVarSet :: (Var -> Bool) -> DVarSet -> Bool+anyDVarSet p = anyUDFM p . getUniqDSet++allDVarSet :: (Var -> Bool) -> DVarSet -> Bool+allDVarSet p = allUDFM p . getUniqDSet++mapDVarSet :: Uniquable b => (a -> b) -> UniqDSet a -> UniqDSet b+mapDVarSet = mapUniqDSet++filterDVarSet :: (Var -> Bool) -> DVarSet -> DVarSet+filterDVarSet = filterUniqDSet++sizeDVarSet :: DVarSet -> Int+sizeDVarSet = sizeUniqDSet++-- | Partition DVarSet according to the predicate given+partitionDVarSet :: (Var -> Bool) -> DVarSet -> (DVarSet, DVarSet)+partitionDVarSet = partitionUniqDSet++-- | Delete a list of variables from DVarSet+delDVarSetList :: DVarSet -> [Var] -> DVarSet+delDVarSetList = delListFromUniqDSet++seqDVarSet :: DVarSet -> ()+seqDVarSet s = sizeDVarSet s `seq` ()++-- | Add a list of variables to DVarSet+extendDVarSetList :: DVarSet -> [Var] -> DVarSet+extendDVarSetList = addListToUniqDSet++-- | Convert a DVarSet to a VarSet by forgeting the order of insertion+dVarSetToVarSet :: DVarSet -> VarSet+dVarSetToVarSet = unsafeUFMToUniqSet . udfmToUfm . getUniqDSet++-- | transCloVarSet for DVarSet+transCloDVarSet :: (DVarSet -> DVarSet)+                  -- Map some variables in the set to+                  -- extra variables that should be in it+                -> DVarSet -> DVarSet+-- (transCloDVarSet f s) repeatedly applies f to new candidates, adding any+-- new variables to s that it finds thereby, until it reaches a fixed point.+--+-- The function fn could be (Var -> DVarSet), but we use (DVarSet -> DVarSet)+-- for efficiency, so that the test can be batched up.+-- It's essential that fn will work fine if given new candidates+-- one at at time; ie  fn {v1,v2} = fn v1 `union` fn v2+transCloDVarSet fn seeds+  = go seeds seeds+  where+    go :: DVarSet  -- Accumulating result+       -> DVarSet  -- Work-list; un-processed subset of accumulating result+       -> DVarSet+    -- Specification: go acc vs = acc `union` transClo fn vs++    go acc candidates+       | isEmptyDVarSet new_vs = acc+       | otherwise            = go (acc `unionDVarSet` new_vs) new_vs+       where+         new_vs = fn candidates `minusDVarSet` acc
+ compiler/cbits/genSym.c view
@@ -0,0 +1,40 @@+#include <assert.h>+#include "Rts.h"+#include "Unique.h"++static HsInt GenSymCounter = 0;+static HsInt GenSymInc = 1;++#define UNIQUE_BITS (sizeof (HsInt) * 8 - UNIQUE_TAG_BITS)+#define UNIQUE_MASK ((1ULL << UNIQUE_BITS) - 1)++STATIC_INLINE void checkUniqueRange(HsInt u STG_UNUSED) {+#if DEBUG+    // Uh oh! We will overflow next time a unique is requested.+    assert(u != UNIQUE_MASK);+#endif+}++HsInt genSym(void) {+#if defined(THREADED_RTS)+    if (n_capabilities == 1) {+        GenSymCounter = (GenSymCounter + GenSymInc) & UNIQUE_MASK;+        checkUniqueRange(GenSymCounter);+        return GenSymCounter;+    } else {+        HsInt n = atomic_inc((StgWord *)&GenSymCounter, GenSymInc)+          & UNIQUE_MASK;+        checkUniqueRange(n);+        return n;+    }+#else+    GenSymCounter = (GenSymCounter + GenSymInc) & UNIQUE_MASK;+    checkUniqueRange(GenSymCounter);+    return GenSymCounter;+#endif+}++void initGenSym(HsInt NewGenSymCounter, HsInt NewGenSymInc) {+  GenSymCounter = NewGenSymCounter;+  GenSymInc = NewGenSymInc;+}
+ compiler/cmm/CmmType.hs view
@@ -0,0 +1,442 @@+module CmmType+    ( CmmType   -- Abstract+    , b8, b16, b32, b64, b128, b256, b512, f32, f64, bWord, bHalfWord, gcWord+    , cInt+    , cmmBits, cmmFloat+    , typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood+    , isFloatType, isGcPtrType, isBitsType+    , isWord32, isWord64, isFloat64, isFloat32++    , Width(..)+    , widthInBits, widthInBytes, widthInLog, widthFromBytes+    , wordWidth, halfWordWidth, cIntWidth+    , halfWordMask+    , narrowU, narrowS+    , rEP_CostCentreStack_mem_alloc+    , rEP_CostCentreStack_scc_count+    , rEP_StgEntCounter_allocs+    , rEP_StgEntCounter_allocd++    , ForeignHint(..)++    , Length+    , vec, vec2, vec4, vec8, vec16+    , vec2f64, vec2b64, vec4f32, vec4b32, vec8b16, vec16b8+    , cmmVec+    , vecLength, vecElemType+    , isVecType+   )+where+++import GhcPrelude++import DynFlags+import FastString+import Outputable++import Data.Word+import Data.Int++-----------------------------------------------------------------------------+--              CmmType+-----------------------------------------------------------------------------++  -- NOTE: CmmType is an abstract type, not exported from this+  --       module so you can easily change its representation+  --+  -- However Width is exported in a concrete way,+  -- and is used extensively in pattern-matching++data CmmType    -- The important one!+  = CmmType CmmCat Width++data CmmCat                -- "Category" (not exported)+   = GcPtrCat              -- GC pointer+   | BitsCat               -- Non-pointer+   | FloatCat              -- Float+   | VecCat Length CmmCat  -- Vector+   deriving( Eq )+        -- See Note [Signed vs unsigned] at the end++instance Outputable CmmType where+  ppr (CmmType cat wid) = ppr cat <> ppr (widthInBits wid)++instance Outputable CmmCat where+  ppr FloatCat       = text "F"+  ppr GcPtrCat       = text "P"+  ppr BitsCat        = text "I"+  ppr (VecCat n cat) = ppr cat <> text "x" <> ppr n <> text "V"++-- Why is CmmType stratified?  For native code generation,+-- most of the time you just want to know what sort of register+-- to put the thing in, and for this you need to know how+-- many bits thing has, and whether it goes in a floating-point+-- register.  By contrast, the distinction between GcPtr and+-- GcNonPtr is of interest to only a few parts of the code generator.++-------- Equality on CmmType --------------+-- CmmType is *not* an instance of Eq; sometimes we care about the+-- Gc/NonGc distinction, and sometimes we don't+-- So we use an explicit function to force you to think about it+cmmEqType :: CmmType -> CmmType -> Bool -- Exact equality+cmmEqType (CmmType c1 w1) (CmmType c2 w2) = c1==c2 && w1==w2++cmmEqType_ignoring_ptrhood :: CmmType -> CmmType -> Bool+  -- This equality is temporary; used in CmmLint+  -- but the RTS files are not yet well-typed wrt pointers+cmmEqType_ignoring_ptrhood (CmmType c1 w1) (CmmType c2 w2)+   = c1 `weak_eq` c2 && w1==w2+   where+     weak_eq :: CmmCat -> CmmCat -> Bool+     FloatCat         `weak_eq` FloatCat         = True+     FloatCat         `weak_eq` _other           = False+     _other           `weak_eq` FloatCat         = False+     (VecCat l1 cat1) `weak_eq` (VecCat l2 cat2) = l1 == l2+                                                   && cat1 `weak_eq` cat2+     (VecCat {})      `weak_eq` _other           = False+     _other           `weak_eq` (VecCat {})      = False+     _word1           `weak_eq` _word2           = True        -- Ignores GcPtr++--- Simple operations on CmmType -----+typeWidth :: CmmType -> Width+typeWidth (CmmType _ w) = w++cmmBits, cmmFloat :: Width -> CmmType+cmmBits  = CmmType BitsCat+cmmFloat = CmmType FloatCat++-------- Common CmmTypes ------------+-- Floats and words of specific widths+b8, b16, b32, b64, b128, b256, b512, f32, f64 :: CmmType+b8     = cmmBits W8+b16    = cmmBits W16+b32    = cmmBits W32+b64    = cmmBits W64+b128   = cmmBits W128+b256   = cmmBits W256+b512   = cmmBits W512+f32    = cmmFloat W32+f64    = cmmFloat W64++-- CmmTypes of native word widths+bWord :: DynFlags -> CmmType+bWord dflags = cmmBits (wordWidth dflags)++bHalfWord :: DynFlags -> CmmType+bHalfWord dflags = cmmBits (halfWordWidth dflags)++gcWord :: DynFlags -> CmmType+gcWord dflags = CmmType GcPtrCat (wordWidth dflags)++cInt :: DynFlags -> CmmType+cInt dflags = cmmBits (cIntWidth  dflags)++------------ Predicates ----------------+isFloatType, isGcPtrType, isBitsType :: CmmType -> Bool+isFloatType (CmmType FloatCat    _) = True+isFloatType _other                  = False++isGcPtrType (CmmType GcPtrCat _) = True+isGcPtrType _other               = False++isBitsType (CmmType BitsCat _) = True+isBitsType _                   = False++isWord32, isWord64, isFloat32, isFloat64 :: CmmType -> Bool+-- isWord64 is true of 64-bit non-floats (both gc-ptrs and otherwise)+-- isFloat32 and 64 are obvious++isWord64 (CmmType BitsCat  W64) = True+isWord64 (CmmType GcPtrCat W64) = True+isWord64 _other                 = False++isWord32 (CmmType BitsCat  W32) = True+isWord32 (CmmType GcPtrCat W32) = True+isWord32 _other                 = False++isFloat32 (CmmType FloatCat W32) = True+isFloat32 _other                 = False++isFloat64 (CmmType FloatCat W64) = True+isFloat64 _other                 = False++-----------------------------------------------------------------------------+--              Width+-----------------------------------------------------------------------------++data Width   = W8 | W16 | W32 | W64+             | W80      -- Extended double-precision float,+                        -- used in x86 native codegen only.+                        -- (we use Ord, so it'd better be in this order)+             | W128+             | W256+             | W512+             deriving (Eq, Ord, Show)++instance Outputable Width where+   ppr rep = ptext (mrStr rep)++mrStr :: Width -> PtrString+mrStr W8   = sLit("W8")+mrStr W16  = sLit("W16")+mrStr W32  = sLit("W32")+mrStr W64  = sLit("W64")+mrStr W128 = sLit("W128")+mrStr W256 = sLit("W256")+mrStr W512 = sLit("W512")+mrStr W80  = sLit("W80")+++-------- Common Widths  ------------+wordWidth :: DynFlags -> Width+wordWidth dflags+ | wORD_SIZE dflags == 4 = W32+ | wORD_SIZE dflags == 8 = W64+ | otherwise             = panic "MachOp.wordRep: Unknown word size"++halfWordWidth :: DynFlags -> Width+halfWordWidth dflags+ | wORD_SIZE dflags == 4 = W16+ | wORD_SIZE dflags == 8 = W32+ | otherwise             = panic "MachOp.halfWordRep: Unknown word size"++halfWordMask :: DynFlags -> Integer+halfWordMask dflags+ | wORD_SIZE dflags == 4 = 0xFFFF+ | wORD_SIZE dflags == 8 = 0xFFFFFFFF+ | otherwise             = panic "MachOp.halfWordMask: Unknown word size"++-- cIntRep is the Width for a C-language 'int'+cIntWidth :: DynFlags -> Width+cIntWidth dflags = case cINT_SIZE dflags of+                   4 -> W32+                   8 -> W64+                   s -> panic ("cIntWidth: Unknown cINT_SIZE: " ++ show s)++widthInBits :: Width -> Int+widthInBits W8   = 8+widthInBits W16  = 16+widthInBits W32  = 32+widthInBits W64  = 64+widthInBits W128 = 128+widthInBits W256 = 256+widthInBits W512 = 512+widthInBits W80  = 80++widthInBytes :: Width -> Int+widthInBytes W8   = 1+widthInBytes W16  = 2+widthInBytes W32  = 4+widthInBytes W64  = 8+widthInBytes W128 = 16+widthInBytes W256 = 32+widthInBytes W512 = 64+widthInBytes W80  = 10++widthFromBytes :: Int -> Width+widthFromBytes 1  = W8+widthFromBytes 2  = W16+widthFromBytes 4  = W32+widthFromBytes 8  = W64+widthFromBytes 16 = W128+widthFromBytes 32 = W256+widthFromBytes 64 = W512+widthFromBytes 10 = W80+widthFromBytes n  = pprPanic "no width for given number of bytes" (ppr n)++-- log_2 of the width in bytes, useful for generating shifts.+widthInLog :: Width -> Int+widthInLog W8   = 0+widthInLog W16  = 1+widthInLog W32  = 2+widthInLog W64  = 3+widthInLog W128 = 4+widthInLog W256 = 5+widthInLog W512 = 6+widthInLog W80  = panic "widthInLog: F80"++-- widening / narrowing++narrowU :: Width -> Integer -> Integer+narrowU W8  x = fromIntegral (fromIntegral x :: Word8)+narrowU W16 x = fromIntegral (fromIntegral x :: Word16)+narrowU W32 x = fromIntegral (fromIntegral x :: Word32)+narrowU W64 x = fromIntegral (fromIntegral x :: Word64)+narrowU _ _ = panic "narrowTo"++narrowS :: Width -> Integer -> Integer+narrowS W8  x = fromIntegral (fromIntegral x :: Int8)+narrowS W16 x = fromIntegral (fromIntegral x :: Int16)+narrowS W32 x = fromIntegral (fromIntegral x :: Int32)+narrowS W64 x = fromIntegral (fromIntegral x :: Int64)+narrowS _ _ = panic "narrowTo"++-----------------------------------------------------------------------------+--              SIMD+-----------------------------------------------------------------------------++type Length = Int++vec :: Length -> CmmType -> CmmType+vec l (CmmType cat w) = CmmType (VecCat l cat) vecw+  where+    vecw :: Width+    vecw = widthFromBytes (l*widthInBytes w)++vec2, vec4, vec8, vec16 :: CmmType -> CmmType+vec2  = vec 2+vec4  = vec 4+vec8  = vec 8+vec16 = vec 16++vec2f64, vec2b64, vec4f32, vec4b32, vec8b16, vec16b8 :: CmmType+vec2f64 = vec 2 f64+vec2b64 = vec 2 b64+vec4f32 = vec 4 f32+vec4b32 = vec 4 b32+vec8b16 = vec 8 b16+vec16b8 = vec 16 b8++cmmVec :: Int -> CmmType -> CmmType+cmmVec n (CmmType cat w) =+    CmmType (VecCat n cat) (widthFromBytes (n*widthInBytes w))++vecLength :: CmmType -> Length+vecLength (CmmType (VecCat l _) _) = l+vecLength _                        = panic "vecLength: not a vector"++vecElemType :: CmmType -> CmmType+vecElemType (CmmType (VecCat l cat) w) = CmmType cat scalw+  where+    scalw :: Width+    scalw = widthFromBytes (widthInBytes w `div` l)+vecElemType _ = panic "vecElemType: not a vector"++isVecType :: CmmType -> Bool+isVecType (CmmType (VecCat {}) _) = True+isVecType _                       = False++-------------------------------------------------------------------------+-- Hints++-- Hints are extra type information we attach to the arguments and+-- results of a foreign call, where more type information is sometimes+-- needed by the ABI to make the correct kind of call.++data ForeignHint+  = NoHint | AddrHint | SignedHint+  deriving( Eq )+        -- Used to give extra per-argument or per-result+        -- information needed by foreign calling conventions++-------------------------------------------------------------------------++-- These don't really belong here, but I don't know where is best to+-- put them.++rEP_CostCentreStack_mem_alloc :: DynFlags -> CmmType+rEP_CostCentreStack_mem_alloc dflags+    = cmmBits (widthFromBytes (pc_REP_CostCentreStack_mem_alloc pc))+    where pc = sPlatformConstants (settings dflags)++rEP_CostCentreStack_scc_count :: DynFlags -> CmmType+rEP_CostCentreStack_scc_count dflags+    = cmmBits (widthFromBytes (pc_REP_CostCentreStack_scc_count pc))+    where pc = sPlatformConstants (settings dflags)++rEP_StgEntCounter_allocs :: DynFlags -> CmmType+rEP_StgEntCounter_allocs dflags+    = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocs pc))+    where pc = sPlatformConstants (settings dflags)++rEP_StgEntCounter_allocd :: DynFlags -> CmmType+rEP_StgEntCounter_allocd dflags+    = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocd pc))+    where pc = sPlatformConstants (settings dflags)++-------------------------------------------------------------------------+{-      Note [Signed vs unsigned]+        ~~~~~~~~~~~~~~~~~~~~~~~~~+Should a CmmType include a signed vs. unsigned distinction?++This is very much like a "hint" in C-- terminology: it isn't necessary+in order to generate correct code, but it might be useful in that the+compiler can generate better code if it has access to higher-level+hints about data.  This is important at call boundaries, because the+definition of a function is not visible at all of its call sites, so+the compiler cannot infer the hints.++Here in Cmm, we're taking a slightly different approach.  We include+the int vs. float hint in the CmmType, because (a) the majority of+platforms have a strong distinction between float and int registers,+and (b) we don't want to do any heavyweight hint-inference in the+native code backend in order to get good code.  We're treating the+hint more like a type: our Cmm is always completely consistent with+respect to hints.  All coercions between float and int are explicit.++What about the signed vs. unsigned hint?  This information might be+useful if we want to keep sub-word-sized values in word-size+registers, which we must do if we only have word-sized registers.++On such a system, there are two straightforward conventions for+representing sub-word-sized values:++(a) Leave the upper bits undefined.  Comparison operations must+    sign- or zero-extend both operands before comparing them,+    depending on whether the comparison is signed or unsigned.++(b) Always keep the values sign- or zero-extended as appropriate.+    Arithmetic operations must narrow the result to the appropriate+    size.++A clever compiler might not use either (a) or (b) exclusively, instead+it would attempt to minimize the coercions by analysis: the same kind+of analysis that propagates hints around.  In Cmm we don't want to+have to do this, so we plump for having richer types and keeping the+type information consistent.++If signed/unsigned hints are missing from CmmType, then the only+choice we have is (a), because we don't know whether the result of an+operation should be sign- or zero-extended.++Many architectures have extending load operations, which work well+with (b).  To make use of them with (a), you need to know whether the+value is going to be sign- or zero-extended by an enclosing comparison+(for example), which involves knowing above the context.  This is+doable but more complex.++Further complicating the issue is foreign calls: a foreign calling+convention can specify that signed 8-bit quantities are passed as+sign-extended 32 bit quantities, for example (this is the case on the+PowerPC).  So we *do* need sign information on foreign call arguments.++Pros for adding signed vs. unsigned to CmmType:++  - It would let us use convention (b) above, and get easier+    code generation for extending loads.++  - Less information required on foreign calls.++  - MachOp type would be simpler++Cons:++  - More complexity++  - What is the CmmType for a VanillaReg?  Currently it is+    always wordRep, but now we have to decide whether it is+    signed or unsigned.  The same VanillaReg can thus have+    different CmmType in different parts of the program.++  - Extra coercions cluttering up expressions.++Currently for GHC, the foreign call point is moot, because we do our+own promotion of sub-word-sized values to word-sized values.  The Int8+type is represented by an Int# which is kept sign-extended at all times+(this is slightly naughty, because we're making assumptions about the+C calling convention rather early on in the compiler).  However, given+this, the cons outweigh the pros.++-}+
+ compiler/coreSyn/CoreArity.hs view
@@ -0,0 +1,1159 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+++        Arity and eta expansion+-}++{-# LANGUAGE CPP #-}++-- | Arity and eta expansion+module CoreArity (+        manifestArity, joinRhsArity, exprArity, typeArity,+        exprEtaExpandArity, findRhsArity, CheapFun, etaExpand,+        etaExpandToJoinPoint, etaExpandToJoinPointRule,+        exprBotStrictness_maybe+    ) where++#include "HsVersions.h"++import GhcPrelude++import CoreSyn+import CoreFVs+import CoreUtils+import CoreSubst+import Demand+import Var+import VarEnv+import Id+import Type+import TyCon    ( initRecTc, checkRecTc )+import Coercion+import BasicTypes+import Unique+import DynFlags ( DynFlags, GeneralFlag(..), gopt )+import Outputable+import FastString+import Pair+import Util     ( debugIsOn )++{-+************************************************************************+*                                                                      *+              manifestArity and exprArity+*                                                                      *+************************************************************************++exprArity is a cheap-and-cheerful version of exprEtaExpandArity.+It tells how many things the expression can be applied to before doing+any work.  It doesn't look inside cases, lets, etc.  The idea is that+exprEtaExpandArity will do the hard work, leaving something that's easy+for exprArity to grapple with.  In particular, Simplify uses exprArity to+compute the ArityInfo for the Id.++Originally I thought that it was enough just to look for top-level lambdas, but+it isn't.  I've seen this++        foo = PrelBase.timesInt++We want foo to get arity 2 even though the eta-expander will leave it+unchanged, in the expectation that it'll be inlined.  But occasionally it+isn't, because foo is blacklisted (used in a rule).++Similarly, see the ok_note check in exprEtaExpandArity.  So+        f = __inline_me (\x -> e)+won't be eta-expanded.++And in any case it seems more robust to have exprArity be a bit more intelligent.+But note that   (\x y z -> f x y z)+should have arity 3, regardless of f's arity.+-}++manifestArity :: CoreExpr -> Arity+-- ^ manifestArity sees how many leading value lambdas there are,+--   after looking through casts+manifestArity (Lam v e) | isId v        = 1 + manifestArity e+                        | otherwise     = manifestArity e+manifestArity (Tick t e) | not (tickishIsCode t) =  manifestArity e+manifestArity (Cast e _)                = manifestArity e+manifestArity _                         = 0++joinRhsArity :: CoreExpr -> JoinArity+-- Join points are supposed to have manifestly-visible+-- lambdas at the top: no ticks, no casts, nothing+-- Moreover, type lambdas count in JoinArity+joinRhsArity (Lam _ e) = 1 + joinRhsArity e+joinRhsArity _         = 0+++---------------+exprArity :: CoreExpr -> Arity+-- ^ An approximate, fast, version of 'exprEtaExpandArity'+exprArity e = go e+  where+    go (Var v)                     = idArity v+    go (Lam x e) | isId x          = go e + 1+                 | otherwise       = go e+    go (Tick t e) | not (tickishIsCode t) = go e+    go (Cast e co)                 = trim_arity (go e) (pSnd (coercionKind co))+                                        -- Note [exprArity invariant]+    go (App e (Type _))            = go e+    go (App f a) | exprIsTrivial a = (go f - 1) `max` 0+        -- See Note [exprArity for applications]+        -- NB: coercions count as a value argument++    go _                           = 0++    trim_arity :: Arity -> Type -> Arity+    trim_arity arity ty = arity `min` length (typeArity ty)++---------------+typeArity :: Type -> [OneShotInfo]+-- How many value arrows are visible in the type?+-- We look through foralls, and newtypes+-- See Note [exprArity invariant]+typeArity ty+  = go initRecTc ty+  where+    go rec_nts ty+      | Just (_, ty')  <- splitForAllTy_maybe ty+      = go rec_nts ty'++      | Just (arg,res) <- splitFunTy_maybe ty+      = typeOneShot arg : go rec_nts res++      | Just (tc,tys) <- splitTyConApp_maybe ty+      , Just (ty', _) <- instNewTyCon_maybe tc tys+      , Just rec_nts' <- checkRecTc rec_nts tc  -- See Note [Expanding newtypes]+                                                -- in TyCon+--   , not (isClassTyCon tc)    -- Do not eta-expand through newtype classes+--                              -- See Note [Newtype classes and eta expansion]+--                              (no longer required)+      = go rec_nts' ty'+        -- Important to look through non-recursive newtypes, so that, eg+        --      (f x)   where f has arity 2, f :: Int -> IO ()+        -- Here we want to get arity 1 for the result!+        --+        -- AND through a layer of recursive newtypes+        -- e.g. newtype Stream m a b = Stream (m (Either b (a, Stream m a b)))++      | otherwise+      = []++---------------+exprBotStrictness_maybe :: CoreExpr -> Maybe (Arity, StrictSig)+-- A cheap and cheerful function that identifies bottoming functions+-- and gives them a suitable strictness signatures.  It's used during+-- float-out+exprBotStrictness_maybe e+  = case getBotArity (arityType env e) of+        Nothing -> Nothing+        Just ar -> Just (ar, sig ar)+  where+    env    = AE { ae_ped_bot = True, ae_cheap_fn = \ _ _ -> False }+    sig ar = mkClosedStrictSig (replicate ar topDmd) botRes++{-+Note [exprArity invariant]+~~~~~~~~~~~~~~~~~~~~~~~~~~+exprArity has the following invariant:++  (1) If typeArity (exprType e) = n,+      then manifestArity (etaExpand e n) = n++      That is, etaExpand can always expand as much as typeArity says+      So the case analysis in etaExpand and in typeArity must match++  (2) exprArity e <= typeArity (exprType e)++  (3) Hence if (exprArity e) = n, then manifestArity (etaExpand e n) = n++      That is, if exprArity says "the arity is n" then etaExpand really+      can get "n" manifest lambdas to the top.++Why is this important?  Because+  - In TidyPgm we use exprArity to fix the *final arity* of+    each top-level Id, and in+  - In CorePrep we use etaExpand on each rhs, so that the visible lambdas+    actually match that arity, which in turn means+    that the StgRhs has the right number of lambdas++An alternative would be to do the eta-expansion in TidyPgm, at least+for top-level bindings, in which case we would not need the trim_arity+in exprArity.  That is a less local change, so I'm going to leave it for today!++Note [Newtype classes and eta expansion]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+    NB: this nasty special case is no longer required, because+    for newtype classes we don't use the class-op rule mechanism+    at all.  See Note [Single-method classes] in TcInstDcls. SLPJ May 2013++-------- Old out of date comments, just for interest -----------+We have to be careful when eta-expanding through newtypes.  In general+it's a good idea, but annoyingly it interacts badly with the class-op+rule mechanism.  Consider++   class C a where { op :: a -> a }+   instance C b => C [b] where+     op x = ...++These translate to++   co :: forall a. (a->a) ~ C a++   $copList :: C b -> [b] -> [b]+   $copList d x = ...++   $dfList :: C b -> C [b]+   {-# DFunUnfolding = [$copList] #-}+   $dfList d = $copList d |> co@[b]++Now suppose we have:++   dCInt :: C Int++   blah :: [Int] -> [Int]+   blah = op ($dfList dCInt)++Now we want the built-in op/$dfList rule will fire to give+   blah = $copList dCInt++But with eta-expansion 'blah' might (and in #3772, which is+slightly more complicated, does) turn into++   blah = op (\eta. ($dfList dCInt |> sym co) eta)++and now it is *much* harder for the op/$dfList rule to fire, because+exprIsConApp_maybe won't hold of the argument to op.  I considered+trying to *make* it hold, but it's tricky and I gave up.++The test simplCore/should_compile/T3722 is an excellent example.+-------- End of old out of date comments, just for interest -----------+++Note [exprArity for applications]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When we come to an application we check that the arg is trivial.+   eg  f (fac x) does not have arity 2,+                 even if f has arity 3!++* We require that is trivial rather merely cheap.  Suppose f has arity 2.+  Then    f (Just y)+  has arity 0, because if we gave it arity 1 and then inlined f we'd get+          let v = Just y in \w. <f-body>+  which has arity 0.  And we try to maintain the invariant that we don't+  have arity decreases.++*  The `max 0` is important!  (\x y -> f x) has arity 2, even if f is+   unknown, hence arity 0+++************************************************************************+*                                                                      *+           Computing the "arity" of an expression+*                                                                      *+************************************************************************++Note [Definition of arity]+~~~~~~~~~~~~~~~~~~~~~~~~~~+The "arity" of an expression 'e' is n if+   applying 'e' to *fewer* than n *value* arguments+   converges rapidly++Or, to put it another way++   there is no work lost in duplicating the partial+   application (e x1 .. x(n-1))++In the divegent case, no work is lost by duplicating because if the thing+is evaluated once, that's the end of the program.++Or, to put it another way, in any context C++   C[ (\x1 .. xn. e x1 .. xn) ]+         is as efficient as+   C[ e ]++It's all a bit more subtle than it looks:++Note [One-shot lambdas]+~~~~~~~~~~~~~~~~~~~~~~~+Consider one-shot lambdas+                let x = expensive in \y z -> E+We want this to have arity 1 if the \y-abstraction is a 1-shot lambda.++Note [Dealing with bottom]+~~~~~~~~~~~~~~~~~~~~~~~~~~+A Big Deal with computing arities is expressions like++   f = \x -> case x of+               True  -> \s -> e1+               False -> \s -> e2++This happens all the time when f :: Bool -> IO ()+In this case we do eta-expand, in order to get that \s to the+top, and give f arity 2.++This isn't really right in the presence of seq.  Consider+        (f bot) `seq` 1++This should diverge!  But if we eta-expand, it won't.  We ignore this+"problem" (unless -fpedantic-bottoms is on), because being scrupulous+would lose an important transformation for many programs. (See+#5587 for an example.)++Consider also+        f = \x -> error "foo"+Here, arity 1 is fine.  But if it is+        f = \x -> case x of+                        True  -> error "foo"+                        False -> \y -> x+y+then we want to get arity 2.  Technically, this isn't quite right, because+        (f True) `seq` 1+should diverge, but it'll converge if we eta-expand f.  Nevertheless, we+do so; it improves some programs significantly, and increasing convergence+isn't a bad thing.  Hence the ABot/ATop in ArityType.++So these two transformations aren't always the Right Thing, and we+have several tickets reporting unexpected behaviour resulting from+this transformation.  So we try to limit it as much as possible:++ (1) Do NOT move a lambda outside a known-bottom case expression+       case undefined of { (a,b) -> \y -> e }+     This showed up in #5557++ (2) Do NOT move a lambda outside a case if all the branches of+     the case are known to return bottom.+        case x of { (a,b) -> \y -> error "urk" }+     This case is less important, but the idea is that if the fn is+     going to diverge eventually anyway then getting the best arity+     isn't an issue, so we might as well play safe++ (3) Do NOT move a lambda outside a case unless+     (a) The scrutinee is ok-for-speculation, or+     (b) more liberally: the scrutinee is cheap (e.g. a variable), and+         -fpedantic-bottoms is not enforced (see #2915 for an example)++Of course both (1) and (2) are readily defeated by disguising the bottoms.++4. Note [Newtype arity]+~~~~~~~~~~~~~~~~~~~~~~~~+Non-recursive newtypes are transparent, and should not get in the way.+We do (currently) eta-expand recursive newtypes too.  So if we have, say++        newtype T = MkT ([T] -> Int)++Suppose we have+        e = coerce T f+where f has arity 1.  Then: etaExpandArity e = 1;+that is, etaExpandArity looks through the coerce.++When we eta-expand e to arity 1: eta_expand 1 e T+we want to get:                  coerce T (\x::[T] -> (coerce ([T]->Int) e) x)++  HOWEVER, note that if you use coerce bogusly you can ge+        coerce Int negate+  And since negate has arity 2, you might try to eta expand.  But you can't+  decopose Int to a function type.   Hence the final case in eta_expand.++Note [The state-transformer hack]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have+        f = e+where e has arity n.  Then, if we know from the context that f has+a usage type like+        t1 -> ... -> tn -1-> t(n+1) -1-> ... -1-> tm -> ...+then we can expand the arity to m.  This usage type says that+any application (x e1 .. en) will be applied to uniquely to (m-n) more args+Consider f = \x. let y = <expensive>+                 in case x of+                      True  -> foo+                      False -> \(s:RealWorld) -> e+where foo has arity 1.  Then we want the state hack to+apply to foo too, so we can eta expand the case.++Then we expect that if f is applied to one arg, it'll be applied to two+(that's the hack -- we don't really know, and sometimes it's false)+See also Id.isOneShotBndr.++Note [State hack and bottoming functions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+It's a terrible idea to use the state hack on a bottoming function.+Here's what happens (#2861):++  f :: String -> IO T+  f = \p. error "..."++Eta-expand, using the state hack:++  f = \p. (\s. ((error "...") |> g1) s) |> g2+  g1 :: IO T ~ (S -> (S,T))+  g2 :: (S -> (S,T)) ~ IO T++Extrude the g2++  f' = \p. \s. ((error "...") |> g1) s+  f = f' |> (String -> g2)++Discard args for bottomming function++  f' = \p. \s. ((error "...") |> g1 |> g3+  g3 :: (S -> (S,T)) ~ (S,T)++Extrude g1.g3++  f'' = \p. \s. (error "...")+  f' = f'' |> (String -> S -> g1.g3)++And now we can repeat the whole loop.  Aargh!  The bug is in applying the+state hack to a function which then swallows the argument.++This arose in another guise in #3959.  Here we had++     catch# (throw exn >> return ())++Note that (throw :: forall a e. Exn e => e -> a) is called with [a = IO ()].+After inlining (>>) we get++     catch# (\_. throw {IO ()} exn)++We must *not* eta-expand to++     catch# (\_ _. throw {...} exn)++because 'catch#' expects to get a (# _,_ #) after applying its argument to+a State#, not another function!++In short, we use the state hack to allow us to push let inside a lambda,+but not to introduce a new lambda.+++Note [ArityType]+~~~~~~~~~~~~~~~~+ArityType is the result of a compositional analysis on expressions,+from which we can decide the real arity of the expression (extracted+with function exprEtaExpandArity).++Here is what the fields mean. If an arbitrary expression 'f' has+ArityType 'at', then++ * If at = ABot n, then (f x1..xn) definitely diverges. Partial+   applications to fewer than n args may *or may not* diverge.++   We allow ourselves to eta-expand bottoming functions, even+   if doing so may lose some `seq` sharing,+       let x = <expensive> in \y. error (g x y)+       ==> \y. let x = <expensive> in error (g x y)++ * If at = ATop as, and n=length as,+   then expanding 'f' to (\x1..xn. f x1 .. xn) loses no sharing,+   assuming the calls of f respect the one-shot-ness of+   its definition.++   NB 'f' is an arbitrary expression, eg (f = g e1 e2).  This 'f'+   can have ArityType as ATop, with length as > 0, only if e1 e2 are+   themselves.++ * In both cases, f, (f x1), ... (f x1 ... f(n-1)) are definitely+   really functions, or bottom, but *not* casts from a data type, in+   at least one case branch.  (If it's a function in one case branch but+   an unsafe cast from a data type in another, the program is bogus.)+   So eta expansion is dynamically ok; see Note [State hack and+   bottoming functions], the part about catch#++Example:+      f = \x\y. let v = <expensive> in+          \s(one-shot) \t(one-shot). blah+      'f' has ArityType [ManyShot,ManyShot,OneShot,OneShot]+      The one-shot-ness means we can, in effect, push that+      'let' inside the \st.+++Suppose f = \xy. x+y+Then  f             :: AT [False,False] ATop+      f v           :: AT [False]       ATop+      f <expensive> :: AT []            ATop++-------------------- Main arity code ----------------------------+-}++-- See Note [ArityType]+data ArityType = ATop [OneShotInfo] | ABot Arity+     -- There is always an explicit lambda+     -- to justify the [OneShot], or the Arity++instance Outputable ArityType where+  ppr (ATop os) = text "ATop" <> parens (ppr (length os))+  ppr (ABot n)  = text "ABot" <> parens (ppr n)++vanillaArityType :: ArityType+vanillaArityType = ATop []      -- Totally uninformative++-- ^ The Arity returned is the number of value args the+-- expression can be applied to without doing much work+exprEtaExpandArity :: DynFlags -> CoreExpr -> Arity+-- exprEtaExpandArity is used when eta expanding+--      e  ==>  \xy -> e x y+exprEtaExpandArity dflags e+  = case (arityType env e) of+      ATop oss -> length oss+      ABot n   -> n+  where+    env = AE { ae_cheap_fn = mk_cheap_fn dflags isCheapApp+             , ae_ped_bot  = gopt Opt_PedanticBottoms dflags }++getBotArity :: ArityType -> Maybe Arity+-- Arity of a divergent function+getBotArity (ABot n) = Just n+getBotArity _        = Nothing++mk_cheap_fn :: DynFlags -> CheapAppFun -> CheapFun+mk_cheap_fn dflags cheap_app+  | not (gopt Opt_DictsCheap dflags)+  = \e _     -> exprIsCheapX cheap_app e+  | otherwise+  = \e mb_ty -> exprIsCheapX cheap_app e+             || case mb_ty of+                  Nothing -> False+                  Just ty -> isDictLikeTy ty+++----------------------+findRhsArity :: DynFlags -> Id -> CoreExpr -> Arity -> (Arity, Bool)+-- This implements the fixpoint loop for arity analysis+-- See Note [Arity analysis]+-- If findRhsArity e = (n, is_bot) then+--  (a) any application of e to <n arguments will not do much work,+--      so it is safe to expand e  ==>  (\x1..xn. e x1 .. xn)+--  (b) if is_bot=True, then e applied to n args is guaranteed bottom+findRhsArity dflags bndr rhs old_arity+  = go (get_arity init_cheap_app)+       -- We always call exprEtaExpandArity once, but usually+       -- that produces a result equal to old_arity, and then+       -- we stop right away (since arities should not decrease)+       -- Result: the common case is that there is just one iteration+  where+    is_lam = has_lam rhs++    has_lam (Tick _ e) = has_lam e+    has_lam (Lam b e)  = isId b || has_lam e+    has_lam _          = False++    init_cheap_app :: CheapAppFun+    init_cheap_app fn n_val_args+      | fn == bndr = True   -- On the first pass, this binder gets infinite arity+      | otherwise  = isCheapApp fn n_val_args++    go :: (Arity, Bool) -> (Arity, Bool)+    go cur_info@(cur_arity, _)+      | cur_arity <= old_arity = cur_info+      | new_arity == cur_arity = cur_info+      | otherwise = ASSERT( new_arity < cur_arity )+#if defined(DEBUG)+                    pprTrace "Exciting arity"+                       (vcat [ ppr bndr <+> ppr cur_arity <+> ppr new_arity+                             , ppr rhs])+#endif+                    go new_info+      where+        new_info@(new_arity, _) = get_arity cheap_app++        cheap_app :: CheapAppFun+        cheap_app fn n_val_args+          | fn == bndr = n_val_args < cur_arity+          | otherwise  = isCheapApp fn n_val_args++    get_arity :: CheapAppFun -> (Arity, Bool)+    get_arity cheap_app+      = case (arityType env rhs) of+          ABot n -> (n, True)+          ATop (os:oss) | isOneShotInfo os || is_lam+                  -> (1 + length oss, False)    -- Don't expand PAPs/thunks+          ATop _  -> (0,              False)    -- Note [Eta expanding thunks]+       where+         env = AE { ae_cheap_fn = mk_cheap_fn dflags cheap_app+                  , ae_ped_bot  = gopt Opt_PedanticBottoms dflags }++{-+Note [Arity analysis]+~~~~~~~~~~~~~~~~~~~~~+The motivating example for arity analysis is this:++  f = \x. let g = f (x+1)+          in \y. ...g...++What arity does f have?  Really it should have arity 2, but a naive+look at the RHS won't see that.  You need a fixpoint analysis which+says it has arity "infinity" the first time round.++This example happens a lot; it first showed up in Andy Gill's thesis,+fifteen years ago!  It also shows up in the code for 'rnf' on lists+in #4138.++The analysis is easy to achieve because exprEtaExpandArity takes an+argument+     type CheapFun = CoreExpr -> Maybe Type -> Bool+used to decide if an expression is cheap enough to push inside a+lambda.  And exprIsCheapX in turn takes an argument+     type CheapAppFun = Id -> Int -> Bool+which tells when an application is cheap. This makes it easy to+write the analysis loop.++The analysis is cheap-and-cheerful because it doesn't deal with+mutual recursion.  But the self-recursive case is the important one.+++Note [Eta expanding through dictionaries]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If the experimental -fdicts-cheap flag is on, we eta-expand through+dictionary bindings.  This improves arities. Thereby, it also+means that full laziness is less prone to floating out the+application of a function to its dictionary arguments, which+can thereby lose opportunities for fusion.  Example:+        foo :: Ord a => a -> ...+     foo = /\a \(d:Ord a). let d' = ...d... in \(x:a). ....+        -- So foo has arity 1++     f = \x. foo dInt $ bar x++The (foo DInt) is floated out, and makes ineffective a RULE+     foo (bar x) = ...++One could go further and make exprIsCheap reply True to any+dictionary-typed expression, but that's more work.++See Note [Dictionary-like types] in TcType.hs for why we use+isDictLikeTy here rather than isDictTy++Note [Eta expanding thunks]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+We don't eta-expand+   * Trivial RHSs     x = y+   * PAPs             x = map g+   * Thunks           f = case y of p -> \x -> blah++When we see+     f = case y of p -> \x -> blah+should we eta-expand it? Well, if 'x' is a one-shot state token+then 'yes' because 'f' will only be applied once.  But otherwise+we (conservatively) say no.  My main reason is to avoid expanding+PAPSs+        f = g d  ==>  f = \x. g d x+because that might in turn make g inline (if it has an inline pragma),+which we might not want.  After all, INLINE pragmas say "inline only+when saturated" so we don't want to be too gung-ho about saturating!+-}++arityLam :: Id -> ArityType -> ArityType+arityLam id (ATop as) = ATop (idStateHackOneShotInfo id : as)+arityLam _  (ABot n)  = ABot (n+1)++floatIn :: Bool -> ArityType -> ArityType+-- We have something like (let x = E in b),+-- where b has the given arity type.+floatIn _     (ABot n)  = ABot n+floatIn True  (ATop as) = ATop as+floatIn False (ATop as) = ATop (takeWhile isOneShotInfo as)+   -- If E is not cheap, keep arity only for one-shots++arityApp :: ArityType -> Bool -> ArityType+-- Processing (fun arg) where at is the ArityType of fun,+-- Knock off an argument and behave like 'let'+arityApp (ABot 0)      _     = ABot 0+arityApp (ABot n)      _     = ABot (n-1)+arityApp (ATop [])     _     = ATop []+arityApp (ATop (_:as)) cheap = floatIn cheap (ATop as)++andArityType :: ArityType -> ArityType -> ArityType   -- Used for branches of a 'case'+andArityType (ABot n1) (ABot n2)  = ABot (n1 `max` n2) -- Note [ABot branches: use max]+andArityType (ATop as)  (ABot _)  = ATop as+andArityType (ABot _)   (ATop bs) = ATop bs+andArityType (ATop as)  (ATop bs) = ATop (as `combine` bs)+  where      -- See Note [Combining case branches]+    combine (a:as) (b:bs) = (a `bestOneShot` b) : combine as bs+    combine []     bs     = takeWhile isOneShotInfo bs+    combine as     []     = takeWhile isOneShotInfo as++{- Note [ABot branches: use max]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider   case x of+             True  -> \x.  error "urk"+             False -> \xy. error "urk2"++Remember: ABot n means "if you apply to n args, it'll definitely diverge".+So we need (ABot 2) for the whole thing, the /max/ of the ABot arities.++Note [Combining case branches]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+  go = \x. let z = go e0+               go2 = \x. case x of+                           True  -> z+                           False -> \s(one-shot). e1+           in go2 x+We *really* want to eta-expand go and go2.+When combining the barnches of the case we have+     ATop [] `andAT` ATop [OneShotLam]+and we want to get ATop [OneShotLam].  But if the inner+lambda wasn't one-shot we don't want to do this.+(We need a proper arity analysis to justify that.)++So we combine the best of the two branches, on the (slightly dodgy)+basis that if we know one branch is one-shot, then they all must be.+-}++---------------------------+type CheapFun = CoreExpr -> Maybe Type -> Bool+        -- How to decide if an expression is cheap+        -- If the Maybe is Just, the type is the type+        -- of the expression; Nothing means "don't know"++data ArityEnv+  = AE { ae_cheap_fn :: CheapFun+       , ae_ped_bot  :: Bool       -- True <=> be pedantic about bottoms+  }++arityType :: ArityEnv -> CoreExpr -> ArityType++arityType env (Cast e co)+  = case arityType env e of+      ATop os -> ATop (take co_arity os)+      ABot n  -> ABot (n `min` co_arity)+  where+    co_arity = length (typeArity (pSnd (coercionKind co)))+    -- See Note [exprArity invariant] (2); must be true of+    -- arityType too, since that is how we compute the arity+    -- of variables, and they in turn affect result of exprArity+    -- #5441 is a nice demo+    -- However, do make sure that ATop -> ATop and ABot -> ABot!+    --   Casts don't affect that part. Getting this wrong provoked #5475++arityType _ (Var v)+  | strict_sig <- idStrictness v+  , not $ isTopSig strict_sig+  , (ds, res) <- splitStrictSig strict_sig+  , let arity = length ds+  = if isBotRes res then ABot arity+                    else ATop (take arity one_shots)+  | otherwise+  = ATop (take (idArity v) one_shots)+  where+    one_shots :: [OneShotInfo]  -- One-shot-ness derived from the type+    one_shots = typeArity (idType v)++        -- Lambdas; increase arity+arityType env (Lam x e)+  | isId x    = arityLam x (arityType env e)+  | otherwise = arityType env e++        -- Applications; decrease arity, except for types+arityType env (App fun (Type _))+   = arityType env fun+arityType env (App fun arg )+   = arityApp (arityType env fun) (ae_cheap_fn env arg Nothing)++        -- Case/Let; keep arity if either the expression is cheap+        -- or it's a 1-shot lambda+        -- The former is not really right for Haskell+        --      f x = case x of { (a,b) -> \y. e }+        --  ===>+        --      f x y = case x of { (a,b) -> e }+        -- The difference is observable using 'seq'+        --+arityType env (Case scrut _ _ alts)+  | exprIsBottom scrut || null alts+  = ABot 0     -- Do not eta expand+               -- See Note [Dealing with bottom (1)]+  | otherwise+  = case alts_type of+     ABot n  | n>0       -> ATop []    -- Don't eta expand+             | otherwise -> ABot 0     -- if RHS is bottomming+                                       -- See Note [Dealing with bottom (2)]++     ATop as | not (ae_ped_bot env)    -- See Note [Dealing with bottom (3)]+             , ae_cheap_fn env scrut Nothing -> ATop as+             | exprOkForSpeculation scrut    -> ATop as+             | otherwise                     -> ATop (takeWhile isOneShotInfo as)+  where+    alts_type = foldr1 andArityType [arityType env rhs | (_,_,rhs) <- alts]++arityType env (Let b e)+  = floatIn (cheap_bind b) (arityType env e)+  where+    cheap_bind (NonRec b e) = is_cheap (b,e)+    cheap_bind (Rec prs)    = all is_cheap prs+    is_cheap (b,e) = ae_cheap_fn env e (Just (idType b))++arityType env (Tick t e)+  | not (tickishIsCode t)     = arityType env e++arityType _ _ = vanillaArityType++{-+%************************************************************************+%*                                                                      *+              The main eta-expander+%*                                                                      *+%************************************************************************++We go for:+   f = \x1..xn -> N  ==>   f = \x1..xn y1..ym -> N y1..ym+                                 (n >= 0)++where (in both cases)++        * The xi can include type variables++        * The yi are all value variables++        * N is a NORMAL FORM (i.e. no redexes anywhere)+          wanting a suitable number of extra args.++The biggest reason for doing this is for cases like++        f = \x -> case x of+                    True  -> \y -> e1+                    False -> \y -> e2++Here we want to get the lambdas together.  A good example is the nofib+program fibheaps, which gets 25% more allocation if you don't do this+eta-expansion.++We may have to sandwich some coerces between the lambdas+to make the types work.   exprEtaExpandArity looks through coerces+when computing arity; and etaExpand adds the coerces as necessary when+actually computing the expansion.++Note [No crap in eta-expanded code]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The eta expander is careful not to introduce "crap".  In particular,+given a CoreExpr satisfying the 'CpeRhs' invariant (in CorePrep), it+returns a CoreExpr satisfying the same invariant. See Note [Eta+expansion and the CorePrep invariants] in CorePrep.++This means the eta-expander has to do a bit of on-the-fly+simplification but it's not too hard.  The alernative, of relying on+a subsequent clean-up phase of the Simplifier to de-crapify the result,+means you can't really use it in CorePrep, which is painful.++Note [Eta expansion for join points]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The no-crap rule is very tiresome to guarantee when+we have join points. Consider eta-expanding+   let j :: Int -> Int -> Bool+       j x = e+   in b++The simple way is+  \(y::Int). (let j x = e in b) y++The no-crap way is+  \(y::Int). let j' :: Int -> Bool+                 j' x = e y+             in b[j'/j] y+where I have written to stress that j's type has+changed.  Note that (of course!) we have to push the application+inside the RHS of the join as well as into the body.  AND if j+has an unfolding we have to push it into there too.  AND j might+be recursive...++So for now I'm abandonig the no-crap rule in this case. I think+that for the use in CorePrep it really doesn't matter; and if+it does, then CoreToStg.myCollectArgs will fall over.++(Moreover, I think that casts can make the no-crap rule fail too.)++Note [Eta expansion and SCCs]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Note that SCCs are not treated specially by etaExpand.  If we have+        etaExpand 2 (\x -> scc "foo" e)+        = (\xy -> (scc "foo" e) y)+So the costs of evaluating 'e' (not 'e y') are attributed to "foo"++Note [Eta expansion and source notes]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+CorePrep puts floatable ticks outside of value applications, but not+type applications. As a result we might be trying to eta-expand an+expression like++  (src<...> v) @a++which we want to lead to code like++  \x -> src<...> v @a x++This means that we need to look through type applications and be ready+to re-add floats on the top.++-}++-- | @etaExpand n e@ returns an expression with+-- the same meaning as @e@, but with arity @n@.+--+-- Given:+--+-- > e' = etaExpand n e+--+-- We should have that:+--+-- > ty = exprType e = exprType e'+etaExpand :: Arity              -- ^ Result should have this number of value args+          -> CoreExpr           -- ^ Expression to expand+          -> CoreExpr+-- etaExpand arity e = res+-- Then 'res' has at least 'arity' lambdas at the top+--+-- etaExpand deals with for-alls. For example:+--              etaExpand 1 E+-- where  E :: forall a. a -> a+-- would return+--      (/\b. \y::a -> E b y)+--+-- It deals with coerces too, though they are now rare+-- so perhaps the extra code isn't worth it++etaExpand n orig_expr+  = go n orig_expr+  where+      -- Strip off existing lambdas and casts+      -- Note [Eta expansion and SCCs]+    go 0 expr = expr+    go n (Lam v body) | isTyVar v = Lam v (go n     body)+                      | otherwise = Lam v (go (n-1) body)+    go n (Cast expr co)           = Cast (go n expr) co+    go n expr+      = -- pprTrace "ee" (vcat [ppr orig_expr, ppr expr, ppr etas]) $+        retick $ etaInfoAbs etas (etaInfoApp subst' sexpr etas)+      where+          in_scope = mkInScopeSet (exprFreeVars expr)+          (in_scope', etas) = mkEtaWW n orig_expr in_scope (exprType expr)+          subst' = mkEmptySubst in_scope'++          -- Find ticks behind type apps.+          -- See Note [Eta expansion and source notes]+          (expr', args) = collectArgs expr+          (ticks, expr'') = stripTicksTop tickishFloatable expr'+          sexpr = foldl' App expr'' args+          retick expr = foldr mkTick expr ticks++                                -- Abstraction    Application+--------------+data EtaInfo = EtaVar Var       -- /\a. []        [] a+                                -- \x.  []        [] x+             | EtaCo Coercion   -- [] |> sym co   [] |> co++instance Outputable EtaInfo where+   ppr (EtaVar v) = text "EtaVar" <+> ppr v+   ppr (EtaCo co) = text "EtaCo"  <+> ppr co++pushCoercion :: Coercion -> [EtaInfo] -> [EtaInfo]+pushCoercion co1 (EtaCo co2 : eis)+  | isReflCo co = eis+  | otherwise   = EtaCo co : eis+  where+    co = co1 `mkTransCo` co2++pushCoercion co eis = EtaCo co : eis++--------------+etaInfoAbs :: [EtaInfo] -> CoreExpr -> CoreExpr+etaInfoAbs []               expr = expr+etaInfoAbs (EtaVar v : eis) expr = Lam v (etaInfoAbs eis expr)+etaInfoAbs (EtaCo co : eis) expr = Cast (etaInfoAbs eis expr) (mkSymCo co)++--------------+etaInfoApp :: Subst -> CoreExpr -> [EtaInfo] -> CoreExpr+-- (etaInfoApp s e eis) returns something equivalent to+--             ((substExpr s e) `appliedto` eis)++etaInfoApp subst (Lam v1 e) (EtaVar v2 : eis)+  = etaInfoApp (CoreSubst.extendSubstWithVar subst v1 v2) e eis++etaInfoApp subst (Cast e co1) eis+  = etaInfoApp subst e (pushCoercion co' eis)+  where+    co' = CoreSubst.substCo subst co1++etaInfoApp subst (Case e b ty alts) eis+  = Case (subst_expr subst e) b1 ty' alts'+  where+    (subst1, b1) = substBndr subst b+    alts' = map subst_alt alts+    ty'   = etaInfoAppTy (CoreSubst.substTy subst ty) eis+    subst_alt (con, bs, rhs) = (con, bs', etaInfoApp subst2 rhs eis)+              where+                 (subst2,bs') = substBndrs subst1 bs++etaInfoApp subst (Let b e) eis+  | not (isJoinBind b)+    -- See Note [Eta expansion for join points]+  = Let b' (etaInfoApp subst' e eis)+  where+    (subst', b') = substBindSC subst b++etaInfoApp subst (Tick t e) eis+  = Tick (substTickish subst t) (etaInfoApp subst e eis)++etaInfoApp subst expr _+  | (Var fun, _) <- collectArgs expr+  , Var fun' <- lookupIdSubst (text "etaInfoApp" <+> ppr fun) subst fun+  , isJoinId fun'+  = subst_expr subst expr++etaInfoApp subst e eis+  = go (subst_expr subst e) eis+  where+    go e []                  = e+    go e (EtaVar v    : eis) = go (App e (varToCoreExpr v)) eis+    go e (EtaCo co    : eis) = go (Cast e co) eis+++--------------+etaInfoAppTy :: Type -> [EtaInfo] -> Type+-- If                    e :: ty+-- then   etaInfoApp e eis :: etaInfoApp ty eis+etaInfoAppTy ty []               = ty+etaInfoAppTy ty (EtaVar v : eis) = etaInfoAppTy (applyTypeToArg ty (varToCoreExpr v)) eis+etaInfoAppTy _  (EtaCo co : eis) = etaInfoAppTy (pSnd (coercionKind co)) eis++--------------+mkEtaWW :: Arity -> CoreExpr -> InScopeSet -> Type+        -> (InScopeSet, [EtaInfo])+        -- EtaInfo contains fresh variables,+        --   not free in the incoming CoreExpr+        -- Outgoing InScopeSet includes the EtaInfo vars+        --   and the original free vars++mkEtaWW orig_n orig_expr in_scope orig_ty+  = go orig_n empty_subst orig_ty []+  where+    empty_subst = mkEmptyTCvSubst in_scope++    go n subst ty eis       -- See Note [exprArity invariant]+       | n == 0+       = (getTCvInScope subst, reverse eis)++       | Just (tcv,ty') <- splitForAllTy_maybe ty+       , let (subst', tcv') = Type.substVarBndr subst tcv+       = let ((n_subst, n_tcv), n_n)+               -- We want to have at least 'n' lambdas at the top.+               -- If tcv is a tyvar, it corresponds to one Lambda (/\).+               --   And we won't reduce n.+               -- If tcv is a covar, we could eta-expand the expr with one+               --   lambda \co:ty. e co. In this case we generate a new variable+               --   of the coercion type, update the scope, and reduce n by 1.+               | isTyVar tcv = ((subst', tcv'), n)+               | otherwise  = (freshEtaId n subst' (varType tcv'), n-1)+           -- Avoid free vars of the original expression+         in go n_n n_subst ty' (EtaVar n_tcv : eis)++       | Just (arg_ty, res_ty) <- splitFunTy_maybe ty+       , not (isTypeLevPoly arg_ty)+          -- See Note [Levity polymorphism invariants] in CoreSyn+          -- See also test case typecheck/should_run/EtaExpandLevPoly++       , let (subst', eta_id') = freshEtaId n subst arg_ty+           -- Avoid free vars of the original expression+       = go (n-1) subst' res_ty (EtaVar eta_id' : eis)++       | Just (co, ty') <- topNormaliseNewType_maybe ty+       =        -- Given this:+                --      newtype T = MkT ([T] -> Int)+                -- Consider eta-expanding this+                --      eta_expand 1 e T+                -- We want to get+                --      coerce T (\x::[T] -> (coerce ([T]->Int) e) x)+         go n subst ty' (pushCoercion co eis)++       | otherwise       -- We have an expression of arity > 0,+                         -- but its type isn't a function, or a binder+                         -- is levity-polymorphic+       = WARN( True, (ppr orig_n <+> ppr orig_ty) $$ ppr orig_expr )+         (getTCvInScope subst, reverse eis)+        -- This *can* legitmately happen:+        -- e.g.  coerce Int (\x. x) Essentially the programmer is+        -- playing fast and loose with types (Happy does this a lot).+        -- So we simply decline to eta-expand.  Otherwise we'd end up+        -- with an explicit lambda having a non-function type++++--------------+-- Don't use short-cutting substitution - we may be changing the types of join+-- points, so applying the in-scope set is necessary+-- TODO Check if we actually *are* changing any join points' types++subst_expr :: Subst -> CoreExpr -> CoreExpr+subst_expr = substExpr (text "CoreArity:substExpr")+++--------------++-- | Split an expression into the given number of binders and a body,+-- eta-expanding if necessary. Counts value *and* type binders.+etaExpandToJoinPoint :: JoinArity -> CoreExpr -> ([CoreBndr], CoreExpr)+etaExpandToJoinPoint join_arity expr+  = go join_arity [] expr+  where+    go 0 rev_bs e         = (reverse rev_bs, e)+    go n rev_bs (Lam b e) = go (n-1) (b : rev_bs) e+    go n rev_bs e         = case etaBodyForJoinPoint n e of+                              (bs, e') -> (reverse rev_bs ++ bs, e')++etaExpandToJoinPointRule :: JoinArity -> CoreRule -> CoreRule+etaExpandToJoinPointRule _ rule@(BuiltinRule {})+  = WARN(True, (sep [text "Can't eta-expand built-in rule:", ppr rule]))+      -- How did a local binding get a built-in rule anyway? Probably a plugin.+    rule+etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs+                                               , ru_args  = args })+  | need_args == 0+  = rule+  | need_args < 0+  = pprPanic "etaExpandToJoinPointRule" (ppr join_arity $$ ppr rule)+  | otherwise+  = rule { ru_bndrs = bndrs ++ new_bndrs, ru_args = args ++ new_args+         , ru_rhs = new_rhs }+  where+    need_args = join_arity - length args+    (new_bndrs, new_rhs) = etaBodyForJoinPoint need_args rhs+    new_args = varsToCoreExprs new_bndrs++-- Adds as many binders as asked for; assumes expr is not a lambda+etaBodyForJoinPoint :: Int -> CoreExpr -> ([CoreBndr], CoreExpr)+etaBodyForJoinPoint need_args body+  = go need_args (exprType body) (init_subst body) [] body+  where+    go 0 _  _     rev_bs e+      = (reverse rev_bs, e)+    go n ty subst rev_bs e+      | Just (tv, res_ty) <- splitForAllTy_maybe ty+      , let (subst', tv') = Type.substVarBndr subst tv+      = go (n-1) res_ty subst' (tv' : rev_bs) (e `App` varToCoreExpr tv')+      | Just (arg_ty, res_ty) <- splitFunTy_maybe ty+      , let (subst', b) = freshEtaId n subst arg_ty+      = go (n-1) res_ty subst' (b : rev_bs) (e `App` Var b)+      | otherwise+      = pprPanic "etaBodyForJoinPoint" $ int need_args $$+                                         ppr body $$ ppr (exprType body)++    init_subst e = mkEmptyTCvSubst (mkInScopeSet (exprFreeVars e))++--------------+freshEtaId :: Int -> TCvSubst -> Type -> (TCvSubst, Id)+-- Make a fresh Id, with specified type (after applying substitution)+-- It should be "fresh" in the sense that it's not in the in-scope set+-- of the TvSubstEnv; and it should itself then be added to the in-scope+-- set of the TvSubstEnv+--+-- The Int is just a reasonable starting point for generating a unique;+-- it does not necessarily have to be unique itself.+freshEtaId n subst ty+      = (subst', eta_id')+      where+        ty'     = Type.substTyUnchecked subst ty+        eta_id' = uniqAway (getTCvInScope subst) $+                  mkSysLocalOrCoVar (fsLit "eta") (mkBuiltinUnique n) ty'+        subst'  = extendTCvInScope subst eta_id'
+ compiler/coreSyn/CoreFVs.hs view
@@ -0,0 +1,777 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++Taken quite directly from the Peyton Jones/Lester paper.+-}++{-# LANGUAGE CPP #-}++-- | A module concerned with finding the free variables of an expression.+module CoreFVs (+        -- * Free variables of expressions and binding groups+        exprFreeVars,+        exprFreeVarsDSet,+        exprFreeVarsList,+        exprFreeIds,+        exprFreeIdsDSet,+        exprFreeIdsList,+        exprsFreeIdsDSet,+        exprsFreeIdsList,+        exprsFreeVars,+        exprsFreeVarsList,+        bindFreeVars,++        -- * Selective free variables of expressions+        InterestingVarFun,+        exprSomeFreeVars, exprsSomeFreeVars,+        exprSomeFreeVarsList, exprsSomeFreeVarsList,++        -- * Free variables of Rules, Vars and Ids+        varTypeTyCoVars,+        varTypeTyCoFVs,+        idUnfoldingVars, idFreeVars, dIdFreeVars,+        bndrRuleAndUnfoldingVarsDSet,+        idFVs,+        idRuleVars, idRuleRhsVars, stableUnfoldingVars,+        ruleRhsFreeVars, ruleFreeVars, rulesFreeVars,+        rulesFreeVarsDSet,+        ruleLhsFreeIds, ruleLhsFreeIdsList,++        expr_fvs,++        -- * Orphan names+        orphNamesOfType, orphNamesOfCo, orphNamesOfAxiom,+        orphNamesOfTypes, orphNamesOfCoCon,+        exprsOrphNames, orphNamesOfFamInst,++        -- * Core syntax tree annotation with free variables+        FVAnn,                  -- annotation, abstract+        CoreExprWithFVs,        -- = AnnExpr Id FVAnn+        CoreExprWithFVs',       -- = AnnExpr' Id FVAnn+        CoreBindWithFVs,        -- = AnnBind Id FVAnn+        CoreAltWithFVs,         -- = AnnAlt Id FVAnn+        freeVars,               -- CoreExpr -> CoreExprWithFVs+        freeVarsBind,           -- CoreBind -> DVarSet -> (DVarSet, CoreBindWithFVs)+        freeVarsOf,             -- CoreExprWithFVs -> DIdSet+        freeVarsOfAnn+    ) where++#include "HsVersions.h"++import GhcPrelude++import CoreSyn+import Id+import IdInfo+import NameSet+import UniqSet+import Unique (Uniquable (..))+import Name+import VarSet+import Var+import Type+import TyCoRep+import TyCon+import CoAxiom+import FamInstEnv+import TysPrim( funTyConName )+import Maybes( orElse )+import Util+import BasicTypes( Activation )+import Outputable+import FV++{-+************************************************************************+*                                                                      *+\section{Finding the free variables of an expression}+*                                                                      *+************************************************************************++This function simply finds the free variables of an expression.+So far as type variables are concerned, it only finds tyvars that are++        * free in type arguments,+        * free in the type of a binder,++but not those that are free in the type of variable occurrence.+-}++-- | Find all locally-defined free Ids or type variables in an expression+-- returning a non-deterministic set.+exprFreeVars :: CoreExpr -> VarSet+exprFreeVars = fvVarSet . exprFVs++-- | Find all locally-defined free Ids or type variables in an expression+-- returning a composable FV computation. See Note [FV naming conventions] in FV+-- for why export it.+exprFVs :: CoreExpr -> FV+exprFVs = filterFV isLocalVar . expr_fvs++-- | Find all locally-defined free Ids or type variables in an expression+-- returning a deterministic set.+exprFreeVarsDSet :: CoreExpr -> DVarSet+exprFreeVarsDSet = fvDVarSet . exprFVs++-- | Find all locally-defined free Ids or type variables in an expression+-- returning a deterministically ordered list.+exprFreeVarsList :: CoreExpr -> [Var]+exprFreeVarsList = fvVarList . exprFVs++-- | Find all locally-defined free Ids in an expression+exprFreeIds :: CoreExpr -> IdSet        -- Find all locally-defined free Ids+exprFreeIds = exprSomeFreeVars isLocalId++-- | Find all locally-defined free Ids in an expression+-- returning a deterministic set.+exprFreeIdsDSet :: CoreExpr -> DIdSet -- Find all locally-defined free Ids+exprFreeIdsDSet = exprSomeFreeVarsDSet isLocalId++-- | Find all locally-defined free Ids in an expression+-- returning a deterministically ordered list.+exprFreeIdsList :: CoreExpr -> [Id] -- Find all locally-defined free Ids+exprFreeIdsList = exprSomeFreeVarsList isLocalId++-- | Find all locally-defined free Ids in several expressions+-- returning a deterministic set.+exprsFreeIdsDSet :: [CoreExpr] -> DIdSet -- Find all locally-defined free Ids+exprsFreeIdsDSet = exprsSomeFreeVarsDSet isLocalId++-- | Find all locally-defined free Ids in several expressions+-- returning a deterministically ordered list.+exprsFreeIdsList :: [CoreExpr] -> [Id]   -- Find all locally-defined free Ids+exprsFreeIdsList = exprsSomeFreeVarsList isLocalId++-- | Find all locally-defined free Ids or type variables in several expressions+-- returning a non-deterministic set.+exprsFreeVars :: [CoreExpr] -> VarSet+exprsFreeVars = fvVarSet . exprsFVs++-- | Find all locally-defined free Ids or type variables in several expressions+-- returning a composable FV computation. See Note [FV naming conventions] in FV+-- for why export it.+exprsFVs :: [CoreExpr] -> FV+exprsFVs exprs = mapUnionFV exprFVs exprs++-- | Find all locally-defined free Ids or type variables in several expressions+-- returning a deterministically ordered list.+exprsFreeVarsList :: [CoreExpr] -> [Var]+exprsFreeVarsList = fvVarList . exprsFVs++-- | Find all locally defined free Ids in a binding group+bindFreeVars :: CoreBind -> VarSet+bindFreeVars (NonRec b r) = fvVarSet $ filterFV isLocalVar $ rhs_fvs (b,r)+bindFreeVars (Rec prs)    = fvVarSet $ filterFV isLocalVar $+                                addBndrs (map fst prs)+                                     (mapUnionFV rhs_fvs prs)++-- | Finds free variables in an expression selected by a predicate+exprSomeFreeVars :: InterestingVarFun   -- ^ Says which 'Var's are interesting+                 -> CoreExpr+                 -> VarSet+exprSomeFreeVars fv_cand e = fvVarSet $ filterFV fv_cand $ expr_fvs e++-- | Finds free variables in an expression selected by a predicate+-- returning a deterministically ordered list.+exprSomeFreeVarsList :: InterestingVarFun -- ^ Says which 'Var's are interesting+                     -> CoreExpr+                     -> [Var]+exprSomeFreeVarsList fv_cand e = fvVarList $ filterFV fv_cand $ expr_fvs e++-- | Finds free variables in an expression selected by a predicate+-- returning a deterministic set.+exprSomeFreeVarsDSet :: InterestingVarFun -- ^ Says which 'Var's are interesting+                     -> CoreExpr+                     -> DVarSet+exprSomeFreeVarsDSet fv_cand e = fvDVarSet $ filterFV fv_cand $ expr_fvs e++-- | Finds free variables in several expressions selected by a predicate+exprsSomeFreeVars :: InterestingVarFun  -- Says which 'Var's are interesting+                  -> [CoreExpr]+                  -> VarSet+exprsSomeFreeVars fv_cand es =+  fvVarSet $ filterFV fv_cand $ mapUnionFV expr_fvs es++-- | Finds free variables in several expressions selected by a predicate+-- returning a deterministically ordered list.+exprsSomeFreeVarsList :: InterestingVarFun  -- Says which 'Var's are interesting+                      -> [CoreExpr]+                      -> [Var]+exprsSomeFreeVarsList fv_cand es =+  fvVarList $ filterFV fv_cand $ mapUnionFV expr_fvs es++-- | Finds free variables in several expressions selected by a predicate+-- returning a deterministic set.+exprsSomeFreeVarsDSet :: InterestingVarFun -- ^ Says which 'Var's are interesting+                      -> [CoreExpr]+                      -> DVarSet+exprsSomeFreeVarsDSet fv_cand e =+  fvDVarSet $ filterFV fv_cand $ mapUnionFV expr_fvs e++--      Comment about obselete code+-- We used to gather the free variables the RULES at a variable occurrence+-- with the following cryptic comment:+--     "At a variable occurrence, add in any free variables of its rule rhss+--     Curiously, we gather the Id's free *type* variables from its binding+--     site, but its free *rule-rhs* variables from its usage sites.  This+--     is a little weird.  The reason is that the former is more efficient,+--     but the latter is more fine grained, and a makes a difference when+--     a variable mentions itself one of its own rule RHSs"+-- Not only is this "weird", but it's also pretty bad because it can make+-- a function seem more recursive than it is.  Suppose+--      f  = ...g...+--      g  = ...+--         RULE g x = ...f...+-- Then f is not mentioned in its own RHS, and needn't be a loop breaker+-- (though g may be).  But if we collect the rule fvs from g's occurrence,+-- it looks as if f mentions itself.  (This bites in the eftInt/eftIntFB+-- code in GHC.Enum.)+--+-- Anyway, it seems plain wrong.  The RULE is like an extra RHS for the+-- function, so its free variables belong at the definition site.+--+-- Deleted code looked like+--     foldVarSet add_rule_var var_itself_set (idRuleVars var)+--     add_rule_var var set | keep_it fv_cand in_scope var = extendVarSet set var+--                          | otherwise                    = set+--      SLPJ Feb06++addBndr :: CoreBndr -> FV -> FV+addBndr bndr fv fv_cand in_scope acc+  = (varTypeTyCoFVs bndr `unionFV`+        -- Include type variables in the binder's type+        --      (not just Ids; coercion variables too!)+     FV.delFV bndr fv) fv_cand in_scope acc++addBndrs :: [CoreBndr] -> FV -> FV+addBndrs bndrs fv = foldr addBndr fv bndrs++expr_fvs :: CoreExpr -> FV+expr_fvs (Type ty) fv_cand in_scope acc =+  tyCoFVsOfType ty fv_cand in_scope acc+expr_fvs (Coercion co) fv_cand in_scope acc =+  tyCoFVsOfCo co fv_cand in_scope acc+expr_fvs (Var var) fv_cand in_scope acc = FV.unitFV var fv_cand in_scope acc+expr_fvs (Lit _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc+expr_fvs (Tick t expr) fv_cand in_scope acc =+  (tickish_fvs t `unionFV` expr_fvs expr) fv_cand in_scope acc+expr_fvs (App fun arg) fv_cand in_scope acc =+  (expr_fvs fun `unionFV` expr_fvs arg) fv_cand in_scope acc+expr_fvs (Lam bndr body) fv_cand in_scope acc =+  addBndr bndr (expr_fvs body) fv_cand in_scope acc+expr_fvs (Cast expr co) fv_cand in_scope acc =+  (expr_fvs expr `unionFV` tyCoFVsOfCo co) fv_cand in_scope acc++expr_fvs (Case scrut bndr ty alts) fv_cand in_scope acc+  = (expr_fvs scrut `unionFV` tyCoFVsOfType ty `unionFV` addBndr bndr+      (mapUnionFV alt_fvs alts)) fv_cand in_scope acc+  where+    alt_fvs (_, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)++expr_fvs (Let (NonRec bndr rhs) body) fv_cand in_scope acc+  = (rhs_fvs (bndr, rhs) `unionFV` addBndr bndr (expr_fvs body))+      fv_cand in_scope acc++expr_fvs (Let (Rec pairs) body) fv_cand in_scope acc+  = addBndrs (map fst pairs)+             (mapUnionFV rhs_fvs pairs `unionFV` expr_fvs body)+               fv_cand in_scope acc++---------+rhs_fvs :: (Id, CoreExpr) -> FV+rhs_fvs (bndr, rhs) = expr_fvs rhs `unionFV`+                      bndrRuleAndUnfoldingFVs bndr+        -- Treat any RULES as extra RHSs of the binding++---------+exprs_fvs :: [CoreExpr] -> FV+exprs_fvs exprs = mapUnionFV expr_fvs exprs++tickish_fvs :: Tickish Id -> FV+tickish_fvs (Breakpoint _ ids) = FV.mkFVs ids+tickish_fvs _ = emptyFV++{-+************************************************************************+*                                                                      *+\section{Free names}+*                                                                      *+************************************************************************+-}++-- | Finds the free /external/ names of an expression, notably+-- including the names of type constructors (which of course do not show+-- up in 'exprFreeVars').+exprOrphNames :: CoreExpr -> NameSet+-- There's no need to delete local binders, because they will all+-- be /internal/ names.+exprOrphNames e+  = go e+  where+    go (Var v)+      | isExternalName n    = unitNameSet n+      | otherwise           = emptyNameSet+      where n = idName v+    go (Lit _)              = emptyNameSet+    go (Type ty)            = orphNamesOfType ty        -- Don't need free tyvars+    go (Coercion co)        = orphNamesOfCo co+    go (App e1 e2)          = go e1 `unionNameSet` go e2+    go (Lam v e)            = go e `delFromNameSet` idName v+    go (Tick _ e)           = go e+    go (Cast e co)          = go e `unionNameSet` orphNamesOfCo co+    go (Let (NonRec _ r) e) = go e `unionNameSet` go r+    go (Let (Rec prs) e)    = exprsOrphNames (map snd prs) `unionNameSet` go e+    go (Case e _ ty as)     = go e `unionNameSet` orphNamesOfType ty+                              `unionNameSet` unionNameSets (map go_alt as)++    go_alt (_,_,r) = go r++-- | Finds the free /external/ names of several expressions: see 'exprOrphNames' for details+exprsOrphNames :: [CoreExpr] -> NameSet+exprsOrphNames es = foldr (unionNameSet . exprOrphNames) emptyNameSet es+++{- **********************************************************************+%*                                                                      *+                    orphNamesXXX++%*                                                                      *+%********************************************************************* -}++orphNamesOfTyCon :: TyCon -> NameSet+orphNamesOfTyCon tycon = unitNameSet (getName tycon) `unionNameSet` case tyConClass_maybe tycon of+    Nothing  -> emptyNameSet+    Just cls -> unitNameSet (getName cls)++orphNamesOfType :: Type -> NameSet+orphNamesOfType ty | Just ty' <- coreView ty = orphNamesOfType ty'+                -- Look through type synonyms (#4912)+orphNamesOfType (TyVarTy _)          = emptyNameSet+orphNamesOfType (LitTy {})           = emptyNameSet+orphNamesOfType (TyConApp tycon tys) = orphNamesOfTyCon tycon+                                       `unionNameSet` orphNamesOfTypes tys+orphNamesOfType (ForAllTy bndr res)  = orphNamesOfType (binderType bndr)+                                       `unionNameSet` orphNamesOfType res+orphNamesOfType (FunTy _ arg res)    = unitNameSet funTyConName    -- NB!  See #8535+                                       `unionNameSet` orphNamesOfType arg+                                       `unionNameSet` orphNamesOfType res+orphNamesOfType (AppTy fun arg)      = orphNamesOfType fun `unionNameSet` orphNamesOfType arg+orphNamesOfType (CastTy ty co)       = orphNamesOfType ty `unionNameSet` orphNamesOfCo co+orphNamesOfType (CoercionTy co)      = orphNamesOfCo co++orphNamesOfThings :: (a -> NameSet) -> [a] -> NameSet+orphNamesOfThings f = foldr (unionNameSet . f) emptyNameSet++orphNamesOfTypes :: [Type] -> NameSet+orphNamesOfTypes = orphNamesOfThings orphNamesOfType++orphNamesOfMCo :: MCoercion -> NameSet+orphNamesOfMCo MRefl    = emptyNameSet+orphNamesOfMCo (MCo co) = orphNamesOfCo co++orphNamesOfCo :: Coercion -> NameSet+orphNamesOfCo (Refl ty)             = orphNamesOfType ty+orphNamesOfCo (GRefl _ ty mco)      = orphNamesOfType ty `unionNameSet` orphNamesOfMCo mco+orphNamesOfCo (TyConAppCo _ tc cos) = unitNameSet (getName tc) `unionNameSet` orphNamesOfCos cos+orphNamesOfCo (AppCo co1 co2)       = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2+orphNamesOfCo (ForAllCo _ kind_co co)+  = orphNamesOfCo kind_co `unionNameSet` orphNamesOfCo co+orphNamesOfCo (FunCo _ co1 co2)     = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2+orphNamesOfCo (CoVarCo _)           = emptyNameSet+orphNamesOfCo (AxiomInstCo con _ cos) = orphNamesOfCoCon con `unionNameSet` orphNamesOfCos cos+orphNamesOfCo (UnivCo p _ t1 t2)    = orphNamesOfProv p `unionNameSet` orphNamesOfType t1 `unionNameSet` orphNamesOfType t2+orphNamesOfCo (SymCo co)            = orphNamesOfCo co+orphNamesOfCo (TransCo co1 co2)     = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2+orphNamesOfCo (NthCo _ _ co)        = orphNamesOfCo co+orphNamesOfCo (LRCo  _ co)          = orphNamesOfCo co+orphNamesOfCo (InstCo co arg)       = orphNamesOfCo co `unionNameSet` orphNamesOfCo arg+orphNamesOfCo (KindCo co)           = orphNamesOfCo co+orphNamesOfCo (SubCo co)            = orphNamesOfCo co+orphNamesOfCo (AxiomRuleCo _ cs)    = orphNamesOfCos cs+orphNamesOfCo (HoleCo _)            = emptyNameSet++orphNamesOfProv :: UnivCoProvenance -> NameSet+orphNamesOfProv UnsafeCoerceProv    = emptyNameSet+orphNamesOfProv (PhantomProv co)    = orphNamesOfCo co+orphNamesOfProv (ProofIrrelProv co) = orphNamesOfCo co+orphNamesOfProv (PluginProv _)      = emptyNameSet++orphNamesOfCos :: [Coercion] -> NameSet+orphNamesOfCos = orphNamesOfThings orphNamesOfCo++orphNamesOfCoCon :: CoAxiom br -> NameSet+orphNamesOfCoCon (CoAxiom { co_ax_tc = tc, co_ax_branches = branches })+  = orphNamesOfTyCon tc `unionNameSet` orphNamesOfCoAxBranches branches++orphNamesOfAxiom :: CoAxiom br -> NameSet+orphNamesOfAxiom axiom+  = orphNamesOfTypes (concatMap coAxBranchLHS $ fromBranches $ coAxiomBranches axiom)+    `extendNameSet` getName (coAxiomTyCon axiom)++orphNamesOfCoAxBranches :: Branches br -> NameSet+orphNamesOfCoAxBranches+  = foldr (unionNameSet . orphNamesOfCoAxBranch) emptyNameSet . fromBranches++orphNamesOfCoAxBranch :: CoAxBranch -> NameSet+orphNamesOfCoAxBranch (CoAxBranch { cab_lhs = lhs, cab_rhs = rhs })+  = orphNamesOfTypes lhs `unionNameSet` orphNamesOfType rhs++-- | orphNamesOfAxiom collects the names of the concrete types and+-- type constructors that make up the LHS of a type family instance,+-- including the family name itself.+--+-- For instance, given `type family Foo a b`:+-- `type instance Foo (F (G (H a))) b = ...` would yield [Foo,F,G,H]+--+-- Used in the implementation of ":info" in GHCi.+orphNamesOfFamInst :: FamInst -> NameSet+orphNamesOfFamInst fam_inst = orphNamesOfAxiom (famInstAxiom fam_inst)++{-+************************************************************************+*                                                                      *+\section[freevars-everywhere]{Attaching free variables to every sub-expression}+*                                                                      *+************************************************************************+-}++-- | Those variables free in the right hand side of a rule returned as a+-- non-deterministic set+ruleRhsFreeVars :: CoreRule -> VarSet+ruleRhsFreeVars (BuiltinRule {}) = noFVs+ruleRhsFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs })+  = fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs)+      -- See Note [Rule free var hack]++-- | Those variables free in the both the left right hand sides of a rule+-- returned as a non-deterministic set+ruleFreeVars :: CoreRule -> VarSet+ruleFreeVars = fvVarSet . ruleFVs++-- | Those variables free in the both the left right hand sides of a rule+-- returned as FV computation+ruleFVs :: CoreRule -> FV+ruleFVs (BuiltinRule {}) = emptyFV+ruleFVs (Rule { ru_fn = _do_not_include+                  -- See Note [Rule free var hack]+              , ru_bndrs = bndrs+              , ru_rhs = rhs, ru_args = args })+  = filterFV isLocalVar $ addBndrs bndrs (exprs_fvs (rhs:args))++-- | Those variables free in the both the left right hand sides of rules+-- returned as FV computation+rulesFVs :: [CoreRule] -> FV+rulesFVs = mapUnionFV ruleFVs++-- | Those variables free in the both the left right hand sides of rules+-- returned as a deterministic set+rulesFreeVarsDSet :: [CoreRule] -> DVarSet+rulesFreeVarsDSet rules = fvDVarSet $ rulesFVs rules++idRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet+-- Just the variables free on the *rhs* of a rule+idRuleRhsVars is_active id+  = mapUnionVarSet get_fvs (idCoreRules id)+  where+    get_fvs (Rule { ru_fn = fn, ru_bndrs = bndrs+                  , ru_rhs = rhs, ru_act = act })+      | is_active act+            -- See Note [Finding rule RHS free vars] in OccAnal.hs+      = delOneFromUniqSet_Directly fvs (getUnique fn)+            -- Note [Rule free var hack]+      where+        fvs = fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs)+    get_fvs _ = noFVs++-- | Those variables free in the right hand side of several rules+rulesFreeVars :: [CoreRule] -> VarSet+rulesFreeVars rules = mapUnionVarSet ruleFreeVars rules++ruleLhsFreeIds :: CoreRule -> VarSet+-- ^ This finds all locally-defined free Ids on the left hand side of a rule+-- and returns them as a non-deterministic set+ruleLhsFreeIds = fvVarSet . ruleLhsFVIds++ruleLhsFreeIdsList :: CoreRule -> [Var]+-- ^ This finds all locally-defined free Ids on the left hand side of a rule+-- and returns them as a determinisitcally ordered list+ruleLhsFreeIdsList = fvVarList . ruleLhsFVIds++ruleLhsFVIds :: CoreRule -> FV+-- ^ This finds all locally-defined free Ids on the left hand side of a rule+-- and returns an FV computation+ruleLhsFVIds (BuiltinRule {}) = emptyFV+ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args })+  = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args)++{-+Note [Rule free var hack]  (Not a hack any more)+~~~~~~~~~~~~~~~~~~~~~~~~~+We used not to include the Id in its own rhs free-var set.+Otherwise the occurrence analyser makes bindings recursive:+        f x y = x+y+        RULE:  f (f x y) z  ==>  f x (f y z)+However, the occurrence analyser distinguishes "non-rule loop breakers"+from "rule-only loop breakers" (see BasicTypes.OccInfo).  So it will+put this 'f' in a Rec block, but will mark the binding as a non-rule loop+breaker, which is perfectly inlinable.+-}++{-+************************************************************************+*                                                                      *+\section[freevars-everywhere]{Attaching free variables to every sub-expression}+*                                                                      *+************************************************************************++The free variable pass annotates every node in the expression with its+NON-GLOBAL free variables and type variables.+-}++type FVAnn = DVarSet  -- See Note [The FVAnn invariant]++{- Note [The FVAnn invariant]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Invariant: a FVAnn, say S, is closed:+  That is: if v is in S,+           then freevars( v's type/kind ) is also in S+-}++-- | Every node in a binding group annotated with its+-- (non-global) free variables, both Ids and TyVars, and type.+type CoreBindWithFVs = AnnBind Id FVAnn++-- | Every node in an expression annotated with its+-- (non-global) free variables, both Ids and TyVars, and type.+-- NB: see Note [The FVAnn invariant]+type CoreExprWithFVs  = AnnExpr  Id FVAnn+type CoreExprWithFVs' = AnnExpr' Id FVAnn++-- | Every node in an expression annotated with its+-- (non-global) free variables, both Ids and TyVars, and type.+type CoreAltWithFVs = AnnAlt Id FVAnn++freeVarsOf :: CoreExprWithFVs -> DIdSet+-- ^ Inverse function to 'freeVars'+freeVarsOf (fvs, _) = fvs++-- | Extract the vars reported in a FVAnn+freeVarsOfAnn :: FVAnn -> DIdSet+freeVarsOfAnn fvs = fvs++noFVs :: VarSet+noFVs = emptyVarSet++aFreeVar :: Var -> DVarSet+aFreeVar = unitDVarSet++unionFVs :: DVarSet -> DVarSet -> DVarSet+unionFVs = unionDVarSet++unionFVss :: [DVarSet] -> DVarSet+unionFVss = unionDVarSets++delBindersFV :: [Var] -> DVarSet -> DVarSet+delBindersFV bs fvs = foldr delBinderFV fvs bs++delBinderFV :: Var -> DVarSet -> DVarSet+-- This way round, so we can do it multiple times using foldr++-- (b `delBinderFV` s)+--   * removes the binder b from the free variable set s,+--   * AND *adds* to s the free variables of b's type+--+-- This is really important for some lambdas:+--      In (\x::a -> x) the only mention of "a" is in the binder.+--+-- Also in+--      let x::a = b in ...+-- we should really note that "a" is free in this expression.+-- It'll be pinned inside the /\a by the binding for b, but+-- it seems cleaner to make sure that a is in the free-var set+-- when it is mentioned.+--+-- This also shows up in recursive bindings.  Consider:+--      /\a -> letrec x::a = x in E+-- Now, there are no explicit free type variables in the RHS of x,+-- but nevertheless "a" is free in its definition.  So we add in+-- the free tyvars of the types of the binders, and include these in the+-- free vars of the group, attached to the top level of each RHS.+--+-- This actually happened in the defn of errorIO in IOBase.hs:+--      errorIO (ST io) = case (errorIO# io) of+--                          _ -> bottom+--                        where+--                          bottom = bottom -- Never evaluated++delBinderFV b s = (s `delDVarSet` b) `unionFVs` dVarTypeTyCoVars b+        -- Include coercion variables too!++varTypeTyCoVars :: Var -> TyCoVarSet+-- Find the type/kind variables free in the type of the id/tyvar+varTypeTyCoVars var = fvVarSet $ varTypeTyCoFVs var++dVarTypeTyCoVars :: Var -> DTyCoVarSet+-- Find the type/kind/coercion variables free in the type of the id/tyvar+dVarTypeTyCoVars var = fvDVarSet $ varTypeTyCoFVs var++varTypeTyCoFVs :: Var -> FV+varTypeTyCoFVs var = tyCoFVsOfType (varType var)++idFreeVars :: Id -> VarSet+idFreeVars id = ASSERT( isId id) fvVarSet $ idFVs id++dIdFreeVars :: Id -> DVarSet+dIdFreeVars id = fvDVarSet $ idFVs id++idFVs :: Id -> FV+-- Type variables, rule variables, and inline variables+idFVs id = ASSERT( isId id)+           varTypeTyCoFVs id `unionFV`+           bndrRuleAndUnfoldingFVs id++bndrRuleAndUnfoldingVarsDSet :: Id -> DVarSet+bndrRuleAndUnfoldingVarsDSet id = fvDVarSet $ bndrRuleAndUnfoldingFVs id++bndrRuleAndUnfoldingFVs :: Id -> FV+bndrRuleAndUnfoldingFVs id+  | isId id   = idRuleFVs id `unionFV` idUnfoldingFVs id+  | otherwise = emptyFV++idRuleVars ::Id -> VarSet  -- Does *not* include CoreUnfolding vars+idRuleVars id = fvVarSet $ idRuleFVs id++idRuleFVs :: Id -> FV+idRuleFVs id = ASSERT( isId id)+  FV.mkFVs (dVarSetElems $ ruleInfoFreeVars (idSpecialisation id))++idUnfoldingVars :: Id -> VarSet+-- Produce free vars for an unfolding, but NOT for an ordinary+-- (non-inline) unfolding, since it is a dup of the rhs+-- and we'll get exponential behaviour if we look at both unf and rhs!+-- But do look at the *real* unfolding, even for loop breakers, else+-- we might get out-of-scope variables+idUnfoldingVars id = fvVarSet $ idUnfoldingFVs id++idUnfoldingFVs :: Id -> FV+idUnfoldingFVs id = stableUnfoldingFVs (realIdUnfolding id) `orElse` emptyFV++stableUnfoldingVars :: Unfolding -> Maybe VarSet+stableUnfoldingVars unf = fvVarSet `fmap` stableUnfoldingFVs unf++stableUnfoldingFVs :: Unfolding -> Maybe FV+stableUnfoldingFVs unf+  = case unf of+      CoreUnfolding { uf_tmpl = rhs, uf_src = src }+         | isStableSource src+         -> Just (filterFV isLocalVar $ expr_fvs rhs)+      DFunUnfolding { df_bndrs = bndrs, df_args = args }+         -> Just (filterFV isLocalVar $ FV.delFVs (mkVarSet bndrs) $ exprs_fvs args)+            -- DFuns are top level, so no fvs from types of bndrs+      _other -> Nothing+++{-+************************************************************************+*                                                                      *+\subsection{Free variables (and types)}+*                                                                      *+************************************************************************+-}++freeVarsBind :: CoreBind+             -> DVarSet                     -- Free vars of scope of binding+             -> (CoreBindWithFVs, DVarSet)  -- Return free vars of binding + scope+freeVarsBind (NonRec binder rhs) body_fvs+  = ( AnnNonRec binder rhs2+    , freeVarsOf rhs2 `unionFVs` body_fvs2+                      `unionFVs` bndrRuleAndUnfoldingVarsDSet binder )+    where+      rhs2      = freeVars rhs+      body_fvs2 = binder `delBinderFV` body_fvs++freeVarsBind (Rec binds) body_fvs+  = ( AnnRec (binders `zip` rhss2)+    , delBindersFV binders all_fvs )+  where+    (binders, rhss) = unzip binds+    rhss2        = map freeVars rhss+    rhs_body_fvs = foldr (unionFVs . freeVarsOf) body_fvs rhss2+    binders_fvs  = fvDVarSet $ mapUnionFV bndrRuleAndUnfoldingFVs binders+                   -- See Note [The FVAnn invariant]+    all_fvs      = rhs_body_fvs `unionFVs` binders_fvs+            -- The "delBinderFV" happens after adding the idSpecVars,+            -- since the latter may add some of the binders as fvs++freeVars :: CoreExpr -> CoreExprWithFVs+-- ^ Annotate a 'CoreExpr' with its (non-global) free type+--   and value variables at every tree node.+freeVars = go+  where+    go :: CoreExpr -> CoreExprWithFVs+    go (Var v)+      | isLocalVar v = (aFreeVar v `unionFVs` ty_fvs, AnnVar v)+      | otherwise    = (emptyDVarSet,                 AnnVar v)+      where+        ty_fvs = dVarTypeTyCoVars v+                 -- See Note [The FVAnn invariant]++    go (Lit lit) = (emptyDVarSet, AnnLit lit)+    go (Lam b body)+      = ( b_fvs `unionFVs` (b `delBinderFV` body_fvs)+        , AnnLam b body' )+      where+        body'@(body_fvs, _) = go body+        b_ty  = idType b+        b_fvs = tyCoVarsOfTypeDSet b_ty+                -- See Note [The FVAnn invariant]++    go (App fun arg)+      = ( freeVarsOf fun' `unionFVs` freeVarsOf arg'+        , AnnApp fun' arg' )+      where+        fun'   = go fun+        arg'   = go arg++    go (Case scrut bndr ty alts)+      = ( (bndr `delBinderFV` alts_fvs)+           `unionFVs` freeVarsOf scrut2+           `unionFVs` tyCoVarsOfTypeDSet ty+          -- Don't need to look at (idType bndr)+          -- because that's redundant with scrut+        , AnnCase scrut2 bndr ty alts2 )+      where+        scrut2 = go scrut++        (alts_fvs_s, alts2) = mapAndUnzip fv_alt alts+        alts_fvs            = unionFVss alts_fvs_s++        fv_alt (con,args,rhs) = (delBindersFV args (freeVarsOf rhs2),+                                 (con, args, rhs2))+                              where+                                 rhs2 = go rhs++    go (Let bind body)+      = (bind_fvs, AnnLet bind2 body2)+      where+        (bind2, bind_fvs) = freeVarsBind bind (freeVarsOf body2)+        body2             = go body++    go (Cast expr co)+      = ( freeVarsOf expr2 `unionFVs` cfvs+        , AnnCast expr2 (cfvs, co) )+      where+        expr2 = go expr+        cfvs  = tyCoVarsOfCoDSet co++    go (Tick tickish expr)+      = ( tickishFVs tickish `unionFVs` freeVarsOf expr2+        , AnnTick tickish expr2 )+      where+        expr2 = go expr+        tickishFVs (Breakpoint _ ids) = mkDVarSet ids+        tickishFVs _                  = emptyDVarSet++    go (Type ty)     = (tyCoVarsOfTypeDSet ty, AnnType ty)+    go (Coercion co) = (tyCoVarsOfCoDSet co, AnnCoercion co)
+ compiler/coreSyn/CoreMap.hs view
@@ -0,0 +1,803 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}++module CoreMap(+   -- * Maps over Core expressions+   CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap,+   -- * Maps over 'Type's+   TypeMap, emptyTypeMap, extendTypeMap, lookupTypeMap, foldTypeMap,+   LooseTypeMap,+   -- ** With explicit scoping+   CmEnv, lookupCME, extendTypeMapWithScope, lookupTypeMapWithScope,+   mkDeBruijnContext,+   -- * Maps over 'Maybe' values+   MaybeMap,+   -- * Maps over 'List' values+   ListMap,+   -- * Maps over 'Literal's+   LiteralMap,+   -- * Map for compressing leaves. See Note [Compressed TrieMap]+   GenMap,+   -- * 'TrieMap' class+   TrieMap(..), insertTM, deleteTM,+   lkDFreeVar, xtDFreeVar,+   lkDNamed, xtDNamed,+   (>.>), (|>), (|>>),+ ) where++#include "HsVersions.h"++import GhcPrelude++import TrieMap+import CoreSyn+import Coercion+import Name+import Type+import TyCoRep+import Var+import FastString(FastString)+import Util++import qualified Data.Map    as Map+import qualified Data.IntMap as IntMap+import VarEnv+import NameEnv+import Outputable+import Control.Monad( (>=>) )++{-+This module implements TrieMaps over Core related data structures+like CoreExpr or Type. It is built on the Tries from the TrieMap+module.++The code is very regular and boilerplate-like, but there is+some neat handling of *binders*.  In effect they are deBruijn+numbered on the fly.+++-}++----------------------+-- Recall that+--   Control.Monad.(>=>) :: (a -> Maybe b) -> (b -> Maybe c) -> a -> Maybe c++-- NB: Be careful about RULES and type families (#5821).  So we should make sure+-- to specify @Key TypeMapX@ (and not @DeBruijn Type@, the reduced form)++-- The CoreMap makes heavy use of GenMap. However the CoreMap Types are not+-- known when defining GenMap so we can only specialize them here.++{-# SPECIALIZE lkG :: Key TypeMapX     -> TypeMapG a     -> Maybe a #-}+{-# SPECIALIZE lkG :: Key CoercionMapX -> CoercionMapG a -> Maybe a #-}+{-# SPECIALIZE lkG :: Key CoreMapX     -> CoreMapG a     -> Maybe a #-}+++{-# SPECIALIZE xtG :: Key TypeMapX     -> XT a -> TypeMapG a -> TypeMapG a #-}+{-# SPECIALIZE xtG :: Key CoercionMapX -> XT a -> CoercionMapG a -> CoercionMapG a #-}+{-# SPECIALIZE xtG :: Key CoreMapX     -> XT a -> CoreMapG a -> CoreMapG a #-}++{-# SPECIALIZE mapG :: (a -> b) -> TypeMapG a     -> TypeMapG b #-}+{-# SPECIALIZE mapG :: (a -> b) -> CoercionMapG a -> CoercionMapG b #-}+{-# SPECIALIZE mapG :: (a -> b) -> CoreMapG a     -> CoreMapG b #-}++{-# SPECIALIZE fdG :: (a -> b -> b) -> TypeMapG a     -> b -> b #-}+{-# SPECIALIZE fdG :: (a -> b -> b) -> CoercionMapG a -> b -> b #-}+{-# SPECIALIZE fdG :: (a -> b -> b) -> CoreMapG a     -> b -> b #-}+++{-+************************************************************************+*                                                                      *+                   CoreMap+*                                                                      *+************************************************************************+-}++lkDNamed :: NamedThing n => n -> DNameEnv a -> Maybe a+lkDNamed n env = lookupDNameEnv env (getName n)++xtDNamed :: NamedThing n => n -> XT a -> DNameEnv a -> DNameEnv a+xtDNamed tc f m = alterDNameEnv f m (getName tc)+++{-+Note [Binders]+~~~~~~~~~~~~~~+ * In general we check binders as late as possible because types are+   less likely to differ than expression structure.  That's why+      cm_lam :: CoreMapG (TypeMapG a)+   rather than+      cm_lam :: TypeMapG (CoreMapG a)++ * We don't need to look at the type of some binders, notably+     - the case binder in (Case _ b _ _)+     - the binders in an alternative+   because they are totally fixed by the context++Note [Empty case alternatives]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+* For a key (Case e b ty (alt:alts))  we don't need to look the return type+  'ty', because every alternative has that type.++* For a key (Case e b ty []) we MUST look at the return type 'ty', because+  otherwise (Case (error () "urk") _ Int  []) would compare equal to+            (Case (error () "urk") _ Bool [])+  which is utterly wrong (#6097)++We could compare the return type regardless, but the wildly common case+is that it's unnecessary, so we have two fields (cm_case and cm_ecase)+for the two possibilities.  Only cm_ecase looks at the type.++See also Note [Empty case alternatives] in CoreSyn.+-}++-- | @CoreMap a@ is a map from 'CoreExpr' to @a@.  If you are a client, this+-- is the type you want.+newtype CoreMap a = CoreMap (CoreMapG a)++instance TrieMap CoreMap where+    type Key CoreMap = CoreExpr+    emptyTM = CoreMap emptyTM+    lookupTM k (CoreMap m) = lookupTM (deBruijnize k) m+    alterTM k f (CoreMap m) = CoreMap (alterTM (deBruijnize k) f m)+    foldTM k (CoreMap m) = foldTM k m+    mapTM f (CoreMap m) = CoreMap (mapTM f m)++-- | @CoreMapG a@ is a map from @DeBruijn CoreExpr@ to @a@.  The extended+-- key makes it suitable for recursive traversal, since it can track binders,+-- but it is strictly internal to this module.  If you are including a 'CoreMap'+-- inside another 'TrieMap', this is the type you want.+type CoreMapG = GenMap CoreMapX++-- | @CoreMapX a@ is the base map from @DeBruijn CoreExpr@ to @a@, but without+-- the 'GenMap' optimization.+data CoreMapX a+  = CM { cm_var   :: VarMap a+       , cm_lit   :: LiteralMap a+       , cm_co    :: CoercionMapG a+       , cm_type  :: TypeMapG a+       , cm_cast  :: CoreMapG (CoercionMapG a)+       , cm_tick  :: CoreMapG (TickishMap a)+       , cm_app   :: CoreMapG (CoreMapG a)+       , cm_lam   :: CoreMapG (BndrMap a)    -- Note [Binders]+       , cm_letn  :: CoreMapG (CoreMapG (BndrMap a))+       , cm_letr  :: ListMap CoreMapG (CoreMapG (ListMap BndrMap a))+       , cm_case  :: CoreMapG (ListMap AltMap a)+       , cm_ecase :: CoreMapG (TypeMapG a)    -- Note [Empty case alternatives]+     }++instance Eq (DeBruijn CoreExpr) where+  D env1 e1 == D env2 e2 = go e1 e2 where+    go (Var v1) (Var v2) = case (lookupCME env1 v1, lookupCME env2 v2) of+                            (Just b1, Just b2) -> b1 == b2+                            (Nothing, Nothing) -> v1 == v2+                            _ -> False+    go (Lit lit1)    (Lit lit2)      = lit1 == lit2+    go (Type t1)    (Type t2)        = D env1 t1 == D env2 t2+    go (Coercion co1) (Coercion co2) = D env1 co1 == D env2 co2+    go (Cast e1 co1) (Cast e2 co2) = D env1 co1 == D env2 co2 && go e1 e2+    go (App f1 a1)   (App f2 a2)   = go f1 f2 && go a1 a2+    -- This seems a bit dodgy, see 'eqTickish'+    go (Tick n1 e1)  (Tick n2 e2)  = n1 == n2 && go e1 e2++    go (Lam b1 e1)  (Lam b2 e2)+      =  D env1 (varType b1) == D env2 (varType b2)+      && D (extendCME env1 b1) e1 == D (extendCME env2 b2) e2++    go (Let (NonRec v1 r1) e1) (Let (NonRec v2 r2) e2)+      =  go r1 r2+      && D (extendCME env1 v1) e1 == D (extendCME env2 v2) e2++    go (Let (Rec ps1) e1) (Let (Rec ps2) e2)+      = equalLength ps1 ps2+      && D env1' rs1 == D env2' rs2+      && D env1' e1  == D env2' e2+      where+        (bs1,rs1) = unzip ps1+        (bs2,rs2) = unzip ps2+        env1' = extendCMEs env1 bs1+        env2' = extendCMEs env2 bs2++    go (Case e1 b1 t1 a1) (Case e2 b2 t2 a2)+      | null a1   -- See Note [Empty case alternatives]+      = null a2 && go e1 e2 && D env1 t1 == D env2 t2+      | otherwise+      =  go e1 e2 && D (extendCME env1 b1) a1 == D (extendCME env2 b2) a2++    go _ _ = False++emptyE :: CoreMapX a+emptyE = CM { cm_var = emptyTM, cm_lit = emptyTM+            , cm_co = emptyTM, cm_type = emptyTM+            , cm_cast = emptyTM, cm_app = emptyTM+            , cm_lam = emptyTM, cm_letn = emptyTM+            , cm_letr = emptyTM, cm_case = emptyTM+            , cm_ecase = emptyTM, cm_tick = emptyTM }++instance TrieMap CoreMapX where+   type Key CoreMapX = DeBruijn CoreExpr+   emptyTM  = emptyE+   lookupTM = lkE+   alterTM  = xtE+   foldTM   = fdE+   mapTM    = mapE++--------------------------+mapE :: (a->b) -> CoreMapX a -> CoreMapX b+mapE f (CM { cm_var = cvar, cm_lit = clit+           , cm_co = cco, cm_type = ctype+           , cm_cast = ccast , cm_app = capp+           , cm_lam = clam, cm_letn = cletn+           , cm_letr = cletr, cm_case = ccase+           , cm_ecase = cecase, cm_tick = ctick })+  = CM { cm_var = mapTM f cvar, cm_lit = mapTM f clit+       , cm_co = mapTM f cco, cm_type = mapTM f ctype+       , cm_cast = mapTM (mapTM f) ccast, cm_app = mapTM (mapTM f) capp+       , cm_lam = mapTM (mapTM f) clam, cm_letn = mapTM (mapTM (mapTM f)) cletn+       , cm_letr = mapTM (mapTM (mapTM f)) cletr, cm_case = mapTM (mapTM f) ccase+       , cm_ecase = mapTM (mapTM f) cecase, cm_tick = mapTM (mapTM f) ctick }++--------------------------+lookupCoreMap :: CoreMap a -> CoreExpr -> Maybe a+lookupCoreMap cm e = lookupTM e cm++extendCoreMap :: CoreMap a -> CoreExpr -> a -> CoreMap a+extendCoreMap m e v = alterTM e (\_ -> Just v) m++foldCoreMap :: (a -> b -> b) -> b -> CoreMap a -> b+foldCoreMap k z m = foldTM k m z++emptyCoreMap :: CoreMap a+emptyCoreMap = emptyTM++instance Outputable a => Outputable (CoreMap a) where+  ppr m = text "CoreMap elts" <+> ppr (foldTM (:) m [])++-------------------------+fdE :: (a -> b -> b) -> CoreMapX a -> b -> b+fdE k m+  = foldTM k (cm_var m)+  . foldTM k (cm_lit m)+  . foldTM k (cm_co m)+  . foldTM k (cm_type m)+  . foldTM (foldTM k) (cm_cast m)+  . foldTM (foldTM k) (cm_tick m)+  . foldTM (foldTM k) (cm_app m)+  . foldTM (foldTM k) (cm_lam m)+  . foldTM (foldTM (foldTM k)) (cm_letn m)+  . foldTM (foldTM (foldTM k)) (cm_letr m)+  . foldTM (foldTM k) (cm_case m)+  . foldTM (foldTM k) (cm_ecase m)++-- lkE: lookup in trie for expressions+lkE :: DeBruijn CoreExpr -> CoreMapX a -> Maybe a+lkE (D env expr) cm = go expr cm+  where+    go (Var v)              = cm_var  >.> lkVar env v+    go (Lit l)              = cm_lit  >.> lookupTM l+    go (Type t)             = cm_type >.> lkG (D env t)+    go (Coercion c)         = cm_co   >.> lkG (D env c)+    go (Cast e c)           = cm_cast >.> lkG (D env e) >=> lkG (D env c)+    go (Tick tickish e)     = cm_tick >.> lkG (D env e) >=> lkTickish tickish+    go (App e1 e2)          = cm_app  >.> lkG (D env e2) >=> lkG (D env e1)+    go (Lam v e)            = cm_lam  >.> lkG (D (extendCME env v) e)+                              >=> lkBndr env v+    go (Let (NonRec b r) e) = cm_letn >.> lkG (D env r)+                              >=> lkG (D (extendCME env b) e) >=> lkBndr env b+    go (Let (Rec prs) e)    = let (bndrs,rhss) = unzip prs+                                  env1 = extendCMEs env bndrs+                              in cm_letr+                                 >.> lkList (lkG . D env1) rhss+                                 >=> lkG (D env1 e)+                                 >=> lkList (lkBndr env1) bndrs+    go (Case e b ty as)     -- See Note [Empty case alternatives]+               | null as    = cm_ecase >.> lkG (D env e) >=> lkG (D env ty)+               | otherwise  = cm_case >.> lkG (D env e)+                              >=> lkList (lkA (extendCME env b)) as++xtE :: DeBruijn CoreExpr -> XT a -> CoreMapX a -> CoreMapX a+xtE (D env (Var v))              f m = m { cm_var  = cm_var m+                                                 |> xtVar env v f }+xtE (D env (Type t))             f m = m { cm_type = cm_type m+                                                 |> xtG (D env t) f }+xtE (D env (Coercion c))         f m = m { cm_co   = cm_co m+                                                 |> xtG (D env c) f }+xtE (D _   (Lit l))              f m = m { cm_lit  = cm_lit m  |> alterTM l f }+xtE (D env (Cast e c))           f m = m { cm_cast = cm_cast m |> xtG (D env e)+                                                 |>> xtG (D env c) f }+xtE (D env (Tick t e))           f m = m { cm_tick = cm_tick m |> xtG (D env e)+                                                 |>> xtTickish t f }+xtE (D env (App e1 e2))          f m = m { cm_app = cm_app m |> xtG (D env e2)+                                                 |>> xtG (D env e1) f }+xtE (D env (Lam v e))            f m = m { cm_lam = cm_lam m+                                                 |> xtG (D (extendCME env v) e)+                                                 |>> xtBndr env v f }+xtE (D env (Let (NonRec b r) e)) f m = m { cm_letn = cm_letn m+                                                 |> xtG (D (extendCME env b) e)+                                                 |>> xtG (D env r)+                                                 |>> xtBndr env b f }+xtE (D env (Let (Rec prs) e))    f m = m { cm_letr =+                                              let (bndrs,rhss) = unzip prs+                                                  env1 = extendCMEs env bndrs+                                              in cm_letr m+                                                 |>  xtList (xtG . D env1) rhss+                                                 |>> xtG (D env1 e)+                                                 |>> xtList (xtBndr env1)+                                                            bndrs f }+xtE (D env (Case e b ty as))     f m+                     | null as   = m { cm_ecase = cm_ecase m |> xtG (D env e)+                                                 |>> xtG (D env ty) f }+                     | otherwise = m { cm_case = cm_case m |> xtG (D env e)+                                                 |>> let env1 = extendCME env b+                                                     in xtList (xtA env1) as f }++-- TODO: this seems a bit dodgy, see 'eqTickish'+type TickishMap a = Map.Map (Tickish Id) a+lkTickish :: Tickish Id -> TickishMap a -> Maybe a+lkTickish = lookupTM++xtTickish :: Tickish Id -> XT a -> TickishMap a -> TickishMap a+xtTickish = alterTM++------------------------+data AltMap a   -- A single alternative+  = AM { am_deflt :: CoreMapG a+       , am_data  :: DNameEnv (CoreMapG a)+       , am_lit   :: LiteralMap (CoreMapG a) }++instance TrieMap AltMap where+   type Key AltMap = CoreAlt+   emptyTM  = AM { am_deflt = emptyTM+                 , am_data = emptyDNameEnv+                 , am_lit  = emptyTM }+   lookupTM = lkA emptyCME+   alterTM  = xtA emptyCME+   foldTM   = fdA+   mapTM    = mapA++instance Eq (DeBruijn CoreAlt) where+  D env1 a1 == D env2 a2 = go a1 a2 where+    go (DEFAULT, _, rhs1) (DEFAULT, _, rhs2)+        = D env1 rhs1 == D env2 rhs2+    go (LitAlt lit1, _, rhs1) (LitAlt lit2, _, rhs2)+        = lit1 == lit2 && D env1 rhs1 == D env2 rhs2+    go (DataAlt dc1, bs1, rhs1) (DataAlt dc2, bs2, rhs2)+        = dc1 == dc2 &&+          D (extendCMEs env1 bs1) rhs1 == D (extendCMEs env2 bs2) rhs2+    go _ _ = False++mapA :: (a->b) -> AltMap a -> AltMap b+mapA f (AM { am_deflt = adeflt, am_data = adata, am_lit = alit })+  = AM { am_deflt = mapTM f adeflt+       , am_data = mapTM (mapTM f) adata+       , am_lit = mapTM (mapTM f) alit }++lkA :: CmEnv -> CoreAlt -> AltMap a -> Maybe a+lkA env (DEFAULT,    _, rhs)  = am_deflt >.> lkG (D env rhs)+lkA env (LitAlt lit, _, rhs)  = am_lit >.> lookupTM lit >=> lkG (D env rhs)+lkA env (DataAlt dc, bs, rhs) = am_data >.> lkDNamed dc+                                        >=> lkG (D (extendCMEs env bs) rhs)++xtA :: CmEnv -> CoreAlt -> XT a -> AltMap a -> AltMap a+xtA env (DEFAULT, _, rhs)    f m =+    m { am_deflt = am_deflt m |> xtG (D env rhs) f }+xtA env (LitAlt l, _, rhs)   f m =+    m { am_lit   = am_lit m   |> alterTM l |>> xtG (D env rhs) f }+xtA env (DataAlt d, bs, rhs) f m =+    m { am_data  = am_data m  |> xtDNamed d+                             |>> xtG (D (extendCMEs env bs) rhs) f }++fdA :: (a -> b -> b) -> AltMap a -> b -> b+fdA k m = foldTM k (am_deflt m)+        . foldTM (foldTM k) (am_data m)+        . foldTM (foldTM k) (am_lit m)++{-+************************************************************************+*                                                                      *+                   Coercions+*                                                                      *+************************************************************************+-}++-- We should really never care about the contents of a coercion. Instead,+-- just look up the coercion's type.+newtype CoercionMap a = CoercionMap (CoercionMapG a)++instance TrieMap CoercionMap where+   type Key CoercionMap = Coercion+   emptyTM                     = CoercionMap emptyTM+   lookupTM k  (CoercionMap m) = lookupTM (deBruijnize k) m+   alterTM k f (CoercionMap m) = CoercionMap (alterTM (deBruijnize k) f m)+   foldTM k    (CoercionMap m) = foldTM k m+   mapTM f     (CoercionMap m) = CoercionMap (mapTM f m)++type CoercionMapG = GenMap CoercionMapX+newtype CoercionMapX a = CoercionMapX (TypeMapX a)++instance TrieMap CoercionMapX where+  type Key CoercionMapX = DeBruijn Coercion+  emptyTM = CoercionMapX emptyTM+  lookupTM = lkC+  alterTM  = xtC+  foldTM f (CoercionMapX core_tm) = foldTM f core_tm+  mapTM f (CoercionMapX core_tm)  = CoercionMapX (mapTM f core_tm)++instance Eq (DeBruijn Coercion) where+  D env1 co1 == D env2 co2+    = D env1 (coercionType co1) ==+      D env2 (coercionType co2)++lkC :: DeBruijn Coercion -> CoercionMapX a -> Maybe a+lkC (D env co) (CoercionMapX core_tm) = lkT (D env $ coercionType co)+                                        core_tm++xtC :: DeBruijn Coercion -> XT a -> CoercionMapX a -> CoercionMapX a+xtC (D env co) f (CoercionMapX m)+  = CoercionMapX (xtT (D env $ coercionType co) f m)++{-+************************************************************************+*                                                                      *+                   Types+*                                                                      *+************************************************************************+-}++-- | @TypeMapG a@ is a map from @DeBruijn Type@ to @a@.  The extended+-- key makes it suitable for recursive traversal, since it can track binders,+-- but it is strictly internal to this module.  If you are including a 'TypeMap'+-- inside another 'TrieMap', this is the type you want. Note that this+-- lookup does not do a kind-check. Thus, all keys in this map must have+-- the same kind. Also note that this map respects the distinction between+-- @Type@ and @Constraint@, despite the fact that they are equivalent type+-- synonyms in Core.+type TypeMapG = GenMap TypeMapX++-- | @TypeMapX a@ is the base map from @DeBruijn Type@ to @a@, but without the+-- 'GenMap' optimization.+data TypeMapX a+  = TM { tm_var    :: VarMap a+       , tm_app    :: TypeMapG (TypeMapG a)+       , tm_tycon  :: DNameEnv a+       , tm_forall :: TypeMapG (BndrMap a) -- See Note [Binders]+       , tm_tylit  :: TyLitMap a+       , tm_coerce :: Maybe a+       }+    -- Note that there is no tyconapp case; see Note [Equality on AppTys] in Type++-- | Squeeze out any synonyms, and change TyConApps to nested AppTys. Why the+-- last one? See Note [Equality on AppTys] in Type+--+-- Note, however, that we keep Constraint and Type apart here, despite the fact+-- that they are both synonyms of TYPE 'LiftedRep (see #11715).+trieMapView :: Type -> Maybe Type+trieMapView ty+  -- First check for TyConApps that need to be expanded to+  -- AppTy chains.+  | Just (tc, tys@(_:_)) <- tcSplitTyConApp_maybe ty+  = Just $ foldl' AppTy (TyConApp tc []) tys++  -- Then resolve any remaining nullary synonyms.+  | Just ty' <- tcView ty = Just ty'+trieMapView _ = Nothing++instance TrieMap TypeMapX where+   type Key TypeMapX = DeBruijn Type+   emptyTM  = emptyT+   lookupTM = lkT+   alterTM  = xtT+   foldTM   = fdT+   mapTM    = mapT++instance Eq (DeBruijn Type) where+  env_t@(D env t) == env_t'@(D env' t')+    | Just new_t  <- tcView t  = D env new_t == env_t'+    | Just new_t' <- tcView t' = env_t       == D env' new_t'+    | otherwise+    = case (t, t') of+        (CastTy t1 _, _)  -> D env t1 == D env t'+        (_, CastTy t1' _) -> D env t  == D env t1'++        (TyVarTy v, TyVarTy v')+            -> case (lookupCME env v, lookupCME env' v') of+                (Just bv, Just bv') -> bv == bv'+                (Nothing, Nothing)  -> v == v'+                _ -> False+                -- See Note [Equality on AppTys] in Type+        (AppTy t1 t2, s) | Just (t1', t2') <- repSplitAppTy_maybe s+            -> D env t1 == D env' t1' && D env t2 == D env' t2'+        (s, AppTy t1' t2') | Just (t1, t2) <- repSplitAppTy_maybe s+            -> D env t1 == D env' t1' && D env t2 == D env' t2'+        (FunTy _ t1 t2, FunTy _ t1' t2')+            -> D env t1 == D env' t1' && D env t2 == D env' t2'+        (TyConApp tc tys, TyConApp tc' tys')+            -> tc == tc' && D env tys == D env' tys'+        (LitTy l, LitTy l')+            -> l == l'+        (ForAllTy (Bndr tv _) ty, ForAllTy (Bndr tv' _) ty')+            -> D env (varType tv)      == D env' (varType tv') &&+               D (extendCME env tv) ty == D (extendCME env' tv') ty'+        (CoercionTy {}, CoercionTy {})+            -> True+        _ -> False++instance {-# OVERLAPPING #-}+         Outputable a => Outputable (TypeMapG a) where+  ppr m = text "TypeMap elts" <+> ppr (foldTM (:) m [])++emptyT :: TypeMapX a+emptyT = TM { tm_var  = emptyTM+            , tm_app  = emptyTM+            , tm_tycon  = emptyDNameEnv+            , tm_forall = emptyTM+            , tm_tylit  = emptyTyLitMap+            , tm_coerce = Nothing }++mapT :: (a->b) -> TypeMapX a -> TypeMapX b+mapT f (TM { tm_var  = tvar, tm_app = tapp, tm_tycon = ttycon+           , tm_forall = tforall, tm_tylit = tlit+           , tm_coerce = tcoerce })+  = TM { tm_var    = mapTM f tvar+       , tm_app    = mapTM (mapTM f) tapp+       , tm_tycon  = mapTM f ttycon+       , tm_forall = mapTM (mapTM f) tforall+       , tm_tylit  = mapTM f tlit+       , tm_coerce = fmap f tcoerce }++-----------------+lkT :: DeBruijn Type -> TypeMapX a -> Maybe a+lkT (D env ty) m = go ty m+  where+    go ty | Just ty' <- trieMapView ty = go ty'+    go (TyVarTy v)                 = tm_var    >.> lkVar env v+    go (AppTy t1 t2)               = tm_app    >.> lkG (D env t1)+                                               >=> lkG (D env t2)+    go (TyConApp tc [])            = tm_tycon  >.> lkDNamed tc+    go ty@(TyConApp _ (_:_))       = pprPanic "lkT TyConApp" (ppr ty)+    go (LitTy l)                   = tm_tylit  >.> lkTyLit l+    go (ForAllTy (Bndr tv _) ty)   = tm_forall >.> lkG (D (extendCME env tv) ty)+                                               >=> lkBndr env tv+    go ty@(FunTy {})               = pprPanic "lkT FunTy" (ppr ty)+    go (CastTy t _)                = go t+    go (CoercionTy {})             = tm_coerce++-----------------+xtT :: DeBruijn Type -> XT a -> TypeMapX a -> TypeMapX a+xtT (D env ty) f m | Just ty' <- trieMapView ty = xtT (D env ty') f m++xtT (D env (TyVarTy v))       f m = m { tm_var    = tm_var m |> xtVar env v f }+xtT (D env (AppTy t1 t2))     f m = m { tm_app    = tm_app m |> xtG (D env t1)+                                                            |>> xtG (D env t2) f }+xtT (D _   (TyConApp tc []))  f m = m { tm_tycon  = tm_tycon m |> xtDNamed tc f }+xtT (D _   (LitTy l))         f m = m { tm_tylit  = tm_tylit m |> xtTyLit l f }+xtT (D env (CastTy t _))      f m = xtT (D env t) f m+xtT (D _   (CoercionTy {}))   f m = m { tm_coerce = tm_coerce m |> f }+xtT (D env (ForAllTy (Bndr tv _) ty))  f m+  = m { tm_forall = tm_forall m |> xtG (D (extendCME env tv) ty)+                                |>> xtBndr env tv f }+xtT (D _   ty@(TyConApp _ (_:_))) _ _ = pprPanic "xtT TyConApp" (ppr ty)+xtT (D _   ty@(FunTy {}))         _ _ = pprPanic "xtT FunTy" (ppr ty)++fdT :: (a -> b -> b) -> TypeMapX a -> b -> b+fdT k m = foldTM k (tm_var m)+        . foldTM (foldTM k) (tm_app m)+        . foldTM k (tm_tycon m)+        . foldTM (foldTM k) (tm_forall m)+        . foldTyLit k (tm_tylit m)+        . foldMaybe k (tm_coerce m)++------------------------+data TyLitMap a = TLM { tlm_number :: Map.Map Integer a+                      , tlm_string :: Map.Map FastString a+                      }++instance TrieMap TyLitMap where+   type Key TyLitMap = TyLit+   emptyTM  = emptyTyLitMap+   lookupTM = lkTyLit+   alterTM  = xtTyLit+   foldTM   = foldTyLit+   mapTM    = mapTyLit++emptyTyLitMap :: TyLitMap a+emptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = Map.empty }++mapTyLit :: (a->b) -> TyLitMap a -> TyLitMap b+mapTyLit f (TLM { tlm_number = tn, tlm_string = ts })+  = TLM { tlm_number = Map.map f tn, tlm_string = Map.map f ts }++lkTyLit :: TyLit -> TyLitMap a -> Maybe a+lkTyLit l =+  case l of+    NumTyLit n -> tlm_number >.> Map.lookup n+    StrTyLit n -> tlm_string >.> Map.lookup n++xtTyLit :: TyLit -> XT a -> TyLitMap a -> TyLitMap a+xtTyLit l f m =+  case l of+    NumTyLit n -> m { tlm_number = tlm_number m |> Map.alter f n }+    StrTyLit n -> m { tlm_string = tlm_string m |> Map.alter f n }++foldTyLit :: (a -> b -> b) -> TyLitMap a -> b -> b+foldTyLit l m = flip (Map.foldr l) (tlm_string m)+              . flip (Map.foldr l) (tlm_number m)++-------------------------------------------------+-- | @TypeMap a@ is a map from 'Type' to @a@.  If you are a client, this+-- is the type you want. The keys in this map may have different kinds.+newtype TypeMap a = TypeMap (TypeMapG (TypeMapG a))++lkTT :: DeBruijn Type -> TypeMap a -> Maybe a+lkTT (D env ty) (TypeMap m) = lkG (D env $ typeKind ty) m+                          >>= lkG (D env ty)++xtTT :: DeBruijn Type -> XT a -> TypeMap a -> TypeMap a+xtTT (D env ty) f (TypeMap m)+  = TypeMap (m |> xtG (D env $ typeKind ty)+               |>> xtG (D env ty) f)++-- Below are some client-oriented functions which operate on 'TypeMap'.++instance TrieMap TypeMap where+    type Key TypeMap = Type+    emptyTM = TypeMap emptyTM+    lookupTM k m = lkTT (deBruijnize k) m+    alterTM k f m = xtTT (deBruijnize k) f m+    foldTM k (TypeMap m) = foldTM (foldTM k) m+    mapTM f (TypeMap m) = TypeMap (mapTM (mapTM f) m)++foldTypeMap :: (a -> b -> b) -> b -> TypeMap a -> b+foldTypeMap k z m = foldTM k m z++emptyTypeMap :: TypeMap a+emptyTypeMap = emptyTM++lookupTypeMap :: TypeMap a -> Type -> Maybe a+lookupTypeMap cm t = lookupTM t cm++extendTypeMap :: TypeMap a -> Type -> a -> TypeMap a+extendTypeMap m t v = alterTM t (const (Just v)) m++lookupTypeMapWithScope :: TypeMap a -> CmEnv -> Type -> Maybe a+lookupTypeMapWithScope m cm t = lkTT (D cm t) m++-- | Extend a 'TypeMap' with a type in the given context.+-- @extendTypeMapWithScope m (mkDeBruijnContext [a,b,c]) t v@ is equivalent to+-- @extendTypeMap m (forall a b c. t) v@, but allows reuse of the context over+-- multiple insertions.+extendTypeMapWithScope :: TypeMap a -> CmEnv -> Type -> a -> TypeMap a+extendTypeMapWithScope m cm t v = xtTT (D cm t) (const (Just v)) m++-- | Construct a deBruijn environment with the given variables in scope.+-- e.g. @mkDeBruijnEnv [a,b,c]@ constructs a context @forall a b c.@+mkDeBruijnContext :: [Var] -> CmEnv+mkDeBruijnContext = extendCMEs emptyCME++-- | A 'LooseTypeMap' doesn't do a kind-check. Thus, when lookup up (t |> g),+-- you'll find entries inserted under (t), even if (g) is non-reflexive.+newtype LooseTypeMap a+  = LooseTypeMap (TypeMapG a)++instance TrieMap LooseTypeMap where+  type Key LooseTypeMap = Type+  emptyTM = LooseTypeMap emptyTM+  lookupTM k (LooseTypeMap m) = lookupTM (deBruijnize k) m+  alterTM k f (LooseTypeMap m) = LooseTypeMap (alterTM (deBruijnize k) f m)+  foldTM f (LooseTypeMap m) = foldTM f m+  mapTM f (LooseTypeMap m) = LooseTypeMap (mapTM f m)++{-+************************************************************************+*                                                                      *+                   Variables+*                                                                      *+************************************************************************+-}++type BoundVar = Int  -- Bound variables are deBruijn numbered+type BoundVarMap a = IntMap.IntMap a++data CmEnv = CME { cme_next :: !BoundVar+                 , cme_env  :: VarEnv BoundVar }++emptyCME :: CmEnv+emptyCME = CME { cme_next = 0, cme_env = emptyVarEnv }++extendCME :: CmEnv -> Var -> CmEnv+extendCME (CME { cme_next = bv, cme_env = env }) v+  = CME { cme_next = bv+1, cme_env = extendVarEnv env v bv }++extendCMEs :: CmEnv -> [Var] -> CmEnv+extendCMEs env vs = foldl' extendCME env vs++lookupCME :: CmEnv -> Var -> Maybe BoundVar+lookupCME (CME { cme_env = env }) v = lookupVarEnv env v++-- | @DeBruijn a@ represents @a@ modulo alpha-renaming.  This is achieved+-- by equipping the value with a 'CmEnv', which tracks an on-the-fly deBruijn+-- numbering.  This allows us to define an 'Eq' instance for @DeBruijn a@, even+-- if this was not (easily) possible for @a@.  Note: we purposely don't+-- export the constructor.  Make a helper function if you find yourself+-- needing it.+data DeBruijn a = D CmEnv a++-- | Synthesizes a @DeBruijn a@ from an @a@, by assuming that there are no+-- bound binders (an empty 'CmEnv').  This is usually what you want if there+-- isn't already a 'CmEnv' in scope.+deBruijnize :: a -> DeBruijn a+deBruijnize = D emptyCME++instance Eq (DeBruijn a) => Eq (DeBruijn [a]) where+    D _   []     == D _    []       = True+    D env (x:xs) == D env' (x':xs') = D env x  == D env' x' &&+                                      D env xs == D env' xs'+    _            == _               = False++--------- Variable binders -------------++-- | A 'BndrMap' is a 'TypeMapG' which allows us to distinguish between+-- binding forms whose binders have different types.  For example,+-- if we are doing a 'TrieMap' lookup on @\(x :: Int) -> ()@, we should+-- not pick up an entry in the 'TrieMap' for @\(x :: Bool) -> ()@:+-- we can disambiguate this by matching on the type (or kind, if this+-- a binder in a type) of the binder.+type BndrMap = TypeMapG++-- Note [Binders]+-- ~~~~~~~~~~~~~~+-- We need to use 'BndrMap' for 'Coercion', 'CoreExpr' AND 'Type', since all+-- of these data types have binding forms.++lkBndr :: CmEnv -> Var -> BndrMap a -> Maybe a+lkBndr env v m = lkG (D env (varType v)) m++xtBndr :: CmEnv -> Var -> XT a -> BndrMap a -> BndrMap a+xtBndr env v f = xtG (D env (varType v)) f++--------- Variable occurrence -------------+data VarMap a = VM { vm_bvar   :: BoundVarMap a  -- Bound variable+                   , vm_fvar   :: DVarEnv a }      -- Free variable++instance TrieMap VarMap where+   type Key VarMap = Var+   emptyTM  = VM { vm_bvar = IntMap.empty, vm_fvar = emptyDVarEnv }+   lookupTM = lkVar emptyCME+   alterTM  = xtVar emptyCME+   foldTM   = fdVar+   mapTM    = mapVar++mapVar :: (a->b) -> VarMap a -> VarMap b+mapVar f (VM { vm_bvar = bv, vm_fvar = fv })+  = VM { vm_bvar = mapTM f bv, vm_fvar = mapTM f fv }++lkVar :: CmEnv -> Var -> VarMap a -> Maybe a+lkVar env v+  | Just bv <- lookupCME env v = vm_bvar >.> lookupTM bv+  | otherwise                  = vm_fvar >.> lkDFreeVar v++xtVar :: CmEnv -> Var -> XT a -> VarMap a -> VarMap a+xtVar env v f m+  | Just bv <- lookupCME env v = m { vm_bvar = vm_bvar m |> alterTM bv f }+  | otherwise                  = m { vm_fvar = vm_fvar m |> xtDFreeVar v f }++fdVar :: (a -> b -> b) -> VarMap a -> b -> b+fdVar k m = foldTM k (vm_bvar m)+          . foldTM k (vm_fvar m)++lkDFreeVar :: Var -> DVarEnv a -> Maybe a+lkDFreeVar var env = lookupDVarEnv env var++xtDFreeVar :: Var -> XT a -> DVarEnv a -> DVarEnv a+xtDFreeVar v f m = alterDVarEnv f m v
+ compiler/coreSyn/CoreOpt.hs view
@@ -0,0 +1,1388 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}++{-# LANGUAGE CPP #-}+module CoreOpt (+        -- ** Simple expression optimiser+        simpleOptPgm, simpleOptExpr, simpleOptExprWith,++        -- ** Join points+        joinPointBinding_maybe, joinPointBindings_maybe,++        -- ** Predicates on expressions+        exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe,++        -- ** Coercions and casts+        pushCoArg, pushCoValArg, pushCoTyArg, collectBindersPushingCo+    ) where++#include "HsVersions.h"++import GhcPrelude++import CoreArity( etaExpandToJoinPoint )++import CoreSyn+import CoreSubst+import CoreUtils+import CoreFVs+import MkCore ( FloatBind(..) )+import PprCore  ( pprCoreBindings, pprRules )+import OccurAnal( occurAnalyseExpr, occurAnalysePgm )+import Literal  ( Literal(LitString) )+import Id+import Var      ( isNonCoVarId )+import VarSet+import VarEnv+import DataCon+import Demand( etaExpandStrictSig )+import OptCoercion ( optCoercion )+import Type     hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList+                       , isInScope, substTyVarBndr, cloneTyVarBndr )+import Coercion hiding ( substCo, substCoVarBndr )+import TyCon        ( tyConArity )+import TysWiredIn+import PrelNames+import BasicTypes+import Module       ( Module )+import ErrUtils+import DynFlags+import Outputable+import Pair+import Util+import Maybes       ( orElse )+import FastString+import Data.List+import qualified Data.ByteString as BS++{-+************************************************************************+*                                                                      *+        The Simple Optimiser+*                                                                      *+************************************************************************++Note [The simple optimiser]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+The simple optimiser is a lightweight, pure (non-monadic) function+that rapidly does a lot of simple optimisations, including++  - inlining things that occur just once,+      or whose RHS turns out to be trivial+  - beta reduction+  - case of known constructor+  - dead code elimination++It does NOT do any call-site inlining; it only inlines a function if+it can do so unconditionally, dropping the binding.  It thereby+guarantees to leave no un-reduced beta-redexes.++It is careful to follow the guidance of "Secrets of the GHC inliner",+and in particular the pre-inline-unconditionally and+post-inline-unconditionally story, to do effective beta reduction on+functions called precisely once, without repeatedly optimising the same+expression.  In fact, the simple optimiser is a good example of this+little dance in action; the full Simplifier is a lot more complicated.++-}++simpleOptExpr :: DynFlags -> CoreExpr -> CoreExpr+-- See Note [The simple optimiser]+-- Do simple optimisation on an expression+-- The optimisation is very straightforward: just+-- inline non-recursive bindings that are used only once,+-- or where the RHS is trivial+--+-- We also inline bindings that bind a Eq# box: see+-- See Note [Getting the map/coerce RULE to work].+--+-- Also we convert functions to join points where possible (as+-- the occurrence analyser does most of the work anyway).+--+-- The result is NOT guaranteed occurrence-analysed, because+-- in  (let x = y in ....) we substitute for x; so y's occ-info+-- may change radically++simpleOptExpr dflags expr+  = -- pprTrace "simpleOptExpr" (ppr init_subst $$ ppr expr)+    simpleOptExprWith dflags init_subst expr+  where+    init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr))+        -- It's potentially important to make a proper in-scope set+        -- Consider  let x = ..y.. in \y. ...x...+        -- Then we should remember to clone y before substituting+        -- for x.  It's very unlikely to occur, because we probably+        -- won't *be* substituting for x if it occurs inside a+        -- lambda.+        --+        -- It's a bit painful to call exprFreeVars, because it makes+        -- three passes instead of two (occ-anal, and go)++simpleOptExprWith :: DynFlags -> Subst -> InExpr -> OutExpr+-- See Note [The simple optimiser]+simpleOptExprWith dflags subst expr+  = simple_opt_expr init_env (occurAnalyseExpr expr)+  where+    init_env = SOE { soe_dflags = dflags+                   , soe_inl = emptyVarEnv+                   , soe_subst = subst }++----------------------+simpleOptPgm :: DynFlags -> Module+             -> CoreProgram -> [CoreRule]+             -> IO (CoreProgram, [CoreRule])+-- See Note [The simple optimiser]+simpleOptPgm dflags this_mod binds rules+  = do { dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"+                       (pprCoreBindings occ_anald_binds $$ pprRules rules );++       ; return (reverse binds', rules') }+  where+    occ_anald_binds  = occurAnalysePgm this_mod+                          (\_ -> True)  {- All unfoldings active -}+                          (\_ -> False) {- No rules active -}+                          rules binds++    (final_env, binds') = foldl' do_one (emptyEnv dflags, []) occ_anald_binds+    final_subst = soe_subst final_env++    rules' = substRulesForImportedIds final_subst rules+             -- We never unconditionally inline into rules,+             -- hence paying just a substitution++    do_one (env, binds') bind+      = case simple_opt_bind env bind of+          (env', Nothing)    -> (env', binds')+          (env', Just bind') -> (env', bind':binds')++-- In these functions the substitution maps InVar -> OutExpr++----------------------+type SimpleClo = (SimpleOptEnv, InExpr)++data SimpleOptEnv+  = SOE { soe_dflags :: DynFlags+        , soe_inl   :: IdEnv SimpleClo+             -- Deals with preInlineUnconditionally; things+             -- that occur exactly once and are inlined+             -- without having first been simplified++        , soe_subst :: Subst+             -- Deals with cloning; includes the InScopeSet+        }++instance Outputable SimpleOptEnv where+  ppr (SOE { soe_inl = inl, soe_subst = subst })+    = text "SOE {" <+> vcat [ text "soe_inl   =" <+> ppr inl+                            , text "soe_subst =" <+> ppr subst ]+                   <+> text "}"++emptyEnv :: DynFlags -> SimpleOptEnv+emptyEnv dflags+  = SOE { soe_dflags = dflags+        , soe_inl = emptyVarEnv+        , soe_subst = emptySubst }++soeZapSubst :: SimpleOptEnv -> SimpleOptEnv+soeZapSubst env@(SOE { soe_subst = subst })+  = env { soe_inl = emptyVarEnv, soe_subst = zapSubstEnv subst }++soeSetInScope :: SimpleOptEnv -> SimpleOptEnv -> SimpleOptEnv+-- Take in-scope set from env1, and the rest from env2+soeSetInScope (SOE { soe_subst = subst1 })+              env2@(SOE { soe_subst = subst2 })+  = env2 { soe_subst = setInScope subst2 (substInScope subst1) }++---------------+simple_opt_clo :: SimpleOptEnv -> SimpleClo -> OutExpr+simple_opt_clo env (e_env, e)+  = simple_opt_expr (soeSetInScope env e_env) e++simple_opt_expr :: SimpleOptEnv -> InExpr -> OutExpr+simple_opt_expr env expr+  = go expr+  where+    subst        = soe_subst env+    in_scope     = substInScope subst+    in_scope_env = (in_scope, simpleUnfoldingFun)++    go (Var v)+       | Just clo <- lookupVarEnv (soe_inl env) v+       = simple_opt_clo env clo+       | otherwise+       = lookupIdSubst (text "simpleOptExpr") (soe_subst env) v++    go (App e1 e2)      = simple_app env e1 [(env,e2)]+    go (Type ty)        = Type     (substTy subst ty)+    go (Coercion co)    = Coercion (optCoercion (soe_dflags env) (getTCvSubst subst) co)+    go (Lit lit)        = Lit lit+    go (Tick tickish e) = mkTick (substTickish subst tickish) (go e)+    go (Cast e co)      | isReflCo co' = go e+                        | otherwise    = Cast (go e) co'+                        where+                          co' = optCoercion (soe_dflags env) (getTCvSubst subst) co++    go (Let bind body) = case simple_opt_bind env bind of+                           (env', Nothing)   -> simple_opt_expr env' body+                           (env', Just bind) -> Let bind (simple_opt_expr env' body)++    go lam@(Lam {})     = go_lam env [] lam+    go (Case e b ty as)+       -- See Note [Getting the map/coerce RULE to work]+      | isDeadBinder b+      , Just (_, [], con, _tys, es) <- exprIsConApp_maybe in_scope_env e'+        -- We don't need to be concerned about floats when looking for coerce.+      , Just (altcon, bs, rhs) <- findAlt (DataAlt con) as+      = case altcon of+          DEFAULT -> go rhs+          _       -> foldr wrapLet (simple_opt_expr env' rhs) mb_prs+            where+              (env', mb_prs) = mapAccumL simple_out_bind env $+                               zipEqual "simpleOptExpr" bs es++         -- Note [Getting the map/coerce RULE to work]+      | isDeadBinder b+      , [(DEFAULT, _, rhs)] <- as+      , isCoVarType (varType b)+      , (Var fun, _args) <- collectArgs e+      , fun `hasKey` coercibleSCSelIdKey+         -- without this last check, we get #11230+      = go rhs++      | otherwise+      = Case e' b' (substTy subst ty)+                   (map (go_alt env') as)+      where+        e' = go e+        (env', b') = subst_opt_bndr env b++    ----------------------+    go_alt env (con, bndrs, rhs)+      = (con, bndrs', simple_opt_expr env' rhs)+      where+        (env', bndrs') = subst_opt_bndrs env bndrs++    ----------------------+    -- go_lam tries eta reduction+    go_lam env bs' (Lam b e)+       = go_lam env' (b':bs') e+       where+         (env', b') = subst_opt_bndr env b+    go_lam env bs' e+       | Just etad_e <- tryEtaReduce bs e' = etad_e+       | otherwise                         = mkLams bs e'+       where+         bs = reverse bs'+         e' = simple_opt_expr env e++----------------------+-- simple_app collects arguments for beta reduction+simple_app :: SimpleOptEnv -> InExpr -> [SimpleClo] -> CoreExpr++simple_app env (Var v) as+  | Just (env', e) <- lookupVarEnv (soe_inl env) v+  = simple_app (soeSetInScope env env') e as++  | let unf = idUnfolding v+  , isCompulsoryUnfolding (idUnfolding v)+  , isAlwaysActive (idInlineActivation v)+    -- See Note [Unfold compulsory unfoldings in LHSs]+  = simple_app (soeZapSubst env) (unfoldingTemplate unf) as++  | otherwise+  , let out_fn = lookupIdSubst (text "simple_app") (soe_subst env) v+  = finish_app env out_fn as++simple_app env (App e1 e2) as+  = simple_app env e1 ((env, e2) : as)++simple_app env (Lam b e) (a:as)+  = wrapLet mb_pr (simple_app env' e as)+  where+     (env', mb_pr) = simple_bind_pair env b Nothing a++simple_app env (Tick t e) as+  -- Okay to do "(Tick t e) x ==> Tick t (e x)"?+  | t `tickishScopesLike` SoftScope+  = mkTick t $ simple_app env e as++-- (let x = e in b) a1 .. an  =>  let x = e in (b a1 .. an)+-- The let might appear there as a result of inlining+-- e.g.   let f = let x = e in b+--        in f a1 a2+-- (#13208)+simple_app env (Let bind body) as+  = case simple_opt_bind env bind of+      (env', Nothing)   -> simple_app env' body as+      (env', Just bind) -> Let bind (simple_app env' body as)++simple_app env e as+  = finish_app env (simple_opt_expr env e) as++finish_app :: SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr+finish_app _ fun []+  = fun+finish_app env fun (arg:args)+  = finish_app env (App fun (simple_opt_clo env arg)) args++----------------------+simple_opt_bind :: SimpleOptEnv -> InBind+                -> (SimpleOptEnv, Maybe OutBind)+simple_opt_bind env (NonRec b r)+  = (env', case mb_pr of+            Nothing    -> Nothing+            Just (b,r) -> Just (NonRec b r))+  where+    (b', r') = joinPointBinding_maybe b r `orElse` (b, r)+    (env', mb_pr) = simple_bind_pair env b' Nothing (env,r')++simple_opt_bind env (Rec prs)+  = (env'', res_bind)+  where+    res_bind          = Just (Rec (reverse rev_prs'))+    prs'              = joinPointBindings_maybe prs `orElse` prs+    (env', bndrs')    = subst_opt_bndrs env (map fst prs')+    (env'', rev_prs') = foldl' do_pr (env', []) (prs' `zip` bndrs')+    do_pr (env, prs) ((b,r), b')+       = (env', case mb_pr of+                  Just pr -> pr : prs+                  Nothing -> prs)+       where+         (env', mb_pr) = simple_bind_pair env b (Just b') (env,r)++----------------------+simple_bind_pair :: SimpleOptEnv+                 -> InVar -> Maybe OutVar+                 -> SimpleClo+                 -> (SimpleOptEnv, Maybe (OutVar, OutExpr))+    -- (simple_bind_pair subst in_var out_rhs)+    --   either extends subst with (in_var -> out_rhs)+    --   or     returns Nothing+simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst })+                 in_bndr mb_out_bndr clo@(rhs_env, in_rhs)+  | Type ty <- in_rhs        -- let a::* = TYPE ty in <body>+  , let out_ty = substTy (soe_subst rhs_env) ty+  = ASSERT( isTyVar in_bndr )+    (env { soe_subst = extendTvSubst subst in_bndr out_ty }, Nothing)++  | Coercion co <- in_rhs+  , let out_co = optCoercion (soe_dflags env) (getTCvSubst (soe_subst rhs_env)) co+  = ASSERT( isCoVar in_bndr )+    (env { soe_subst = extendCvSubst subst in_bndr out_co }, Nothing)++  | ASSERT2( isNonCoVarId in_bndr, ppr in_bndr )+    -- The previous two guards got rid of tyvars and coercions+    -- See Note [CoreSyn type and coercion invariant] in CoreSyn+    pre_inline_unconditionally+  = (env { soe_inl = extendVarEnv inl_env in_bndr clo }, Nothing)++  | otherwise+  = simple_out_bind_pair env in_bndr mb_out_bndr out_rhs+                         occ active stable_unf+  where+    stable_unf = isStableUnfolding (idUnfolding in_bndr)+    active     = isAlwaysActive (idInlineActivation in_bndr)+    occ        = idOccInfo in_bndr++    out_rhs | Just join_arity <- isJoinId_maybe in_bndr+            = simple_join_rhs join_arity+            | otherwise+            = simple_opt_clo env clo++    simple_join_rhs join_arity -- See Note [Preserve join-binding arity]+      = mkLams join_bndrs' (simple_opt_expr env_body join_body)+      where+        env0 = soeSetInScope env rhs_env+        (join_bndrs, join_body) = collectNBinders join_arity in_rhs+        (env_body, join_bndrs') = subst_opt_bndrs env0 join_bndrs++    pre_inline_unconditionally :: Bool+    pre_inline_unconditionally+       | isExportedId in_bndr     = False+       | stable_unf               = False+       | not active               = False    -- Note [Inline prag in simplOpt]+       | not (safe_to_inline occ) = False+       | otherwise                = True++        -- Unconditionally safe to inline+    safe_to_inline :: OccInfo -> Bool+    safe_to_inline (IAmALoopBreaker {}) = False+    safe_to_inline IAmDead              = True+    safe_to_inline occ@(OneOcc {})      =  not (occ_in_lam occ)+                                        && occ_one_br occ+    safe_to_inline (ManyOccs {})        = False++-------------------+simple_out_bind :: SimpleOptEnv -> (InVar, OutExpr)+                -> (SimpleOptEnv, Maybe (OutVar, OutExpr))+simple_out_bind env@(SOE { soe_subst = subst }) (in_bndr, out_rhs)+  | Type out_ty <- out_rhs+  = ASSERT( isTyVar in_bndr )+    (env { soe_subst = extendTvSubst subst in_bndr out_ty }, Nothing)++  | Coercion out_co <- out_rhs+  = ASSERT( isCoVar in_bndr )+    (env { soe_subst = extendCvSubst subst in_bndr out_co }, Nothing)++  | otherwise+  = simple_out_bind_pair env in_bndr Nothing out_rhs+                         (idOccInfo in_bndr) True False++-------------------+simple_out_bind_pair :: SimpleOptEnv+                     -> InId -> Maybe OutId -> OutExpr+                     -> OccInfo -> Bool -> Bool+                     -> (SimpleOptEnv, Maybe (OutVar, OutExpr))+simple_out_bind_pair env in_bndr mb_out_bndr out_rhs+                     occ_info active stable_unf+  | ASSERT2( isNonCoVarId in_bndr, ppr in_bndr )+    -- Type and coercion bindings are caught earlier+    -- See Note [CoreSyn type and coercion invariant]+    post_inline_unconditionally+  = ( env' { soe_subst = extendIdSubst (soe_subst env) in_bndr out_rhs }+    , Nothing)++  | otherwise+  = ( env', Just (out_bndr, out_rhs) )+  where+    (env', bndr1) = case mb_out_bndr of+                      Just out_bndr -> (env, out_bndr)+                      Nothing       -> subst_opt_bndr env in_bndr+    out_bndr = add_info env' in_bndr bndr1++    post_inline_unconditionally :: Bool+    post_inline_unconditionally+       | isExportedId in_bndr  = False -- Note [Exported Ids and trivial RHSs]+       | stable_unf            = False -- Note [Stable unfoldings and postInlineUnconditionally]+       | not active            = False --     in SimplUtils+       | is_loop_breaker       = False -- If it's a loop-breaker of any kind, don't inline+                                       -- because it might be referred to "earlier"+       | exprIsTrivial out_rhs = True+       | coercible_hack        = True+       | otherwise             = False++    is_loop_breaker = isWeakLoopBreaker occ_info++    -- See Note [Getting the map/coerce RULE to work]+    coercible_hack | (Var fun, args) <- collectArgs out_rhs+                   , Just dc <- isDataConWorkId_maybe fun+                   , dc `hasKey` heqDataConKey || dc `hasKey` coercibleDataConKey+                   = all exprIsTrivial args+                   | otherwise+                   = False++{- Note [Exported Ids and trivial RHSs]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We obviously do not want to unconditionally inline an Id that is exported.+In SimplUtils, Note [Top level and postInlineUnconditionally], we+explain why we don't inline /any/ top-level things unconditionally, even+trivial ones.  But we do here!  Why?  In the simple optimiser++  * We do no rule rewrites+  * We do no call-site inlining++Those differences obviate the reasons for not inlining a trivial rhs,+and increase the benefit for doing so.  So we unconditionally inline trivial+rhss here.++Note [Preserve join-binding arity]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Be careful /not/ to eta-reduce the RHS of a join point, lest we lose+the join-point arity invariant.  #15108 was caused by simplifying+the RHS with simple_opt_expr, which does eta-reduction.  Solution:+simplify the RHS of a join point by simplifying under the lambdas+(which of course should be there).+-}++----------------------+subst_opt_bndrs :: SimpleOptEnv -> [InVar] -> (SimpleOptEnv, [OutVar])+subst_opt_bndrs env bndrs = mapAccumL subst_opt_bndr env bndrs++subst_opt_bndr :: SimpleOptEnv -> InVar -> (SimpleOptEnv, OutVar)+subst_opt_bndr env bndr+  | isTyVar bndr  = (env { soe_subst = subst_tv }, tv')+  | isCoVar bndr  = (env { soe_subst = subst_cv }, cv')+  | otherwise     = subst_opt_id_bndr env bndr+  where+    subst           = soe_subst env+    (subst_tv, tv') = substTyVarBndr subst bndr+    (subst_cv, cv') = substCoVarBndr subst bndr++subst_opt_id_bndr :: SimpleOptEnv -> InId -> (SimpleOptEnv, OutId)+-- Nuke all fragile IdInfo, unfolding, and RULES;+--    it gets added back later by add_info+-- Rather like SimplEnv.substIdBndr+--+-- It's important to zap fragile OccInfo (which CoreSubst.substIdBndr+-- carefully does not do) because simplOptExpr invalidates it++subst_opt_id_bndr env@(SOE { soe_subst = subst, soe_inl = inl }) old_id+  = (env { soe_subst = new_subst, soe_inl = new_inl }, new_id)+  where+    Subst in_scope id_subst tv_subst cv_subst = subst++    id1    = uniqAway in_scope old_id+    id2    = setIdType id1 (substTy subst (idType old_id))+    new_id = zapFragileIdInfo id2+             -- Zaps rules, unfolding, and fragile OccInfo+             -- The unfolding and rules will get added back later, by add_info++    new_in_scope = in_scope `extendInScopeSet` new_id++    no_change = new_id == old_id++        -- Extend the substitution if the unique has changed,+        -- See the notes with substTyVarBndr for the delSubstEnv+    new_id_subst+      | no_change = delVarEnv id_subst old_id+      | otherwise = extendVarEnv id_subst old_id (Var new_id)++    new_subst = Subst new_in_scope new_id_subst tv_subst cv_subst+    new_inl   = delVarEnv inl old_id++----------------------+add_info :: SimpleOptEnv -> InVar -> OutVar -> OutVar+add_info env old_bndr new_bndr+ | isTyVar old_bndr = new_bndr+ | otherwise        = maybeModifyIdInfo mb_new_info new_bndr+ where+   subst = soe_subst env+   mb_new_info = substIdInfo subst new_bndr (idInfo old_bndr)++simpleUnfoldingFun :: IdUnfoldingFun+simpleUnfoldingFun id+  | isAlwaysActive (idInlineActivation id) = idUnfolding id+  | otherwise                              = noUnfolding++wrapLet :: Maybe (Id,CoreExpr) -> CoreExpr -> CoreExpr+wrapLet Nothing      body = body+wrapLet (Just (b,r)) body = Let (NonRec b r) body++{-+Note [Inline prag in simplOpt]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If there's an INLINE/NOINLINE pragma that restricts the phase in+which the binder can be inlined, we don't inline here; after all,+we don't know what phase we're in.  Here's an example++  foo :: Int -> Int -> Int+  {-# INLINE foo #-}+  foo m n = inner m+     where+       {-# INLINE [1] inner #-}+       inner m = m+n++  bar :: Int -> Int+  bar n = foo n 1++When inlining 'foo' in 'bar' we want the let-binding for 'inner'+to remain visible until Phase 1++Note [Unfold compulsory unfoldings in LHSs]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When the user writes `RULES map coerce = coerce` as a rule, the rule+will only ever match if simpleOptExpr replaces coerce by its unfolding+on the LHS, because that is the core that the rule matching engine+will find. So do that for everything that has a compulsory+unfolding. Also see Note [Desugaring coerce as cast] in Desugar.++However, we don't want to inline 'seq', which happens to also have a+compulsory unfolding, so we only do this unfolding only for things+that are always-active.  See Note [User-defined RULES for seq] in MkId.++Note [Getting the map/coerce RULE to work]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We wish to allow the "map/coerce" RULE to fire:++  {-# RULES "map/coerce" map coerce = coerce #-}++The naive core produced for this is++  forall a b (dict :: Coercible * a b).+    map @a @b (coerce @a @b @dict) = coerce @[a] @[b] @dict'++  where dict' :: Coercible [a] [b]+        dict' = ...++This matches literal uses of `map coerce` in code, but that's not what we+want. We want it to match, say, `map MkAge` (where newtype Age = MkAge Int)+too. Some of this is addressed by compulsorily unfolding coerce on the LHS,+yielding++  forall a b (dict :: Coercible * a b).+    map @a @b (\(x :: a) -> case dict of+      MkCoercible (co :: a ~R# b) -> x |> co) = ...++Getting better. But this isn't exactly what gets produced. This is because+Coercible essentially has ~R# as a superclass, and superclasses get eagerly+extracted during solving. So we get this:++  forall a b (dict :: Coercible * a b).+    case Coercible_SCSel @* @a @b dict of+      _ [Dead] -> map @a @b (\(x :: a) -> case dict of+                               MkCoercible (co :: a ~R# b) -> x |> co) = ...++Unfortunately, this still abstracts over a Coercible dictionary. We really+want it to abstract over the ~R# evidence. So, we have Desugar.unfold_coerce,+which transforms the above to (see also Note [Desugaring coerce as cast] in+Desugar)++  forall a b (co :: a ~R# b).+    let dict = MkCoercible @* @a @b co in+    case Coercible_SCSel @* @a @b dict of+      _ [Dead] -> map @a @b (\(x :: a) -> case dict of+         MkCoercible (co :: a ~R# b) -> x |> co) = let dict = ... in ...++Now, we need simpleOptExpr to fix this up. It does so by taking three+separate actions:+  1. Inline certain non-recursive bindings. The choice whether to inline+     is made in simple_bind_pair. Note the rather specific check for+     MkCoercible in there.++  2. Stripping case expressions like the Coercible_SCSel one.+     See the `Case` case of simple_opt_expr's `go` function.++  3. Look for case expressions that unpack something that was+     just packed and inline them. This is also done in simple_opt_expr's+     `go` function.++This is all a fair amount of special-purpose hackery, but it's for+a good cause. And it won't hurt other RULES and such that it comes across.+++************************************************************************+*                                                                      *+                Join points+*                                                                      *+************************************************************************+-}++-- | Returns Just (bndr,rhs) if the binding is a join point:+-- If it's a JoinId, just return it+-- If it's not yet a JoinId but is always tail-called,+--    make it into a JoinId and return it.+-- In the latter case, eta-expand the RHS if necessary, to make the+-- lambdas explicit, as is required for join points+--+-- Precondition: the InBndr has been occurrence-analysed,+--               so its OccInfo is valid+joinPointBinding_maybe :: InBndr -> InExpr -> Maybe (InBndr, InExpr)+joinPointBinding_maybe bndr rhs+  | not (isId bndr)+  = Nothing++  | isJoinId bndr+  = Just (bndr, rhs)++  | AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr)+  , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs+  , let str_sig   = idStrictness bndr+        str_arity = count isId bndrs  -- Strictness demands are for Ids only+        join_bndr = bndr `asJoinId`        join_arity+                         `setIdStrictness` etaExpandStrictSig str_arity str_sig+  = Just (join_bndr, mkLams bndrs body)++  | otherwise+  = Nothing++joinPointBindings_maybe :: [(InBndr, InExpr)] -> Maybe [(InBndr, InExpr)]+joinPointBindings_maybe bndrs+  = mapM (uncurry joinPointBinding_maybe) bndrs+++{- Note [Strictness and join points]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have++   let f = \x.  if x>200 then e1 else e1++and we know that f is strict in x.  Then if we subsequently+discover that f is an arity-2 join point, we'll eta-expand it to++   let f = \x y.  if x>200 then e1 else e1++and now it's only strict if applied to two arguments.  So we should+adjust the strictness info.++A more common case is when++   f = \x. error ".."++and again its arity increases (#15517)+-}++{- *********************************************************************+*                                                                      *+         exprIsConApp_maybe+*                                                                      *+************************************************************************++Note [exprIsConApp_maybe]+~~~~~~~~~~~~~~~~~~~~~~~~~+exprIsConApp_maybe is a very important function.  There are two principal+uses:+  * case e of { .... }+  * cls_op e, where cls_op is a class operation++In both cases you want to know if e is of form (C e1..en) where C is+a data constructor.++However e might not *look* as if+++Note [exprIsConApp_maybe on literal strings]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+See #9400 and #13317.++Conceptually, a string literal "abc" is just ('a':'b':'c':[]), but in Core+they are represented as unpackCString# "abc"# by MkCore.mkStringExprFS, or+unpackCStringUtf8# when the literal contains multi-byte UTF8 characters.++For optimizations we want to be able to treat it as a list, so they can be+decomposed when used in a case-statement. exprIsConApp_maybe detects those+calls to unpackCString# and returns:++Just (':', [Char], ['a', unpackCString# "bc"]).++We need to be careful about UTF8 strings here. ""# contains a ByteString, so+we must parse it back into a FastString to split off the first character.+That way we can treat unpackCString# and unpackCStringUtf8# in the same way.++We must also be caeful about+   lvl = "foo"#+   ...(unpackCString# lvl)...+to ensure that we see through the let-binding for 'lvl'.  Hence the+(exprIsLiteral_maybe .. arg) in the guard before the call to+dealWithStringLiteral.++Note [Push coercions in exprIsConApp_maybe]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In #13025 I found a case where we had+    op (df @t1 @t2)     -- op is a ClassOp+where+    df = (/\a b. K e1 e2) |> g++To get this to come out we need to simplify on the fly+   ((/\a b. K e1 e2) |> g) @t1 @t2++Hence the use of pushCoArgs.++Note [exprIsConApp_maybe on data constructors with wrappers]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Problem:+- some data constructors have wrappers+- these wrappers inline late (see MkId Note [Activation for data constructor wrappers])+- but we still want case-of-known-constructor to fire early.++Example:+   data T = MkT !Int+   $WMkT n = case n of n' -> MkT n'   -- Wrapper for MkT+   foo x = case $WMkT e of MkT y -> blah++Here we want the case-of-known-constructor transformation to fire, giving+   foo x = case e of x' -> let y = x' in blah++Here's how exprIsConApp_maybe achieves this:++0.  Start with scrutinee = $WMkT e++1.  Inline $WMkT on-the-fly.  That's why data-constructor wrappers are marked+    as expandable. (See CoreUtils.isExpandableApp.) Now we have+      scrutinee = (\n. case n of n' -> MkT n') e++2.  Beta-reduce the application, generating a floated 'let'.+    See Note [beta-reduction in exprIsConApp_maybe] below.  Now we have+      scrutinee = case n of n' -> MkT n'+      with floats {Let n = e}++3.  Float the "case x of x' ->" binding out.  Now we have+      scrutinee = MkT n'+      with floats {Let n = e; case n of n' ->}++And now we have a known-constructor MkT that we can return.++Notice that both (2) and (3) require exprIsConApp_maybe to gather and return+a bunch of floats, both let and case bindings.++Note [beta-reduction in exprIsConApp_maybe]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The unfolding a definition (_e.g._ a let-bound variable or a datacon wrapper) is+typically a function. For instance, take the wrapper for MkT in Note+[exprIsConApp_maybe on data constructors with wrappers]:++    $WMkT n = case n of { n' -> T n' }++If `exprIsConApp_maybe` is trying to analyse `$MkT arg`, upon unfolding of $MkT,+it will see++   (\n -> case n of { n' -> T n' }) arg++In order to go progress, `exprIsConApp_maybe` must perform a beta-reduction.++We don't want to blindly substitute `arg` in the body of the function, because+it duplicates work. We can (and, in fact, used to) substitute `arg` in the body,+but only when `arg` is a variable (or something equally work-free).++But, because of Note [exprIsConApp_maybe on data constructors with wrappers],+'exprIsConApp_maybe' now returns floats. So, instead, we can beta-reduce+_always_:++    (\x -> body) arg++Is transformed into++   let x = arg in body++Which, effectively, means emitting a float `let x = arg` and recursively+analysing the body.++For newtypes, this strategy requires that their wrappers have compulsory unfoldings.+Suppose we have+   newtype T a b where+     MkT :: a -> T b a   -- Note args swapped++This defines a worker function MkT, a wrapper function $WMkT, and an axT:+   $WMkT :: forall a b. a -> T b a+   $WMkT = /\b a. \(x:a). MkT a b x    -- A real binding++   MkT :: forall a b. a -> T a b+   MkT = /\a b. \(x:a). x |> (ax a b)  -- A compulsory unfolding++   axiom axT :: a ~R# T a b++Now we are optimising+   case $WMkT (I# 3) |> sym axT of I# y -> ...+we clearly want to simplify this. If $WMkT did not have a compulsory+unfolding, we would end up with+   let a = I#3 in case a of I# y -> ...+because in general, we do this on-the-fly beta-reduction+   (\x. e) blah  -->  let x = blah in e+and then float the the let.  (Substitution would risk duplicating 'blah'.)++But if the case-of-known-constructor doesn't actually fire (i.e.+exprIsConApp_maybe does not return Just) then nothing happens, and nothing+will happen the next time either.++See test T16254, which checks the behavior of newtypes.+-}++data ConCont = CC [CoreExpr] Coercion+                  -- Substitution already applied++-- | Returns @Just ([b1..bp], dc, [t1..tk], [x1..xn])@ if the argument+-- expression is a *saturated* constructor application of the form @let b1 in+-- .. let bp in dc t1..tk x1 .. xn@, where t1..tk are the+-- *universally-quantified* type args of 'dc'. Floats can also be (and most+-- likely are) single-alternative case expressions. Why does+-- 'exprIsConApp_maybe' return floats? We may have to look through lets and+-- cases to detect that we are in the presence of a data constructor wrapper. In+-- this case, we need to return the lets and cases that we traversed. See Note+-- [exprIsConApp_maybe on data constructors with wrappers]. Data constructor wrappers+-- are unfolded late, but we really want to trigger case-of-known-constructor as+-- early as possible. See also Note [Activation for data constructor wrappers]+-- in MkId.+--+-- We also return the incoming InScopeSet, augmented with+-- the binders from any [FloatBind] that we return+exprIsConApp_maybe :: InScopeEnv -> CoreExpr+                   -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])+exprIsConApp_maybe (in_scope, id_unf) expr+  = go (Left in_scope) [] expr (CC [] (mkRepReflCo (exprType expr)))+  where+    go :: Either InScopeSet Subst+             -- Left in-scope  means "empty substitution"+             -- Right subst    means "apply this substitution to the CoreExpr"+             -- NB: in the call (go subst floats expr cont)+             --     the substitution applies to 'expr', but /not/ to 'floats' or 'cont'+       -> [FloatBind] -> CoreExpr -> ConCont+             -- Notice that the floats here are in reverse order+       -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])+    go subst floats (Tick t expr) cont+       | not (tickishIsCode t) = go subst floats expr cont++    go subst floats (Cast expr co1) (CC args co2)+       | Just (args', m_co1') <- pushCoArgs (subst_co subst co1) args+            -- See Note [Push coercions in exprIsConApp_maybe]+       = case m_co1' of+           MCo co1' -> go subst floats expr (CC args' (co1' `mkTransCo` co2))+           MRefl    -> go subst floats expr (CC args' co2)++    go subst floats (App fun arg) (CC args co)+       = go subst floats fun (CC (subst_expr subst arg : args) co)++    go subst floats (Lam bndr body) (CC (arg:args) co)+       | exprIsTrivial arg          -- Don't duplicate stuff!+       = go (extend subst bndr arg) floats body (CC args co)+       | otherwise+       = let (subst', bndr') = subst_bndr subst bndr+             float           = FloatLet (NonRec bndr' arg)+         in go subst' (float:floats) body (CC args co)++    go subst floats (Let (NonRec bndr rhs) expr) cont+       = let rhs'            = subst_expr subst rhs+             (subst', bndr') = subst_bndr subst bndr+             float           = FloatLet (NonRec bndr' rhs')+         in go subst' (float:floats) expr cont++    go subst floats (Case scrut b _ [(con, vars, expr)]) cont+       = let+          scrut'           = subst_expr subst scrut+          (subst', b')     = subst_bndr subst b+          (subst'', vars') = subst_bndrs subst' vars+          float            = FloatCase scrut' b' con vars'+         in+           go subst'' (float:floats) expr cont++    go (Right sub) floats (Var v) cont+       = go (Left (substInScope sub))+            floats+            (lookupIdSubst (text "exprIsConApp" <+> ppr expr) sub v)+            cont++    go (Left in_scope) floats (Var fun) cont@(CC args co)++        | Just con <- isDataConWorkId_maybe fun+        , count isValArg args == idArity fun+        = succeedWith in_scope floats $+          pushCoDataCon con args co++        -- Look through data constructor wrappers: they inline late (See Note+        -- [Activation for data constructor wrappers]) but we want to do+        -- case-of-known-constructor optimisation eagerly.+        | isDataConWrapId fun+        , let rhs = uf_tmpl (realIdUnfolding fun)+        = go (Left in_scope) floats rhs cont++        -- Look through dictionary functions; see Note [Unfolding DFuns]+        | DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = dfun_args } <- unfolding+        , bndrs `equalLength` args    -- See Note [DFun arity check]+        , let subst = mkOpenSubst in_scope (bndrs `zip` args)+        = succeedWith in_scope floats $+          pushCoDataCon con (map (substExpr (text "exprIsConApp1") subst) dfun_args) co++        -- Look through unfoldings, but only arity-zero one;+        -- if arity > 0 we are effectively inlining a function call,+        -- and that is the business of callSiteInline.+        -- In practice, without this test, most of the "hits" were+        -- CPR'd workers getting inlined back into their wrappers,+        | idArity fun == 0+        , Just rhs <- expandUnfolding_maybe unfolding+        , let in_scope' = extendInScopeSetSet in_scope (exprFreeVars rhs)+        = go (Left in_scope') floats rhs cont++        -- See Note [exprIsConApp_maybe on literal strings]+        | (fun `hasKey` unpackCStringIdKey) ||+          (fun `hasKey` unpackCStringUtf8IdKey)+        , [arg]              <- args+        , Just (LitString str) <- exprIsLiteral_maybe (in_scope, id_unf) arg+        = succeedWith in_scope floats $+          dealWithStringLiteral fun str co+        where+          unfolding = id_unf fun++    go _ _ _ _ = Nothing++    succeedWith :: InScopeSet -> [FloatBind]+                -> Maybe (DataCon, [Type], [CoreExpr])+                -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])+    succeedWith in_scope rev_floats x+      = do { (con, tys, args) <- x+           ; let floats = reverse rev_floats+           ; return (in_scope, floats, con, tys, args) }++    ----------------------------+    -- Operations on the (Either InScopeSet CoreSubst)+    -- The Left case is wildly dominant+    subst_co (Left {}) co = co+    subst_co (Right s) co = CoreSubst.substCo s co++    subst_expr (Left {}) e = e+    subst_expr (Right s) e = substExpr (text "exprIsConApp2") s e++    subst_bndr msubst bndr+      = (Right subst', bndr')+      where+        (subst', bndr') = substBndr subst bndr+        subst = case msubst of+                  Left in_scope -> mkEmptySubst in_scope+                  Right subst   -> subst++    subst_bndrs subst bs = mapAccumL subst_bndr subst bs++    extend (Left in_scope) v e = Right (extendSubst (mkEmptySubst in_scope) v e)+    extend (Right s)       v e = Right (extendSubst s v e)+++-- See Note [exprIsConApp_maybe on literal strings]+dealWithStringLiteral :: Var -> BS.ByteString -> Coercion+                      -> Maybe (DataCon, [Type], [CoreExpr])++-- This is not possible with user-supplied empty literals, MkCore.mkStringExprFS+-- turns those into [] automatically, but just in case something else in GHC+-- generates a string literal directly.+dealWithStringLiteral _   str co+  | BS.null str+  = pushCoDataCon nilDataCon [Type charTy] co++dealWithStringLiteral fun str co+  = let strFS = mkFastStringByteString str++        char = mkConApp charDataCon [mkCharLit (headFS strFS)]+        charTail = bytesFS (tailFS strFS)++        -- In singleton strings, just add [] instead of unpackCstring# ""#.+        rest = if BS.null charTail+                 then mkConApp nilDataCon [Type charTy]+                 else App (Var fun)+                          (Lit (LitString charTail))++    in pushCoDataCon consDataCon [Type charTy, char, rest] co++{-+Note [Unfolding DFuns]+~~~~~~~~~~~~~~~~~~~~~~+DFuns look like++  df :: forall a b. (Eq a, Eq b) -> Eq (a,b)+  df a b d_a d_b = MkEqD (a,b) ($c1 a b d_a d_b)+                               ($c2 a b d_a d_b)++So to split it up we just need to apply the ops $c1, $c2 etc+to the very same args as the dfun.  It takes a little more work+to compute the type arguments to the dictionary constructor.++Note [DFun arity check]+~~~~~~~~~~~~~~~~~~~~~~~+Here we check that the total number of supplied arguments (inclding+type args) matches what the dfun is expecting.  This may be *less*+than the ordinary arity of the dfun: see Note [DFun unfoldings] in CoreSyn+-}++exprIsLiteral_maybe :: InScopeEnv -> CoreExpr -> Maybe Literal+-- Same deal as exprIsConApp_maybe, but much simpler+-- Nevertheless we do need to look through unfoldings for+-- Integer and string literals, which are vigorously hoisted to top level+-- and not subsequently inlined+exprIsLiteral_maybe env@(_, id_unf) e+  = case e of+      Lit l     -> Just l+      Tick _ e' -> exprIsLiteral_maybe env e' -- dubious?+      Var v     | Just rhs <- expandUnfolding_maybe (id_unf v)+                -> exprIsLiteral_maybe env rhs+      _         -> Nothing++{-+Note [exprIsLambda_maybe]+~~~~~~~~~~~~~~~~~~~~~~~~~~+exprIsLambda_maybe will, given an expression `e`, try to turn it into the form+`Lam v e'` (returned as `Just (v,e')`). Besides using lambdas, it looks through+casts (using the Push rule), and it unfolds function calls if the unfolding+has a greater arity than arguments are present.++Currently, it is used in Rules.match, and is required to make+"map coerce = coerce" match.+-}++exprIsLambda_maybe :: InScopeEnv -> CoreExpr+                      -> Maybe (Var, CoreExpr,[Tickish Id])+    -- See Note [exprIsLambda_maybe]++-- The simple case: It is a lambda already+exprIsLambda_maybe _ (Lam x e)+    = Just (x, e, [])++-- Still straightforward: Ticks that we can float out of the way+exprIsLambda_maybe (in_scope_set, id_unf) (Tick t e)+    | tickishFloatable t+    , Just (x, e, ts) <- exprIsLambda_maybe (in_scope_set, id_unf) e+    = Just (x, e, t:ts)++-- Also possible: A casted lambda. Push the coercion inside+exprIsLambda_maybe (in_scope_set, id_unf) (Cast casted_e co)+    | Just (x, e,ts) <- exprIsLambda_maybe (in_scope_set, id_unf) casted_e+    -- Only do value lambdas.+    -- this implies that x is not in scope in gamma (makes this code simpler)+    , not (isTyVar x) && not (isCoVar x)+    , ASSERT( not $ x `elemVarSet` tyCoVarsOfCo co) True+    , Just (x',e') <- pushCoercionIntoLambda in_scope_set x e co+    , let res = Just (x',e',ts)+    = --pprTrace "exprIsLambda_maybe:Cast" (vcat [ppr casted_e,ppr co,ppr res)])+      res++-- Another attempt: See if we find a partial unfolding+exprIsLambda_maybe (in_scope_set, id_unf) e+    | (Var f, as, ts) <- collectArgsTicks tickishFloatable e+    , idArity f > count isValArg as+    -- Make sure there is hope to get a lambda+    , Just rhs <- expandUnfolding_maybe (id_unf f)+    -- Optimize, for beta-reduction+    , let e' = simpleOptExprWith unsafeGlobalDynFlags (mkEmptySubst in_scope_set) (rhs `mkApps` as)+    -- Recurse, because of possible casts+    , Just (x', e'', ts') <- exprIsLambda_maybe (in_scope_set, id_unf) e'+    , let res = Just (x', e'', ts++ts')+    = -- pprTrace "exprIsLambda_maybe:Unfold" (vcat [ppr e, ppr (x',e'')])+      res++exprIsLambda_maybe _ _e+    = -- pprTrace "exprIsLambda_maybe:Fail" (vcat [ppr _e])+      Nothing+++{- *********************************************************************+*                                                                      *+              The "push rules"+*                                                                      *+************************************************************************++Here we implement the "push rules" from FC papers:++* The push-argument rules, where we can move a coercion past an argument.+  We have+      (fun |> co) arg+  and we want to transform it to+    (fun arg') |> co'+  for some suitable co' and tranformed arg'.++* The PushK rule for data constructors.  We have+       (K e1 .. en) |> co+  and we want to tranform to+       (K e1' .. en')+  by pushing the coercion into the arguments+-}++pushCoArgs :: CoercionR -> [CoreArg] -> Maybe ([CoreArg], MCoercion)+pushCoArgs co []         = return ([], MCo co)+pushCoArgs co (arg:args) = do { (arg',  m_co1) <- pushCoArg  co  arg+                              ; case m_co1 of+                                  MCo co1 -> do { (args', m_co2) <- pushCoArgs co1 args+                                                 ; return (arg':args', m_co2) }+                                  MRefl  -> return (arg':args, MRefl) }++pushCoArg :: CoercionR -> CoreArg -> Maybe (CoreArg, MCoercion)+-- We have (fun |> co) arg, and we want to transform it to+--         (fun arg) |> co+-- This may fail, e.g. if (fun :: N) where N is a newtype+-- C.f. simplCast in Simplify.hs+-- 'co' is always Representational+-- If the returned coercion is Nothing, then it would have been reflexive+pushCoArg co (Type ty) = do { (ty', m_co') <- pushCoTyArg co ty+                            ; return (Type ty', m_co') }+pushCoArg co val_arg   = do { (arg_co, m_co') <- pushCoValArg co+                            ; return (val_arg `mkCast` arg_co, m_co') }++pushCoTyArg :: CoercionR -> Type -> Maybe (Type, MCoercionR)+-- We have (fun |> co) @ty+-- Push the coercion through to return+--         (fun @ty') |> co'+-- 'co' is always Representational+-- If the returned coercion is Nothing, then it would have been reflexive;+-- it's faster not to compute it, though.+pushCoTyArg co ty+  -- The following is inefficient - don't do `eqType` here, the coercion+  -- optimizer will take care of it. See #14737.+  -- -- | tyL `eqType` tyR+  -- -- = Just (ty, Nothing)++  | isReflCo co+  = Just (ty, MRefl)++  | isForAllTy_ty tyL+  = ASSERT2( isForAllTy_ty tyR, ppr co $$ ppr ty )+    Just (ty `mkCastTy` co1, MCo co2)++  | otherwise+  = Nothing+  where+    Pair tyL tyR = coercionKind co+       -- co :: tyL ~ tyR+       -- tyL = forall (a1 :: k1). ty1+       -- tyR = forall (a2 :: k2). ty2++    co1 = mkSymCo (mkNthCo Nominal 0 co)+       -- co1 :: k2 ~N k1+       -- Note that NthCo can extract a Nominal equality between the+       -- kinds of the types related by a coercion between forall-types.+       -- See the NthCo case in CoreLint.++    co2 = mkInstCo co (mkGReflLeftCo Nominal ty co1)+        -- co2 :: ty1[ (ty|>co1)/a1 ] ~ ty2[ ty/a2 ]+        -- Arg of mkInstCo is always nominal, hence mkNomReflCo++pushCoValArg :: CoercionR -> Maybe (Coercion, MCoercion)+-- We have (fun |> co) arg+-- Push the coercion through to return+--         (fun (arg |> co_arg)) |> co_res+-- 'co' is always Representational+-- If the second returned Coercion is actually Nothing, then no cast is necessary;+-- the returned coercion would have been reflexive.+pushCoValArg co+  -- The following is inefficient - don't do `eqType` here, the coercion+  -- optimizer will take care of it. See #14737.+  -- -- | tyL `eqType` tyR+  -- -- = Just (mkRepReflCo arg, Nothing)++  | isReflCo co+  = Just (mkRepReflCo arg, MRefl)++  | isFunTy tyL+  , (co1, co2) <- decomposeFunCo Representational co+              -- If   co  :: (tyL1 -> tyL2) ~ (tyR1 -> tyR2)+              -- then co1 :: tyL1 ~ tyR1+              --      co2 :: tyL2 ~ tyR2+  = ASSERT2( isFunTy tyR, ppr co $$ ppr arg )+    Just (mkSymCo co1, MCo co2)++  | otherwise+  = Nothing+  where+    arg = funArgTy tyR+    Pair tyL tyR = coercionKind co++pushCoercionIntoLambda+    :: InScopeSet -> Var -> CoreExpr -> CoercionR -> Maybe (Var, CoreExpr)+-- This implements the Push rule from the paper on coercions+--    (\x. e) |> co+-- ===>+--    (\x'. e |> co')+pushCoercionIntoLambda in_scope x e co+    | ASSERT(not (isTyVar x) && not (isCoVar x)) True+    , Pair s1s2 t1t2 <- coercionKind co+    , Just (_s1,_s2) <- splitFunTy_maybe s1s2+    , Just (t1,_t2) <- splitFunTy_maybe t1t2+    = let (co1, co2) = decomposeFunCo Representational co+          -- Should we optimize the coercions here?+          -- Otherwise they might not match too well+          x' = x `setIdType` t1+          in_scope' = in_scope `extendInScopeSet` x'+          subst = extendIdSubst (mkEmptySubst in_scope')+                                x+                                (mkCast (Var x') co1)+      in Just (x', substExpr (text "pushCoercionIntoLambda") subst e `mkCast` co2)+    | otherwise+    = pprTrace "exprIsLambda_maybe: Unexpected lambda in case" (ppr (Lam x e))+      Nothing++pushCoDataCon :: DataCon -> [CoreExpr] -> Coercion+              -> Maybe (DataCon+                       , [Type]      -- Universal type args+                       , [CoreExpr]) -- All other args incl existentials+-- Implement the KPush reduction rule as described in "Down with kinds"+-- The transformation applies iff we have+--      (C e1 ... en) `cast` co+-- where co :: (T t1 .. tn) ~ to_ty+-- The left-hand one must be a T, because exprIsConApp returned True+-- but the right-hand one might not be.  (Though it usually will.)+pushCoDataCon dc dc_args co+  | isReflCo co || from_ty `eqType` to_ty  -- try cheap test first+  , let (univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args+  = Just (dc, map exprToType univ_ty_args, rest_args)++  | Just (to_tc, to_tc_arg_tys) <- splitTyConApp_maybe to_ty+  , to_tc == dataConTyCon dc+        -- These two tests can fail; we might see+        --      (C x y) `cast` (g :: T a ~ S [a]),+        -- where S is a type function.  In fact, exprIsConApp+        -- will probably not be called in such circumstances,+        -- but there's nothing wrong with it++  = let+        tc_arity       = tyConArity to_tc+        dc_univ_tyvars = dataConUnivTyVars dc+        dc_ex_tcvars   = dataConExTyCoVars dc+        arg_tys        = dataConRepArgTys dc++        non_univ_args  = dropList dc_univ_tyvars dc_args+        (ex_args, val_args) = splitAtList dc_ex_tcvars non_univ_args++        -- Make the "Psi" from the paper+        omegas = decomposeCo tc_arity co (tyConRolesRepresentational to_tc)+        (psi_subst, to_ex_arg_tys)+          = liftCoSubstWithEx Representational+                              dc_univ_tyvars+                              omegas+                              dc_ex_tcvars+                              (map exprToType ex_args)++          -- Cast the value arguments (which include dictionaries)+        new_val_args = zipWith cast_arg arg_tys val_args+        cast_arg arg_ty arg = mkCast arg (psi_subst arg_ty)++        to_ex_args = map Type to_ex_arg_tys++        dump_doc = vcat [ppr dc,      ppr dc_univ_tyvars, ppr dc_ex_tcvars,+                         ppr arg_tys, ppr dc_args,+                         ppr ex_args, ppr val_args, ppr co, ppr from_ty, ppr to_ty, ppr to_tc ]+    in+    ASSERT2( eqType from_ty (mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args)), dump_doc )+    ASSERT2( equalLength val_args arg_tys, dump_doc )+    Just (dc, to_tc_arg_tys, to_ex_args ++ new_val_args)++  | otherwise+  = Nothing++  where+    Pair from_ty to_ty = coercionKind co++collectBindersPushingCo :: CoreExpr -> ([Var], CoreExpr)+-- Collect lambda binders, pushing coercions inside if possible+-- E.g.   (\x.e) |> g         g :: <Int> -> blah+--        = (\x. e |> Nth 1 g)+--+-- That is,+--+-- collectBindersPushingCo ((\x.e) |> g) === ([x], e |> Nth 1 g)+collectBindersPushingCo e+  = go [] e+  where+    -- Peel off lambdas until we hit a cast.+    go :: [Var] -> CoreExpr -> ([Var], CoreExpr)+    -- The accumulator is in reverse order+    go bs (Lam b e)   = go (b:bs) e+    go bs (Cast e co) = go_c bs e co+    go bs e           = (reverse bs, e)++    -- We are in a cast; peel off casts until we hit a lambda.+    go_c :: [Var] -> CoreExpr -> CoercionR -> ([Var], CoreExpr)+    -- (go_c bs e c) is same as (go bs e (e |> c))+    go_c bs (Cast e co1) co2 = go_c bs e (co1 `mkTransCo` co2)+    go_c bs (Lam b e)    co  = go_lam bs b e co+    go_c bs e            co  = (reverse bs, mkCast e co)++    -- We are in a lambda under a cast; peel off lambdas and build a+    -- new coercion for the body.+    go_lam :: [Var] -> Var -> CoreExpr -> CoercionR -> ([Var], CoreExpr)+    -- (go_lam bs b e c) is same as (go_c bs (\b.e) c)+    go_lam bs b e co+      | isTyVar b+      , let Pair tyL tyR = coercionKind co+      , ASSERT( isForAllTy_ty tyL )+        isForAllTy_ty tyR+      , isReflCo (mkNthCo Nominal 0 co)  -- See Note [collectBindersPushingCo]+      = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkTyVarTy b)))++      | isCoVar b+      , let Pair tyL tyR = coercionKind co+      , ASSERT( isForAllTy_co tyL )+        isForAllTy_co tyR+      , isReflCo (mkNthCo Nominal 0 co)  -- See Note [collectBindersPushingCo]+      , let cov = mkCoVarCo b+      = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkCoercionTy cov)))++      | isId b+      , let Pair tyL tyR = coercionKind co+      , ASSERT( isFunTy tyL) isFunTy tyR+      , (co_arg, co_res) <- decomposeFunCo Representational co+      , isReflCo co_arg  -- See Note [collectBindersPushingCo]+      = go_c (b:bs) e co_res++      | otherwise = (reverse bs, mkCast (Lam b e) co)++{- Note [collectBindersPushingCo]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We just look for coercions of form+   <type> -> blah+(and similarly for foralls) to keep this function simple.  We could do+more elaborate stuff, but it'd involve substitution etc.+-}
+ compiler/coreSyn/CoreSeq.hs view
@@ -0,0 +1,113 @@+-- |+-- Various utilities for forcing Core structures+--+-- It can often be useful to force various parts of the AST. This module+-- provides a number of @seq@-like functions to accomplish this.++module CoreSeq (+        -- * Utilities for forcing Core structures+        seqExpr, seqExprs, seqUnfolding, seqRules,+        megaSeqIdInfo, seqRuleInfo, seqBinds,+    ) where++import GhcPrelude++import CoreSyn+import IdInfo+import Demand( seqDemand, seqStrictSig )+import BasicTypes( seqOccInfo )+import VarSet( seqDVarSet )+import Var( varType, tyVarKind )+import Type( seqType, isTyVar )+import Coercion( seqCo )+import Id( Id, idInfo )++-- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the+-- compiler+megaSeqIdInfo :: IdInfo -> ()+megaSeqIdInfo info+  = seqRuleInfo (ruleInfo info)                 `seq`++-- Omitting this improves runtimes a little, presumably because+-- some unfoldings are not calculated at all+--    seqUnfolding (unfoldingInfo info)         `seq`++    seqDemand (demandInfo info)                 `seq`+    seqStrictSig (strictnessInfo info)          `seq`+    seqCaf (cafInfo info)                       `seq`+    seqOneShot (oneShotInfo info)               `seq`+    seqOccInfo (occInfo info)++seqOneShot :: OneShotInfo -> ()+seqOneShot l = l `seq` ()++seqRuleInfo :: RuleInfo -> ()+seqRuleInfo (RuleInfo rules fvs) = seqRules rules `seq` seqDVarSet fvs++seqCaf :: CafInfo -> ()+seqCaf c = c `seq` ()++seqRules :: [CoreRule] -> ()+seqRules [] = ()+seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)+  = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules+seqRules (BuiltinRule {} : rules) = seqRules rules++seqExpr :: CoreExpr -> ()+seqExpr (Var v)         = v `seq` ()+seqExpr (Lit lit)       = lit `seq` ()+seqExpr (App f a)       = seqExpr f `seq` seqExpr a+seqExpr (Lam b e)       = seqBndr b `seq` seqExpr e+seqExpr (Let b e)       = seqBind b `seq` seqExpr e+seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as+seqExpr (Cast e co)     = seqExpr e `seq` seqCo co+seqExpr (Tick n e)      = seqTickish n `seq` seqExpr e+seqExpr (Type t)        = seqType t+seqExpr (Coercion co)   = seqCo co++seqExprs :: [CoreExpr] -> ()+seqExprs [] = ()+seqExprs (e:es) = seqExpr e `seq` seqExprs es++seqTickish :: Tickish Id -> ()+seqTickish ProfNote{ profNoteCC = cc } = cc `seq` ()+seqTickish HpcTick{} = ()+seqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids+seqTickish SourceNote{} = ()++seqBndr :: CoreBndr -> ()+seqBndr b | isTyVar b = seqType (tyVarKind b)+          | otherwise = seqType (varType b)             `seq`+                        megaSeqIdInfo (idInfo b)++seqBndrs :: [CoreBndr] -> ()+seqBndrs [] = ()+seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs++seqBinds :: [Bind CoreBndr] -> ()+seqBinds bs = foldr (seq . seqBind) () bs++seqBind :: Bind CoreBndr -> ()+seqBind (NonRec b e) = seqBndr b `seq` seqExpr e+seqBind (Rec prs)    = seqPairs prs++seqPairs :: [(CoreBndr, CoreExpr)] -> ()+seqPairs [] = ()+seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs++seqAlts :: [CoreAlt] -> ()+seqAlts [] = ()+seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts++seqUnfolding :: Unfolding -> ()+seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,+                uf_is_value = b1, uf_is_work_free = b2,+                uf_expandable = b3, uf_is_conlike = b4,+                uf_guidance = g})+  = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g++seqUnfolding _ = ()++seqGuidance :: UnfoldingGuidance -> ()+seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()+seqGuidance _                      = ()
+ compiler/coreSyn/CoreStats.hs view
@@ -0,0 +1,137 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-2015+-}++-- | Functions to computing the statistics reflective of the "size"+-- of a Core expression+module CoreStats (+        -- * Expression and bindings size+        coreBindsSize, exprSize,+        CoreStats(..), coreBindsStats, exprStats,+    ) where++import GhcPrelude++import BasicTypes+import CoreSyn+import Outputable+import Coercion+import Var+import Type (Type, typeSize)+import Id (isJoinId)++data CoreStats = CS { cs_tm :: !Int    -- Terms+                    , cs_ty :: !Int    -- Types+                    , cs_co :: !Int    -- Coercions+                    , cs_vb :: !Int    -- Local value bindings+                    , cs_jb :: !Int }  -- Local join bindings+++instance Outputable CoreStats where+ ppr (CS { cs_tm = i1, cs_ty = i2, cs_co = i3, cs_vb = i4, cs_jb = i5 })+   = braces (sep [text "terms:"     <+> intWithCommas i1 <> comma,+                  text "types:"     <+> intWithCommas i2 <> comma,+                  text "coercions:" <+> intWithCommas i3 <> comma,+                  text "joins:"     <+> intWithCommas i5 <> char '/' <>+                                        intWithCommas (i4 + i5) ])++plusCS :: CoreStats -> CoreStats -> CoreStats+plusCS (CS { cs_tm = p1, cs_ty = q1, cs_co = r1, cs_vb = v1, cs_jb = j1 })+       (CS { cs_tm = p2, cs_ty = q2, cs_co = r2, cs_vb = v2, cs_jb = j2 })+  = CS { cs_tm = p1+p2, cs_ty = q1+q2, cs_co = r1+r2, cs_vb = v1+v2+       , cs_jb = j1+j2 }++zeroCS, oneTM :: CoreStats+zeroCS = CS { cs_tm = 0, cs_ty = 0, cs_co = 0, cs_vb = 0, cs_jb = 0 }+oneTM  = zeroCS { cs_tm = 1 }++sumCS :: (a -> CoreStats) -> [a] -> CoreStats+sumCS f = foldl' (\s a -> plusCS s (f a)) zeroCS++coreBindsStats :: [CoreBind] -> CoreStats+coreBindsStats = sumCS (bindStats TopLevel)++bindStats :: TopLevelFlag -> CoreBind -> CoreStats+bindStats top_lvl (NonRec v r) = bindingStats top_lvl v r+bindStats top_lvl (Rec prs)    = sumCS (\(v,r) -> bindingStats top_lvl v r) prs++bindingStats :: TopLevelFlag -> Var -> CoreExpr -> CoreStats+bindingStats top_lvl v r = letBndrStats top_lvl v `plusCS` exprStats r++bndrStats :: Var -> CoreStats+bndrStats v = oneTM `plusCS` tyStats (varType v)++letBndrStats :: TopLevelFlag -> Var -> CoreStats+letBndrStats top_lvl v+  | isTyVar v || isTopLevel top_lvl = bndrStats v+  | isJoinId v = oneTM { cs_jb = 1 } `plusCS` ty_stats+  | otherwise  = oneTM { cs_vb = 1 } `plusCS` ty_stats+  where+    ty_stats = tyStats (varType v)++exprStats :: CoreExpr -> CoreStats+exprStats (Var {})        = oneTM+exprStats (Lit {})        = oneTM+exprStats (Type t)        = tyStats t+exprStats (Coercion c)    = coStats c+exprStats (App f a)       = exprStats f `plusCS` exprStats a+exprStats (Lam b e)       = bndrStats b `plusCS` exprStats e+exprStats (Let b e)       = bindStats NotTopLevel b `plusCS` exprStats e+exprStats (Case e b _ as) = exprStats e `plusCS` bndrStats b+                                        `plusCS` sumCS altStats as+exprStats (Cast e co)     = coStats co `plusCS` exprStats e+exprStats (Tick _ e)      = exprStats e++altStats :: CoreAlt -> CoreStats+altStats (_, bs, r) = altBndrStats bs `plusCS` exprStats r++altBndrStats :: [Var] -> CoreStats+-- Charge one for the alternative, not for each binder+altBndrStats vs = oneTM `plusCS` sumCS (tyStats . varType) vs++tyStats :: Type -> CoreStats+tyStats ty = zeroCS { cs_ty = typeSize ty }++coStats :: Coercion -> CoreStats+coStats co = zeroCS { cs_co = coercionSize co }++coreBindsSize :: [CoreBind] -> Int+-- We use coreBindStats for user printout+-- but this one is a quick and dirty basis for+-- the simplifier's tick limit+coreBindsSize bs = sum (map bindSize bs)++exprSize :: CoreExpr -> Int+-- ^ A measure of the size of the expressions, strictly greater than 0+-- Counts *leaves*, not internal nodes. Types and coercions are not counted.+exprSize (Var _)         = 1+exprSize (Lit _)         = 1+exprSize (App f a)       = exprSize f + exprSize a+exprSize (Lam b e)       = bndrSize b + exprSize e+exprSize (Let b e)       = bindSize b + exprSize e+exprSize (Case e b _ as) = exprSize e + bndrSize b + 1 + sum (map altSize as)+exprSize (Cast e _)      = 1 + exprSize e+exprSize (Tick n e)      = tickSize n + exprSize e+exprSize (Type _)        = 1+exprSize (Coercion _)    = 1++tickSize :: Tickish Id -> Int+tickSize (ProfNote _ _ _) = 1+tickSize _ = 1++bndrSize :: Var -> Int+bndrSize _ = 1++bndrsSize :: [Var] -> Int+bndrsSize = sum . map bndrSize++bindSize :: CoreBind -> Int+bindSize (NonRec b e) = bndrSize b + exprSize e+bindSize (Rec prs)    = sum (map pairSize prs)++pairSize :: (Var, CoreExpr) -> Int+pairSize (b,e) = bndrSize b + exprSize e++altSize :: CoreAlt -> Int+altSize (_,bs,e) = bndrsSize bs + exprSize e
+ compiler/coreSyn/CoreSubst.hs view
@@ -0,0 +1,758 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+++Utility functions on @Core@ syntax+-}++{-# LANGUAGE CPP #-}+module CoreSubst (+        -- * Main data types+        Subst(..), -- Implementation exported for supercompiler's Renaming.hs only+        TvSubstEnv, IdSubstEnv, InScopeSet,++        -- ** Substituting into expressions and related types+        deShadowBinds, substSpec, substRulesForImportedIds,+        substTy, substCo, substExpr, substExprSC, substBind, substBindSC,+        substUnfolding, substUnfoldingSC,+        lookupIdSubst, lookupTCvSubst, substIdOcc,+        substTickish, substDVarSet, substIdInfo,++        -- ** Operations on substitutions+        emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, substInScope, isEmptySubst,+        extendIdSubst, extendIdSubstList, extendTCvSubst, extendTvSubstList,+        extendSubst, extendSubstList, extendSubstWithVar, zapSubstEnv,+        addInScopeSet, extendInScope, extendInScopeList, extendInScopeIds,+        isInScope, setInScope, getTCvSubst, extendTvSubst, extendCvSubst,+        delBndr, delBndrs,++        -- ** Substituting and cloning binders+        substBndr, substBndrs, substRecBndrs, substTyVarBndr, substCoVarBndr,+        cloneBndr, cloneBndrs, cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs,++    ) where++#include "HsVersions.h"+++import GhcPrelude++import CoreSyn+import CoreFVs+import CoreSeq+import CoreUtils+import qualified Type+import qualified Coercion++        -- We are defining local versions+import Type     hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList+                       , isInScope, substTyVarBndr, cloneTyVarBndr )+import Coercion hiding ( substCo, substCoVarBndr )++import PrelNames+import VarSet+import VarEnv+import Id+import Name     ( Name )+import Var+import IdInfo+import UniqSupply+import Maybes+import Util+import Outputable+import PprCore          ()              -- Instances+import Data.List++++{-+************************************************************************+*                                                                      *+\subsection{Substitutions}+*                                                                      *+************************************************************************+-}++-- | A substitution environment, containing 'Id', 'TyVar', and 'CoVar'+-- substitutions.+--+-- Some invariants apply to how you use the substitution:+--+-- 1. Note [The substitution invariant] in TyCoRep+--+-- 2. Note [Substitutions apply only once] in TyCoRep+data Subst+  = Subst InScopeSet  -- Variables in in scope (both Ids and TyVars) /after/+                      -- applying the substitution+          IdSubstEnv  -- Substitution from NcIds to CoreExprs+          TvSubstEnv  -- Substitution from TyVars to Types+          CvSubstEnv  -- Substitution from CoVars to Coercions++        -- INVARIANT 1: See TyCoRep Note [The substitution invariant]+        -- This is what lets us deal with name capture properly+        -- It's a hard invariant to check...+        --+        -- INVARIANT 2: The substitution is apply-once; see Note [Apply once] with+        --              Types.TvSubstEnv+        --+        -- INVARIANT 3: See Note [Extending the Subst]++{-+Note [Extending the Subst]+~~~~~~~~~~~~~~~~~~~~~~~~~~+For a core Subst, which binds Ids as well, we make a different choice for Ids+than we do for TyVars.++For TyVars, see Note [Extending the TCvSubst] with Type.TvSubstEnv++For Ids, we have a different invariant+        The IdSubstEnv is extended *only* when the Unique on an Id changes+        Otherwise, we just extend the InScopeSet++In consequence:++* If all subst envs are empty, substExpr would be a+  no-op, so substExprSC ("short cut") does nothing.++  However, substExpr still goes ahead and substitutes.  Reason: we may+  want to replace existing Ids with new ones from the in-scope set, to+  avoid space leaks.++* In substIdBndr, we extend the IdSubstEnv only when the unique changes++* If the CvSubstEnv, TvSubstEnv and IdSubstEnv are all empty,+  substExpr does nothing (Note that the above rule for substIdBndr+  maintains this property.  If the incoming envts are both empty, then+  substituting the type and IdInfo can't change anything.)++* In lookupIdSubst, we *must* look up the Id in the in-scope set, because+  it may contain non-trivial changes.  Example:+        (/\a. \x:a. ...x...) Int+  We extend the TvSubstEnv with [a |-> Int]; but x's unique does not change+  so we only extend the in-scope set.  Then we must look up in the in-scope+  set when we find the occurrence of x.++* The requirement to look up the Id in the in-scope set means that we+  must NOT take no-op short cut when the IdSubst is empty.+  We must still look up every Id in the in-scope set.++* (However, we don't need to do so for expressions found in the IdSubst+  itself, whose range is assumed to be correct wrt the in-scope set.)++Why do we make a different choice for the IdSubstEnv than the+TvSubstEnv and CvSubstEnv?++* For Ids, we change the IdInfo all the time (e.g. deleting the+  unfolding), and adding it back later, so using the TyVar convention+  would entail extending the substitution almost all the time++* The simplifier wants to look up in the in-scope set anyway, in case it+  can see a better unfolding from an enclosing case expression++* For TyVars, only coercion variables can possibly change, and they are+  easy to spot+-}++-- | An environment for substituting for 'Id's+type IdSubstEnv = IdEnv CoreExpr   -- Domain is NcIds, i.e. not coercions++----------------------------+isEmptySubst :: Subst -> Bool+isEmptySubst (Subst _ id_env tv_env cv_env)+  = isEmptyVarEnv id_env && isEmptyVarEnv tv_env && isEmptyVarEnv cv_env++emptySubst :: Subst+emptySubst = Subst emptyInScopeSet emptyVarEnv emptyVarEnv emptyVarEnv++mkEmptySubst :: InScopeSet -> Subst+mkEmptySubst in_scope = Subst in_scope emptyVarEnv emptyVarEnv emptyVarEnv++mkSubst :: InScopeSet -> TvSubstEnv -> CvSubstEnv -> IdSubstEnv -> Subst+mkSubst in_scope tvs cvs ids = Subst in_scope ids tvs cvs++-- | Find the in-scope set: see TyCoRep Note [The substitution invariant]+substInScope :: Subst -> InScopeSet+substInScope (Subst in_scope _ _ _) = in_scope++-- | Remove all substitutions for 'Id's and 'Var's that might have been built up+-- while preserving the in-scope set+zapSubstEnv :: Subst -> Subst+zapSubstEnv (Subst in_scope _ _ _) = Subst in_scope emptyVarEnv emptyVarEnv emptyVarEnv++-- | Add a substitution for an 'Id' to the 'Subst': you must ensure that the in-scope set is+-- such that TyCoRep Note [The substitution invariant]+-- holds after extending the substitution like this+extendIdSubst :: Subst -> Id -> CoreExpr -> Subst+-- ToDo: add an ASSERT that fvs(subst-result) is already in the in-scope set+extendIdSubst (Subst in_scope ids tvs cvs) v r+  = ASSERT2( isNonCoVarId v, ppr v $$ ppr r )+    Subst in_scope (extendVarEnv ids v r) tvs cvs++-- | Adds multiple 'Id' substitutions to the 'Subst': see also 'extendIdSubst'+extendIdSubstList :: Subst -> [(Id, CoreExpr)] -> Subst+extendIdSubstList (Subst in_scope ids tvs cvs) prs+  = ASSERT( all (isNonCoVarId . fst) prs )+    Subst in_scope (extendVarEnvList ids prs) tvs cvs++-- | Add a substitution for a 'TyVar' to the 'Subst'+-- The 'TyVar' *must* be a real TyVar, and not a CoVar+-- You must ensure that the in-scope set is such that+-- TyCoRep Note [The substitution invariant] holds+-- after extending the substitution like this.+extendTvSubst :: Subst -> TyVar -> Type -> Subst+extendTvSubst (Subst in_scope ids tvs cvs) tv ty+  = ASSERT( isTyVar tv )+    Subst in_scope ids (extendVarEnv tvs tv ty) cvs++-- | Adds multiple 'TyVar' substitutions to the 'Subst': see also 'extendTvSubst'+extendTvSubstList :: Subst -> [(TyVar,Type)] -> Subst+extendTvSubstList subst vrs+  = foldl' extend subst vrs+  where+    extend subst (v, r) = extendTvSubst subst v r++-- | Add a substitution from a 'CoVar' to a 'Coercion' to the 'Subst':+-- you must ensure that the in-scope set satisfies+-- TyCoRep Note [The substitution invariant]+-- after extending the substitution like this+extendCvSubst :: Subst -> CoVar -> Coercion -> Subst+extendCvSubst (Subst in_scope ids tvs cvs) v r+  = ASSERT( isCoVar v )+    Subst in_scope ids tvs (extendVarEnv cvs v r)++-- | Add a substitution appropriate to the thing being substituted+--   (whether an expression, type, or coercion). See also+--   'extendIdSubst', 'extendTvSubst', 'extendCvSubst'+extendSubst :: Subst -> Var -> CoreArg -> Subst+extendSubst subst var arg+  = case arg of+      Type ty     -> ASSERT( isTyVar var ) extendTvSubst subst var ty+      Coercion co -> ASSERT( isCoVar var ) extendCvSubst subst var co+      _           -> ASSERT( isId    var ) extendIdSubst subst var arg++extendSubstWithVar :: Subst -> Var -> Var -> Subst+extendSubstWithVar subst v1 v2+  | isTyVar v1 = ASSERT( isTyVar v2 ) extendTvSubst subst v1 (mkTyVarTy v2)+  | isCoVar v1 = ASSERT( isCoVar v2 ) extendCvSubst subst v1 (mkCoVarCo v2)+  | otherwise  = ASSERT( isId    v2 ) extendIdSubst subst v1 (Var v2)++-- | Add a substitution as appropriate to each of the terms being+--   substituted (whether expressions, types, or coercions). See also+--   'extendSubst'.+extendSubstList :: Subst -> [(Var,CoreArg)] -> Subst+extendSubstList subst []              = subst+extendSubstList subst ((var,rhs):prs) = extendSubstList (extendSubst subst var rhs) prs++-- | Find the substitution for an 'Id' in the 'Subst'+lookupIdSubst :: SDoc -> Subst -> Id -> CoreExpr+lookupIdSubst doc (Subst in_scope ids _ _) v+  | not (isLocalId v) = Var v+  | Just e  <- lookupVarEnv ids       v = e+  | Just v' <- lookupInScope in_scope v = Var v'+        -- Vital! See Note [Extending the Subst]+  | otherwise = WARN( True, text "CoreSubst.lookupIdSubst" <+> doc <+> ppr v+                            $$ ppr in_scope)+                Var v++-- | Find the substitution for a 'TyVar' in the 'Subst'+lookupTCvSubst :: Subst -> TyVar -> Type+lookupTCvSubst (Subst _ _ tvs cvs) v+  | isTyVar v+  = lookupVarEnv tvs v `orElse` Type.mkTyVarTy v+  | otherwise+  = mkCoercionTy $ lookupVarEnv cvs v `orElse` mkCoVarCo v++delBndr :: Subst -> Var -> Subst+delBndr (Subst in_scope ids tvs cvs) v+  | isCoVar v = Subst in_scope ids tvs (delVarEnv cvs v)+  | isTyVar v = Subst in_scope ids (delVarEnv tvs v) cvs+  | otherwise = Subst in_scope (delVarEnv ids v) tvs cvs++delBndrs :: Subst -> [Var] -> Subst+delBndrs (Subst in_scope ids tvs cvs) vs+  = Subst in_scope (delVarEnvList ids vs) (delVarEnvList tvs vs) (delVarEnvList cvs vs)+      -- Easiest thing is just delete all from all!++-- | Simultaneously substitute for a bunch of variables+--   No left-right shadowing+--   ie the substitution for   (\x \y. e) a1 a2+--      so neither x nor y scope over a1 a2+mkOpenSubst :: InScopeSet -> [(Var,CoreArg)] -> Subst+mkOpenSubst in_scope pairs = Subst in_scope+                                   (mkVarEnv [(id,e)  | (id, e) <- pairs, isId id])+                                   (mkVarEnv [(tv,ty) | (tv, Type ty) <- pairs])+                                   (mkVarEnv [(v,co)  | (v, Coercion co) <- pairs])++------------------------------+isInScope :: Var -> Subst -> Bool+isInScope v (Subst in_scope _ _ _) = v `elemInScopeSet` in_scope++-- | Add the 'Var' to the in-scope set, but do not remove+-- any existing substitutions for it+addInScopeSet :: Subst -> VarSet -> Subst+addInScopeSet (Subst in_scope ids tvs cvs) vs+  = Subst (in_scope `extendInScopeSetSet` vs) ids tvs cvs++-- | Add the 'Var' to the in-scope set: as a side effect,+-- and remove any existing substitutions for it+extendInScope :: Subst -> Var -> Subst+extendInScope (Subst in_scope ids tvs cvs) v+  = Subst (in_scope `extendInScopeSet` v)+          (ids `delVarEnv` v) (tvs `delVarEnv` v) (cvs `delVarEnv` v)++-- | Add the 'Var's to the in-scope set: see also 'extendInScope'+extendInScopeList :: Subst -> [Var] -> Subst+extendInScopeList (Subst in_scope ids tvs cvs) vs+  = Subst (in_scope `extendInScopeSetList` vs)+          (ids `delVarEnvList` vs) (tvs `delVarEnvList` vs) (cvs `delVarEnvList` vs)++-- | Optimized version of 'extendInScopeList' that can be used if you are certain+-- all the things being added are 'Id's and hence none are 'TyVar's or 'CoVar's+extendInScopeIds :: Subst -> [Id] -> Subst+extendInScopeIds (Subst in_scope ids tvs cvs) vs+  = Subst (in_scope `extendInScopeSetList` vs)+          (ids `delVarEnvList` vs) tvs cvs++setInScope :: Subst -> InScopeSet -> Subst+setInScope (Subst _ ids tvs cvs) in_scope = Subst in_scope ids tvs cvs++-- Pretty printing, for debugging only++instance Outputable Subst where+  ppr (Subst in_scope ids tvs cvs)+        =  text "<InScope =" <+> in_scope_doc+        $$ text " IdSubst   =" <+> ppr ids+        $$ text " TvSubst   =" <+> ppr tvs+        $$ text " CvSubst   =" <+> ppr cvs+         <> char '>'+    where+    in_scope_doc = pprVarSet (getInScopeVars in_scope) (braces . fsep . map ppr)++{-+************************************************************************+*                                                                      *+        Substituting expressions+*                                                                      *+************************************************************************+-}++-- | Apply a substitution to an entire 'CoreExpr'. Remember, you may only+-- apply the substitution /once/:+-- see Note [Substitutions apply only once] in TyCoRep+--+-- Do *not* attempt to short-cut in the case of an empty substitution!+-- See Note [Extending the Subst]+substExprSC :: SDoc -> Subst -> CoreExpr -> CoreExpr+substExprSC doc subst orig_expr+  | isEmptySubst subst = orig_expr+  | otherwise          = -- pprTrace "enter subst-expr" (doc $$ ppr orig_expr) $+                         subst_expr doc subst orig_expr++substExpr :: SDoc -> Subst -> CoreExpr -> CoreExpr+substExpr doc subst orig_expr = subst_expr doc subst orig_expr++subst_expr :: SDoc -> Subst -> CoreExpr -> CoreExpr+subst_expr doc subst expr+  = go expr+  where+    go (Var v)         = lookupIdSubst (doc $$ text "subst_expr") subst v+    go (Type ty)       = Type (substTy subst ty)+    go (Coercion co)   = Coercion (substCo subst co)+    go (Lit lit)       = Lit lit+    go (App fun arg)   = App (go fun) (go arg)+    go (Tick tickish e) = mkTick (substTickish subst tickish) (go e)+    go (Cast e co)     = Cast (go e) (substCo subst co)+       -- Do not optimise even identity coercions+       -- Reason: substitution applies to the LHS of RULES, and+       --         if you "optimise" an identity coercion, you may+       --         lose a binder. We optimise the LHS of rules at+       --         construction time++    go (Lam bndr body) = Lam bndr' (subst_expr doc subst' body)+                       where+                         (subst', bndr') = substBndr subst bndr++    go (Let bind body) = Let bind' (subst_expr doc subst' body)+                       where+                         (subst', bind') = substBind subst bind++    go (Case scrut bndr ty alts) = Case (go scrut) bndr' (substTy subst ty) (map (go_alt subst') alts)+                                 where+                                 (subst', bndr') = substBndr subst bndr++    go_alt subst (con, bndrs, rhs) = (con, bndrs', subst_expr doc subst' rhs)+                                 where+                                   (subst', bndrs') = substBndrs subst bndrs++-- | Apply a substitution to an entire 'CoreBind', additionally returning an updated 'Subst'+-- that should be used by subsequent substitutions.+substBind, substBindSC :: Subst -> CoreBind -> (Subst, CoreBind)++substBindSC subst bind    -- Short-cut if the substitution is empty+  | not (isEmptySubst subst)+  = substBind subst bind+  | otherwise+  = case bind of+       NonRec bndr rhs -> (subst', NonRec bndr' rhs)+          where+            (subst', bndr') = substBndr subst bndr+       Rec pairs -> (subst', Rec (bndrs' `zip` rhss'))+          where+            (bndrs, rhss)    = unzip pairs+            (subst', bndrs') = substRecBndrs subst bndrs+            rhss' | isEmptySubst subst'+                  = rhss+                  | otherwise+                  = map (subst_expr (text "substBindSC") subst') rhss++substBind subst (NonRec bndr rhs)+  = (subst', NonRec bndr' (subst_expr (text "substBind") subst rhs))+  where+    (subst', bndr') = substBndr subst bndr++substBind subst (Rec pairs)+   = (subst', Rec (bndrs' `zip` rhss'))+   where+       (bndrs, rhss)    = unzip pairs+       (subst', bndrs') = substRecBndrs subst bndrs+       rhss' = map (subst_expr (text "substBind") subst') rhss++-- | De-shadowing the program is sometimes a useful pre-pass. It can be done simply+-- by running over the bindings with an empty substitution, because substitution+-- returns a result that has no-shadowing guaranteed.+--+-- (Actually, within a single /type/ there might still be shadowing, because+-- 'substTy' is a no-op for the empty substitution, but that's probably OK.)+--+-- [Aug 09] This function is not used in GHC at the moment, but seems so+--          short and simple that I'm going to leave it here+deShadowBinds :: CoreProgram -> CoreProgram+deShadowBinds binds = snd (mapAccumL substBind emptySubst binds)++{-+************************************************************************+*                                                                      *+        Substituting binders+*                                                                      *+************************************************************************++Remember that substBndr and friends are used when doing expression+substitution only.  Their only business is substitution, so they+preserve all IdInfo (suitably substituted).  For example, we *want* to+preserve occ info in rules.+-}++-- | Substitutes a 'Var' for another one according to the 'Subst' given, returning+-- the result and an updated 'Subst' that should be used by subsequent substitutions.+-- 'IdInfo' is preserved by this process, although it is substituted into appropriately.+substBndr :: Subst -> Var -> (Subst, Var)+substBndr subst bndr+  | isTyVar bndr  = substTyVarBndr subst bndr+  | isCoVar bndr  = substCoVarBndr subst bndr+  | otherwise     = substIdBndr (text "var-bndr") subst subst bndr++-- | Applies 'substBndr' to a number of 'Var's, accumulating a new 'Subst' left-to-right+substBndrs :: Subst -> [Var] -> (Subst, [Var])+substBndrs subst bndrs = mapAccumL substBndr subst bndrs++-- | Substitute in a mutually recursive group of 'Id's+substRecBndrs :: Subst -> [Id] -> (Subst, [Id])+substRecBndrs subst bndrs+  = (new_subst, new_bndrs)+  where         -- Here's the reason we need to pass rec_subst to subst_id+    (new_subst, new_bndrs) = mapAccumL (substIdBndr (text "rec-bndr") new_subst) subst bndrs++substIdBndr :: SDoc+            -> Subst            -- ^ Substitution to use for the IdInfo+            -> Subst -> Id      -- ^ Substitution and Id to transform+            -> (Subst, Id)      -- ^ Transformed pair+                                -- NB: unfolding may be zapped++substIdBndr _doc rec_subst subst@(Subst in_scope env tvs cvs) old_id+  = -- pprTrace "substIdBndr" (doc $$ ppr old_id $$ ppr in_scope) $+    (Subst (in_scope `extendInScopeSet` new_id) new_env tvs cvs, new_id)+  where+    id1 = uniqAway in_scope old_id      -- id1 is cloned if necessary+    id2 | no_type_change = id1+        | otherwise      = setIdType id1 (substTy subst old_ty)++    old_ty = idType old_id+    no_type_change = (isEmptyVarEnv tvs && isEmptyVarEnv cvs) ||+                     noFreeVarsOfType old_ty++        -- new_id has the right IdInfo+        -- The lazy-set is because we're in a loop here, with+        -- rec_subst, when dealing with a mutually-recursive group+    new_id = maybeModifyIdInfo mb_new_info id2+    mb_new_info = substIdInfo rec_subst id2 (idInfo id2)+        -- NB: unfolding info may be zapped++        -- Extend the substitution if the unique has changed+        -- See the notes with substTyVarBndr for the delVarEnv+    new_env | no_change = delVarEnv env old_id+            | otherwise = extendVarEnv env old_id (Var new_id)++    no_change = id1 == old_id+        -- See Note [Extending the Subst]+        -- it's /not/ necessary to check mb_new_info and no_type_change++{-+Now a variant that unconditionally allocates a new unique.+It also unconditionally zaps the OccInfo.+-}++-- | Very similar to 'substBndr', but it always allocates a new 'Unique' for+-- each variable in its output.  It substitutes the IdInfo though.+cloneIdBndr :: Subst -> UniqSupply -> Id -> (Subst, Id)+cloneIdBndr subst us old_id+  = clone_id subst subst (old_id, uniqFromSupply us)++-- | Applies 'cloneIdBndr' to a number of 'Id's, accumulating a final+-- substitution from left to right+cloneIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])+cloneIdBndrs subst us ids+  = mapAccumL (clone_id subst) subst (ids `zip` uniqsFromSupply us)++cloneBndrs :: Subst -> UniqSupply -> [Var] -> (Subst, [Var])+-- Works for all kinds of variables (typically case binders)+-- not just Ids+cloneBndrs subst us vs+  = mapAccumL (\subst (v, u) -> cloneBndr subst u v) subst (vs `zip` uniqsFromSupply us)++cloneBndr :: Subst -> Unique -> Var -> (Subst, Var)+cloneBndr subst uniq v+  | isTyVar v = cloneTyVarBndr subst v uniq+  | otherwise = clone_id subst subst (v,uniq)  -- Works for coercion variables too++-- | Clone a mutually recursive group of 'Id's+cloneRecIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])+cloneRecIdBndrs subst us ids+  = (subst', ids')+  where+    (subst', ids') = mapAccumL (clone_id subst') subst+                               (ids `zip` uniqsFromSupply us)++-- Just like substIdBndr, except that it always makes a new unique+-- It is given the unique to use+clone_id    :: Subst                    -- Substitution for the IdInfo+            -> Subst -> (Id, Unique)    -- Substitution and Id to transform+            -> (Subst, Id)              -- Transformed pair++clone_id rec_subst subst@(Subst in_scope idvs tvs cvs) (old_id, uniq)+  = (Subst (in_scope `extendInScopeSet` new_id) new_idvs tvs new_cvs, new_id)+  where+    id1     = setVarUnique old_id uniq+    id2     = substIdType subst id1+    new_id  = maybeModifyIdInfo (substIdInfo rec_subst id2 (idInfo old_id)) id2+    (new_idvs, new_cvs) | isCoVar old_id = (idvs, extendVarEnv cvs old_id (mkCoVarCo new_id))+                        | otherwise      = (extendVarEnv idvs old_id (Var new_id), cvs)++{-+************************************************************************+*                                                                      *+                Types and Coercions+*                                                                      *+************************************************************************++For types and coercions we just call the corresponding functions in+Type and Coercion, but we have to repackage the substitution, from a+Subst to a TCvSubst.+-}++substTyVarBndr :: Subst -> TyVar -> (Subst, TyVar)+substTyVarBndr (Subst in_scope id_env tv_env cv_env) tv+  = case Type.substTyVarBndr (TCvSubst in_scope tv_env cv_env) tv of+        (TCvSubst in_scope' tv_env' cv_env', tv')+           -> (Subst in_scope' id_env tv_env' cv_env', tv')++cloneTyVarBndr :: Subst -> TyVar -> Unique -> (Subst, TyVar)+cloneTyVarBndr (Subst in_scope id_env tv_env cv_env) tv uniq+  = case Type.cloneTyVarBndr (TCvSubst in_scope tv_env cv_env) tv uniq of+        (TCvSubst in_scope' tv_env' cv_env', tv')+           -> (Subst in_scope' id_env tv_env' cv_env', tv')++substCoVarBndr :: Subst -> TyVar -> (Subst, TyVar)+substCoVarBndr (Subst in_scope id_env tv_env cv_env) cv+  = case Coercion.substCoVarBndr (TCvSubst in_scope tv_env cv_env) cv of+        (TCvSubst in_scope' tv_env' cv_env', cv')+           -> (Subst in_scope' id_env tv_env' cv_env', cv')++-- | See 'Type.substTy'+substTy :: Subst -> Type -> Type+substTy subst ty = Type.substTyUnchecked (getTCvSubst subst) ty++getTCvSubst :: Subst -> TCvSubst+getTCvSubst (Subst in_scope _ tenv cenv) = TCvSubst in_scope tenv cenv++-- | See 'Coercion.substCo'+substCo :: Subst -> Coercion -> Coercion+substCo subst co = Coercion.substCo (getTCvSubst subst) co++{-+************************************************************************+*                                                                      *+\section{IdInfo substitution}+*                                                                      *+************************************************************************+-}++substIdType :: Subst -> Id -> Id+substIdType subst@(Subst _ _ tv_env cv_env) id+  | (isEmptyVarEnv tv_env && isEmptyVarEnv cv_env) || noFreeVarsOfType old_ty = id+  | otherwise   = setIdType id (substTy subst old_ty)+                -- The tyCoVarsOfType is cheaper than it looks+                -- because we cache the free tyvars of the type+                -- in a Note in the id's type itself+  where+    old_ty = idType id++------------------+-- | Substitute into some 'IdInfo' with regard to the supplied new 'Id'.+substIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo+substIdInfo subst new_id info+  | nothing_to_do = Nothing+  | otherwise     = Just (info `setRuleInfo`      substSpec subst new_id old_rules+                               `setUnfoldingInfo` substUnfolding subst old_unf)+  where+    old_rules     = ruleInfo info+    old_unf       = unfoldingInfo info+    nothing_to_do = isEmptyRuleInfo old_rules && not (isFragileUnfolding old_unf)++------------------+-- | Substitutes for the 'Id's within an unfolding+substUnfolding, substUnfoldingSC :: Subst -> Unfolding -> Unfolding+        -- Seq'ing on the returned Unfolding is enough to cause+        -- all the substitutions to happen completely++substUnfoldingSC subst unf       -- Short-cut version+  | isEmptySubst subst = unf+  | otherwise          = substUnfolding subst unf++substUnfolding subst df@(DFunUnfolding { df_bndrs = bndrs, df_args = args })+  = df { df_bndrs = bndrs', df_args = args' }+  where+    (subst',bndrs') = substBndrs subst bndrs+    args'           = map (substExpr (text "subst-unf:dfun") subst') args++substUnfolding subst unf@(CoreUnfolding { uf_tmpl = tmpl, uf_src = src })+        -- Retain an InlineRule!+  | not (isStableSource src)  -- Zap an unstable unfolding, to save substitution work+  = NoUnfolding+  | otherwise                 -- But keep a stable one!+  = seqExpr new_tmpl `seq`+    unf { uf_tmpl = new_tmpl }+  where+    new_tmpl = substExpr (text "subst-unf") subst tmpl++substUnfolding _ unf = unf      -- NoUnfolding, OtherCon++------------------+substIdOcc :: Subst -> Id -> Id+-- These Ids should not be substituted to non-Ids+substIdOcc subst v = case lookupIdSubst (text "substIdOcc") subst v of+                        Var v' -> v'+                        other  -> pprPanic "substIdOcc" (vcat [ppr v <+> ppr other, ppr subst])++------------------+-- | Substitutes for the 'Id's within the 'WorkerInfo' given the new function 'Id'+substSpec :: Subst -> Id -> RuleInfo -> RuleInfo+substSpec subst new_id (RuleInfo rules rhs_fvs)+  = seqRuleInfo new_spec `seq` new_spec+  where+    subst_ru_fn = const (idName new_id)+    new_spec = RuleInfo (map (substRule subst subst_ru_fn) rules)+                        (substDVarSet subst rhs_fvs)++------------------+substRulesForImportedIds :: Subst -> [CoreRule] -> [CoreRule]+substRulesForImportedIds subst rules+  = map (substRule subst not_needed) rules+  where+    not_needed name = pprPanic "substRulesForImportedIds" (ppr name)++------------------+substRule :: Subst -> (Name -> Name) -> CoreRule -> CoreRule++-- The subst_ru_fn argument is applied to substitute the ru_fn field+-- of the rule:+--    - Rules for *imported* Ids never change ru_fn+--    - Rules for *local* Ids are in the IdInfo for that Id,+--      and the ru_fn field is simply replaced by the new name+--      of the Id+substRule _ _ rule@(BuiltinRule {}) = rule+substRule subst subst_ru_fn rule@(Rule { ru_bndrs = bndrs, ru_args = args+                                       , ru_fn = fn_name, ru_rhs = rhs+                                       , ru_local = is_local })+  = rule { ru_bndrs = bndrs'+         , ru_fn    = if is_local+                        then subst_ru_fn fn_name+                        else fn_name+         , ru_args  = map (substExpr doc subst') args+         , ru_rhs   = substExpr (text "foo") subst' rhs }+           -- Do NOT optimise the RHS (previously we did simplOptExpr here)+           -- See Note [Substitute lazily]+  where+    doc = text "subst-rule" <+> ppr fn_name+    (subst', bndrs') = substBndrs subst bndrs++------------------+substDVarSet :: Subst -> DVarSet -> DVarSet+substDVarSet subst fvs+  = mkDVarSet $ fst $ foldr (subst_fv subst) ([], emptyVarSet) $ dVarSetElems fvs+  where+  subst_fv subst fv acc+     | isId fv = expr_fvs (lookupIdSubst (text "substDVarSet") subst fv) isLocalVar emptyVarSet $! acc+     | otherwise = tyCoFVsOfType (lookupTCvSubst subst fv) (const True) emptyVarSet $! acc++------------------+substTickish :: Subst -> Tickish Id -> Tickish Id+substTickish subst (Breakpoint n ids)+   = Breakpoint n (map do_one ids)+ where+    do_one = getIdFromTrivialExpr . lookupIdSubst (text "subst_tickish") subst+substTickish _subst other = other++{- Note [Substitute lazily]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+The functions that substitute over IdInfo must be pretty lazy, because+they are knot-tied by substRecBndrs.++One case in point was #10627 in which a rule for a function 'f'+referred to 'f' (at a different type) on the RHS.  But instead of just+substituting in the rhs of the rule, we were calling simpleOptExpr, which+looked at the idInfo for 'f'; result <<loop>>.++In any case we don't need to optimise the RHS of rules, or unfoldings,+because the simplifier will do that.+++Note [substTickish]+~~~~~~~~~~~~~~~~~~~~~~+A Breakpoint contains a list of Ids.  What happens if we ever want to+substitute an expression for one of these Ids?++First, we ensure that we only ever substitute trivial expressions for+these Ids, by marking them as NoOccInfo in the occurrence analyser.+Then, when substituting for the Id, we unwrap any type applications+and abstractions to get back to an Id, with getIdFromTrivialExpr.++Second, we have to ensure that we never try to substitute a literal+for an Id in a breakpoint.  We ensure this by never storing an Id with+an unlifted type in a Breakpoint - see Coverage.mkTickish.+Breakpoints can't handle free variables with unlifted types anyway.+-}++{-+Note [Worker inlining]+~~~~~~~~~~~~~~~~~~~~~~+A worker can get sustituted away entirely.+        - it might be trivial+        - it might simply be very small+We do not treat an InlWrapper as an 'occurrence' in the occurrence+analyser, so it's possible that the worker is not even in scope any more.++In all all these cases we simply drop the special case, returning to+InlVanilla.  The WARN is just so I can see if it happens a lot.+-}+
+ compiler/coreSyn/CoreSyn.hs view
@@ -0,0 +1,2232 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}++{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE BangPatterns #-}++-- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection+module CoreSyn (+        -- * Main data types+        Expr(..), Alt, Bind(..), AltCon(..), Arg,+        Tickish(..), TickishScoping(..), TickishPlacement(..),+        CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,+        TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr,++        -- * In/Out type synonyms+        InId, InBind, InExpr, InAlt, InArg, InType, InKind,+               InBndr, InVar, InCoercion, InTyVar, InCoVar,+        OutId, OutBind, OutExpr, OutAlt, OutArg, OutType, OutKind,+               OutBndr, OutVar, OutCoercion, OutTyVar, OutCoVar, MOutCoercion,++        -- ** 'Expr' construction+        mkLet, mkLets, mkLetNonRec, mkLetRec, mkLams,+        mkApps, mkTyApps, mkCoApps, mkVarApps, mkTyArg,++        mkIntLit, mkIntLitInt,+        mkWordLit, mkWordLitWord,+        mkWord64LitWord64, mkInt64LitInt64,+        mkCharLit, mkStringLit,+        mkFloatLit, mkFloatLitFloat,+        mkDoubleLit, mkDoubleLitDouble,++        mkConApp, mkConApp2, mkTyBind, mkCoBind,+        varToCoreExpr, varsToCoreExprs,++        isId, cmpAltCon, cmpAlt, ltAlt,++        -- ** Simple 'Expr' access functions and predicates+        bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,+        collectBinders, collectTyBinders, collectTyAndValBinders,+        collectNBinders,+        collectArgs, stripNArgs, collectArgsTicks, flattenBinds,++        exprToType, exprToCoercion_maybe,+        applyTypeToArg,++        isValArg, isTypeArg, isCoArg, isTyCoArg, valArgCount, valBndrCount,+        isRuntimeArg, isRuntimeVar,++        -- * Tick-related functions+        tickishCounts, tickishScoped, tickishScopesLike, tickishFloatable,+        tickishCanSplit, mkNoCount, mkNoScope,+        tickishIsCode, tickishPlace,+        tickishContains,++        -- * Unfolding data types+        Unfolding(..),  UnfoldingGuidance(..), UnfoldingSource(..),++        -- ** Constructing 'Unfolding's+        noUnfolding, bootUnfolding, evaldUnfolding, mkOtherCon,+        unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,++        -- ** Predicates and deconstruction on 'Unfolding'+        unfoldingTemplate, expandUnfolding_maybe,+        maybeUnfoldingTemplate, otherCons,+        isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,+        isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,+        isStableUnfolding, isFragileUnfolding, hasSomeUnfolding,+        isBootUnfolding,+        canUnfold, neverUnfoldGuidance, isStableSource,++        -- * Annotated expression data types+        AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,++        -- ** Operations on annotated expressions+        collectAnnArgs, collectAnnArgsTicks,++        -- ** Operations on annotations+        deAnnotate, deAnnotate', deAnnAlt, deAnnBind,+        collectAnnBndrs, collectNAnnBndrs,++        -- * Orphanhood+        IsOrphan(..), isOrphan, notOrphan, chooseOrphanAnchor,++        -- * Core rule data types+        CoreRule(..), RuleBase,+        RuleName, RuleFun, IdUnfoldingFun, InScopeEnv,+        RuleEnv(..), mkRuleEnv, emptyRuleEnv,++        -- ** Operations on 'CoreRule's+        ruleArity, ruleName, ruleIdName, ruleActivation,+        setRuleIdName, ruleModule,+        isBuiltinRule, isLocalRule, isAutoRule,+    ) where++#include "HsVersions.h"++import GhcPrelude++import CostCentre+import VarEnv( InScopeSet )+import Var+import Type+import Coercion+import Name+import NameSet+import NameEnv( NameEnv, emptyNameEnv )+import Literal+import DataCon+import Module+import BasicTypes+import DynFlags+import Outputable+import Util+import UniqSet+import SrcLoc     ( RealSrcSpan, containsSpan )+import Binary++import Data.Data hiding (TyCon)+import Data.Int+import Data.Word++infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`, `mkCoApps`+-- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)++{-+************************************************************************+*                                                                      *+\subsection{The main data types}+*                                                                      *+************************************************************************++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 <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:+--+-- 1. The source code is parsed into an abstract syntax tree, which is represented+--    by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames'+--+-- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName'+--    (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical.+--    For example, this program:+--+-- @+--      f x = let f x = x + 1+--            in f (x - 2)+-- @+--+--    Would be renamed by having 'Unique's attached so it looked something like this:+--+-- @+--      f_1 x_2 = let f_3 x_4 = x_4 + 1+--                in f_3 (x_2 - 2)+-- @+--    But see Note [Shadowing] below.+--+-- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating+--    type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names.+--+-- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into+--    this 'Expr' type, which has far fewer constructors and hence is easier to perform+--    optimization, analysis and code generation on.+--+-- The type parameter @b@ is for the type of binders in the expression tree.+--+-- The language consists of the following elements:+--+-- *  Variables+--    See Note [Variable occurrences in Core]+--+-- *  Primitive literals+--+-- *  Applications: note that the argument may be a 'Type'.+--    See Note [CoreSyn let/app invariant]+--    See Note [Levity polymorphism invariants]+--+-- *  Lambda abstraction+--    See Note [Levity polymorphism invariants]+--+-- *  Recursive and non recursive @let@s. Operationally+--    this corresponds to allocating a thunk for the things+--    bound and then executing the sub-expression.+--+--    See Note [CoreSyn letrec invariant]+--    See Note [CoreSyn let/app invariant]+--    See Note [Levity polymorphism invariants]+--    See Note [CoreSyn type and coercion invariant]+--+-- *  Case expression. Operationally this corresponds to evaluating+--    the scrutinee (expression examined) to weak head normal form+--    and then examining at most one level of resulting constructor (i.e. you+--    cannot do nested pattern matching directly with this).+--+--    The binder gets bound to the value of the scrutinee,+--    and the 'Type' must be that of all the case alternatives+--+--    #case_invariants#+--    This is one of the more complicated elements of the Core language,+--    and comes with a number of restrictions:+--+--    1. The list of alternatives may be empty;+--       See Note [Empty case alternatives]+--+--    2. The 'DEFAULT' case alternative must be first in the list,+--       if it occurs at all.+--+--    3. The remaining cases are in order of increasing+--         tag  (for 'DataAlts') or+--         lit  (for 'LitAlts').+--       This makes finding the relevant constructor easy,+--       and makes comparison easier too.+--+--    4. The list of alternatives must be exhaustive. An /exhaustive/ case+--       does not necessarily mention all constructors:+--+--       @+--            data Foo = Red | Green | Blue+--       ... case x of+--            Red   -> True+--            other -> f (case x of+--                            Green -> ...+--                            Blue  -> ... ) ...+--       @+--+--       The inner case does not need a @Red@ alternative, because @x@+--       can't be @Red@ at that program point.+--+--    5. Floating-point values must not be scrutinised against literals.+--       See #9238 and Note [Rules for floating-point comparisons]+--       in PrelRules for rationale.+--+-- *  Cast an expression to a particular type.+--    This is used to implement @newtype@s (a @newtype@ constructor or+--    destructor just becomes a 'Cast' in Core) and GADTs.+--+-- *  Notes. These allow general information to be added to expressions+--    in the syntax tree+--+-- *  A type: this should only show up at the top level of an Arg+--+-- *  A coercion++-- If you edit this type, you may need to update the GHC formalism+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs+data Expr b+  = Var   Id+  | Lit   Literal+  | App   (Expr b) (Arg b)+  | Lam   b (Expr b)+  | Let   (Bind b) (Expr b)+  | Case  (Expr b) b Type [Alt b]       -- See #case_invariants#+  | Cast  (Expr b) Coercion+  | Tick  (Tickish Id) (Expr b)+  | Type  Type+  | Coercion Coercion+  deriving Data++-- | Type synonym for expressions that occur in function argument positions.+-- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not+type Arg b = Expr b++-- | A case split alternative. Consists of the constructor leading to the alternative,+-- the variables bound from the constructor, and the expression to be executed given that binding.+-- The default alternative is @(DEFAULT, [], rhs)@++-- If you edit this type, you may need to update the GHC formalism+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs+type Alt b = (AltCon, [b], Expr b)++-- | A case alternative constructor (i.e. pattern match)++-- If you edit this type, you may need to update the GHC formalism+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs+data AltCon+  = DataAlt DataCon   --  ^ A plain data constructor: @case e of { Foo x -> ... }@.+                      -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@++  | LitAlt  Literal   -- ^ A literal: @case e of { 1 -> ... }@+                      -- Invariant: always an *unlifted* literal+                      -- See Note [Literal alternatives]++  | 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.+-- The instance adheres to the order described in [CoreSyn case invariants]+instance Ord AltCon where+  compare (DataAlt con1) (DataAlt con2) =+    ASSERT( dataConTyCon con1 == dataConTyCon con2 )+    compare (dataConTag con1) (dataConTag con2)+  compare (DataAlt _) _ = GT+  compare _ (DataAlt _) = LT+  compare (LitAlt l1) (LitAlt l2) = compare l1 l2+  compare (LitAlt _) DEFAULT = GT+  compare DEFAULT DEFAULT = EQ+  compare DEFAULT _ = LT++-- | 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+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs+data Bind b = NonRec b (Expr b)+            | Rec [(b, (Expr b))]+  deriving Data++{-+Note [Shadowing]+~~~~~~~~~~~~~~~~+While various passes attempt to rename on-the-fly in a manner that+avoids "shadowing" (thereby simplifying downstream optimizations),+neither the simplifier nor any other pass GUARANTEES that shadowing is+avoided. Thus, all passes SHOULD work fine even in the presence of+arbitrary shadowing in their inputs.++In particular, scrutinee variables `x` in expressions of the form+`Case e x t` are often renamed to variables with a prefix+"wild_". These "wild" variables may appear in the body of the+case-expression, and further, may be shadowed within the body.++So the Unique in a Var is not really unique at all.  Still, it's very+useful to give a constant-time equality/ordering for Vars, and to give+a key that can be used to make sets of Vars (VarSet), or mappings from+Vars to other things (VarEnv).   Moreover, if you do want to eliminate+shadowing, you can give a new Unique to an Id without changing its+printable name, which makes debugging easier.++Note [Literal alternatives]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Literal alternatives (LitAlt lit) are always for *un-lifted* literals.+We have one literal, a literal Integer, that is lifted, and we don't+allow in a LitAlt, because LitAlt cases don't do any evaluation. Also+(see #5603) if you say+    case 3 of+      S# x -> ...+      J# _ _ -> ...+(where S#, J# are the constructors for Integer) we don't want the+simplifier calling findAlt with argument (LitAlt 3).  No no.  Integer+literals are an opaque encoding of an algebraic data type, not of+an unlifted literal, like all the others.++Also, we do not permit case analysis with literal patterns on floating-point+types. See #9238 and Note [Rules for floating-point comparisons] in+PrelRules for the rationale for this restriction.++-------------------------- CoreSyn INVARIANTS ---------------------------++Note [Variable occurrences in Core]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Variable /occurrences/ are never CoVars, though /bindings/ can be.+All CoVars appear in Coercions.++For example+  \(c :: Age~#Int) (d::Int). d |> (sym c)+Here 'c' is a CoVar, which is lambda-bound, but it /occurs/ in+a Coercion, (sym c).++Note [CoreSyn letrec invariant]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The right hand sides of all top-level and recursive @let@s+/must/ be of lifted type (see "Type#type_classification" for+the meaning of /lifted/ vs. /unlifted/).++There is one exception to this rule, top-level @let@s are+allowed to bind primitive string literals: see+Note [CoreSyn top-level string literals].++Note [CoreSyn top-level string literals]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+As an exception to the usual rule that top-level binders must be lifted,+we allow binding primitive string literals (of type Addr#) of type Addr# at the+top level. This allows us to share string literals earlier in the pipeline and+crucially allows other optimizations in the Core2Core pipeline to fire.+Consider,++  f n = let a::Addr# = "foo"#+        in \x -> blah++In order to be able to inline `f`, we would like to float `a` to the top.+Another option would be to inline `a`, but that would lead to duplicating string+literals, which we want to avoid. See #8472.++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.++We allow the top-level primitive string literals to be wrapped in Ticks+in the same way they can be wrapped when nested in an expression.+CoreToSTG currently discards Ticks around top-level primitive string literals.+See #14779.++Also see Note [Compilation plan for top-level string literals].++Note [Compilation plan for top-level string literals]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Here is a summary on how top-level string literals are handled by various+parts of the compilation pipeline.++* In the source language, there is no way to bind a primitive string literal+  at the top level.++* In Core, we have a special rule that permits top-level Addr# bindings. See+  Note [CoreSyn top-level string literals]. Core-to-core passes may introduce+  new top-level string literals.++* In STG, top-level string literals are explicitly represented in the syntax+  tree.++* A top-level string literal may end up exported from a module. In this case,+  in the object file, the content of the exported literal is given a label with+  the _bytes suffix.++Note [CoreSyn let/app invariant]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The let/app invariant+     the right hand side of a non-recursive 'Let', and+     the argument of an 'App',+    /may/ be of unlifted type, but only if+    the expression is ok-for-speculation+    or the 'Let' is for a join point.++This means that the let can be floated around+without difficulty. For example, this is OK:++   y::Int# = x +# 1#++But this is not, as it may affect termination if the+expression is floated out:++   y::Int# = fac 4#++In this situation you should use @case@ rather than a @let@. The function+'CoreUtils.needsCaseBinding' can help you determine which to generate, or+alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,+which will generate a @case@ if necessary++The let/app invariant is initially enforced by mkCoreLet and mkCoreApp in+coreSyn/MkCore.++Note [CoreSyn type and coercion invariant]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We allow a /non-recursive/, /non-top-level/ let to bind type and+coercion variables.  These can be very convenient for postponing type+substitutions until the next run of the simplifier.++* A type variable binding must have a RHS of (Type ty)++* A coercion variable binding must have a RHS of (Coercion co)++  It is possible to have terms that return a coercion, but we use+  case-binding for those; e.g.+     case (eq_sel d) of (co :: a ~# b) -> blah+  where eq_sel :: (a~b) -> (a~#b)++  Or even even+      case (df @Int) of (co :: a ~# b) -> blah+  Which is very exotic, and I think never encountered; but see+  Note [Equality superclasses in quantified constraints]+  in TcCanonical++Note [CoreSyn case invariants]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+See #case_invariants#++Note [Levity polymorphism invariants]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+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 the argument of an App must not be levity-polymorphic.++A type (t::TYPE r) is "levity polymorphic" if 'r' has any free variables.++For example+  \(r::RuntimeRep). \(a::TYPE r). \(x::a). e+is illegal because x's type has kind (TYPE r), which has 'r' free.++See Note [Levity polymorphism checking] in DsMonad to see where these+invariants are established for user-written code.++Note [CoreSyn let goal]+~~~~~~~~~~~~~~~~~~~~~~~+* The simplifier tries to ensure that if the RHS of a let is a constructor+  application, its arguments are trivial, so that the constructor can be+  inlined vigorously.++Note [Type let]+~~~~~~~~~~~~~~~+See #type_let#++Note [Empty case alternatives]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The alternatives of a case expression should be exhaustive.  But+this exhaustive list can be empty!++* A case expression can have empty alternatives if (and only if) the+  scrutinee is bound to raise an exception or diverge. When do we know+  this?  See Note [Bottoming expressions] in CoreUtils.++* The possibility of empty alternatives is one reason we need a type on+  the case expression: if the alternatives are empty we can't get the+  type from the alternatives!++* In the case of empty types (see Note [Bottoming expressions]), say+    data T+  we do NOT want to replace+    case (x::T) of Bool {}   -->   error Bool "Inaccessible case"+  because x might raise an exception, and *that*'s what we want to see!+  (#6067 is an example.) To preserve semantics we'd have to say+     x `seq` error Bool "Inaccessible case"+  but the 'seq' is just a case, so we are back to square 1.  Or I suppose+  we could say+     x |> UnsafeCoerce T Bool+  but that loses all trace of the fact that this originated with an empty+  set of alternatives.++* We can use the empty-alternative construct to coerce error values from+  one type to another.  For example++    f :: Int -> Int+    f n = error "urk"++    g :: Int -> (# Char, Bool #)+    g x = case f x of { 0 -> ..., n -> ... }++  Then if we inline f in g's RHS we get+    case (error Int "urk") of (# Char, Bool #) { ... }+  and we can discard the alternatives since the scrutinee is bottom to give+    case (error Int "urk") of (# Char, Bool #) {}++  This is nicer than using an unsafe coerce between Int ~ (# Char,Bool #),+  if for no other reason that we don't need to instantiate the (~) at an+  unboxed type.++* We treat a case expression with empty alternatives as trivial iff+  its scrutinee is (see CoreUtils.exprIsTrivial).  This is actually+  important; see Note [Empty case is trivial] in CoreUtils++* An empty case is replaced by its scrutinee during the CoreToStg+  conversion; remember STG is un-typed, so there is no need for+  the empty case to do the type conversion.++Note [Join points]+~~~~~~~~~~~~~~~~~~+In Core, a *join point* is a specially tagged function whose only occurrences+are saturated tail calls. A tail call can appear in these places:++  1. In the branches (not the scrutinee) of a case+  2. Underneath a let (value or join point)+  3. Inside another join point++We write a join-point declaration as+  join j @a @b x y = e1 in e2,+like a let binding but with "join" instead (or "join rec" for "let rec"). Note+that we put the parameters before the = rather than using lambdas; this is+because it's relevant how many parameters the join point takes *as a join+point.* This number is called the *join arity,* distinct from arity because it+counts types as well as values. Note that a join point may return a lambda! So+  join j x = x + 1+is different from+  join j = \x -> x + 1+The former has join arity 1, while the latter has join arity 0.++The identifier for a join point is called a join id or a *label.* An invocation+is called a *jump.* We write a jump using the jump keyword:++  jump j 3++The words *label* and *jump* are evocative of assembly code (or Cmm) for a+reason: join points are indeed compiled as labeled blocks, and jumps become+actual jumps (plus argument passing and stack adjustment). There is no closure+allocated and only a fraction of the function-call overhead. Hence we would+like as many functions as possible to become join points (see OccurAnal) and+the type rules for join points ensure we preserve the properties that make them+efficient.++In the actual AST, a join point is indicated by the IdDetails of the binder: a+local value binding gets 'VanillaId' but a join point gets a 'JoinId' with its+join arity.++For more details, see the paper:++  Luke Maurer, Paul Downen, Zena Ariola, and Simon Peyton Jones. "Compiling+  without continuations." Submitted to PLDI'17.++  https://www.microsoft.com/en-us/research/publication/compiling-without-continuations/++Note [Invariants on join points]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+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 #13394++Examples:++  join j1  x = 1 + x in jump j (jump j x)  -- Fails 1: non-tail call+  join j1' x = 1 + x in if even a+                          then jump j1 a+                          else jump j1 a b -- Fails 1: inconsistent calls+  join j2  x = flip (+) x in j2 1 2        -- Fails 2: not enough lambdas+  join j2' x = \y -> x + y in j3 1         -- Passes: extra lams ok+  join j @a (x :: a) = x                   -- Fails 4: polymorphic in ret type++Invariant 1 applies to left-hand sides of rewrite rules, so a rule for a join+point must have an exact call as its LHS.++Strictly speaking, invariant 3 is redundant, since a call from inside a lazy+binding isn't a tail call. Since a let-bound value can't invoke a free join+point, then, they can't be mutually recursive. (A Core binding group *can*+include spurious extra bindings if the occurrence analyser hasn't run, so+invariant 3 does still need to be checked.) For the rigorous definition of+"tail call", see Section 3 of the paper (Note [Join points]).++Invariant 4 is subtle; see Note [The polymorphism rule of join points].++Core Lint will check these invariants, anticipating that any binder whose+OccInfo is marked AlwaysTailCalled will become a join point as soon as the+simplifier (or simpleOptPgm) runs.++Note [The type of a join point]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A join point has the same type it would have as a function. That is, if it takes+an Int and a Bool and its body produces a String, its type is `Int -> Bool ->+String`. Natural as this may seem, it can be awkward. A join point shouldn't be+thought to "return" in the same sense a function does---a jump is one-way. This+is crucial for understanding how case-of-case interacts with join points:++  case (join+          j :: Int -> Bool -> String+          j x y = ...+        in+          jump j z w) of+    "" -> True+    _  -> False++The simplifier will pull the case into the join point (see Note [Case-of-case+and join points] in Simplify):++  join+    j :: Int -> Bool -> Bool -- changed!+    j x y = case ... of "" -> True+                        _  -> False+  in+    jump j z w++The body of the join point now returns a Bool, so the label `j` has to have its+type updated accordingly. Inconvenient though this may be, it has the advantage+that 'CoreUtils.exprType' can still return a type for any expression, including+a jump.++This differs from the paper (see Note [Invariants on join points]). In the+paper, we instead give j the type `Int -> Bool -> forall a. a`. Then each jump+carries the "return type" as a parameter, exactly the way other non-returning+functions like `error` work:++  case (join+          j :: Int -> Bool -> forall a. a+          j x y = ...+        in+          jump j z w @String) of+    "" -> True+    _  -> False++Now we can move the case inward and we only have to change the jump:++  join+    j :: Int -> Bool -> forall a. a+    j x y = case ... of "" -> True+                        _  -> False+  in+    jump j z w @Bool++(Core Lint would still check that the body of the join point has the right type;+that type would simply not be reflected in the join id.)++Note [The polymorphism rule of join points]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Invariant 4 of Note [Invariants on join points] forbids a join point to be+polymorphic in its return type. That is, if its type is++  forall a1 ... ak. t1 -> ... -> tn -> r++where its join arity is k+n, none of the type parameters ai may occur free in r.++In some way, this falls out of the fact that given++  join+     j @a1 ... @ak x1 ... xn = e1+  in e2++then all calls to `j` are in tail-call positions of `e`, and expressions in+tail-call positions in `e` have the same type as `e`.+Therefore the type of `e1` -- the return type of the join point -- must be the+same as the type of e2.+Since the type variables aren't bound in `e2`, its type can't include them, and+thus neither can the type of `e1`.++This unfortunately prevents the `go` in the following code from being a+join-point:++  iter :: forall a. Int -> (a -> a) -> a -> a+  iter @a n f x = go @a n f x+    where+      go :: forall a. Int -> (a -> a) -> a -> a+      go @a 0 _ x = x+      go @a n f x = go @a (n-1) f (f x)++In this case, a static argument transformation would fix that (see+ticket #14620):++  iter :: forall a. Int -> (a -> a) -> a -> a+  iter @a n f x = go' @a n f x+    where+      go' :: Int -> (a -> a) -> a -> a+      go' 0 _ x = x+      go' n f x = go' (n-1) f (f x)++In general, loopification could be employed to do that (see #14068.)++Can we simply drop the requirement, and allow `go` to be a join-point? We+could, and it would work. But we could not longer apply the case-of-join-point+transformation universally. This transformation would do:++  case (join go @a n f x = case n of 0 -> x+                                     n -> go @a (n-1) f (f x)+        in go @Bool n neg True) of+    True -> e1; False -> e2++ ===>++  join go @a n f x = case n of 0 -> case x of True -> e1; False -> e2+                          n -> go @a (n-1) f (f x)+  in go @Bool n neg True++but that is ill-typed, as `x` is type `a`, not `Bool`.+++This also justifies why we do not consider the `e` in `e |> co` to be in+tail position: A cast changes the type, but the type must be the same. But+operationally, casts are vacuous, so this is a bit unfortunate! See #14610 for+ideas how to fix this.++************************************************************************+*                                                                      *+            In/Out type synonyms+*                                                                      *+********************************************************************* -}++{- Many passes apply a substitution, and it's very handy to have type+   synonyms to remind us whether or not the substitution has been applied -}++-- Pre-cloning or substitution+type InBndr     = CoreBndr+type InType     = Type+type InKind     = Kind+type InBind     = CoreBind+type InExpr     = CoreExpr+type InAlt      = CoreAlt+type InArg      = CoreArg+type InCoercion = Coercion++-- Post-cloning or substitution+type OutBndr     = CoreBndr+type OutType     = Type+type OutKind     = Kind+type OutCoercion = Coercion+type OutBind     = CoreBind+type OutExpr     = CoreExpr+type OutAlt      = CoreAlt+type OutArg      = CoreArg+type MOutCoercion = MCoercion+++{- *********************************************************************+*                                                                      *+              Ticks+*                                                                      *+************************************************************************+-}++-- | Allows attaching extra information to points in expressions++-- If you edit this type, you may need to update the GHC formalism+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs+data Tickish id =+    -- | An @{-# SCC #-}@ profiling annotation, either automatically+    -- added by the desugarer as a result of -auto-all, or added by+    -- the user.+    ProfNote {+      profNoteCC    :: CostCentre, -- ^ the cost centre+      profNoteCount :: !Bool,      -- ^ bump the entry count?+      profNoteScope :: !Bool       -- ^ scopes over the enclosed expression+                                   -- (i.e. not just a tick)+    }++  -- | A "tick" used by HPC to track the execution of each+  -- subexpression in the original source code.+  | HpcTick {+      tickModule :: Module,+      tickId     :: !Int+    }++  -- | A breakpoint for the GHCi debugger.  This behaves like an HPC+  -- tick, but has a list of free variables which will be available+  -- for inspection in GHCi when the program stops at the breakpoint.+  --+  -- NB. we must take account of these Ids when (a) counting free variables,+  -- and (b) substituting (don't substitute for them)+  | Breakpoint+    { breakpointId     :: !Int+    , breakpointFVs    :: [id]  -- ^ the order of this list is important:+                                -- it matches the order of the lists in the+                                -- appropriate entry in HscTypes.ModBreaks.+                                --+                                -- Careful about substitution!  See+                                -- Note [substTickish] in CoreSubst.+    }++  -- | A source note.+  --+  -- Source notes are pure annotations: Their presence should neither+  -- influence compilation nor execution. The semantics are given by+  -- causality: The presence of a source note means that a local+  -- change in the referenced source code span will possibly provoke+  -- the generated code to change. On the flip-side, the functionality+  -- of annotated code *must* be invariant against changes to all+  -- source code *except* the spans referenced in the source notes+  -- (see "Causality of optimized Haskell" paper for details).+  --+  -- Therefore extending the scope of any given source note is always+  -- valid. Note that it is still undesirable though, as this reduces+  -- their usefulness for debugging and profiling. Therefore we will+  -- generally try only to make use of this property where it is+  -- necessary to enable optimizations.+  | SourceNote+    { sourceSpan :: RealSrcSpan -- ^ Source covered+    , sourceName :: String      -- ^ Name for source location+                                --   (uses same names as CCs)+    }++  deriving (Eq, Ord, Data)++-- | A "counting tick" (where tickishCounts is True) is one that+-- counts evaluations in some way.  We cannot discard a counting tick,+-- and the compiler should preserve the number of counting ticks as+-- far as possible.+--+-- However, we still allow the simplifier to increase or decrease+-- sharing, so in practice the actual number of ticks may vary, except+-- that we never change the value from zero to non-zero or vice versa.+tickishCounts :: Tickish id -> Bool+tickishCounts n@ProfNote{} = profNoteCount n+tickishCounts HpcTick{}    = True+tickishCounts Breakpoint{} = True+tickishCounts _            = False+++-- | Specifies the scoping behaviour of ticks. This governs the+-- behaviour of ticks that care about the covered code and the cost+-- associated with it. Important for ticks relating to profiling.+data TickishScoping =+    -- | No scoping: The tick does not care about what code it+    -- covers. Transformations can freely move code inside as well as+    -- outside without any additional annotation obligations+    NoScope++    -- | Soft scoping: We want all code that is covered to stay+    -- covered.  Note that this scope type does not forbid+    -- transformations from happening, as long as all results of+    -- the transformations are still covered by this tick or a copy of+    -- it. For example+    --+    --   let x = tick<...> (let y = foo in bar) in baz+    --     ===>+    --   let x = tick<...> bar; y = tick<...> foo in baz+    --+    -- Is a valid transformation as far as "bar" and "foo" is+    -- concerned, because both still are scoped over by the tick.+    --+    -- Note though that one might object to the "let" not being+    -- covered by the tick any more. However, we are generally lax+    -- with this - constant costs don't matter too much, and given+    -- that the "let" was effectively merged we can view it as having+    -- lost its identity anyway.+    --+    -- Also note that this scoping behaviour allows floating a tick+    -- "upwards" in pretty much any situation. For example:+    --+    --   case foo of x -> tick<...> bar+    --     ==>+    --   tick<...> case foo of x -> bar+    --+    -- While this is always leagl, we want to make a best effort to+    -- only make us of this where it exposes transformation+    -- opportunities.+  | SoftScope++    -- | Cost centre scoping: We don't want any costs to move to other+    -- cost-centre stacks. This means we not only want no code or cost+    -- to get moved out of their cost centres, but we also object to+    -- code getting associated with new cost-centre ticks - or+    -- changing the order in which they get applied.+    --+    -- A rule of thumb is that we don't want any code to gain new+    -- annotations. However, there are notable exceptions, for+    -- example:+    --+    --   let f = \y -> foo in tick<...> ... (f x) ...+    --     ==>+    --   tick<...> ... foo[x/y] ...+    --+    -- In-lining lambdas like this is always legal, because inlining a+    -- function does not change the cost-centre stack when the+    -- function is called.+  | CostCentreScope++  deriving (Eq)++-- | Returns the intended scoping rule for a Tickish+tickishScoped :: Tickish id -> TickishScoping+tickishScoped n@ProfNote{}+  | profNoteScope n        = CostCentreScope+  | otherwise              = NoScope+tickishScoped HpcTick{}    = NoScope+tickishScoped Breakpoint{} = CostCentreScope+   -- Breakpoints are scoped: eventually we're going to do call+   -- stacks, but also this helps prevent the simplifier from moving+   -- breakpoints around and changing their result type (see #1531).+tickishScoped SourceNote{} = SoftScope++-- | Returns whether the tick scoping rule is at least as permissive+-- as the given scoping rule.+tickishScopesLike :: Tickish id -> TickishScoping -> Bool+tickishScopesLike t scope = tickishScoped t `like` scope+  where NoScope         `like` _               = True+        _               `like` NoScope         = False+        SoftScope       `like` _               = True+        _               `like` SoftScope       = False+        CostCentreScope `like` _               = True++-- | Returns @True@ for ticks that can be floated upwards easily even+-- where it might change execution counts, such as:+--+--   Just (tick<...> foo)+--     ==>+--   tick<...> (Just foo)+--+-- This is a combination of @tickishSoftScope@ and+-- @tickishCounts@. Note that in principle splittable ticks can become+-- floatable using @mkNoTick@ -- even though there's currently no+-- tickish for which that is the case.+tickishFloatable :: Tickish id -> Bool+tickishFloatable t = t `tickishScopesLike` SoftScope && not (tickishCounts t)++-- | Returns @True@ for a tick that is both counting /and/ scoping and+-- can be split into its (tick, scope) parts using 'mkNoScope' and+-- 'mkNoTick' respectively.+tickishCanSplit :: Tickish id -> Bool+tickishCanSplit ProfNote{profNoteScope = True, profNoteCount = True}+                   = True+tickishCanSplit _  = False++mkNoCount :: Tickish id -> Tickish id+mkNoCount n | not (tickishCounts n)   = n+            | not (tickishCanSplit n) = panic "mkNoCount: Cannot split!"+mkNoCount n@ProfNote{}                = n {profNoteCount = False}+mkNoCount _                           = panic "mkNoCount: Undefined split!"++mkNoScope :: Tickish id -> Tickish id+mkNoScope n | tickishScoped n == NoScope  = n+            | not (tickishCanSplit n)     = panic "mkNoScope: Cannot split!"+mkNoScope n@ProfNote{}                    = n {profNoteScope = False}+mkNoScope _                               = panic "mkNoScope: Undefined split!"++-- | Return @True@ if this source annotation compiles to some backend+-- code. Without this flag, the tickish is seen as a simple annotation+-- that does not have any associated evaluation code.+--+-- What this means that we are allowed to disregard the tick if doing+-- so means that we can skip generating any code in the first place. A+-- typical example is top-level bindings:+--+--   foo = tick<...> \y -> ...+--     ==>+--   foo = \y -> tick<...> ...+--+-- Here there is just no operational difference between the first and+-- the second version. Therefore code generation should simply+-- translate the code as if it found the latter.+tickishIsCode :: Tickish id -> Bool+tickishIsCode SourceNote{} = False+tickishIsCode _tickish     = True  -- all the rest for now+++-- | Governs the kind of expression that the tick gets placed on when+-- annotating for example using @mkTick@. If we find that we want to+-- put a tickish on an expression ruled out here, we try to float it+-- inwards until we find a suitable expression.+data TickishPlacement =++    -- | Place ticks exactly on run-time expressions. We can still+    -- move the tick through pure compile-time constructs such as+    -- other ticks, casts or type lambdas. This is the most+    -- restrictive placement rule for ticks, as all tickishs have in+    -- common that they want to track runtime processes. The only+    -- legal placement rule for counting ticks.+    PlaceRuntime++    -- | As @PlaceRuntime@, but we float the tick through all+    -- lambdas. This makes sense where there is little difference+    -- between annotating the lambda and annotating the lambda's code.+  | PlaceNonLam++    -- | In addition to floating through lambdas, cost-centre style+    -- tickishs can also be moved from constructors, non-function+    -- variables and literals. For example:+    --+    --   let x = scc<...> C (scc<...> y) (scc<...> 3) in ...+    --+    -- Neither the constructor application, the variable or the+    -- literal are likely to have any cost worth mentioning. And even+    -- if y names a thunk, the call would not care about the+    -- evaluation context. Therefore removing all annotations in the+    -- above example is safe.+  | PlaceCostCentre++  deriving (Eq)++-- | Placement behaviour we want for the ticks+tickishPlace :: Tickish id -> TickishPlacement+tickishPlace n@ProfNote{}+  | profNoteCount n        = PlaceRuntime+  | otherwise              = PlaceCostCentre+tickishPlace HpcTick{}     = PlaceRuntime+tickishPlace Breakpoint{}  = PlaceRuntime+tickishPlace SourceNote{}  = PlaceNonLam++-- | Returns whether one tick "contains" the other one, therefore+-- making the second tick redundant.+tickishContains :: Eq b => Tickish b -> Tickish b -> Bool+tickishContains (SourceNote sp1 n1) (SourceNote sp2 n2)+  = containsSpan sp1 sp2 && n1 == n2+    -- compare the String last+tickishContains t1 t2+  = t1 == t2++{-+************************************************************************+*                                                                      *+                Orphans+*                                                                      *+************************************************************************+-}++-- | Is this instance an orphan?  If it is not an orphan, contains an 'OccName'+-- witnessing the instance's non-orphanhood.+-- See Note [Orphans]+data IsOrphan+  = IsOrphan+  | NotOrphan OccName -- The OccName 'n' witnesses the instance's non-orphanhood+                      -- In that case, the instance is fingerprinted as part+                      -- of the definition of 'n's definition+    deriving Data++-- | Returns true if 'IsOrphan' is orphan.+isOrphan :: IsOrphan -> Bool+isOrphan IsOrphan = True+isOrphan _ = False++-- | Returns true if 'IsOrphan' is not an orphan.+notOrphan :: IsOrphan -> Bool+notOrphan NotOrphan{} = True+notOrphan _ = False++chooseOrphanAnchor :: NameSet -> IsOrphan+-- Something (rule, instance) is relate to all the Names in this+-- list. Choose one of them to be an "anchor" for the orphan.  We make+-- the choice deterministic to avoid gratuitious changes in the ABI+-- hash (#4012).  Specifically, use lexicographic comparison of+-- OccName rather than comparing Uniques+--+-- NB: 'minimum' use Ord, and (Ord OccName) works lexicographically+--+chooseOrphanAnchor local_names+  | isEmptyNameSet local_names = IsOrphan+  | otherwise                  = NotOrphan (minimum occs)+  where+    occs = map nameOccName $ nonDetEltsUniqSet local_names+    -- It's OK to use nonDetEltsUFM here, see comments above++instance Binary IsOrphan where+    put_ bh IsOrphan = putByte bh 0+    put_ bh (NotOrphan n) = do+        putByte bh 1+        put_ bh n+    get bh = do+        h <- getByte bh+        case h of+            0 -> return IsOrphan+            _ -> do+                n <- get bh+                return $ NotOrphan n++{-+Note [Orphans]+~~~~~~~~~~~~~~+Class instances, rules, and family instances are divided into orphans+and non-orphans.  Roughly speaking, an instance/rule is an orphan if+its left hand side mentions nothing defined in this module.  Orphan-hood+has two major consequences++ * A module that contains orphans is called an "orphan module".  If+   the module being compiled depends (transitively) on an oprhan+   module M, then M.hi is read in regardless of whether M is oherwise+   needed. This is to ensure that we don't miss any instance decls in+   M.  But it's painful, because it means we need to keep track of all+   the orphan modules below us.++ * A non-orphan is not finger-printed separately.  Instead, for+   fingerprinting purposes it is treated as part of the entity it+   mentions on the LHS.  For example+      data T = T1 | T2+      instance Eq T where ....+   The instance (Eq T) is incorprated as part of T's fingerprint.++   In contrast, orphans are all fingerprinted together in the+   mi_orph_hash field of the ModIface.++   See MkIface.addFingerprints.++Orphan-hood is computed+  * For class instances:+      when we make a ClsInst+    (because it is needed during instance lookup)++  * For rules and family instances:+       when we generate an IfaceRule (MkIface.coreRuleToIfaceRule)+                     or IfaceFamInst (MkIface.instanceToIfaceInst)+-}++{-+************************************************************************+*                                                                      *+\subsection{Transformation rules}+*                                                                      *+************************************************************************++The CoreRule type and its friends are dealt with mainly in CoreRules,+but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.+-}++-- | Gathers a collection of 'CoreRule's. Maps (the name of) an 'Id' to its rules+type RuleBase = NameEnv [CoreRule]+        -- The rules are unordered;+        -- we sort out any overlaps on lookup++-- | A full rule environment which we can apply rules from.  Like a 'RuleBase',+-- but it also includes the set of visible orphans we use to filter out orphan+-- rules which are not visible (even though we can see them...)+data RuleEnv+    = RuleEnv { re_base          :: RuleBase+              , re_visible_orphs :: ModuleSet+              }++mkRuleEnv :: RuleBase -> [Module] -> RuleEnv+mkRuleEnv rules vis_orphs = RuleEnv rules (mkModuleSet vis_orphs)++emptyRuleEnv :: RuleEnv+emptyRuleEnv = RuleEnv emptyNameEnv emptyModuleSet++-- | A 'CoreRule' is:+--+-- * \"Local\" if the function it is a rule for is defined in the+--   same module as the rule itself.+--+-- * \"Orphan\" if nothing on the LHS is defined in the same module+--   as the rule itself+data CoreRule+  = Rule {+        ru_name :: RuleName,            -- ^ Name of the rule, for communication with the user+        ru_act  :: Activation,          -- ^ When the rule is active++        -- Rough-matching stuff+        -- see comments with InstEnv.ClsInst( is_cls, is_rough )+        ru_fn    :: Name,               -- ^ Name of the 'Id.Id' at the head of this rule+        ru_rough :: [Maybe Name],       -- ^ Name at the head of each argument to the left hand side++        -- Proper-matching stuff+        -- see comments with InstEnv.ClsInst( is_tvs, is_tys )+        ru_bndrs :: [CoreBndr],         -- ^ Variables quantified over+        ru_args  :: [CoreExpr],         -- ^ Left hand side arguments++        -- And the right-hand side+        ru_rhs   :: CoreExpr,           -- ^ Right hand side of the rule+                                        -- Occurrence info is guaranteed correct+                                        -- See Note [OccInfo in unfoldings and rules]++        -- Locality+        ru_auto :: Bool,   -- ^ @True@  <=> this rule is auto-generated+                           --               (notably by Specialise or SpecConstr)+                           --   @False@ <=> generated at the user's behest+                           -- See Note [Trimming auto-rules] in TidyPgm+                           -- for the sole purpose of this field.++        ru_origin :: !Module,   -- ^ 'Module' the rule was defined in, used+                                -- to test if we should see an orphan rule.++        ru_orphan :: !IsOrphan, -- ^ Whether or not the rule is an orphan.++        ru_local :: Bool        -- ^ @True@ iff the fn at the head of the rule is+                                -- defined in the same module as the rule+                                -- and is not an implicit 'Id' (like a record selector,+                                -- class operation, or data constructor).  This+                                -- is different from 'ru_orphan', where a rule+                                -- can avoid being an orphan if *any* Name in+                                -- LHS of the rule was defined in the same+                                -- module as the rule.+    }++  -- | Built-in rules are used for constant folding+  -- and suchlike.  They have no free variables.+  -- A built-in rule is always visible (there is no such thing as+  -- an orphan built-in rule.)+  | BuiltinRule {+        ru_name  :: RuleName,   -- ^ As above+        ru_fn    :: Name,       -- ^ As above+        ru_nargs :: Int,        -- ^ Number of arguments that 'ru_try' consumes,+                                -- if it fires, including type arguments+        ru_try   :: RuleFun+                -- ^ This function does the rewrite.  It given too many+                -- arguments, it simply discards them; the returned 'CoreExpr'+                -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args+    }+                -- See Note [Extra args in rule matching] in Rules.hs++type RuleFun = DynFlags -> InScopeEnv -> Id -> [CoreExpr] -> Maybe CoreExpr+type InScopeEnv = (InScopeSet, IdUnfoldingFun)++type IdUnfoldingFun = Id -> Unfolding+-- A function that embodies how to unfold an Id if you need+-- to do that in the Rule.  The reason we need to pass this info in+-- is that whether an Id is unfoldable depends on the simplifier phase++isBuiltinRule :: CoreRule -> Bool+isBuiltinRule (BuiltinRule {}) = True+isBuiltinRule _                = False++isAutoRule :: CoreRule -> Bool+isAutoRule (BuiltinRule {}) = False+isAutoRule (Rule { ru_auto = is_auto }) = is_auto++-- | The number of arguments the 'ru_fn' must be applied+-- to before the rule can match on it+ruleArity :: CoreRule -> Int+ruleArity (BuiltinRule {ru_nargs = n}) = n+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++-- | The 'Name' of the 'Id.Id' at the head of the rule left hand side+ruleIdName :: CoreRule -> Name+ruleIdName = ru_fn++isLocalRule :: CoreRule -> Bool+isLocalRule = ru_local++-- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side+setRuleIdName :: Name -> CoreRule -> CoreRule+setRuleIdName nm ru = ru { ru_fn = nm }++{-+************************************************************************+*                                                                      *+                Unfoldings+*                                                                      *+************************************************************************++The @Unfolding@ type is declared here to avoid numerous loops+-}++-- | Records the /unfolding/ of an identifier, which is approximately the form the+-- identifier would have if we substituted its definition in for the identifier.+-- This type should be treated as abstract everywhere except in "CoreUnfold"+data Unfolding+  = NoUnfolding        -- ^ We have no information about the unfolding.++  | BootUnfolding      -- ^ We have no information about the unfolding, because+                       -- this 'Id' came from an @hi-boot@ file.+                       -- See Note [Inlining and hs-boot files] in ToIface+                       -- for what this is used for.++  | OtherCon [AltCon]  -- ^ It ain't one of these constructors.+                       -- @OtherCon xs@ also indicates that something has been evaluated+                       -- and hence there's no point in re-evaluating it.+                       -- @OtherCon []@ is used even for non-data-type values+                       -- to indicated evaluated-ness.  Notably:+                       --+                       -- > data C = C !(Int -> Int)+                       -- > case x of { C f -> ... }+                       --+                       -- Here, @f@ gets an @OtherCon []@ unfolding.++  | DFunUnfolding {     -- The Unfolding of a DFunId+                        -- See Note [DFun unfoldings]+                        --     df = /\a1..am. \d1..dn. MkD t1 .. tk+                        --                                 (op1 a1..am d1..dn)+                        --                                 (op2 a1..am d1..dn)+        df_bndrs :: [Var],      -- The bound variables [a1..m],[d1..dn]+        df_con   :: DataCon,    -- The dictionary data constructor (never a newtype datacon)+        df_args  :: [CoreExpr]  -- Args of the data con: types, superclasses and methods,+    }                           -- in positional order++  | CoreUnfolding {             -- An unfolding for an Id with no pragma,+                                -- or perhaps a NOINLINE pragma+                                -- (For NOINLINE, the phase, if any, is in the+                                -- InlinePragInfo for this Id.)+        uf_tmpl       :: CoreExpr,        -- Template; occurrence info is correct+        uf_src        :: UnfoldingSource, -- Where the unfolding came from+        uf_is_top     :: Bool,          -- True <=> top level binding+        uf_is_value   :: Bool,          -- exprIsHNF template (cached); it is ok to discard+                                        --      a `seq` on this variable+        uf_is_conlike :: Bool,          -- True <=> applicn of constructor or CONLIKE function+                                        --      Cached version of exprIsConLike+        uf_is_work_free :: Bool,                -- True <=> doesn't waste (much) work to expand+                                        --          inside an inlining+                                        --      Cached version of exprIsCheap+        uf_expandable :: Bool,          -- True <=> can expand in RULE matching+                                        --      Cached version of exprIsExpandable+        uf_guidance   :: UnfoldingGuidance      -- Tells about the *size* of the template.+    }+  -- ^ An unfolding with redundant cached information. Parameters:+  --+  --  uf_tmpl: Template used to perform unfolding;+  --           NB: Occurrence info is guaranteed correct:+  --               see Note [OccInfo in unfoldings and rules]+  --+  --  uf_is_top: Is this a top level binding?+  --+  --  uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on+  --     this variable+  --+  --  uf_is_work_free:  Does this waste only a little work if we expand it inside an inlining?+  --     Basically this is a cached version of 'exprIsWorkFree'+  --+  --  uf_guidance:  Tells us about the /size/ of the unfolding template+++------------------------------------------------+data UnfoldingSource+  = -- See also Note [Historical note: unfoldings for wrappers]++    InlineRhs          -- The current rhs of the function+                       -- Replace uf_tmpl each time around++  | InlineStable       -- From an INLINE or INLINABLE pragma+                       --   INLINE     if guidance is UnfWhen+                       --   INLINABLE  if guidance is UnfIfGoodArgs/UnfoldNever+                       -- (well, technically an INLINABLE might be made+                       -- UnfWhen if it was small enough, and then+                       -- it will behave like INLINE outside the current+                       -- module, but that is the way automatic unfoldings+                       -- work so it is consistent with the intended+                       -- meaning of INLINABLE).+                       --+                       -- uf_tmpl may change, but only as a result of+                       -- gentle simplification, it doesn't get updated+                       -- to the current RHS during compilation as with+                       -- InlineRhs.+                       --+                       -- See Note [InlineStable]++  | InlineCompulsory   -- Something that *has* no binding, so you *must* inline it+                       -- Only a few primop-like things have this property+                       -- (see MkId.hs, calls to mkCompulsoryUnfolding).+                       -- Inline absolutely always, however boring the context.++++-- | 'UnfoldingGuidance' says when unfolding should take place+data UnfoldingGuidance+  = UnfWhen {   -- Inline without thinking about the *size* of the uf_tmpl+                -- Used (a) for small *and* cheap unfoldings+                --      (b) for INLINE functions+                -- See Note [INLINE for small functions] in CoreUnfold+      ug_arity    :: Arity,     -- Number of value arguments expected++      ug_unsat_ok  :: Bool,     -- True <=> ok to inline even if unsaturated+      ug_boring_ok :: Bool      -- True <=> ok to inline even if the context is boring+                -- So True,True means "always"+    }++  | UnfIfGoodArgs {     -- Arose from a normal Id; the info here is the+                        -- result of a simple analysis of the RHS++      ug_args ::  [Int],  -- Discount if the argument is evaluated.+                          -- (i.e., a simplification will definitely+                          -- be possible).  One elt of the list per *value* arg.++      ug_size :: Int,     -- The "size" of the unfolding.++      ug_res :: Int       -- Scrutinee discount: the discount to substract if the thing is in+    }                     -- a context (case (thing args) of ...),+                          -- (where there are the right number of arguments.)++  | UnfNever        -- The RHS is big, so don't inline it+  deriving (Eq)++{-+Note [Historical note: unfoldings for wrappers]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We used to have a nice clever scheme in interface files for+wrappers. A wrapper's unfolding can be reconstructed from its worker's+id and its strictness. This decreased .hi file size (sometimes+significantly, for modules like GHC.Classes with many high-arity w/w+splits) and had a slight corresponding effect on compile times.++However, when we added the second demand analysis, this scheme lead to+some Core lint errors. The second analysis could change the strictness+signatures, which sometimes resulted in a wrapper's regenerated+unfolding applying the wrapper to too many arguments.++Instead of repairing the clever .hi scheme, we abandoned it in favor+of simplicity. The .hi sizes are usually insignificant (excluding the++1M for base libraries), and compile time barely increases (~+1% for+nofib). The nicer upshot is that the UnfoldingSource no longer mentions+an Id, so, eg, substitutions need not traverse them.+++Note [DFun unfoldings]+~~~~~~~~~~~~~~~~~~~~~~+The Arity in a DFunUnfolding is total number of args (type and value)+that the DFun needs to produce a dictionary.  That's not necessarily+related to the ordinary arity of the dfun Id, esp if the class has+one method, so the dictionary is represented by a newtype.  Example++     class C a where { op :: a -> Int }+     instance C a -> C [a] where op xs = op (head xs)++The instance translates to++     $dfCList :: forall a. C a => C [a]  -- Arity 2!+     $dfCList = /\a.\d. $copList {a} d |> co++     $copList :: forall a. C a => [a] -> Int  -- Arity 2!+     $copList = /\a.\d.\xs. op {a} d (head xs)++Now we might encounter (op (dfCList {ty} d) a1 a2)+and we want the (op (dfList {ty} d)) rule to fire, because $dfCList+has all its arguments, even though its (value) arity is 2.  That's+why we record the number of expected arguments in the DFunUnfolding.++Note that although it's an Arity, it's most convenient for it to give+the *total* number of arguments, both type and value.  See the use+site in exprIsConApp_maybe.+-}++-- Constants for the UnfWhen constructor+needSaturated, unSaturatedOk :: Bool+needSaturated = False+unSaturatedOk = True++boringCxtNotOk, boringCxtOk :: Bool+boringCxtOk    = True+boringCxtNotOk = False++------------------------------------------------+noUnfolding :: Unfolding+-- ^ There is no known 'Unfolding'+evaldUnfolding :: Unfolding+-- ^ This unfolding marks the associated thing as being evaluated++noUnfolding    = NoUnfolding+evaldUnfolding = OtherCon []++-- | There is no known 'Unfolding', because this came from an+-- hi-boot file.+bootUnfolding :: Unfolding+bootUnfolding = BootUnfolding++mkOtherCon :: [AltCon] -> Unfolding+mkOtherCon = OtherCon++isStableSource :: UnfoldingSource -> Bool+-- Keep the unfolding template+isStableSource InlineCompulsory   = True+isStableSource InlineStable       = True+isStableSource InlineRhs          = False++-- | Retrieves the template of an unfolding: panics if none is known+unfoldingTemplate :: Unfolding -> CoreExpr+unfoldingTemplate = uf_tmpl++-- | Retrieves the template of an unfolding if possible+-- maybeUnfoldingTemplate is used mainly wnen specialising, and we do+-- want to specialise DFuns, so it's important to return a template+-- for DFunUnfoldings+maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr+maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr })+  = Just expr+maybeUnfoldingTemplate (DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = args })+  = Just (mkLams bndrs (mkApps (Var (dataConWorkId con)) args))+maybeUnfoldingTemplate _+  = Nothing++-- | The constructors that the unfolding could never be:+-- returns @[]@ if no information is available+otherCons :: Unfolding -> [AltCon]+otherCons (OtherCon cons) = cons+otherCons _               = []++-- | Determines if it is certainly the case that the unfolding will+-- yield a value (something in HNF): returns @False@ if unsure+isValueUnfolding :: Unfolding -> Bool+        -- Returns False for OtherCon+isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald+isValueUnfolding _                                          = False++-- | Determines if it possibly the case that the unfolding will+-- yield a value. Unlike 'isValueUnfolding' it returns @True@+-- for 'OtherCon'+isEvaldUnfolding :: Unfolding -> Bool+        -- Returns True for OtherCon+isEvaldUnfolding (OtherCon _)                               = True+isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald+isEvaldUnfolding _                                          = False++-- | @True@ if the unfolding is a constructor application, the application+-- of a CONLIKE function or 'OtherCon'+isConLikeUnfolding :: Unfolding -> Bool+isConLikeUnfolding (OtherCon _)                             = True+isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con })  = con+isConLikeUnfolding _                                        = False++-- | Is the thing we will unfold into certainly cheap?+isCheapUnfolding :: Unfolding -> Bool+isCheapUnfolding (CoreUnfolding { uf_is_work_free = is_wf }) = is_wf+isCheapUnfolding _                                           = False++isExpandableUnfolding :: Unfolding -> Bool+isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable+isExpandableUnfolding _                                              = False++expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr+-- Expand an expandable unfolding; this is used in rule matching+--   See Note [Expanding variables] in Rules.hs+-- The key point here is that CONLIKE things can be expanded+expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs+expandUnfolding_maybe _                                                       = Nothing++isCompulsoryUnfolding :: Unfolding -> Bool+isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True+isCompulsoryUnfolding _                                             = False++isStableUnfolding :: Unfolding -> Bool+-- True of unfoldings that should not be overwritten+-- by a CoreUnfolding for the RHS of a let-binding+isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src+isStableUnfolding (DFunUnfolding {})               = True+isStableUnfolding _                                = False++-- | Only returns False if there is no unfolding information available at all+hasSomeUnfolding :: Unfolding -> Bool+hasSomeUnfolding NoUnfolding   = False+hasSomeUnfolding BootUnfolding = False+hasSomeUnfolding _             = True++isBootUnfolding :: Unfolding -> Bool+isBootUnfolding BootUnfolding = True+isBootUnfolding _             = False++neverUnfoldGuidance :: UnfoldingGuidance -> Bool+neverUnfoldGuidance UnfNever = True+neverUnfoldGuidance _        = False++isFragileUnfolding :: Unfolding -> Bool+-- An unfolding is fragile if it mentions free variables or+-- is otherwise subject to change.  A robust one can be kept.+-- See Note [Fragile unfoldings]+isFragileUnfolding (CoreUnfolding {}) = True+isFragileUnfolding (DFunUnfolding {}) = True+isFragileUnfolding _                  = False+  -- NoUnfolding, BootUnfolding, OtherCon are all non-fragile++canUnfold :: Unfolding -> Bool+canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)+canUnfold _                                   = False++{- Note [Fragile unfoldings]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+An unfolding is "fragile" if it mentions free variables (and hence would+need substitution) or might be affected by optimisation.  The non-fragile+ones are++   NoUnfolding, BootUnfolding++   OtherCon {}    If we know this binder (say a lambda binder) will be+                  bound to an evaluated thing, we want to retain that+                  info in simpleOptExpr; see #13077.++We consider even a StableUnfolding as fragile, because it needs substitution.++Note [InlineStable]+~~~~~~~~~~~~~~~~~+When you say+      {-# INLINE f #-}+      f x = <rhs>+you intend that calls (f e) are replaced by <rhs>[e/x] So we+should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle+with it.  Meanwhile, we can optimise <rhs> to our heart's content,+leaving the original unfolding intact in Unfolding of 'f'. For example+        all xs = foldr (&&) True xs+        any p = all . map p  {-# INLINE any #-}+We optimise any's RHS fully, but leave the InlineRule saying "all . map p",+which deforests well at the call site.++So INLINE pragma gives rise to an InlineRule, which captures the original RHS.++Moreover, it's only used when 'f' is applied to the+specified number of arguments; that is, the number of argument on+the LHS of the '=' sign in the original source definition.+For example, (.) is now defined in the libraries like this+   {-# INLINE (.) #-}+   (.) f g = \x -> f (g x)+so that it'll inline when applied to two arguments. If 'x' appeared+on the left, thus+   (.) f g x = f (g x)+it'd only inline when applied to three arguments.  This slightly-experimental+change was requested by Roman, but it seems to make sense.++See also Note [Inlining an InlineRule] in CoreUnfold.+++Note [OccInfo in unfoldings and rules]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+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 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+++************************************************************************+*                                                                      *+                  AltCon+*                                                                      *+************************************************************************+-}++-- The Ord is needed for the FiniteMap used in the lookForConstructor+-- in SimplEnv.  If you declared that lookForConstructor *ignores*+-- constructor-applications with LitArg args, then you could get+-- rid of this Ord.++instance Outputable AltCon where+  ppr (DataAlt dc) = ppr dc+  ppr (LitAlt lit) = ppr lit+  ppr DEFAULT      = text "__DEFAULT"++cmpAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Ordering+cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2++ltAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Bool+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++cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2+cmpAltCon (DataAlt _)  DEFAULT      = GT+cmpAltCon (LitAlt  l1) (LitAlt  l2) = l1 `compare` l2+cmpAltCon (LitAlt _)   DEFAULT      = GT++cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>+                                  ppr con1 <+> ppr con2 )+                      LT++{-+************************************************************************+*                                                                      *+\subsection{Useful synonyms}+*                                                                      *+************************************************************************++Note [CoreProgram]+~~~~~~~~~~~~~~~~~~+The top level bindings of a program, a CoreProgram, are represented as+a list of CoreBind++ * Later bindings in the list can refer to earlier ones, but not vice+   versa.  So this is OK+      NonRec { x = 4 }+      Rec { p = ...q...x...+          ; q = ...p...x }+      Rec { f = ...p..x..f.. }+      NonRec { g = ..f..q...x.. }+   But it would NOT be ok for 'f' to refer to 'g'.++ * The occurrence analyser does strongly-connected component analysis+   on each Rec binding, and splits it into a sequence of smaller+   bindings where possible.  So the program typically starts life as a+   single giant Rec, which is then dependency-analysed into smaller+   chunks.+-}++-- If you edit this type, you may need to update the GHC formalism+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs+type CoreProgram = [CoreBind]   -- See Note [CoreProgram]++-- | The common case for the type of binders and variables when+-- we are manipulating the Core language within GHC+type CoreBndr = Var+-- | Expressions where binders are 'CoreBndr's+type CoreExpr = Expr CoreBndr+-- | Argument expressions where binders are 'CoreBndr's+type CoreArg  = Arg  CoreBndr+-- | Binding groups where binders are 'CoreBndr's+type CoreBind = Bind CoreBndr+-- | Case alternatives where binders are 'CoreBndr's+type CoreAlt  = Alt  CoreBndr++{-+************************************************************************+*                                                                      *+\subsection{Tagging}+*                                                                      *+************************************************************************+-}++-- | Binders are /tagged/ with a t+data TaggedBndr t = TB CoreBndr t       -- TB for "tagged binder"++type TaggedBind t = Bind (TaggedBndr t)+type TaggedExpr t = Expr (TaggedBndr t)+type TaggedArg  t = Arg  (TaggedBndr t)+type TaggedAlt  t = Alt  (TaggedBndr t)++instance Outputable b => Outputable (TaggedBndr b) where+  ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'++deTagExpr :: TaggedExpr t -> CoreExpr+deTagExpr (Var v)                   = Var v+deTagExpr (Lit l)                   = Lit l+deTagExpr (Type ty)                 = Type ty+deTagExpr (Coercion co)             = Coercion co+deTagExpr (App e1 e2)               = App (deTagExpr e1) (deTagExpr e2)+deTagExpr (Lam (TB b _) e)          = Lam b (deTagExpr e)+deTagExpr (Let bind body)           = Let (deTagBind bind) (deTagExpr body)+deTagExpr (Case e (TB b _) ty alts) = Case (deTagExpr e) b ty (map deTagAlt alts)+deTagExpr (Tick t e)                = Tick t (deTagExpr e)+deTagExpr (Cast e co)               = Cast (deTagExpr e) co++deTagBind :: TaggedBind t -> CoreBind+deTagBind (NonRec (TB b _) rhs) = NonRec b (deTagExpr rhs)+deTagBind (Rec prs)             = Rec [(b, deTagExpr rhs) | (TB b _, rhs) <- prs]++deTagAlt :: TaggedAlt t -> CoreAlt+deTagAlt (con, bndrs, rhs) = (con, [b | TB b _ <- bndrs], deTagExpr rhs)++{-+************************************************************************+*                                                                      *+\subsection{Core-constructing functions with checking}+*                                                                      *+************************************************************************+-}++-- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to+-- use 'MkCore.mkCoreApps' if possible+mkApps    :: Expr b -> [Arg b]  -> Expr b+-- | Apply a list of type argument expressions to a function expression in a nested fashion+mkTyApps  :: Expr b -> [Type]   -> Expr b+-- | Apply a list of coercion argument expressions to a function expression in a nested fashion+mkCoApps  :: Expr b -> [Coercion] -> Expr b+-- | Apply a list of type or value variables to a function expression in a nested fashion+mkVarApps :: Expr b -> [Var] -> Expr b+-- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to+-- use 'MkCore.mkCoreConApps' if possible+mkConApp      :: DataCon -> [Arg b] -> Expr b++mkApps    f args = foldl' App                       f args+mkCoApps  f args = foldl' (\ e a -> App e (Coercion a)) f args+mkVarApps f vars = foldl' (\ e a -> App e (varToCoreExpr a)) f vars+mkConApp con args = mkApps (Var (dataConWorkId con)) args++mkTyApps  f args = foldl' (\ e a -> App e (mkTyArg a)) f args++mkConApp2 :: DataCon -> [Type] -> [Var] -> Expr b+mkConApp2 con tys arg_ids = Var (dataConWorkId con)+                            `mkApps` map Type tys+                            `mkApps` map varToCoreExpr arg_ids++mkTyArg :: Type -> Expr b+mkTyArg ty+  | Just co <- isCoercionTy_maybe ty = Coercion co+  | otherwise                        = Type ty++-- | Create a machine integer literal expression of type @Int#@ from an @Integer@.+-- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'+mkIntLit      :: DynFlags -> Integer -> Expr b+-- | Create a machine integer literal expression of type @Int#@ from an @Int@.+-- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'+mkIntLitInt   :: DynFlags -> Int     -> Expr b++mkIntLit    dflags n = Lit (mkLitInt dflags n)+mkIntLitInt dflags n = Lit (mkLitInt dflags (toInteger n))++-- | Create a machine word literal expression of type  @Word#@ from an @Integer@.+-- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'+mkWordLit     :: DynFlags -> Integer -> Expr b+-- | Create a machine word literal expression of type  @Word#@ from a @Word@.+-- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'+mkWordLitWord :: DynFlags -> Word -> Expr b++mkWordLit     dflags w = Lit (mkLitWord dflags w)+mkWordLitWord dflags w = Lit (mkLitWord dflags (toInteger w))++mkWord64LitWord64 :: Word64 -> Expr b+mkWord64LitWord64 w = Lit (mkLitWord64 (toInteger w))++mkInt64LitInt64 :: Int64 -> Expr b+mkInt64LitInt64 w = Lit (mkLitInt64 (toInteger w))++-- | Create a machine character literal expression of type @Char#@.+-- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'+mkCharLit :: Char -> Expr b+-- | Create a machine string literal expression of type @Addr#@.+-- If you want an expression of type @String@ use 'MkCore.mkStringExpr'+mkStringLit :: String -> Expr b++mkCharLit   c = Lit (mkLitChar c)+mkStringLit s = Lit (mkLitString s)++-- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.+-- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'+mkFloatLit :: Rational -> Expr b+-- | Create a machine single precision literal expression of type @Float#@ from a @Float@.+-- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'+mkFloatLitFloat :: Float -> Expr b++mkFloatLit      f = Lit (mkLitFloat f)+mkFloatLitFloat f = Lit (mkLitFloat (toRational f))++-- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.+-- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'+mkDoubleLit :: Rational -> Expr b+-- | Create a machine double precision literal expression of type @Double#@ from a @Double@.+-- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'+mkDoubleLitDouble :: Double -> Expr b++mkDoubleLit       d = Lit (mkLitDouble d)+mkDoubleLitDouble d = Lit (mkLitDouble (toRational d))++-- | Bind all supplied binding groups over an expression in a nested let expression. Assumes+-- that the rhs satisfies the let/app invariant.  Prefer to use 'MkCore.mkCoreLets' if+-- possible, which does guarantee the invariant+mkLets        :: [Bind b] -> Expr b -> Expr b+-- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to+-- use 'MkCore.mkCoreLams' if possible+mkLams        :: [b] -> Expr b -> Expr b++mkLams binders body = foldr Lam body binders+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+mkTyBind :: TyVar -> Type -> CoreBind+mkTyBind tv ty      = NonRec tv (Type ty)++-- | 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+mkCoBind :: CoVar -> Coercion -> CoreBind+mkCoBind cv co      = NonRec cv (Coercion co)++-- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately+varToCoreExpr :: CoreBndr -> Expr b+varToCoreExpr v | isTyVar v = Type (mkTyVarTy v)+                | isCoVar v = Coercion (mkCoVarCo v)+                | otherwise = ASSERT( isId v ) Var v++varsToCoreExprs :: [CoreBndr] -> [Expr b]+varsToCoreExprs vs = map varToCoreExpr vs++{-+************************************************************************+*                                                                      *+   Getting a result type+*                                                                      *+************************************************************************++These are defined here to avoid a module loop between CoreUtils and CoreFVs++-}++applyTypeToArg :: Type -> CoreExpr -> Type+-- ^ Determines the type resulting from applying an expression with given type+-- to a given argument expression+applyTypeToArg fun_ty arg = piResultTy fun_ty (exprToType arg)++-- | If the expression is a 'Type', converts. Otherwise,+-- panics. NB: This does /not/ convert 'Coercion' to 'CoercionTy'.+exprToType :: CoreExpr -> Type+exprToType (Type ty)     = ty+exprToType _bad          = pprPanic "exprToType" empty++-- | If the expression is a 'Coercion', converts.+exprToCoercion_maybe :: CoreExpr -> Maybe Coercion+exprToCoercion_maybe (Coercion co) = Just co+exprToCoercion_maybe _             = Nothing++{-+************************************************************************+*                                                                      *+\subsection{Simple access functions}+*                                                                      *+************************************************************************+-}++-- | Extract every variable by this group+bindersOf  :: Bind b -> [b]+-- If you edit this function, you may need to update the GHC formalism+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs+bindersOf (NonRec binder _) = [binder]+bindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]++-- | 'bindersOf' applied to a list of binding groups+bindersOfBinds :: [Bind b] -> [b]+bindersOfBinds binds = foldr ((++) . bindersOf) [] binds++rhssOfBind :: Bind b -> [Expr b]+rhssOfBind (NonRec _ rhs) = [rhs]+rhssOfBind (Rec pairs)    = [rhs | (_,rhs) <- pairs]++rhssOfAlts :: [Alt b] -> [Expr b]+rhssOfAlts alts = [e | (_,_,e) <- alts]++-- | Collapse all the bindings in the supplied groups into a single+-- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group+flattenBinds :: [Bind b] -> [(b, Expr b)]+flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds+flattenBinds (Rec prs1   : binds) = prs1 ++ flattenBinds binds+flattenBinds []                   = []++-- | We often want to strip off leading lambdas before getting down to+-- business. Variants are 'collectTyBinders', 'collectValBinders',+-- and 'collectTyAndValBinders'+collectBinders         :: Expr b   -> ([b],     Expr b)+collectTyBinders       :: CoreExpr -> ([TyVar], CoreExpr)+collectValBinders      :: CoreExpr -> ([Id],    CoreExpr)+collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)+-- | Strip off exactly N leading lambdas (type or value). Good for use with+-- join points.+collectNBinders        :: Int -> Expr b -> ([b], Expr b)++collectBinders expr+  = go [] expr+  where+    go bs (Lam b e) = go (b:bs) e+    go bs e          = (reverse bs, e)++collectTyBinders expr+  = go [] expr+  where+    go tvs (Lam b e) | isTyVar b = go (b:tvs) e+    go tvs e                     = (reverse tvs, e)++collectValBinders expr+  = go [] expr+  where+    go ids (Lam b e) | isId b = go (b:ids) e+    go ids body               = (reverse ids, body)++collectTyAndValBinders expr+  = (tvs, ids, body)+  where+    (tvs, body1) = collectTyBinders expr+    (ids, body)  = collectValBinders body1++collectNBinders orig_n orig_expr+  = go orig_n [] orig_expr+  where+    go 0 bs expr      = (reverse bs, expr)+    go n bs (Lam b e) = go (n-1) (b:bs) e+    go _ _  _         = pprPanic "collectNBinders" $ int orig_n++-- | Takes a nested application expression and returns the function+-- being applied and the arguments to which it is applied+collectArgs :: Expr b -> (Expr b, [Arg b])+collectArgs expr+  = go expr []+  where+    go (App f a) as = go f (a:as)+    go e         as = (e, as)++-- | Attempt to remove the last N arguments of a function call.+-- Strip off any ticks or coercions encountered along the way and any+-- at the end.+stripNArgs :: Word -> Expr a -> Maybe (Expr a)+stripNArgs !n (Tick _ e) = stripNArgs n e+stripNArgs n (Cast f _) = stripNArgs n f+stripNArgs 0 e = Just e+stripNArgs n (App f _) = stripNArgs (n - 1) f+stripNArgs _ _ = Nothing++-- | Like @collectArgs@, but also collects looks through floatable+-- ticks if it means that we can find more arguments.+collectArgsTicks :: (Tickish Id -> Bool) -> Expr b+                 -> (Expr b, [Arg b], [Tickish Id])+collectArgsTicks skipTick expr+  = go expr [] []+  where+    go (App f a)  as ts = go f (a:as) ts+    go (Tick t e) as ts+      | skipTick t      = go e as (t:ts)+    go e          as ts = (e, as, reverse ts)+++{-+************************************************************************+*                                                                      *+\subsection{Predicates}+*                                                                      *+************************************************************************++At one time we optionally carried type arguments through to runtime.+@isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,+i.e. if type applications are actual lambdas because types are kept around+at runtime.  Similarly isRuntimeArg.+-}++-- | Will this variable exist at runtime?+isRuntimeVar :: Var -> Bool+isRuntimeVar = isId++-- | Will this argument expression exist at runtime?+isRuntimeArg :: CoreExpr -> Bool+isRuntimeArg = isValArg++-- | Returns @True@ for value arguments, false for type args+-- NB: coercions are value arguments (zero width, to be sure,+-- like State#, but still value args).+isValArg :: Expr b -> Bool+isValArg e = not (isTypeArg e)++-- | Returns @True@ iff the expression is a 'Type' or 'Coercion'+-- expression at its top level+isTyCoArg :: Expr b -> Bool+isTyCoArg (Type {})     = True+isTyCoArg (Coercion {}) = True+isTyCoArg _             = False++-- | Returns @True@ iff the expression is a 'Coercion'+-- expression at its top level+isCoArg :: Expr b -> Bool+isCoArg (Coercion {}) = True+isCoArg _             = False++-- | Returns @True@ iff the expression is a 'Type' expression at its+-- top level.  Note this does NOT include 'Coercion's.+isTypeArg :: Expr b -> Bool+isTypeArg (Type {}) = True+isTypeArg _         = False++-- | The number of binders that bind values rather than types+valBndrCount :: [CoreBndr] -> Int+valBndrCount = count isId++-- | The number of argument expressions that are values rather than types at their top level+valArgCount :: [Arg b] -> Int+valArgCount = count isValArg++{-+************************************************************************+*                                                                      *+\subsection{Annotated core}+*                                                                      *+************************************************************************+-}++-- | Annotated core: allows annotation at every node in the tree+type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)++-- | A clone of the 'Expr' type but allowing annotation at every tree node+data AnnExpr' bndr annot+  = AnnVar      Id+  | AnnLit      Literal+  | AnnLam      bndr (AnnExpr bndr annot)+  | AnnApp      (AnnExpr bndr annot) (AnnExpr bndr annot)+  | AnnCase     (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]+  | AnnLet      (AnnBind bndr annot) (AnnExpr bndr annot)+  | AnnCast     (AnnExpr bndr annot) (annot, Coercion)+                   -- Put an annotation on the (root of) the coercion+  | AnnTick     (Tickish Id) (AnnExpr bndr annot)+  | AnnType     Type+  | AnnCoercion Coercion++-- | A clone of the 'Alt' type but allowing annotation at every tree node+type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)++-- | A clone of the 'Bind' type but allowing annotation at every tree node+data AnnBind bndr annot+  = AnnNonRec bndr (AnnExpr bndr annot)+  | AnnRec    [(bndr, AnnExpr bndr annot)]++-- | Takes a nested application expression and returns the function+-- being applied and the arguments to which it is applied+collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])+collectAnnArgs expr+  = go expr []+  where+    go (_, AnnApp f a) as = go f (a:as)+    go e               as = (e, as)++collectAnnArgsTicks :: (Tickish Var -> Bool) -> AnnExpr b a+                       -> (AnnExpr b a, [AnnExpr b a], [Tickish Var])+collectAnnArgsTicks tickishOk expr+  = go expr [] []+  where+    go (_, AnnApp f a)  as ts = go f (a:as) ts+    go (_, AnnTick t e) as ts | tickishOk t+                              = go e as (t:ts)+    go e                as ts = (e, as, reverse ts)++deAnnotate :: AnnExpr bndr annot -> Expr bndr+deAnnotate (_, e) = deAnnotate' e++deAnnotate' :: AnnExpr' bndr annot -> Expr bndr+deAnnotate' (AnnType t)           = Type t+deAnnotate' (AnnCoercion co)      = Coercion co+deAnnotate' (AnnVar  v)           = Var v+deAnnotate' (AnnLit  lit)         = Lit lit+deAnnotate' (AnnLam  binder body) = Lam binder (deAnnotate body)+deAnnotate' (AnnApp  fun arg)     = App (deAnnotate fun) (deAnnotate arg)+deAnnotate' (AnnCast e (_,co))    = Cast (deAnnotate e) co+deAnnotate' (AnnTick tick body)   = Tick tick (deAnnotate body)++deAnnotate' (AnnLet bind body)+  = Let (deAnnBind bind) (deAnnotate body)+deAnnotate' (AnnCase scrut v t alts)+  = Case (deAnnotate scrut) v t (map deAnnAlt alts)++deAnnAlt :: AnnAlt bndr annot -> Alt bndr+deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)++deAnnBind  :: AnnBind b annot -> Bind b+deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)+deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]++-- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'+collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)+collectAnnBndrs e+  = collect [] e+  where+    collect bs (_, AnnLam b body) = collect (b:bs) body+    collect bs body               = (reverse bs, body)++-- | As 'collectNBinders' but for 'AnnExpr' rather than 'Expr'+collectNAnnBndrs :: Int -> AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)+collectNAnnBndrs orig_n e+  = collect orig_n [] e+  where+    collect 0 bs body               = (reverse bs, body)+    collect n bs (_, AnnLam b body) = collect (n-1) (b:bs) body+    collect _ _  _                  = pprPanic "collectNBinders" $ int orig_n
+ compiler/coreSyn/CoreTidy.hs view
@@ -0,0 +1,282 @@+{-+(c) The University of Glasgow 2006+(c) The AQUA Project, Glasgow University, 1996-1998+++This module contains "tidying" code for *nested* expressions, bindings, rules.+The code for *top-level* bindings is in TidyPgm.+-}++{-# LANGUAGE CPP #-}+module CoreTidy (+        tidyExpr, tidyVarOcc, tidyRule, tidyRules, tidyUnfolding+    ) where++#include "HsVersions.h"++import GhcPrelude++import CoreSyn+import CoreSeq ( seqUnfolding )+import CoreArity+import Id+import IdInfo+import Demand ( zapUsageEnvSig )+import Type( tidyType, tidyVarBndr )+import Coercion( tidyCo )+import Var+import VarEnv+import UniqFM+import Name hiding (tidyNameOcc)+import SrcLoc+import Maybes+import Data.List++{-+************************************************************************+*                                                                      *+\subsection{Tidying expressions, rules}+*                                                                      *+************************************************************************+-}++tidyBind :: TidyEnv+         -> CoreBind+         ->  (TidyEnv, CoreBind)++tidyBind env (NonRec bndr rhs)+  = tidyLetBndr env env (bndr,rhs) =: \ (env', bndr') ->+    (env', NonRec bndr' (tidyExpr env' rhs))++tidyBind env (Rec prs)+  = let+       (env', bndrs') = mapAccumL (tidyLetBndr env') env prs+    in+    map (tidyExpr env') (map snd prs)   =: \ rhss' ->+    (env', Rec (zip bndrs' rhss'))+++------------  Expressions  --------------+tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr+tidyExpr env (Var v)       = Var (tidyVarOcc env v)+tidyExpr env (Type ty)     = Type (tidyType env ty)+tidyExpr env (Coercion co) = Coercion (tidyCo env co)+tidyExpr _   (Lit lit)     = Lit lit+tidyExpr env (App f a)     = App (tidyExpr env f) (tidyExpr env a)+tidyExpr env (Tick t e)    = Tick (tidyTickish env t) (tidyExpr env e)+tidyExpr env (Cast e co)   = Cast (tidyExpr env e) (tidyCo env co)++tidyExpr env (Let b e)+  = tidyBind env b      =: \ (env', b') ->+    Let b' (tidyExpr env' e)++tidyExpr env (Case e b ty alts)+  = tidyBndr env b  =: \ (env', b) ->+    Case (tidyExpr env e) b (tidyType env ty)+         (map (tidyAlt env') alts)++tidyExpr env (Lam b e)+  = tidyBndr env b      =: \ (env', b) ->+    Lam b (tidyExpr env' e)++------------  Case alternatives  --------------+tidyAlt :: TidyEnv -> CoreAlt -> CoreAlt+tidyAlt env (con, vs, rhs)+  = tidyBndrs env vs    =: \ (env', vs) ->+    (con, vs, tidyExpr env' rhs)++------------  Tickish  --------------+tidyTickish :: TidyEnv -> Tickish Id -> Tickish Id+tidyTickish env (Breakpoint ix ids) = Breakpoint ix (map (tidyVarOcc env) ids)+tidyTickish _   other_tickish       = other_tickish++------------  Rules  --------------+tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]+tidyRules _   [] = []+tidyRules env (rule : rules)+  = tidyRule env rule           =: \ rule ->+    tidyRules env rules         =: \ rules ->+    (rule : rules)++tidyRule :: TidyEnv -> CoreRule -> CoreRule+tidyRule _   rule@(BuiltinRule {}) = rule+tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,+                          ru_fn = fn, ru_rough = mb_ns })+  = tidyBndrs env bndrs         =: \ (env', bndrs) ->+    map (tidyExpr env') args    =: \ args ->+    rule { ru_bndrs = bndrs, ru_args = args,+           ru_rhs   = tidyExpr env' rhs,+           ru_fn    = tidyNameOcc env fn,+           ru_rough = map (fmap (tidyNameOcc env')) mb_ns }++{-+************************************************************************+*                                                                      *+\subsection{Tidying non-top-level binders}+*                                                                      *+************************************************************************+-}++tidyNameOcc :: TidyEnv -> Name -> Name+-- In rules and instances, we have Names, and we must tidy them too+-- Fortunately, we can lookup in the VarEnv with a name+tidyNameOcc (_, var_env) n = case lookupUFM var_env n of+                                Nothing -> n+                                Just v  -> idName v++tidyVarOcc :: TidyEnv -> Var -> Var+tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v++-- tidyBndr is used for lambda and case binders+tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)+tidyBndr env var+  | isTyCoVar var = tidyVarBndr env var+  | otherwise     = tidyIdBndr env var++tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])+tidyBndrs env vars = mapAccumL tidyBndr env vars++-- Non-top-level variables, not covars+tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)+tidyIdBndr env@(tidy_env, var_env) id+  = -- Do this pattern match strictly, otherwise we end up holding on to+    -- stuff in the OccName.+    case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->+    let+        -- Give the Id a fresh print-name, *and* rename its type+        -- The SrcLoc isn't important now,+        -- though we could extract it from the Id+        --+        ty'      = tidyType env (idType id)+        name'    = mkInternalName (idUnique id) occ' noSrcSpan+        id'      = mkLocalIdWithInfo name' ty' new_info+        var_env' = extendVarEnv var_env id id'++        -- Note [Tidy IdInfo]+        new_info = vanillaIdInfo `setOccInfo` occInfo old_info+                                 `setUnfoldingInfo` new_unf+                                  -- see Note [Preserve OneShotInfo]+                                 `setOneShotInfo` oneShotInfo old_info+        old_info = idInfo id+        old_unf  = unfoldingInfo old_info+        new_unf  = zapUnfolding old_unf  -- See Note [Preserve evaluatedness]+    in+    ((tidy_env', var_env'), id')+   }++tidyLetBndr :: TidyEnv         -- Knot-tied version for unfoldings+            -> TidyEnv         -- The one to extend+            -> (Id, CoreExpr) -> (TidyEnv, Var)+-- Used for local (non-top-level) let(rec)s+-- Just like tidyIdBndr above, but with more IdInfo+tidyLetBndr rec_tidy_env env@(tidy_env, var_env) (id,rhs)+  = case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->+    let+        ty'      = tidyType env (idType id)+        name'    = mkInternalName (idUnique id) occ' noSrcSpan+        details  = idDetails id+        id'      = mkLocalVar details name' ty' new_info+        var_env' = extendVarEnv var_env id id'++        -- Note [Tidy IdInfo]+        -- We need to keep around any interesting strictness and+        -- demand info because later on we may need to use it when+        -- converting to A-normal form.+        -- eg.+        --      f (g x),  where f is strict in its argument, will be converted+        --      into  case (g x) of z -> f z  by CorePrep, but only if f still+        --      has its strictness info.+        --+        -- Similarly for the demand info - on a let binder, this tells+        -- CorePrep to turn the let into a case.+        -- But: Remove the usage demand here+        --      (See Note [Zapping DmdEnv after Demand Analyzer] in WorkWrap)+        --+        -- Similarly arity info for eta expansion in CorePrep+        --+        -- Set inline-prag info so that we preseve it across+        -- separate compilation boundaries+        old_info = idInfo id+        new_info = vanillaIdInfo+                    `setOccInfo`        occInfo old_info+                    `setArityInfo`      exprArity rhs+                    `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info)+                    `setDemandInfo`     demandInfo old_info+                    `setInlinePragInfo` inlinePragInfo old_info+                    `setUnfoldingInfo`  new_unf++        old_unf = unfoldingInfo old_info+        new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf+                | otherwise                 = zapUnfolding old_unf+                                              -- See Note [Preserve evaluatedness]+    in+    ((tidy_env', var_env'), id') }++------------ Unfolding  --------------+tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding+tidyUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) _+  = df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args }+  where+    (tidy_env', bndrs') = tidyBndrs tidy_env bndrs++tidyUnfolding tidy_env+              unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })+              unf_from_rhs+  | isStableSource src+  = seqIt $ unf { uf_tmpl = tidyExpr tidy_env unf_rhs }    -- Preserves OccInfo+    -- This seqIt avoids a space leak: otherwise the uf_is_value,+    -- uf_is_conlike, ... fields may retain a reference to the+    -- pre-tidied expression forever (ToIface doesn't look at them)++  | otherwise+  = unf_from_rhs+  where seqIt unf = seqUnfolding unf `seq` unf+tidyUnfolding _ unf _ = unf     -- NoUnfolding or OtherCon++{-+Note [Tidy IdInfo]+~~~~~~~~~~~~~~~~~~+All nested Ids now have the same IdInfo, namely vanillaIdInfo, which+should save some space; except that we preserve occurrence info for+two reasons:++  (a) To make printing tidy core nicer++  (b) Because we tidy RULES and InlineRules, which may then propagate+      via --make into the compilation of the next module, and we want+      the benefit of that occurrence analysis when we use the rule or+      or inline the function.  In particular, it's vital not to lose+      loop-breaker info, else we get an infinite inlining loop++Note that tidyLetBndr puts more IdInfo back.++Note [Preserve evaluatedness]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+  data T = MkT !Bool+  ....(case v of MkT y ->+       let z# = case y of+                  True -> 1#+                  False -> 2#+       in ...)++The z# binding is ok because the RHS is ok-for-speculation,+but Lint will complain unless it can *see* that.  So we+preserve the evaluated-ness on 'y' in tidyBndr.++(Another alternative would be to tidy unboxed lets into cases,+but that seems more indirect and surprising.)++Note [Preserve OneShotInfo]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+We keep the OneShotInfo because we want it to propagate into the interface.+Not all OneShotInfo is determined by a compiler analysis; some is added by a+call of GHC.Exts.oneShot, which is then discarded before the end of the+optimisation pipeline, leaving only the OneShotInfo on the lambda. Hence we+must preserve this info in inlinings. See Note [The oneShot function] in MkId.++This applies to lambda binders only, hence it is stored in IfaceLamBndr.+-}++(=:) :: a -> (a -> b) -> b+m =: k = m `seq` k m
+ compiler/coreSyn/CoreUnfold.hs view
@@ -0,0 +1,1605 @@+{-+(c) The University of Glasgow 2006+(c) The AQUA Project, Glasgow University, 1994-1998+++Core-syntax unfoldings++Unfoldings (which can travel across module boundaries) are in Core+syntax (namely @CoreExpr@s).++The type @Unfolding@ sits ``above'' simply-Core-expressions+unfoldings, capturing ``higher-level'' things we know about a binding,+usually things that the simplifier found out (e.g., ``it's a+literal'').  In the corner of a @CoreUnfolding@ unfolding, you will+find, unsurprisingly, a Core expression.+-}++{-# LANGUAGE CPP #-}++module CoreUnfold (+        Unfolding, UnfoldingGuidance,   -- Abstract types++        noUnfolding, mkImplicitUnfolding,+        mkUnfolding, mkCoreUnfolding,+        mkTopUnfolding, mkSimpleUnfolding, mkWorkerUnfolding,+        mkInlineUnfolding, mkInlineUnfoldingWithArity,+        mkInlinableUnfolding, mkWwInlineRule,+        mkCompulsoryUnfolding, mkDFunUnfolding,+        specUnfolding,++        ArgSummary(..),++        couldBeSmallEnoughToInline, inlineBoringOk,+        certainlyWillInline, smallEnoughToInline,++        callSiteInline, CallCtxt(..),++        -- Reexport from CoreSubst (it only live there so it can be used+        -- by the Very Simple Optimiser)+        exprIsConApp_maybe, exprIsLiteral_maybe+    ) where++#include "HsVersions.h"++import GhcPrelude++import DynFlags+import CoreSyn+import PprCore          ()      -- Instances+import OccurAnal        ( occurAnalyseExpr_NoBinderSwap )+import CoreOpt+import CoreArity       ( manifestArity )+import CoreUtils+import Id+import Demand          ( isBottomingSig )+import DataCon+import Literal+import PrimOp+import IdInfo+import BasicTypes       ( Arity, InlineSpec(..), inlinePragmaSpec )+import Type+import PrelNames+import TysPrim          ( realWorldStatePrimTy )+import Bag+import Util+import Outputable+import ForeignCall+import Name++import qualified Data.ByteString as BS+import Data.List++{-+************************************************************************+*                                                                      *+\subsection{Making unfoldings}+*                                                                      *+************************************************************************+-}++mkTopUnfolding :: DynFlags -> Bool -> CoreExpr -> Unfolding+mkTopUnfolding dflags is_bottoming rhs+  = mkUnfolding dflags InlineRhs True is_bottoming rhs++mkImplicitUnfolding :: DynFlags -> CoreExpr -> Unfolding+-- For implicit Ids, do a tiny bit of optimising first+mkImplicitUnfolding dflags expr+  = mkTopUnfolding dflags False (simpleOptExpr dflags expr)++-- Note [Top-level flag on inline rules]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- Slight hack: note that mk_inline_rules conservatively sets the+-- top-level flag to True.  It gets set more accurately by the simplifier+-- Simplify.simplUnfolding.++mkSimpleUnfolding :: DynFlags -> CoreExpr -> Unfolding+mkSimpleUnfolding dflags rhs+  = mkUnfolding dflags InlineRhs False False rhs++mkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding+mkDFunUnfolding bndrs con ops+  = DFunUnfolding { df_bndrs = bndrs+                  , df_con = con+                  , df_args = map occurAnalyseExpr_NoBinderSwap ops }+                  -- See Note [Occurrence analysis of unfoldings]++mkWwInlineRule :: DynFlags -> CoreExpr -> Arity -> Unfolding+mkWwInlineRule dflags expr arity+  = mkCoreUnfolding InlineStable True+                   (simpleOptExpr dflags expr)+                   (UnfWhen { ug_arity = arity, ug_unsat_ok = unSaturatedOk+                            , ug_boring_ok = boringCxtNotOk })++mkCompulsoryUnfolding :: CoreExpr -> Unfolding+mkCompulsoryUnfolding expr         -- Used for things that absolutely must be unfolded+  = mkCoreUnfolding InlineCompulsory True+                    (simpleOptExpr unsafeGlobalDynFlags expr)+                    (UnfWhen { ug_arity = 0    -- Arity of unfolding doesn't matter+                             , ug_unsat_ok = unSaturatedOk, ug_boring_ok = boringCxtOk })++mkWorkerUnfolding :: DynFlags -> (CoreExpr -> CoreExpr) -> Unfolding -> Unfolding+-- See Note [Worker-wrapper for INLINABLE functions] in WorkWrap+mkWorkerUnfolding dflags work_fn+                  (CoreUnfolding { uf_src = src, uf_tmpl = tmpl+                                 , uf_is_top = top_lvl })+  | isStableSource src+  = mkCoreUnfolding src top_lvl new_tmpl guidance+  where+    new_tmpl = simpleOptExpr dflags (work_fn tmpl)+    guidance = calcUnfoldingGuidance dflags False new_tmpl++mkWorkerUnfolding _ _ _ = noUnfolding++-- | Make an unfolding that may be used unsaturated+-- (ug_unsat_ok = unSaturatedOk) and that is reported as having its+-- manifest arity (the number of outer lambdas applications will+-- resolve before doing any work).+mkInlineUnfolding :: CoreExpr -> Unfolding+mkInlineUnfolding expr+  = mkCoreUnfolding InlineStable+                    True         -- Note [Top-level flag on inline rules]+                    expr' guide+  where+    expr' = simpleOptExpr unsafeGlobalDynFlags expr+    guide = UnfWhen { ug_arity = manifestArity expr'+                    , ug_unsat_ok = unSaturatedOk+                    , ug_boring_ok = boring_ok }+    boring_ok = inlineBoringOk expr'++-- | Make an unfolding that will be used once the RHS has been saturated+-- to the given arity.+mkInlineUnfoldingWithArity :: Arity -> CoreExpr -> Unfolding+mkInlineUnfoldingWithArity arity expr+  = mkCoreUnfolding InlineStable+                    True         -- Note [Top-level flag on inline rules]+                    expr' guide+  where+    expr' = simpleOptExpr unsafeGlobalDynFlags expr+    guide = UnfWhen { ug_arity = arity+                    , ug_unsat_ok = needSaturated+                    , ug_boring_ok = boring_ok }+    -- See Note [INLINE pragmas and boring contexts] as to why we need to look+    -- at the arity here.+    boring_ok | arity == 0 = True+              | otherwise  = inlineBoringOk expr'++mkInlinableUnfolding :: DynFlags -> CoreExpr -> Unfolding+mkInlinableUnfolding dflags expr+  = mkUnfolding dflags InlineStable False False expr'+  where+    expr' = simpleOptExpr dflags expr++specUnfolding :: DynFlags -> [Var] -> (CoreExpr -> CoreExpr) -> Arity+              -> Unfolding -> Unfolding+-- See Note [Specialising unfoldings]+-- specUnfolding spec_bndrs spec_app arity_decrease unf+--   = \spec_bndrs. spec_app( unf )+--+specUnfolding dflags spec_bndrs spec_app arity_decrease+              df@(DFunUnfolding { df_bndrs = old_bndrs, df_con = con, df_args = args })+  = ASSERT2( arity_decrease == count isId old_bndrs - count isId spec_bndrs, ppr df )+    mkDFunUnfolding spec_bndrs con (map spec_arg args)+      -- There is a hard-to-check assumption here that the spec_app has+      -- enough applications to exactly saturate the old_bndrs+      -- For DFunUnfoldings we transform+      --       \old_bndrs. MkD <op1> ... <opn>+      -- to+      --       \new_bndrs. MkD (spec_app(\old_bndrs. <op1>)) ... ditto <opn>+      -- The ASSERT checks the value part of that+  where+    spec_arg arg = simpleOptExpr dflags (spec_app (mkLams old_bndrs arg))+                   -- The beta-redexes created by spec_app will be+                   -- simplified away by simplOptExpr++specUnfolding dflags spec_bndrs spec_app arity_decrease+              (CoreUnfolding { uf_src = src, uf_tmpl = tmpl+                             , uf_is_top = top_lvl+                             , uf_guidance = old_guidance })+ | isStableSource src  -- See Note [Specialising unfoldings]+ , UnfWhen { ug_arity     = old_arity+           , ug_unsat_ok  = unsat_ok+           , ug_boring_ok = boring_ok } <- old_guidance+ = let guidance = UnfWhen { ug_arity     = old_arity - arity_decrease+                          , ug_unsat_ok  = unsat_ok+                          , ug_boring_ok = boring_ok }+       new_tmpl = simpleOptExpr dflags (mkLams spec_bndrs (spec_app tmpl))+                   -- The beta-redexes created by spec_app will be+                   -- simplified away by simplOptExpr++   in mkCoreUnfolding src top_lvl new_tmpl guidance++specUnfolding _ _ _ _ _ = noUnfolding++{- Note [Specialising unfoldings]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When we specialise a function for some given type-class arguments, we use+specUnfolding to specialise its unfolding.  Some important points:++* If the original function has a DFunUnfolding, the specialised one+  must do so too!  Otherwise we lose the magic rules that make it+  interact with ClassOps++* There is a bit of hack for INLINABLE functions:+     f :: Ord a => ....+     f = <big-rhs>+     {- INLINABLE f #-}+  Now if we specialise f, should the specialised version still have+  an INLINABLE pragma?  If it does, we'll capture a specialised copy+  of <big-rhs> as its unfolding, and that probaby won't inline.  But+  if we don't, the specialised version of <big-rhs> might be small+  enough to inline at a call site. This happens with Control.Monad.liftM3,+  and can cause a lot more allocation as a result (nofib n-body shows this).++  Moreover, keeping the INLINABLE thing isn't much help, because+  the specialised function (probaby) isn't overloaded any more.++  Conclusion: drop the INLINEALE pragma.  In practice what this means is:+     if a stable unfolding has UnfoldingGuidance of UnfWhen,+        we keep it (so the specialised thing too will always inline)+     if a stable unfolding has UnfoldingGuidance of UnfIfGoodArgs+        (which arises from INLINABLE), we discard it++Note [Honour INLINE on 0-ary bindings]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider++   x = <expensive>+   {-# INLINE x #-}++   f y = ...x...++The semantics of an INLINE pragma is++  inline x at every call site, provided it is saturated;+  that is, applied to at least as many arguments as appear+  on the LHS of the Haskell source definition.++(This soure-code-derived arity is stored in the `ug_arity` field of+the `UnfoldingGuidance`.)++In the example, x's ug_arity is 0, so we should inline it at every use+site.  It's rare to have such an INLINE pragma (usually INLINE Is on+functions), but it's occasionally very important (#15578, #15519).+In #15519 we had something like+   x = case (g a b) of I# r -> T r+   {-# INLINE x #-}+   f y = ...(h x)....++where h is strict.  So we got+   f y = ...(case g a b of I# r -> h (T r))...++and that in turn allowed SpecConstr to ramp up performance.++How do we deliver on this?  By adjusting the ug_boring_ok+flag in mkInlineUnfoldingWithArity; see+Note [INLINE pragmas and boring contexts]++NB: there is a real risk that full laziness will float it right back+out again. Consider again+  x = factorial 200+  {-# INLINE x #-}+  f y = ...x...++After inlining we get+  f y = ...(factorial 200)...++but it's entirely possible that full laziness will do+  lvl23 = factorial 200+  f y = ...lvl23...++That's a problem for another day.++Note [INLINE pragmas and boring contexts]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+An INLINE pragma uses mkInlineUnfoldingWithArity to build the+unfolding.  That sets the ug_boring_ok flag to False if the function+is not tiny (inlineBoringOK), so that even INLINE functions are not+inlined in an utterly boring context.  E.g.+     \x y. Just (f y x)+Nothing is gained by inlining f here, even if it has an INLINE+pragma.++But for 0-ary bindings, we want to inline regardless; see+Note [Honour INLINE on 0-ary bindings].++I'm a bit worried that it's possible for the same kind of problem+to arise for non-0-ary functions too, but let's wait and see.+-}++mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr+                -> UnfoldingGuidance -> Unfolding+-- Occurrence-analyses the expression before capturing it+mkCoreUnfolding src top_lvl expr guidance+  = CoreUnfolding { uf_tmpl         = occurAnalyseExpr_NoBinderSwap expr,+                      -- See Note [Occurrence analysis of unfoldings]+                    uf_src          = src,+                    uf_is_top       = top_lvl,+                    uf_is_value     = exprIsHNF        expr,+                    uf_is_conlike   = exprIsConLike    expr,+                    uf_is_work_free = exprIsWorkFree   expr,+                    uf_expandable   = exprIsExpandable expr,+                    uf_guidance     = guidance }++mkUnfolding :: DynFlags -> UnfoldingSource+            -> Bool       -- Is top-level+            -> Bool       -- Definitely a bottoming binding+                          -- (only relevant for top-level bindings)+            -> CoreExpr+            -> Unfolding+-- Calculates unfolding guidance+-- Occurrence-analyses the expression before capturing it+mkUnfolding dflags src is_top_lvl is_bottoming expr+  = CoreUnfolding { uf_tmpl         = occurAnalyseExpr_NoBinderSwap expr,+                      -- See Note [Occurrence analysis of unfoldings]+                    uf_src          = src,+                    uf_is_top       = is_top_lvl,+                    uf_is_value     = exprIsHNF        expr,+                    uf_is_conlike   = exprIsConLike    expr,+                    uf_expandable   = exprIsExpandable expr,+                    uf_is_work_free = exprIsWorkFree   expr,+                    uf_guidance     = guidance }+  where+    is_top_bottoming = is_top_lvl && is_bottoming+    guidance         = calcUnfoldingGuidance dflags is_top_bottoming expr+        -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr_NoBinderSwap expr))!+        -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression]++{-+Note [Occurrence analysis of unfoldings]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We do occurrence-analysis of unfoldings once and for all, when the+unfolding is built, rather than each time we inline them.++But given this decision it's vital that we do+*always* do it.  Consider this unfolding+    \x -> letrec { f = ...g...; g* = f } in body+where g* is (for some strange reason) the loop breaker.  If we don't+occ-anal it when reading it in, we won't mark g as a loop breaker, and+we may inline g entirely in body, dropping its binding, and leaving+the occurrence in f out of scope. This happened in #8892, where+the unfolding in question was a DFun unfolding.++But more generally, the simplifier is designed on the+basis that it is looking at occurrence-analysed expressions, so better+ensure that they acutally are.++We use occurAnalyseExpr_NoBinderSwap instead of occurAnalyseExpr;+see Note [No binder swap in unfoldings].++Note [No binder swap in unfoldings]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The binder swap can temporarily violate Core Lint, by assinging+a LocalId binding to a GlobalId. For example, if A.foo{r872}+is a GlobalId with unique r872, then++ case A.foo{r872} of bar {+   K x -> ...(A.foo{r872})...+ }++gets transformed to++  case A.foo{r872} of bar {+    K x -> let foo{r872} = bar+           in ...(A.foo{r872})...++This is usually not a problem, because the simplifier will transform+this to:++  case A.foo{r872} of bar {+    K x -> ...(bar)...++However, after occurrence analysis but before simplification, this extra 'let'+violates the Core Lint invariant that we do not have local 'let' bindings for+GlobalIds.  That seems (just) tolerable for the occurrence analysis that happens+just before the Simplifier, but not for unfoldings, which are Linted+independently.+As a quick workaround, we disable binder swap in this module.+See #16288 and #16296 for further plans.++Note [Calculate unfolding guidance on the non-occ-anal'd expression]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Notice that we give the non-occur-analysed expression to+calcUnfoldingGuidance.  In some ways it'd be better to occur-analyse+first; for example, sometimes during simplification, there's a large+let-bound thing which has been substituted, and so is now dead; so+'expr' contains two copies of the thing while the occurrence-analysed+expression doesn't.++Nevertheless, we *don't* and *must not* occ-analyse before computing+the size because++a) The size computation bales out after a while, whereas occurrence+   analysis does not.++b) Residency increases sharply if you occ-anal first.  I'm not+   100% sure why, but it's a large effect.  Compiling Cabal went+   from residency of 534M to over 800M with this one change.++This can occasionally mean that the guidance is very pessimistic;+it gets fixed up next round.  And it should be rare, because large+let-bound things that are dead are usually caught by preInlineUnconditionally+++************************************************************************+*                                                                      *+\subsection{The UnfoldingGuidance type}+*                                                                      *+************************************************************************+-}++inlineBoringOk :: CoreExpr -> Bool+-- See Note [INLINE for small functions]+-- True => the result of inlining the expression is+--         no bigger than the expression itself+--     eg      (\x y -> f y x)+-- This is a quick and dirty version. It doesn't attempt+-- to deal with  (\x y z -> x (y z))+-- The really important one is (x `cast` c)+inlineBoringOk e+  = go 0 e+  where+    go :: Int -> CoreExpr -> Bool+    go credit (Lam x e) | isId x           = go (credit+1) e+                        | otherwise        = go credit e+    go credit (App f (Type {}))            = go credit f+    go credit (App f a) | credit > 0+                        , exprIsTrivial a  = go (credit-1) f+    go credit (Tick _ e)                 = go credit e -- dubious+    go credit (Cast e _)                   = go credit e+    go _      (Var {})                     = boringCxtOk+    go _      _                            = boringCxtNotOk++calcUnfoldingGuidance+        :: DynFlags+        -> Bool          -- Definitely a top-level, bottoming binding+        -> CoreExpr      -- Expression to look at+        -> UnfoldingGuidance+calcUnfoldingGuidance dflags is_top_bottoming (Tick t expr)+  | not (tickishIsCode t)  -- non-code ticks don't matter for unfolding+  = calcUnfoldingGuidance dflags is_top_bottoming expr+calcUnfoldingGuidance dflags is_top_bottoming expr+  = case sizeExpr dflags bOMB_OUT_SIZE val_bndrs body of+      TooBig -> UnfNever+      SizeIs size cased_bndrs scrut_discount+        | uncondInline expr n_val_bndrs size+        -> UnfWhen { ug_unsat_ok = unSaturatedOk+                   , ug_boring_ok =  boringCxtOk+                   , ug_arity = n_val_bndrs }   -- Note [INLINE for small functions]++        | is_top_bottoming+        -> UnfNever   -- See Note [Do not inline top-level bottoming functions]++        | otherwise+        -> UnfIfGoodArgs { ug_args  = map (mk_discount cased_bndrs) val_bndrs+                         , ug_size  = size+                         , ug_res   = scrut_discount }++  where+    (bndrs, body) = collectBinders expr+    bOMB_OUT_SIZE = ufCreationThreshold dflags+           -- Bomb out if size gets bigger than this+    val_bndrs   = filter isId bndrs+    n_val_bndrs = length val_bndrs++    mk_discount :: Bag (Id,Int) -> Id -> Int+    mk_discount cbs bndr = foldlBag combine 0 cbs+           where+             combine acc (bndr', disc)+               | bndr == bndr' = acc `plus_disc` disc+               | otherwise     = acc++             plus_disc :: Int -> Int -> Int+             plus_disc | isFunTy (idType bndr) = max+                       | otherwise             = (+)+             -- See Note [Function and non-function discounts]++{-+Note [Computing the size of an expression]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The basic idea of sizeExpr is obvious enough: count nodes.  But getting the+heuristics right has taken a long time.  Here's the basic strategy:++    * Variables, literals: 0+      (Exception for string literals, see litSize.)++    * Function applications (f e1 .. en): 1 + #value args++    * Constructor applications: 1, regardless of #args++    * Let(rec): 1 + size of components++    * Note, cast: 0++Examples++  Size  Term+  --------------+    0     42#+    0     x+    0     True+    2     f x+    1     Just x+    4     f (g x)++Notice that 'x' counts 0, while (f x) counts 2.  That's deliberate: there's+a function call to account for.  Notice also that constructor applications+are very cheap, because exposing them to a caller is so valuable.++[25/5/11] All sizes are now multiplied by 10, except for primops+(which have sizes like 1 or 4.  This makes primops look fantastically+cheap, and seems to be almost unversally beneficial.  Done partly as a+result of #4978.++Note [Do not inline top-level bottoming functions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The FloatOut pass has gone to some trouble to float out calls to 'error'+and similar friends.  See Note [Bottoming floats] in SetLevels.+Do not re-inline them!  But we *do* still inline if they are very small+(the uncondInline stuff).++Note [INLINE for small functions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider        {-# INLINE f #-}+                f x = Just x+                g y = f y+Then f's RHS is no larger than its LHS, so we should inline it into+even the most boring context.  In general, f the function is+sufficiently small that its body is as small as the call itself, the+inline unconditionally, regardless of how boring the context is.++Things to note:++(1) We inline *unconditionally* if inlined thing is smaller (using sizeExpr)+    than the thing it's replacing.  Notice that+      (f x) --> (g 3)             -- YES, unconditionally+      (f x) --> x : []            -- YES, *even though* there are two+                                  --      arguments to the cons+      x     --> g 3               -- NO+      x     --> Just v            -- NO++    It's very important not to unconditionally replace a variable by+    a non-atomic term.++(2) We do this even if the thing isn't saturated, else we end up with the+    silly situation that+       f x y = x+       ...map (f 3)...+    doesn't inline.  Even in a boring context, inlining without being+    saturated will give a lambda instead of a PAP, and will be more+    efficient at runtime.++(3) However, when the function's arity > 0, we do insist that it+    has at least one value argument at the call site.  (This check is+    made in the UnfWhen case of callSiteInline.) Otherwise we find this:+         f = /\a \x:a. x+         d = /\b. MkD (f b)+    If we inline f here we get+         d = /\b. MkD (\x:b. x)+    and then prepareRhs floats out the argument, abstracting the type+    variables, so we end up with the original again!++(4) We must be much more cautious about arity-zero things. Consider+       let x = y +# z in ...+    In *size* terms primops look very small, because the generate a+    single instruction, but we do not want to unconditionally replace+    every occurrence of x with (y +# z).  So we only do the+    unconditional-inline thing for *trivial* expressions.++    NB: you might think that PostInlineUnconditionally would do this+    but it doesn't fire for top-level things; see SimplUtils+    Note [Top level and postInlineUnconditionally]+-}++uncondInline :: CoreExpr -> Arity -> Int -> Bool+-- Inline unconditionally if there no size increase+-- Size of call is arity (+1 for the function)+-- See Note [INLINE for small functions]+uncondInline rhs arity size+  | arity > 0 = size <= 10 * (arity + 1) -- See Note [INLINE for small functions] (1)+  | otherwise = exprIsTrivial rhs        -- See Note [INLINE for small functions] (4)++sizeExpr :: DynFlags+         -> Int             -- Bomb out if it gets bigger than this+         -> [Id]            -- Arguments; we're interested in which of these+                            -- get case'd+         -> CoreExpr+         -> ExprSize++-- Note [Computing the size of an expression]++sizeExpr dflags bOMB_OUT_SIZE top_args expr+  = size_up expr+  where+    size_up (Cast e _) = size_up e+    size_up (Tick _ e) = size_up e+    size_up (Type _)   = sizeZero           -- Types cost nothing+    size_up (Coercion _) = sizeZero+    size_up (Lit lit)  = sizeN (litSize lit)+    size_up (Var f) | isRealWorldId f = sizeZero+                      -- Make sure we get constructor discounts even+                      -- on nullary constructors+                    | otherwise       = size_up_call f [] 0++    size_up (App fun arg)+      | isTyCoArg arg = size_up fun+      | otherwise     = size_up arg  `addSizeNSD`+                        size_up_app fun [arg] (if isRealWorldExpr arg then 1 else 0)++    size_up (Lam b e)+      | isId b && not (isRealWorldId b) = lamScrutDiscount dflags (size_up e `addSizeN` 10)+      | otherwise = size_up e++    size_up (Let (NonRec binder rhs) body)+      = size_up_rhs (binder, rhs) `addSizeNSD`+        size_up body              `addSizeN`+        size_up_alloc binder++    size_up (Let (Rec pairs) body)+      = foldr (addSizeNSD . size_up_rhs)+              (size_up body `addSizeN` sum (map (size_up_alloc . fst) pairs))+              pairs++    size_up (Case e _ _ alts)+        | null alts+        = size_up e    -- case e of {} never returns, so take size of scrutinee++    size_up (Case e _ _ alts)+        -- Now alts is non-empty+        | Just v <- is_top_arg e -- We are scrutinising an argument variable+        = let+            alt_sizes = map size_up_alt alts++                  -- alts_size tries to compute a good discount for+                  -- the case when we are scrutinising an argument variable+            alts_size (SizeIs tot tot_disc tot_scrut)+                          -- Size of all alternatives+                      (SizeIs max _        _)+                          -- Size of biggest alternative+                  = SizeIs tot (unitBag (v, 20 + tot - max)+                      `unionBags` tot_disc) tot_scrut+                          -- If the variable is known, we produce a+                          -- discount that will take us back to 'max',+                          -- the size of the largest alternative The+                          -- 1+ is a little discount for reduced+                          -- allocation in the caller+                          --+                          -- Notice though, that we return tot_disc,+                          -- the total discount from all branches.  I+                          -- think that's right.++            alts_size tot_size _ = tot_size+          in+          alts_size (foldr1 addAltSize alt_sizes)  -- alts is non-empty+                    (foldr1 maxSize    alt_sizes)+                -- Good to inline if an arg is scrutinised, because+                -- that may eliminate allocation in the caller+                -- And it eliminates the case itself+        where+          is_top_arg (Var v) | v `elem` top_args = Just v+          is_top_arg (Cast e _) = is_top_arg e+          is_top_arg _ = Nothing+++    size_up (Case e _ _ alts) = size_up e  `addSizeNSD`+                                foldr (addAltSize . size_up_alt) case_size alts+      where+          case_size+           | is_inline_scrut e, lengthAtMost alts 1 = sizeN (-10)+           | otherwise = sizeZero+                -- Normally we don't charge for the case itself, but+                -- we charge one per alternative (see size_up_alt,+                -- below) to account for the cost of the info table+                -- and comparisons.+                --+                -- However, in certain cases (see is_inline_scrut+                -- below), no code is generated for the case unless+                -- there are multiple alts.  In these cases we+                -- subtract one, making the first alt free.+                -- e.g. case x# +# y# of _ -> ...   should cost 1+                --      case touch# x# of _ -> ...  should cost 0+                -- (see #4978)+                --+                -- I would like to not have the "lengthAtMost alts 1"+                -- condition above, but without that some programs got worse+                -- (spectral/hartel/event and spectral/para).  I don't fully+                -- understand why. (SDM 24/5/11)++                -- unboxed variables, inline primops and unsafe foreign calls+                -- are all "inline" things:+          is_inline_scrut (Var v) = isUnliftedType (idType v)+          is_inline_scrut scrut+              | (Var f, _) <- collectArgs scrut+                = case idDetails f of+                    FCallId fc  -> not (isSafeForeignCall fc)+                    PrimOpId op -> not (primOpOutOfLine op)+                    _other      -> False+              | otherwise+                = False++    size_up_rhs (bndr, rhs)+      | Just join_arity <- isJoinId_maybe bndr+        -- Skip arguments to join point+      , (_bndrs, body) <- collectNBinders join_arity rhs+      = size_up body+      | otherwise+      = size_up rhs++    ------------+    -- size_up_app is used when there's ONE OR MORE value args+    size_up_app (App fun arg) args voids+        | isTyCoArg arg                  = size_up_app fun args voids+        | isRealWorldExpr arg            = size_up_app fun (arg:args) (voids + 1)+        | otherwise                      = size_up arg  `addSizeNSD`+                                           size_up_app fun (arg:args) voids+    size_up_app (Var fun)     args voids = size_up_call fun args voids+    size_up_app (Tick _ expr) args voids = size_up_app expr args voids+    size_up_app (Cast expr _) args voids = size_up_app expr args voids+    size_up_app other         args voids = size_up other `addSizeN`+                                           callSize (length args) voids+       -- if the lhs is not an App or a Var, or an invisible thing like a+       -- Tick or Cast, then we should charge for a complete call plus the+       -- size of the lhs itself.++    ------------+    size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize+    size_up_call fun val_args voids+       = case idDetails fun of+           FCallId _        -> sizeN (callSize (length val_args) voids)+           DataConWorkId dc -> conSize    dc (length val_args)+           PrimOpId op      -> primOpSize op (length val_args)+           ClassOpId _      -> classOpSize dflags top_args val_args+           _                -> funSize dflags top_args fun (length val_args) voids++    ------------+    size_up_alt (_con, _bndrs, rhs) = size_up rhs `addSizeN` 10+        -- Don't charge for args, so that wrappers look cheap+        -- (See comments about wrappers with Case)+        --+        -- IMPORTANT: *do* charge 1 for the alternative, else we+        -- find that giant case nests are treated as practically free+        -- A good example is Foreign.C.Error.errnoToIOError++    ------------+    -- Cost to allocate binding with given binder+    size_up_alloc bndr+      |  isTyVar bndr                 -- Doesn't exist at runtime+      || isJoinId bndr                -- Not allocated at all+      || isUnliftedType (idType bndr) -- Doesn't live in heap+      = 0+      | otherwise+      = 10++    ------------+        -- These addSize things have to be here because+        -- I don't want to give them bOMB_OUT_SIZE as an argument+    addSizeN TooBig          _  = TooBig+    addSizeN (SizeIs n xs d) m  = mkSizeIs bOMB_OUT_SIZE (n + m) xs d++        -- addAltSize is used to add the sizes of case alternatives+    addAltSize TooBig            _      = TooBig+    addAltSize _                 TooBig = TooBig+    addAltSize (SizeIs n1 xs d1) (SizeIs n2 ys d2)+        = mkSizeIs bOMB_OUT_SIZE (n1 + n2)+                                 (xs `unionBags` ys)+                                 (d1 + d2) -- Note [addAltSize result discounts]++        -- This variant ignores the result discount from its LEFT argument+        -- It's used when the second argument isn't part of the result+    addSizeNSD TooBig            _      = TooBig+    addSizeNSD _                 TooBig = TooBig+    addSizeNSD (SizeIs n1 xs _) (SizeIs n2 ys d2)+        = mkSizeIs bOMB_OUT_SIZE (n1 + n2)+                                 (xs `unionBags` ys)+                                 d2  -- Ignore d1++    isRealWorldId id = idType id `eqType` realWorldStatePrimTy++    -- an expression of type State# RealWorld must be a variable+    isRealWorldExpr (Var id)   = isRealWorldId id+    isRealWorldExpr (Tick _ e) = isRealWorldExpr e+    isRealWorldExpr _          = False++-- | Finds a nominal size of a string literal.+litSize :: Literal -> Int+-- Used by CoreUnfold.sizeExpr+litSize (LitNumber LitNumInteger _ _) = 100   -- Note [Size of literal integers]+litSize (LitNumber LitNumNatural _ _) = 100+litSize (LitString str) = 10 + 10 * ((BS.length str + 3) `div` 4)+        -- If size could be 0 then @f "x"@ might be too small+        -- [Sept03: make literal strings a bit bigger to avoid fruitless+        --  duplication of little strings]+litSize _other = 0    -- Must match size of nullary constructors+                      -- Key point: if  x |-> 4, then x must inline unconditionally+                      --            (eg via case binding)++classOpSize :: DynFlags -> [Id] -> [CoreExpr] -> ExprSize+-- See Note [Conlike is interesting]+classOpSize _ _ []+  = sizeZero+classOpSize dflags top_args (arg1 : other_args)+  = SizeIs size arg_discount 0+  where+    size = 20 + (10 * length other_args)+    -- If the class op is scrutinising a lambda bound dictionary then+    -- give it a discount, to encourage the inlining of this function+    -- The actual discount is rather arbitrarily chosen+    arg_discount = case arg1 of+                     Var dict | dict `elem` top_args+                              -> unitBag (dict, ufDictDiscount dflags)+                     _other   -> emptyBag++-- | The size of a function call+callSize+ :: Int  -- ^ number of value args+ -> Int  -- ^ number of value args that are void+ -> Int+callSize n_val_args voids = 10 * (1 + n_val_args - voids)+        -- The 1+ is for the function itself+        -- Add 1 for each non-trivial arg;+        -- the allocation cost, as in let(rec)++-- | The size of a jump to a join point+jumpSize+ :: Int  -- ^ number of value args+ -> Int  -- ^ number of value args that are void+ -> Int+jumpSize n_val_args voids = 2 * (1 + n_val_args - voids)+  -- A jump is 20% the size of a function call. Making jumps free reopens+  -- bug #6048, but making them any more expensive loses a 21% improvement in+  -- spectral/puzzle. TODO Perhaps adjusting the default threshold would be a+  -- better solution?++funSize :: DynFlags -> [Id] -> Id -> Int -> Int -> ExprSize+-- Size for functions that are not constructors or primops+-- Note [Function applications]+funSize dflags top_args fun n_val_args voids+  | fun `hasKey` buildIdKey   = buildSize+  | fun `hasKey` augmentIdKey = augmentSize+  | otherwise = SizeIs size arg_discount res_discount+  where+    some_val_args = n_val_args > 0+    is_join = isJoinId fun++    size | is_join              = jumpSize n_val_args voids+         | not some_val_args    = 0+         | otherwise            = callSize n_val_args voids++        --                  DISCOUNTS+        --  See Note [Function and non-function discounts]+    arg_discount | some_val_args && fun `elem` top_args+                 = unitBag (fun, ufFunAppDiscount dflags)+                 | otherwise = emptyBag+        -- If the function is an argument and is applied+        -- to some values, give it an arg-discount++    res_discount | idArity fun > n_val_args = ufFunAppDiscount dflags+                 | otherwise                = 0+        -- If the function is partially applied, show a result discount+-- XXX maybe behave like ConSize for eval'd variable++conSize :: DataCon -> Int -> ExprSize+conSize dc n_val_args+  | n_val_args == 0 = SizeIs 0 emptyBag 10    -- Like variables++-- See Note [Unboxed tuple size and result discount]+  | isUnboxedTupleCon dc = SizeIs 0 emptyBag (10 * (1 + n_val_args))++-- See Note [Constructor size and result discount]+  | otherwise = SizeIs 10 emptyBag (10 * (1 + n_val_args))++-- XXX still looks to large to me++{-+Note [Constructor size and result discount]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Treat a constructors application as size 10, regardless of how many+arguments it has; we are keen to expose them (and we charge separately+for their args).  We can't treat them as size zero, else we find that+(Just x) has size 0, which is the same as a lone variable; and hence+'v' will always be replaced by (Just x), where v is bound to Just x.++The "result discount" is applied if the result of the call is+scrutinised (say by a case).  For a constructor application that will+mean the constructor application will disappear, so we don't need to+charge it to the function.  So the discount should at least match the+cost of the constructor application, namely 10.  But to give a bit+of extra incentive we give a discount of 10*(1 + n_val_args).++Simon M tried a MUCH bigger discount: (10 * (10 + n_val_args)),+and said it was an "unambiguous win", but its terribly dangerous+because a function with many many case branches, each finishing with+a constructor, can have an arbitrarily large discount.  This led to+terrible code bloat: see #6099.++Note [Unboxed tuple size and result discount]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+However, unboxed tuples count as size zero. I found occasions where we had+        f x y z = case op# x y z of { s -> (# s, () #) }+and f wasn't getting inlined.++I tried giving unboxed tuples a *result discount* of zero (see the+commented-out line).  Why?  When returned as a result they do not+allocate, so maybe we don't want to charge so much for them If you+have a non-zero discount here, we find that workers often get inlined+back into wrappers, because it look like+    f x = case $wf x of (# a,b #) -> (a,b)+and we are keener because of the case.  However while this change+shrank binary sizes by 0.5% it also made spectral/boyer allocate 5%+more. All other changes were very small. So it's not a big deal but I+didn't adopt the idea.++Note [Function and non-function discounts]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We want a discount if the function is applied. A good example is+monadic combinators with continuation arguments, where inlining is+quite important.++But we don't want a big discount when a function is called many times+(see the detailed comments with #6048) because if the function is+big it won't be inlined at its many call sites and no benefit results.+Indeed, we can get exponentially big inlinings this way; that is what+#6048 is about.++On the other hand, for data-valued arguments, if there are lots of+case expressions in the body, each one will get smaller if we apply+the function to a constructor application, so we *want* a big discount+if the argument is scrutinised by many case expressions.++Conclusion:+  - For functions, take the max of the discounts+  - For data values, take the sum of the discounts+++Note [Literal integer size]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Literal integers *can* be big (mkInteger [...coefficients...]), but+need not be (S# n).  We just use an arbitrary big-ish constant here+so that, in particular, we don't inline top-level defns like+   n = S# 5+There's no point in doing so -- any optimisations will see the S#+through n's unfolding.  Nor will a big size inhibit unfoldings functions+that mention a literal Integer, because the float-out pass will float+all those constants to top level.+-}++primOpSize :: PrimOp -> Int -> ExprSize+primOpSize op n_val_args+ = if primOpOutOfLine op+      then sizeN (op_size + n_val_args)+      else sizeN op_size+ where+   op_size = primOpCodeSize op+++buildSize :: ExprSize+buildSize = SizeIs 0 emptyBag 40+        -- We really want to inline applications of build+        -- build t (\cn -> e) should cost only the cost of e (because build will be inlined later)+        -- Indeed, we should add a result_discount because build is+        -- very like a constructor.  We don't bother to check that the+        -- build is saturated (it usually is).  The "-2" discounts for the \c n,+        -- The "4" is rather arbitrary.++augmentSize :: ExprSize+augmentSize = SizeIs 0 emptyBag 40+        -- Ditto (augment t (\cn -> e) ys) should cost only the cost of+        -- e plus ys. The -2 accounts for the \cn++-- When we return a lambda, give a discount if it's used (applied)+lamScrutDiscount :: DynFlags -> ExprSize -> ExprSize+lamScrutDiscount dflags (SizeIs n vs _) = SizeIs n vs (ufFunAppDiscount dflags)+lamScrutDiscount _      TooBig          = TooBig++{-+Note [addAltSize result discounts]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When adding the size of alternatives, we *add* the result discounts+too, rather than take the *maximum*.  For a multi-branch case, this+gives a discount for each branch that returns a constructor, making us+keener to inline.  I did try using 'max' instead, but it makes nofib+'rewrite' and 'puzzle' allocate significantly more, and didn't make+binary sizes shrink significantly either.++Note [Discounts and thresholds]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Constants for discounts and thesholds are defined in main/DynFlags,+all of form ufXxxx.   They are:++ufCreationThreshold+     At a definition site, if the unfolding is bigger than this, we+     may discard it altogether++ufUseThreshold+     At a call site, if the unfolding, less discounts, is smaller than+     this, then it's small enough inline++ufKeenessFactor+     Factor by which the discounts are multiplied before+     subtracting from size++ufDictDiscount+     The discount for each occurrence of a dictionary argument+     as an argument of a class method.  Should be pretty small+     else big functions may get inlined++ufFunAppDiscount+     Discount for a function argument that is applied.  Quite+     large, because if we inline we avoid the higher-order call.++ufDearOp+     The size of a foreign call or not-dupable PrimOp++ufVeryAggressive+     If True, the compiler ignores all the thresholds and inlines very+     aggressively. It still adheres to arity, simplifier phase control and+     loop breakers.+++Note [Function applications]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In a function application (f a b)++  - If 'f' is an argument to the function being analysed,+    and there's at least one value arg, record a FunAppDiscount for f++  - If the application if a PAP (arity > 2 in this example)+    record a *result* discount (because inlining+    with "extra" args in the call may mean that we now+    get a saturated application)++Code for manipulating sizes+-}++-- | The size of a candidate expression for unfolding+data ExprSize+    = TooBig+    | SizeIs { _es_size_is  :: {-# UNPACK #-} !Int -- ^ Size found+             , _es_args     :: !(Bag (Id,Int))+               -- ^ Arguments cased herein, and discount for each such+             , _es_discount :: {-# UNPACK #-} !Int+               -- ^ Size to subtract if result is scrutinised by a case+               -- expression+             }++instance Outputable ExprSize where+  ppr TooBig         = text "TooBig"+  ppr (SizeIs a _ c) = brackets (int a <+> int c)++-- subtract the discount before deciding whether to bale out. eg. we+-- want to inline a large constructor application into a selector:+--      tup = (a_1, ..., a_99)+--      x = case tup of ...+--+mkSizeIs :: Int -> Int -> Bag (Id, Int) -> Int -> ExprSize+mkSizeIs max n xs d | (n - d) > max = TooBig+                    | otherwise     = SizeIs n xs d++maxSize :: ExprSize -> ExprSize -> ExprSize+maxSize TooBig         _                                  = TooBig+maxSize _              TooBig                             = TooBig+maxSize s1@(SizeIs n1 _ _) s2@(SizeIs n2 _ _) | n1 > n2   = s1+                                              | otherwise = s2++sizeZero :: ExprSize+sizeN :: Int -> ExprSize++sizeZero = SizeIs 0 emptyBag 0+sizeN n  = SizeIs n emptyBag 0++{-+************************************************************************+*                                                                      *+\subsection[considerUnfolding]{Given all the info, do (not) do the unfolding}+*                                                                      *+************************************************************************++We use 'couldBeSmallEnoughToInline' to avoid exporting inlinings that+we ``couldn't possibly use'' on the other side.  Can be overridden w/+flaggery.  Just the same as smallEnoughToInline, except that it has no+actual arguments.+-}++couldBeSmallEnoughToInline :: DynFlags -> Int -> CoreExpr -> Bool+couldBeSmallEnoughToInline dflags threshold rhs+  = case sizeExpr dflags threshold [] body of+       TooBig -> False+       _      -> True+  where+    (_, body) = collectBinders rhs++----------------+smallEnoughToInline :: DynFlags -> Unfolding -> Bool+smallEnoughToInline dflags (CoreUnfolding {uf_guidance = UnfIfGoodArgs {ug_size = size}})+  = size <= ufUseThreshold dflags+smallEnoughToInline _ _+  = False++----------------++certainlyWillInline :: DynFlags -> IdInfo -> Maybe Unfolding+-- ^ Sees if the unfolding is pretty certain to inline.+-- If so, return a *stable* unfolding for it, that will always inline.+certainlyWillInline dflags fn_info+  = case unfoldingInfo fn_info of+      CoreUnfolding { uf_tmpl = e, uf_guidance = g }+        | loop_breaker -> Nothing      -- Won't inline, so try w/w+        | noinline     -> Nothing      -- See Note [Worker-wrapper for NOINLINE functions]+        | otherwise    -> do_cunf e g  -- Depends on size, so look at that++      DFunUnfolding {} -> Just fn_unf  -- Don't w/w DFuns; it never makes sense+                                       -- to do so, and even if it is currently a+                                       -- loop breaker, it may not be later++      _other_unf       -> Nothing++  where+    loop_breaker = isStrongLoopBreaker (occInfo fn_info)+    noinline     = inlinePragmaSpec (inlinePragInfo fn_info) == NoInline+    fn_unf       = unfoldingInfo fn_info++    do_cunf :: CoreExpr -> UnfoldingGuidance -> Maybe Unfolding+    do_cunf _ UnfNever     = Nothing+    do_cunf _ (UnfWhen {}) = Just (fn_unf { uf_src = InlineStable })+                             -- INLINE functions have UnfWhen++        -- The UnfIfGoodArgs case seems important.  If we w/w small functions+        -- binary sizes go up by 10%!  (This is with SplitObjs.)+        -- I'm not totally sure why.+        -- INLINABLE functions come via this path+        --    See Note [certainlyWillInline: INLINABLE]+    do_cunf expr (UnfIfGoodArgs { ug_size = size, ug_args = args })+      | not (null args)  -- See Note [certainlyWillInline: be careful of thunks]+      , not (isBottomingSig (strictnessInfo fn_info))+              -- Do not unconditionally inline a bottoming functions even if+              -- it seems smallish. We've carefully lifted it out to top level,+              -- so we don't want to re-inline it.+      , let arity = length args+      , size - (10 * (arity + 1)) <= ufUseThreshold dflags+      = Just (fn_unf { uf_src      = InlineStable+                     , uf_guidance = UnfWhen { ug_arity     = arity+                                             , ug_unsat_ok  = unSaturatedOk+                                             , ug_boring_ok = inlineBoringOk expr } })+             -- Note the "unsaturatedOk". A function like  f = \ab. a+             -- will certainly inline, even if partially applied (f e), so we'd+             -- better make sure that the transformed inlining has the same property+      | otherwise+      = Nothing++{- Note [certainlyWillInline: be careful of thunks]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Don't claim that thunks will certainly inline, because that risks work+duplication.  Even if the work duplication is not great (eg is_cheap+holds), it can make a big difference in an inner loop In #5623 we+found that the WorkWrap phase thought that+       y = case x of F# v -> F# (v +# v)+was certainlyWillInline, so the addition got duplicated.++Note [certainlyWillInline: INLINABLE]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+certainlyWillInline /must/ return Nothing for a large INLINABLE thing,+even though we have a stable inlining, so that strictness w/w takes+place.  It makes a big difference to efficiency, and the w/w pass knows+how to transfer the INLINABLE info to the worker; see WorkWrap+Note [Worker-wrapper for INLINABLE functions]++************************************************************************+*                                                                      *+\subsection{callSiteInline}+*                                                                      *+************************************************************************++This is the key function.  It decides whether to inline a variable at a call site++callSiteInline is used at call sites, so it is a bit more generous.+It's a very important function that embodies lots of heuristics.+A non-WHNF can be inlined if it doesn't occur inside a lambda,+and occurs exactly once or+    occurs once in each branch of a case and is small++If the thing is in WHNF, there's no danger of duplicating work,+so we can inline if it occurs once, or is small++NOTE: we don't want to inline top-level functions that always diverge.+It just makes the code bigger.  Tt turns out that the convenient way to prevent+them inlining is to give them a NOINLINE pragma, which we do in+StrictAnal.addStrictnessInfoToTopId+-}++callSiteInline :: DynFlags+               -> Id                    -- The Id+               -> Bool                  -- True <=> unfolding is active+               -> Bool                  -- True if there are no arguments at all (incl type args)+               -> [ArgSummary]          -- One for each value arg; True if it is interesting+               -> CallCtxt              -- True <=> continuation is interesting+               -> Maybe CoreExpr        -- Unfolding, if any++data ArgSummary = TrivArg       -- Nothing interesting+                | NonTrivArg    -- Arg has structure+                | ValueArg      -- Arg is a con-app or PAP+                                -- ..or con-like. Note [Conlike is interesting]++instance Outputable ArgSummary where+  ppr TrivArg    = text "TrivArg"+  ppr NonTrivArg = text "NonTrivArg"+  ppr ValueArg   = text "ValueArg"++nonTriv ::  ArgSummary -> Bool+nonTriv TrivArg = False+nonTriv _       = True++data CallCtxt+  = BoringCtxt+  | RhsCtxt             -- Rhs of a let-binding; see Note [RHS of lets]+  | DiscArgCtxt         -- Argument of a function with non-zero arg discount+  | RuleArgCtxt         -- We are somewhere in the argument of a function with rules++  | ValAppCtxt          -- We're applied to at least one value arg+                        -- This arises when we have ((f x |> co) y)+                        -- Then the (f x) has argument 'x' but in a ValAppCtxt++  | CaseCtxt            -- We're the scrutinee of a case+                        -- that decomposes its scrutinee++instance Outputable CallCtxt where+  ppr CaseCtxt    = text "CaseCtxt"+  ppr ValAppCtxt  = text "ValAppCtxt"+  ppr BoringCtxt  = text "BoringCtxt"+  ppr RhsCtxt     = text "RhsCtxt"+  ppr DiscArgCtxt = text "DiscArgCtxt"+  ppr RuleArgCtxt = text "RuleArgCtxt"++callSiteInline dflags id active_unfolding lone_variable arg_infos cont_info+  = case idUnfolding id of+      -- idUnfolding checks for loop-breakers, returning NoUnfolding+      -- Things with an INLINE pragma may have an unfolding *and*+      -- be a loop breaker  (maybe the knot is not yet untied)+        CoreUnfolding { uf_tmpl = unf_template+                      , uf_is_work_free = is_wf+                      , uf_guidance = guidance, uf_expandable = is_exp }+          | active_unfolding -> tryUnfolding dflags id lone_variable+                                    arg_infos cont_info unf_template+                                    is_wf is_exp guidance+          | otherwise -> traceInline dflags id "Inactive unfolding:" (ppr id) Nothing+        NoUnfolding      -> Nothing+        BootUnfolding    -> Nothing+        OtherCon {}      -> Nothing+        DFunUnfolding {} -> Nothing     -- Never unfold a DFun++traceInline :: DynFlags -> Id -> String -> SDoc -> a -> a+traceInline dflags inline_id str doc result+ | Just prefix <- inlineCheck dflags+ =  if prefix `isPrefixOf` occNameString (getOccName inline_id)+      then pprTrace str doc result+      else result+ | dopt Opt_D_dump_inlinings dflags && dopt Opt_D_verbose_core2core dflags+ = pprTrace str doc result+ | otherwise+ = result++tryUnfolding :: DynFlags -> Id -> Bool -> [ArgSummary] -> CallCtxt+             -> CoreExpr -> Bool -> Bool -> UnfoldingGuidance+             -> Maybe CoreExpr+tryUnfolding dflags id lone_variable+             arg_infos cont_info unf_template+             is_wf is_exp guidance+ = case guidance of+     UnfNever -> traceInline dflags id str (text "UnfNever") Nothing++     UnfWhen { ug_arity = uf_arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok }+        | enough_args && (boring_ok || some_benefit || ufVeryAggressive dflags)+                -- See Note [INLINE for small functions (3)]+        -> traceInline dflags id str (mk_doc some_benefit empty True) (Just unf_template)+        | otherwise+        -> traceInline dflags id str (mk_doc some_benefit empty False) Nothing+        where+          some_benefit = calc_some_benefit uf_arity+          enough_args = (n_val_args >= uf_arity) || (unsat_ok && n_val_args > 0)++     UnfIfGoodArgs { ug_args = arg_discounts, ug_res = res_discount, ug_size = size }+        | ufVeryAggressive dflags+        -> traceInline dflags id str (mk_doc some_benefit extra_doc True) (Just unf_template)+        | is_wf && some_benefit && small_enough+        -> traceInline dflags id str (mk_doc some_benefit extra_doc True) (Just unf_template)+        | otherwise+        -> traceInline dflags id str (mk_doc some_benefit extra_doc False) Nothing+        where+          some_benefit = calc_some_benefit (length arg_discounts)+          extra_doc = text "discounted size =" <+> int discounted_size+          discounted_size = size - discount+          small_enough = discounted_size <= ufUseThreshold dflags+          discount = computeDiscount dflags arg_discounts+                                     res_discount arg_infos cont_info++  where+    mk_doc some_benefit extra_doc yes_or_no+      = vcat [ text "arg infos" <+> ppr arg_infos+             , text "interesting continuation" <+> ppr cont_info+             , text "some_benefit" <+> ppr some_benefit+             , text "is exp:" <+> ppr is_exp+             , text "is work-free:" <+> ppr is_wf+             , text "guidance" <+> ppr guidance+             , extra_doc+             , text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"]++    str = "Considering inlining: " ++ showSDocDump dflags (ppr id)+    n_val_args = length arg_infos++           -- some_benefit is used when the RHS is small enough+           -- and the call has enough (or too many) value+           -- arguments (ie n_val_args >= arity). But there must+           -- be *something* interesting about some argument, or the+           -- result context, to make it worth inlining+    calc_some_benefit :: Arity -> Bool   -- The Arity is the number of args+                                         -- expected by the unfolding+    calc_some_benefit uf_arity+       | not saturated = interesting_args       -- Under-saturated+                                        -- Note [Unsaturated applications]+       | otherwise = interesting_args   -- Saturated or over-saturated+                  || interesting_call+      where+        saturated      = n_val_args >= uf_arity+        over_saturated = n_val_args > uf_arity+        interesting_args = any nonTriv arg_infos+                -- NB: (any nonTriv arg_infos) looks at the+                -- over-saturated args too which is "wrong";+                -- but if over-saturated we inline anyway.++        interesting_call+          | over_saturated+          = True+          | otherwise+          = case cont_info of+              CaseCtxt   -> not (lone_variable && is_exp)  -- Note [Lone variables]+              ValAppCtxt -> True                           -- Note [Cast then apply]+              RuleArgCtxt -> uf_arity > 0  -- See Note [Unfold info lazy contexts]+              DiscArgCtxt -> uf_arity > 0  -- Note [Inlining in ArgCtxt]+              RhsCtxt     -> uf_arity > 0  --+              _other      -> False         -- See Note [Nested functions]+++{-+Note [Unfold into lazy contexts], Note [RHS of lets]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When the call is the argument of a function with a RULE, or the RHS of a let,+we are a little bit keener to inline.  For example+     f y = (y,y,y)+     g y = let x = f y in ...(case x of (a,b,c) -> ...) ...+We'd inline 'f' if the call was in a case context, and it kind-of-is,+only we can't see it.  Also+     x = f v+could be expensive whereas+     x = case v of (a,b) -> a+is patently cheap and may allow more eta expansion.+So we treat the RHS of a let as not-totally-boring.++Note [Unsaturated applications]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When a call is not saturated, we *still* inline if one of the+arguments has interesting structure.  That's sometimes very important.+A good example is the Ord instance for Bool in Base:++ Rec {+    $fOrdBool =GHC.Classes.D:Ord+                 @ Bool+                 ...+                 $cmin_ajX++    $cmin_ajX [Occ=LoopBreaker] :: Bool -> Bool -> Bool+    $cmin_ajX = GHC.Classes.$dmmin @ Bool $fOrdBool+  }++But the defn of GHC.Classes.$dmmin is:++  $dmmin :: forall a. GHC.Classes.Ord a => a -> a -> a+    {- Arity: 3, HasNoCafRefs, Strictness: SLL,+       Unfolding: (\ @ a $dOrd :: GHC.Classes.Ord a x :: a y :: a ->+                   case @ a GHC.Classes.<= @ a $dOrd x y of wild {+                     GHC.Types.False -> y GHC.Types.True -> x }) -}++We *really* want to inline $dmmin, even though it has arity 3, in+order to unravel the recursion.+++Note [Things to watch]+~~~~~~~~~~~~~~~~~~~~~~+*   { y = I# 3; x = y `cast` co; ...case (x `cast` co) of ... }+    Assume x is exported, so not inlined unconditionally.+    Then we want x to inline unconditionally; no reason for it+    not to, and doing so avoids an indirection.++*   { x = I# 3; ....f x.... }+    Make sure that x does not inline unconditionally!+    Lest we get extra allocation.++Note [Inlining an InlineRule]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+An InlineRules is used for+  (a) programmer INLINE pragmas+  (b) inlinings from worker/wrapper++For (a) the RHS may be large, and our contract is that we *only* inline+when the function is applied to all the arguments on the LHS of the+source-code defn.  (The uf_arity in the rule.)++However for worker/wrapper it may be worth inlining even if the+arity is not satisfied (as we do in the CoreUnfolding case) so we don't+require saturation.++Note [Nested functions]+~~~~~~~~~~~~~~~~~~~~~~~+At one time we treated a call of a non-top-level function as+"interesting" (regardless of how boring the context) in the hope+that inlining it would eliminate the binding, and its allocation.+Specifically, in the default case of interesting_call we had+   _other -> not is_top && uf_arity > 0++But actually postInlineUnconditionally does some of this and overall+it makes virtually no difference to nofib.  So I simplified away this+special case++Note [Cast then apply]+~~~~~~~~~~~~~~~~~~~~~~+Consider+   myIndex = __inline_me ( (/\a. <blah>) |> co )+   co :: (forall a. a -> a) ~ (forall a. T a)+     ... /\a.\x. case ((myIndex a) |> sym co) x of { ... } ...++We need to inline myIndex to unravel this; but the actual call (myIndex a) has+no value arguments.  The ValAppCtxt gives it enough incentive to inline.++Note [Inlining in ArgCtxt]+~~~~~~~~~~~~~~~~~~~~~~~~~~+The condition (arity > 0) here is very important, because otherwise+we end up inlining top-level stuff into useless places; eg+   x = I# 3#+   f = \y.  g x+This can make a very big difference: it adds 16% to nofib 'integer' allocs,+and 20% to 'power'.++At one stage I replaced this condition by 'True' (leading to the above+slow-down).  The motivation was test eyeball/inline1.hs; but that seems+to work ok now.++NOTE: arguably, we should inline in ArgCtxt only if the result of the+call is at least CONLIKE.  At least for the cases where we use ArgCtxt+for the RHS of a 'let', we only profit from the inlining if we get a+CONLIKE thing (modulo lets).++Note [Lone variables]   See also Note [Interaction of exprIsWorkFree and lone variables]+~~~~~~~~~~~~~~~~~~~~~   which appears below+The "lone-variable" case is important.  I spent ages messing about+with unsatisfactory variants, but this is nice.  The idea is that if a+variable appears all alone++        as an arg of lazy fn, or rhs    BoringCtxt+        as scrutinee of a case          CaseCtxt+        as arg of a fn                  ArgCtxt+AND+        it is bound to a cheap expression++then we should not inline it (unless there is some other reason,+e.g. it is the sole occurrence).  That is what is happening at+the use of 'lone_variable' in 'interesting_call'.++Why?  At least in the case-scrutinee situation, turning+        let x = (a,b) in case x of y -> ...+into+        let x = (a,b) in case (a,b) of y -> ...+and thence to+        let x = (a,b) in let y = (a,b) in ...+is bad if the binding for x will remain.++Another example: I discovered that strings+were getting inlined straight back into applications of 'error'+because the latter is strict.+        s = "foo"+        f = \x -> ...(error s)...++Fundamentally such contexts should not encourage inlining because, provided+the RHS is "expandable" (see Note [exprIsExpandable] in CoreUtils) the+context can ``see'' the unfolding of the variable (e.g. case or a+RULE) so there's no gain.++However, watch out:++ * Consider this:+        foo = _inline_ (\n. [n])+        bar = _inline_ (foo 20)+        baz = \n. case bar of { (m:_) -> m + n }+   Here we really want to inline 'bar' so that we can inline 'foo'+   and the whole thing unravels as it should obviously do.  This is+   important: in the NDP project, 'bar' generates a closure data+   structure rather than a list.++   So the non-inlining of lone_variables should only apply if the+   unfolding is regarded as cheap; because that is when exprIsConApp_maybe+   looks through the unfolding.  Hence the "&& is_wf" in the+   InlineRule branch.++ * Even a type application or coercion isn't a lone variable.+   Consider+        case $fMonadST @ RealWorld of { :DMonad a b c -> c }+   We had better inline that sucker!  The case won't see through it.++   For now, I'm treating treating a variable applied to types+   in a *lazy* context "lone". The motivating example was+        f = /\a. \x. BIG+        g = /\a. \y.  h (f a)+   There's no advantage in inlining f here, and perhaps+   a significant disadvantage.  Hence some_val_args in the Stop case++Note [Interaction of exprIsWorkFree and lone variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The lone-variable test says "don't inline if a case expression+scrutinises a lone variable whose unfolding is cheap".  It's very+important that, under these circumstances, exprIsConApp_maybe+can spot a constructor application. So, for example, we don't+consider+        let x = e in (x,x)+to be cheap, and that's good because exprIsConApp_maybe doesn't+think that expression is a constructor application.++In the 'not (lone_variable && is_wf)' test, I used to test is_value+rather than is_wf, which was utterly wrong, because the above+expression responds True to exprIsHNF, which is what sets is_value.++This kind of thing can occur if you have++        {-# INLINE foo #-}+        foo = let x = e in (x,x)++which Roman did.+++-}++computeDiscount :: DynFlags -> [Int] -> Int -> [ArgSummary] -> CallCtxt+                -> Int+computeDiscount dflags arg_discounts res_discount arg_infos cont_info+        -- We multiple the raw discounts (args_discount and result_discount)+        -- ty opt_UnfoldingKeenessFactor because the former have to do with+        --  *size* whereas the discounts imply that there's some extra+        --  *efficiency* to be gained (e.g. beta reductions, case reductions)+        -- by inlining.++  = 10          -- Discount of 10 because the result replaces the call+                -- so we count 10 for the function itself++    + 10 * length actual_arg_discounts+               -- Discount of 10 for each arg supplied,+               -- because the result replaces the call++    + round (ufKeenessFactor dflags *+             fromIntegral (total_arg_discount + res_discount'))+  where+    actual_arg_discounts = zipWith mk_arg_discount arg_discounts arg_infos+    total_arg_discount   = sum actual_arg_discounts++    mk_arg_discount _        TrivArg    = 0+    mk_arg_discount _        NonTrivArg = 10+    mk_arg_discount discount ValueArg   = discount++    res_discount'+      | LT <- arg_discounts `compareLength` arg_infos+      = res_discount   -- Over-saturated+      | otherwise+      = case cont_info of+           BoringCtxt  -> 0+           CaseCtxt    -> res_discount  -- Presumably a constructor+           ValAppCtxt  -> res_discount  -- Presumably a function+           _           -> 40 `min` res_discount+                -- ToDo: this 40 `min` res_discount doesn't seem right+                --   for DiscArgCtxt it shouldn't matter because the function will+                --       get the arg discount for any non-triv arg+                --   for RuleArgCtxt we do want to be keener to inline; but not only+                --       constructor results+                --   for RhsCtxt I suppose that exposing a data con is good in general+                --   And 40 seems very arbitrary+                --+                -- res_discount can be very large when a function returns+                -- constructors; but we only want to invoke that large discount+                -- when there's a case continuation.+                -- Otherwise we, rather arbitrarily, threshold it.  Yuk.+                -- But we want to aovid inlining large functions that return+                -- constructors into contexts that are simply "interesting"
+ compiler/coreSyn/CoreUtils.hs view
@@ -0,0 +1,2633 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+++Utility functions on @Core@ syntax+-}++{-# LANGUAGE CPP #-}++-- | Commonly useful utilites for manipulating the Core language+module CoreUtils (+        -- * Constructing expressions+        mkCast,+        mkTick, mkTicks, mkTickNoHNF, tickHNFArgs,+        bindNonRec, needsCaseBinding,+        mkAltExpr,++        -- * Taking expressions apart+        findDefault, addDefault, findAlt, isDefaultAlt,+        mergeAlts, trimConArgs,+        filterAlts, combineIdenticalAlts, refineDefaultAlt,++        -- * Properties of expressions+        exprType, coreAltType, coreAltsType, isExprLevPoly,+        exprIsDupable, exprIsTrivial, getIdFromTrivialExpr, exprIsBottom,+        getIdFromTrivialExpr_maybe,+        exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,+        exprIsHNF, exprOkForSpeculation, exprOkForSideEffects, exprIsWorkFree,+        exprIsBig, exprIsConLike,+        rhsIsStatic, isCheapApp, isExpandableApp,+        exprIsTickedString, exprIsTickedString_maybe,+        exprIsTopLevelBindable,+        altsAreExhaustive,++        -- * Equality+        cheapEqExpr, cheapEqExpr', eqExpr,+        diffExpr, diffBinds,++        -- * Eta reduction+        tryEtaReduce,++        -- * Manipulating data constructors and types+        exprToType, exprToCoercion_maybe,+        applyTypeToArgs, applyTypeToArg,+        dataConRepInstPat, dataConRepFSInstPat,+        isEmptyTy,++        -- * Working with ticks+        stripTicksTop, stripTicksTopE, stripTicksTopT,+        stripTicksE, stripTicksT,++        -- * StaticPtr+        collectMakeStaticArgs,++        -- * Join points+        isJoinBind+    ) where++#include "HsVersions.h"++import GhcPrelude++import CoreSyn+import PrelNames ( makeStaticName )+import PprCore+import CoreFVs( exprFreeVars )+import Var+import SrcLoc+import VarEnv+import VarSet+import Name+import Literal+import DataCon+import PrimOp+import Id+import IdInfo+import PrelNames( absentErrorIdKey )+import Type+import TyCoRep( TyCoBinder(..), TyBinder )+import Coercion+import TyCon+import Unique+import Outputable+import TysPrim+import DynFlags+import FastString+import Maybes+import ListSetOps       ( minusList )+import BasicTypes       ( Arity, isConLike )+import Platform+import Util+import Pair+import Data.ByteString     ( ByteString )+import Data.Function       ( on )+import Data.List+import Data.Ord            ( comparing )+import OrdList+import qualified Data.Set as Set+import UniqSet++{-+************************************************************************+*                                                                      *+\subsection{Find the type of a Core atom/expression}+*                                                                      *+************************************************************************+-}++exprType :: CoreExpr -> Type+-- ^ Recover the type of a well-typed Core expression. Fails when+-- applied to the actual 'CoreSyn.Type' expression as it cannot+-- really be said to have a type+exprType (Var var)           = idType var+exprType (Lit lit)           = literalType lit+exprType (Coercion co)       = coercionType co+exprType (Let bind body)+  | NonRec tv rhs <- bind    -- See Note [Type bindings]+  , Type ty <- rhs           = substTyWithUnchecked [tv] [ty] (exprType body)+  | otherwise                = exprType body+exprType (Case _ _ ty _)     = ty+exprType (Cast _ co)         = pSnd (coercionKind co)+exprType (Tick _ e)          = exprType e+exprType (Lam binder expr)   = mkLamType binder (exprType expr)+exprType e@(App _ _)+  = case collectArgs e of+        (fun, args) -> applyTypeToArgs e (exprType fun) args++exprType other = pprTrace "exprType" (pprCoreExpr other) alphaTy++coreAltType :: CoreAlt -> Type+-- ^ Returns the type of the alternatives right hand side+coreAltType alt@(_,bs,rhs)+  = case occCheckExpand bs rhs_ty of+      -- Note [Existential variables and silly type synonyms]+      Just ty -> ty+      Nothing -> pprPanic "coreAltType" (pprCoreAlt alt $$ ppr rhs_ty)+  where+    rhs_ty = exprType rhs++coreAltsType :: [CoreAlt] -> Type+-- ^ Returns the type of the first alternative, which should be the same as for all alternatives+coreAltsType (alt:_) = coreAltType alt+coreAltsType []      = panic "corAltsType"++-- | Is this expression levity polymorphic? This should be the+-- same as saying (isKindLevPoly . typeKind . exprType) but+-- much faster.+isExprLevPoly :: CoreExpr -> Bool+isExprLevPoly = go+  where+   go (Var _)                      = False  -- no levity-polymorphic binders+   go (Lit _)                      = False  -- no levity-polymorphic literals+   go e@(App f _) | not (go_app f) = False+                  | otherwise      = check_type e+   go (Lam _ _)                    = False+   go (Let _ e)                    = go e+   go e@(Case {})                  = check_type e -- checking type is fast+   go e@(Cast {})                  = check_type e+   go (Tick _ e)                   = go e+   go e@(Type {})                  = pprPanic "isExprLevPoly ty" (ppr e)+   go (Coercion {})                = False  -- this case can happen in SetLevels++   check_type = isTypeLevPoly . exprType  -- slow approach++      -- if the function is a variable (common case), check its+      -- levityInfo. This might mean we don't need to look up and compute+      -- on the type. Spec of these functions: return False if there is+      -- no possibility, ever, of this expression becoming levity polymorphic,+      -- no matter what it's applied to; return True otherwise.+      -- returning True is always safe. See also Note [Levity info] in+      -- IdInfo+   go_app (Var id)        = not (isNeverLevPolyId id)+   go_app (Lit _)         = False+   go_app (App f _)       = go_app f+   go_app (Lam _ e)       = go_app e+   go_app (Let _ e)       = go_app e+   go_app (Case _ _ ty _) = resultIsLevPoly ty+   go_app (Cast _ co)     = resultIsLevPoly (pSnd $ coercionKind co)+   go_app (Tick _ e)      = go_app e+   go_app e@(Type {})     = pprPanic "isExprLevPoly app ty" (ppr e)+   go_app e@(Coercion {}) = pprPanic "isExprLevPoly app co" (ppr e)+++{-+Note [Type bindings]+~~~~~~~~~~~~~~~~~~~~+Core does allow type bindings, although such bindings are+not much used, except in the output of the desugarer.+Example:+     let a = Int in (\x:a. x)+Given this, exprType must be careful to substitute 'a' in the+result type (#8522).++Note [Existential variables and silly type synonyms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+        data T = forall a. T (Funny a)+        type Funny a = Bool+        f :: T -> Bool+        f (T x) = x++Now, the type of 'x' is (Funny a), where 'a' is existentially quantified.+That means that 'exprType' and 'coreAltsType' may give a result that *appears*+to mention an out-of-scope type variable.  See #3409 for a more real-world+example.++Various possibilities suggest themselves:++ - Ignore the problem, and make Lint not complain about such variables++ - Expand all type synonyms (or at least all those that discard arguments)+      This is tricky, because at least for top-level things we want to+      retain the type the user originally specified.++ - Expand synonyms on the fly, when the problem arises. That is what+   we are doing here.  It's not too expensive, I think.++Note that there might be existentially quantified coercion variables, too.+-}++-- Not defined with applyTypeToArg because you can't print from CoreSyn.+applyTypeToArgs :: CoreExpr -> Type -> [CoreExpr] -> Type+-- ^ A more efficient version of 'applyTypeToArg' when we have several arguments.+-- The first argument is just for debugging, and gives some context+applyTypeToArgs e op_ty args+  = go op_ty args+  where+    go op_ty []                   = op_ty+    go op_ty (Type ty : args)     = go_ty_args op_ty [ty] args+    go op_ty (Coercion co : args) = go_ty_args op_ty [mkCoercionTy co] args+    go op_ty (_ : args)           | Just (_, res_ty) <- splitFunTy_maybe op_ty+                                  = go res_ty args+    go _ _ = pprPanic "applyTypeToArgs" panic_msg++    -- go_ty_args: accumulate type arguments so we can+    -- instantiate all at once with piResultTys+    go_ty_args op_ty rev_tys (Type ty : args)+       = go_ty_args op_ty (ty:rev_tys) args+    go_ty_args op_ty rev_tys (Coercion co : args)+       = go_ty_args op_ty (mkCoercionTy co : rev_tys) args+    go_ty_args op_ty rev_tys args+       = go (piResultTys op_ty (reverse rev_tys)) args++    panic_msg = vcat [ text "Expression:" <+> pprCoreExpr e+                     , text "Type:" <+> ppr op_ty+                     , text "Args:" <+> ppr args ]+++{-+************************************************************************+*                                                                      *+\subsection{Attaching notes}+*                                                                      *+************************************************************************+-}++-- | Wrap the given expression in the coercion safely, dropping+-- identity coercions and coalescing nested coercions+mkCast :: CoreExpr -> CoercionR -> CoreExpr+mkCast e co+  | ASSERT2( coercionRole co == Representational+           , text "coercion" <+> ppr co <+> ptext (sLit "passed to mkCast")+             <+> ppr e <+> text "has wrong role" <+> ppr (coercionRole co) )+    isReflCo co+  = e++mkCast (Coercion e_co) co+  | isCoVarType (pSnd (coercionKind co))+       -- The guard here checks that g has a (~#) on both sides,+       -- otherwise decomposeCo fails.  Can in principle happen+       -- with unsafeCoerce+  = Coercion (mkCoCast e_co co)++mkCast (Cast expr co2) co+  = WARN(let { Pair  from_ty  _to_ty  = coercionKind co;+               Pair _from_ty2  to_ty2 = coercionKind co2} in+            not (from_ty `eqType` to_ty2),+             vcat ([ text "expr:" <+> ppr expr+                   , text "co2:" <+> ppr co2+                   , text "co:" <+> ppr co ]) )+    mkCast expr (mkTransCo co2 co)++mkCast (Tick t expr) co+   = Tick t (mkCast expr co)++mkCast expr co+  = let Pair from_ty _to_ty = coercionKind co in+    WARN( not (from_ty `eqType` exprType expr),+          text "Trying to coerce" <+> text "(" <> ppr expr+          $$ text "::" <+> ppr (exprType expr) <> text ")"+          $$ ppr co $$ ppr (coercionType co) )+    (Cast expr co)++-- | Wraps the given expression in the source annotation, dropping the+-- annotation if possible.+mkTick :: Tickish Id -> CoreExpr -> CoreExpr+mkTick t orig_expr = mkTick' id id orig_expr+ where+  -- Some ticks (cost-centres) can be split in two, with the+  -- non-counting part having laxer placement properties.+  canSplit = tickishCanSplit t && tickishPlace (mkNoCount t) /= tickishPlace t++  mkTick' :: (CoreExpr -> CoreExpr) -- ^ apply after adding tick (float through)+          -> (CoreExpr -> CoreExpr) -- ^ apply before adding tick (float with)+          -> CoreExpr               -- ^ current expression+          -> CoreExpr+  mkTick' top rest expr = case expr of++    -- Cost centre ticks should never be reordered relative to each+    -- other. Therefore we can stop whenever two collide.+    Tick t2 e+      | ProfNote{} <- t2, ProfNote{} <- t -> top $ Tick t $ rest expr++    -- Otherwise we assume that ticks of different placements float+    -- through each other.+      | tickishPlace t2 /= tickishPlace t -> mkTick' (top . Tick t2) rest e++    -- For annotations this is where we make sure to not introduce+    -- redundant ticks.+      | tickishContains t t2              -> mkTick' top rest e+      | tickishContains t2 t              -> orig_expr+      | otherwise                         -> mkTick' top (rest . Tick t2) e++    -- Ticks don't care about types, so we just float all ticks+    -- through them. Note that it's not enough to check for these+    -- cases top-level. While mkTick will never produce Core with type+    -- expressions below ticks, such constructs can be the result of+    -- unfoldings. We therefore make an effort to put everything into+    -- the right place no matter what we start with.+    Cast e co   -> mkTick' (top . flip Cast co) rest e+    Coercion co -> Coercion co++    Lam x e+      -- Always float through type lambdas. Even for non-type lambdas,+      -- floating is allowed for all but the most strict placement rule.+      | not (isRuntimeVar x) || tickishPlace t /= PlaceRuntime+      -> mkTick' (top . Lam x) rest e++      -- If it is both counting and scoped, we split the tick into its+      -- two components, often allowing us to keep the counting tick on+      -- the outside of the lambda and push the scoped tick inside.+      -- The point of this is that the counting tick can probably be+      -- floated, and the lambda may then be in a position to be+      -- beta-reduced.+      | canSplit+      -> top $ Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e++    App f arg+      -- Always float through type applications.+      | not (isRuntimeArg arg)+      -> mkTick' (top . flip App arg) rest f++      -- We can also float through constructor applications, placement+      -- permitting. Again we can split.+      | isSaturatedConApp expr && (tickishPlace t==PlaceCostCentre || canSplit)+      -> if tickishPlace t == PlaceCostCentre+         then top $ rest $ tickHNFArgs t expr+         else top $ Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr++    Var x+      | notFunction && tickishPlace t == PlaceCostCentre+      -> orig_expr+      | notFunction && canSplit+      -> top $ Tick (mkNoScope t) $ rest expr+      where+        -- SCCs can be eliminated on variables provided the variable+        -- is not a function.  In these cases the SCC makes no difference:+        -- the cost of evaluating the variable will be attributed to its+        -- definition site.  When the variable refers to a function, however,+        -- an SCC annotation on the variable affects the cost-centre stack+        -- when the function is called, so we must retain those.+        notFunction = not (isFunTy (idType x))++    Lit{}+      | tickishPlace t == PlaceCostCentre+      -> orig_expr++    -- Catch-all: Annotate where we stand+    _any -> top $ Tick t $ rest expr++mkTicks :: [Tickish Id] -> CoreExpr -> CoreExpr+mkTicks ticks expr = foldr mkTick expr ticks++isSaturatedConApp :: CoreExpr -> Bool+isSaturatedConApp e = go e []+  where go (App f a) as = go f (a:as)+        go (Var fun) args+           = isConLikeId fun && idArity fun == valArgCount args+        go (Cast f _) as = go f as+        go _ _ = False++mkTickNoHNF :: Tickish Id -> CoreExpr -> CoreExpr+mkTickNoHNF t e+  | exprIsHNF e = tickHNFArgs t e+  | otherwise   = mkTick t e++-- push a tick into the arguments of a HNF (call or constructor app)+tickHNFArgs :: Tickish Id -> CoreExpr -> CoreExpr+tickHNFArgs t e = push t e+ where+  push t (App f (Type u)) = App (push t f) (Type u)+  push t (App f arg) = App (push t f) (mkTick t arg)+  push _t e = e++-- | Strip ticks satisfying a predicate from top of an expression+stripTicksTop :: (Tickish Id -> Bool) -> Expr b -> ([Tickish Id], Expr b)+stripTicksTop p = go []+  where go ts (Tick t e) | p t = go (t:ts) e+        go ts other            = (reverse ts, other)++-- | Strip ticks satisfying a predicate from top of an expression,+-- returning the remaining expression+stripTicksTopE :: (Tickish Id -> Bool) -> Expr b -> Expr b+stripTicksTopE p = go+  where go (Tick t e) | p t = go e+        go other            = other++-- | Strip ticks satisfying a predicate from top of an expression,+-- returning the ticks+stripTicksTopT :: (Tickish Id -> Bool) -> Expr b -> [Tickish Id]+stripTicksTopT p = go []+  where go ts (Tick t e) | p t = go (t:ts) e+        go ts _                = ts++-- | Completely strip ticks satisfying a predicate from an+-- expression. Note this is O(n) in the size of the expression!+stripTicksE :: (Tickish Id -> Bool) -> Expr b -> Expr b+stripTicksE p expr = go expr+  where go (App e a)        = App (go e) (go a)+        go (Lam b e)        = Lam b (go e)+        go (Let b e)        = Let (go_bs b) (go e)+        go (Case e b t as)  = Case (go e) b t (map go_a as)+        go (Cast e c)       = Cast (go e) c+        go (Tick t e)+          | p t             = go e+          | otherwise       = Tick t (go e)+        go other            = other+        go_bs (NonRec b e)  = NonRec b (go e)+        go_bs (Rec bs)      = Rec (map go_b bs)+        go_b (b, e)         = (b, go e)+        go_a (c,bs,e)       = (c,bs, go e)++stripTicksT :: (Tickish Id -> Bool) -> Expr b -> [Tickish Id]+stripTicksT p expr = fromOL $ go expr+  where go (App e a)        = go e `appOL` go a+        go (Lam _ e)        = go e+        go (Let b e)        = go_bs b `appOL` go e+        go (Case e _ _ as)  = go e `appOL` concatOL (map go_a as)+        go (Cast e _)       = go e+        go (Tick t e)+          | p t             = t `consOL` go e+          | otherwise       = go e+        go _                = nilOL+        go_bs (NonRec _ e)  = go e+        go_bs (Rec bs)      = concatOL (map go_b bs)+        go_b (_, e)         = go e+        go_a (_, _, e)      = go e++{-+************************************************************************+*                                                                      *+\subsection{Other expression construction}+*                                                                      *+************************************************************************+-}++bindNonRec :: Id -> CoreExpr -> CoreExpr -> CoreExpr+-- ^ @bindNonRec x r b@ produces either:+--+-- > let x = r in b+--+-- or:+--+-- > case r of x { _DEFAULT_ -> b }+--+-- depending on whether we have to use a @case@ or @let@+-- binding for the expression (see 'needsCaseBinding').+-- It's used by the desugarer to avoid building bindings+-- that give Core Lint a heart attack, although actually+-- the simplifier deals with them perfectly well. See+-- also 'MkCore.mkCoreLet'+bindNonRec bndr rhs body+  | isTyVar bndr                       = let_bind+  | isCoVar bndr                       = if isCoArg rhs then let_bind+    {- See Note [Binding coercions] -}                  else case_bind+  | isJoinId bndr                      = let_bind+  | needsCaseBinding (idType bndr) rhs = case_bind+  | otherwise                          = let_bind+  where+    case_bind = Case rhs bndr (exprType body) [(DEFAULT, [], body)]+    let_bind  = Let (NonRec bndr rhs) body++-- | Tests whether we have to use a @case@ rather than @let@ binding for this expression+-- as per the invariants of 'CoreExpr': see "CoreSyn#let_app_invariant"+needsCaseBinding :: Type -> CoreExpr -> Bool+needsCaseBinding ty rhs = isUnliftedType ty && not (exprOkForSpeculation rhs)+        -- Make a case expression instead of a let+        -- These can arise either from the desugarer,+        -- or from beta reductions: (\x.e) (x +# y)++mkAltExpr :: AltCon     -- ^ Case alternative constructor+          -> [CoreBndr] -- ^ Things bound by the pattern match+          -> [Type]     -- ^ The type arguments to the case alternative+          -> CoreExpr+-- ^ This guy constructs the value that the scrutinee must have+-- given that you are in one particular branch of a case+mkAltExpr (DataAlt con) args inst_tys+  = mkConApp con (map Type inst_tys ++ varsToCoreExprs args)+mkAltExpr (LitAlt lit) [] []+  = Lit lit+mkAltExpr (LitAlt _) _ _ = panic "mkAltExpr LitAlt"+mkAltExpr DEFAULT _ _ = panic "mkAltExpr DEFAULT"++{- Note [Binding coercions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider binding a CoVar, c = e.  Then, we must atisfy+Note [CoreSyn type and coercion invariant] in CoreSyn,+which allows only (Coercion co) on the RHS.++************************************************************************+*                                                                      *+               Operations oer case alternatives+*                                                                      *+************************************************************************++The default alternative must be first, if it exists at all.+This makes it easy to find, though it makes matching marginally harder.+-}++-- | Extract the default case alternative+findDefault :: [(AltCon, [a], b)] -> ([(AltCon, [a], b)], Maybe b)+findDefault ((DEFAULT,args,rhs) : alts) = ASSERT( null args ) (alts, Just rhs)+findDefault alts                        =                     (alts, Nothing)++addDefault :: [(AltCon, [a], b)] -> Maybe b -> [(AltCon, [a], b)]+addDefault alts Nothing    = alts+addDefault alts (Just rhs) = (DEFAULT, [], rhs) : alts++isDefaultAlt :: (AltCon, a, b) -> Bool+isDefaultAlt (DEFAULT, _, _) = True+isDefaultAlt _               = False++-- | Find the case alternative corresponding to a particular+-- constructor: panics if no such constructor exists+findAlt :: AltCon -> [(AltCon, a, b)] -> Maybe (AltCon, a, b)+    -- A "Nothing" result *is* legitimate+    -- See Note [Unreachable code]+findAlt con alts+  = case alts of+        (deflt@(DEFAULT,_,_):alts) -> go alts (Just deflt)+        _                          -> go alts Nothing+  where+    go []                     deflt = deflt+    go (alt@(con1,_,_) : alts) deflt+      = case con `cmpAltCon` con1 of+          LT -> deflt   -- Missed it already; the alts are in increasing order+          EQ -> Just alt+          GT -> ASSERT( not (con1 == DEFAULT) ) go alts deflt++{- Note [Unreachable code]+~~~~~~~~~~~~~~~~~~~~~~~~~~+It is possible (although unusual) for GHC to find a case expression+that cannot match.  For example:++     data Col = Red | Green | Blue+     x = Red+     f v = case x of+              Red -> ...+              _ -> ...(case x of { Green -> e1; Blue -> e2 })...++Suppose that for some silly reason, x isn't substituted in the case+expression.  (Perhaps there's a NOINLINE on it, or profiling SCC stuff+gets in the way; cf #3118.)  Then the full-lazines pass might produce+this++     x = Red+     lvl = case x of { Green -> e1; Blue -> e2 })+     f v = case x of+             Red -> ...+             _ -> ...lvl...++Now if x gets inlined, we won't be able to find a matching alternative+for 'Red'.  That's because 'lvl' is unreachable.  So rather than crashing+we generate (error "Inaccessible alternative").++Similar things can happen (augmented by GADTs) when the Simplifier+filters down the matching alternatives in Simplify.rebuildCase.+-}++---------------------------------+mergeAlts :: [(AltCon, a, b)] -> [(AltCon, a, b)] -> [(AltCon, a, b)]+-- ^ Merge alternatives preserving order; alternatives in+-- the first argument shadow ones in the second+mergeAlts [] as2 = as2+mergeAlts as1 [] = as1+mergeAlts (a1:as1) (a2:as2)+  = case a1 `cmpAlt` a2 of+        LT -> a1 : mergeAlts as1      (a2:as2)+        EQ -> a1 : mergeAlts as1      as2       -- Discard a2+        GT -> a2 : mergeAlts (a1:as1) as2+++---------------------------------+trimConArgs :: AltCon -> [CoreArg] -> [CoreArg]+-- ^ Given:+--+-- > case (C a b x y) of+-- >        C b x y -> ...+--+-- We want to drop the leading type argument of the scrutinee+-- leaving the arguments to match against the pattern++trimConArgs DEFAULT      args = ASSERT( null args ) []+trimConArgs (LitAlt _)   args = ASSERT( null args ) []+trimConArgs (DataAlt dc) args = dropList (dataConUnivTyVars dc) args++filterAlts :: TyCon                -- ^ Type constructor of scrutinee's type (used to prune possibilities)+           -> [Type]               -- ^ And its type arguments+           -> [AltCon]             -- ^ 'imposs_cons': constructors known to be impossible due to the form of the scrutinee+           -> [(AltCon, [Var], a)] -- ^ Alternatives+           -> ([AltCon], [(AltCon, [Var], a)])+             -- Returns:+             --  1. Constructors that will never be encountered by the+             --     *default* case (if any).  A superset of imposs_cons+             --  2. The new alternatives, trimmed by+             --        a) remove imposs_cons+             --        b) remove constructors which can't match because of GADTs+             --+             -- NB: the final list of alternatives may be empty:+             -- This is a tricky corner case.  If the data type has no constructors,+             -- which GHC allows, or if the imposs_cons covers all constructors (after taking+             -- account of GADTs), then no alternatives can match.+             --+             -- If callers need to preserve the invariant that there is always at least one branch+             -- in a "case" statement then they will need to manually add a dummy case branch that just+             -- calls "error" or similar.+filterAlts _tycon inst_tys imposs_cons alts+  = (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt)+  where+    (alts_wo_default, maybe_deflt) = findDefault alts+    alt_cons = [con | (con,_,_) <- alts_wo_default]++    trimmed_alts = filterOut (impossible_alt inst_tys) alts_wo_default++    imposs_cons_set = Set.fromList imposs_cons+    imposs_deflt_cons =+      imposs_cons ++ filterOut (`Set.member` imposs_cons_set) alt_cons+         -- "imposs_deflt_cons" are handled+         --   EITHER by the context,+         --   OR by a non-DEFAULT branch in this case expression.++    impossible_alt :: [Type] -> (AltCon, a, b) -> Bool+    impossible_alt _ (con, _, _) | con `Set.member` imposs_cons_set = True+    impossible_alt inst_tys (DataAlt con, _, _) = dataConCannotMatch inst_tys con+    impossible_alt _  _                         = False++-- | Refine the default alternative to a 'DataAlt', if there is a unique way to do so.+-- See Note [Refine Default Alts]+refineDefaultAlt :: [Unique]          -- ^ Uniques for constructing new binders+                 -> TyCon             -- ^ Type constructor of scrutinee's type+                 -> [Type]            -- ^ Type arguments of scrutinee's type+                 -> [AltCon]          -- ^ Constructors that cannot match the DEFAULT (if any)+                 -> [CoreAlt]+                 -> (Bool, [CoreAlt]) -- ^ 'True', if a default alt was replaced with a 'DataAlt'+refineDefaultAlt us tycon tys imposs_deflt_cons all_alts+  | (DEFAULT,_,rhs) : rest_alts <- all_alts+  , isAlgTyCon tycon            -- It's a data type, tuple, or unboxed tuples.+  , not (isNewTyCon tycon)      -- We can have a newtype, if we are just doing an eval:+                                --      case x of { DEFAULT -> e }+                                -- and we don't want to fill in a default for them!+  , Just all_cons <- tyConDataCons_maybe tycon+  , let imposs_data_cons = mkUniqSet [con | DataAlt con <- imposs_deflt_cons]+                             -- We now know it's a data type, so we can use+                             -- UniqSet rather than Set (more efficient)+        impossible con   = con `elementOfUniqSet` imposs_data_cons+                             || dataConCannotMatch tys con+  = case filterOut impossible all_cons of+       -- Eliminate the default alternative+       -- altogether if it can't match:+       []    -> (False, rest_alts)++       -- It matches exactly one constructor, so fill it in:+       [con] -> (True, mergeAlts rest_alts [(DataAlt con, ex_tvs ++ arg_ids, rhs)])+                       -- We need the mergeAlts to keep the alternatives in the right order+             where+                (ex_tvs, arg_ids) = dataConRepInstPat us con tys++       -- It matches more than one, so do nothing+       _  -> (False, all_alts)++  | debugIsOn, isAlgTyCon tycon, null (tyConDataCons tycon)+  , not (isFamilyTyCon tycon || isAbstractTyCon tycon)+        -- Check for no data constructors+        -- This can legitimately happen for abstract types and type families,+        -- so don't report that+  = (False, all_alts)++  | otherwise      -- The common case+  = (False, all_alts)++{- Note [Refine Default Alts]++refineDefaultAlt replaces the DEFAULT alt with a constructor if there is one+possible value it could be.++The simplest example being++foo :: () -> ()+foo x = case x of !_ -> ()++rewrites to++foo :: () -> ()+foo x = case x of () -> ()++There are two reasons in general why this is desirable.++1. We can simplify inner expressions++In this example we can eliminate the inner case by refining the outer case.+If we don't refine it, we are left with both case expressions.++```+{-# LANGUAGE BangPatterns #-}+module Test where++mid x = x+{-# NOINLINE mid #-}++data Foo = Foo1 ()++test :: Foo -> ()+test x =+  case x of+    !_ -> mid (case x of+                Foo1 x1 -> x1)++```++refineDefaultAlt fills in the DEFAULT here with `Foo ip1` and then x+becomes bound to `Foo ip1` so is inlined into the other case which+causes the KnownBranch optimisation to kick in.+++2. combineIdenticalAlts does a better job++Simon Jakobi also points out that that combineIdenticalAlts will do a better job+if we refine the DEFAULT first.++```+data D = C0 | C1 | C2++case e of+   DEFAULT -> e0+   C0 -> e1+   C1 -> e1+```++When we apply combineIdenticalAlts to this expression, it can't+combine the alts for C0 and C1, as we already have a default case.++If we apply refineDefaultAlt first, we get++```+case e of+  C0 -> e1+  C1 -> e1+  C2 -> e0+```++and combineIdenticalAlts can turn that into++```+case e of+  DEFAULT -> e1+  C2 -> e0+```++It isn't obvious that refineDefaultAlt does this but if you look at its one+call site in SimplUtils then the `imposs_deflt_cons` argument is populated with+constructors which are matched elsewhere.++-}+++++{- Note [Combine identical alternatives]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If several alternatives are identical, merge them into a single+DEFAULT alternative.  I've occasionally seen this making a big+difference:++     case e of               =====>     case e of+       C _ -> f x                         D v -> ....v....+       D v -> ....v....                   DEFAULT -> f x+       DEFAULT -> f x++The point is that we merge common RHSs, at least for the DEFAULT case.+[One could do something more elaborate but I've never seen it needed.]+To avoid an expensive test, we just merge branches equal to the *first*+alternative; this picks up the common cases+     a) all branches equal+     b) some branches equal to the DEFAULT (which occurs first)++The case where Combine Identical Alternatives transformation showed up+was like this (base/Foreign/C/Err/Error.hs):++        x | p `is` 1 -> e1+          | p `is` 2 -> e2+        ...etc...++where @is@ was something like++        p `is` n = p /= (-1) && p == n++This gave rise to a horrible sequence of cases++        case p of+          (-1) -> $j p+          1    -> e1+          DEFAULT -> $j p++and similarly in cascade for all the join points!++NB: it's important that all this is done in [InAlt], *before* we work+on the alternatives themselves, because Simplify.simplAlt may zap the+occurrence info on the binders in the alternatives, which in turn+defeats combineIdenticalAlts (see #7360).++Note [Care with impossible-constructors when combining alternatives]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have (#10538)+   data T = A | B | C | D++      case x::T of   (Imposs-default-cons {A,B})+         DEFAULT -> e1+         A -> e2+         B -> e1++When calling combineIdentialAlts, we'll have computed that the+"impossible constructors" for the DEFAULT alt is {A,B}, since if x is+A or B we'll take the other alternatives.  But suppose we combine B+into the DEFAULT, to get++      case x::T of   (Imposs-default-cons {A})+         DEFAULT -> e1+         A -> e2++Then we must be careful to trim the impossible constructors to just {A},+else we risk compiling 'e1' wrong!++Not only that, but we take care when there is no DEFAULT beforehand,+because we are introducing one.  Consider++   case x of   (Imposs-default-cons {A,B,C})+     A -> e1+     B -> e2+     C -> e1++Then when combining the A and C alternatives we get++   case x of   (Imposs-default-cons {B})+     DEFAULT -> e1+     B -> e2++Note that we have a new DEFAULT branch that we didn't have before.  So+we need delete from the "impossible-default-constructors" all the+known-con alternatives that we have eliminated. (In #11172 we+missed the first one.)++-}++combineIdenticalAlts :: [AltCon]    -- Constructors that cannot match DEFAULT+                     -> [CoreAlt]+                     -> (Bool,      -- True <=> something happened+                         [AltCon],  -- New constructors that cannot match DEFAULT+                         [CoreAlt]) -- New alternatives+-- See Note [Combine identical alternatives]+-- True <=> we did some combining, result is a single DEFAULT alternative+combineIdenticalAlts imposs_deflt_cons ((con1,bndrs1,rhs1) : rest_alts)+  | all isDeadBinder bndrs1    -- Remember the default+  , not (null elim_rest) -- alternative comes first+  = (True, imposs_deflt_cons', deflt_alt : filtered_rest)+  where+    (elim_rest, filtered_rest) = partition identical_to_alt1 rest_alts+    deflt_alt = (DEFAULT, [], mkTicks (concat tickss) rhs1)++     -- See Note [Care with impossible-constructors when combining alternatives]+    imposs_deflt_cons' = imposs_deflt_cons `minusList` elim_cons+    elim_cons = elim_con1 ++ map fstOf3 elim_rest+    elim_con1 = case con1 of     -- Don't forget con1!+                  DEFAULT -> []  -- See Note [+                  _       -> [con1]++    cheapEqTicked e1 e2 = cheapEqExpr' tickishFloatable e1 e2+    identical_to_alt1 (_con,bndrs,rhs)+      = all isDeadBinder bndrs && rhs `cheapEqTicked` rhs1+    tickss = map (stripTicksT tickishFloatable . thdOf3) elim_rest++combineIdenticalAlts imposs_cons alts+  = (False, imposs_cons, alts)++{- *********************************************************************+*                                                                      *+             exprIsTrivial+*                                                                      *+************************************************************************++Note [exprIsTrivial]+~~~~~~~~~~~~~~~~~~~~+@exprIsTrivial@ is true of expressions we are unconditionally happy to+                duplicate; simple variables and constants, and type+                applications.  Note that primop Ids aren't considered+                trivial unless++Note [Variables are trivial]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+There used to be a gruesome test for (hasNoBinding v) in the+Var case:+        exprIsTrivial (Var v) | hasNoBinding v = idArity v == 0+The idea here is that a constructor worker, like \$wJust, is+really short for (\x -> \$wJust x), because \$wJust has no binding.+So it should be treated like a lambda.  Ditto unsaturated primops.+But now constructor workers are not "have-no-binding" Ids.  And+completely un-applied primops and foreign-call Ids are sufficiently+rare that I plan to allow them to be duplicated and put up with+saturating them.++Note [Tick trivial]+~~~~~~~~~~~~~~~~~~~+Ticks are only trivial if they are pure annotations. If we treat+"tick<n> x" as trivial, it will be inlined inside lambdas and the+entry count will be skewed, for example.  Furthermore "scc<n> x" will+turn into just "x" in mkTick.++Note [Empty case is trivial]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The expression (case (x::Int) Bool of {}) is just a type-changing+case used when we are sure that 'x' will not return.  See+Note [Empty case alternatives] in CoreSyn.++If the scrutinee is trivial, then so is the whole expression; and the+CoreToSTG pass in fact drops the case expression leaving only the+scrutinee.++Having more trivial expressions is good.  Moreover, if we don't treat+it as trivial we may land up with let-bindings like+   let v = case x of {} in ...+and after CoreToSTG that gives+   let v = x in ...+and that confuses the code generator (#11155). So best to kill+it off at source.+-}++exprIsTrivial :: CoreExpr -> Bool+-- If you modify this function, you may also+-- need to modify getIdFromTrivialExpr+exprIsTrivial (Var _)          = True        -- See Note [Variables are trivial]+exprIsTrivial (Type _)         = True+exprIsTrivial (Coercion _)     = True+exprIsTrivial (Lit lit)        = litIsTrivial lit+exprIsTrivial (App e arg)      = not (isRuntimeArg arg) && exprIsTrivial e+exprIsTrivial (Lam b e)        = not (isRuntimeVar b) && exprIsTrivial e+exprIsTrivial (Tick t e)       = not (tickishIsCode t) && exprIsTrivial e+                                 -- See Note [Tick trivial]+exprIsTrivial (Cast e _)       = exprIsTrivial e+exprIsTrivial (Case e _ _ [])  = exprIsTrivial e  -- See Note [Empty case is trivial]+exprIsTrivial _                = False++{-+Note [getIdFromTrivialExpr]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+When substituting in a breakpoint we need to strip away the type cruft+from a trivial expression and get back to the Id.  The invariant is+that the expression we're substituting was originally trivial+according to exprIsTrivial, AND the expression is not a literal.+See Note [substTickish] for how breakpoint substitution preserves+this extra invariant.++We also need this functionality in CorePrep to extract out Id of a+function which we are saturating.  However, in this case we don't know+if the variable actually refers to a literal; thus we use+'getIdFromTrivialExpr_maybe' to handle this case.  See test+T12076lit for an example where this matters.+-}++getIdFromTrivialExpr :: HasDebugCallStack => CoreExpr -> Id+getIdFromTrivialExpr e+    = fromMaybe (pprPanic "getIdFromTrivialExpr" (ppr e))+                (getIdFromTrivialExpr_maybe e)++getIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Id+-- See Note [getIdFromTrivialExpr]+-- Th equations for this should line up with those for exprIsTrivial+getIdFromTrivialExpr_maybe e+  = go e+  where+    go (App f t) | not (isRuntimeArg t)   = go f+    go (Tick t e) | not (tickishIsCode t) = go e+    go (Cast e _)                         = go e+    go (Lam b e) | not (isRuntimeVar b)   = go e+    go (Case e _ _ [])                    = go e+    go (Var v) = Just v+    go _       = Nothing++{-+exprIsBottom is a very cheap and cheerful function; it may return+False for bottoming expressions, but it never costs much to ask.  See+also CoreArity.exprBotStrictness_maybe, but that's a bit more+expensive.+-}++exprIsBottom :: CoreExpr -> Bool+-- See Note [Bottoming expressions]+exprIsBottom e+  | isEmptyTy (exprType e)+  = True+  | otherwise+  = go 0 e+  where+    go n (Var v) = isBottomingId v &&  n >= idArity v+    go n (App e a) | isTypeArg a = go n e+                   | otherwise   = go (n+1) e+    go n (Tick _ e)              = go n e+    go n (Cast e _)              = go n e+    go n (Let _ e)               = go n e+    go n (Lam v e) | isTyVar v   = go n e+    go _ (Case _ _ _ alts)       = null alts+       -- See Note [Empty case alternatives] in CoreSyn+    go _ _                       = False++{- Note [Bottoming expressions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A bottoming expression is guaranteed to diverge, or raise an+exception.  We can test for it in two different ways, and exprIsBottom+checks for both of these situations:++* Visibly-bottom computations.  For example+      (error Int "Hello")+  is visibly bottom.  The strictness analyser also finds out if+  a function diverges or raises an exception, and puts that info+  in its strictness signature.++* Empty types.  If a type is empty, its only inhabitant is bottom.+  For example:+      data T+      f :: T -> Bool+      f = \(x:t). case x of Bool {}+  Since T has no data constructors, the case alternatives are of course+  empty.  However note that 'x' is not bound to a visibly-bottom value;+  it's the *type* that tells us it's going to diverge.++A GADT may also be empty even though it has constructors:+        data T a where+          T1 :: a -> T Bool+          T2 :: T Int+        ...(case (x::T Char) of {})...+Here (T Char) is uninhabited.  A more realistic case is (Int ~ Bool),+which is likewise uninhabited.+++************************************************************************+*                                                                      *+             exprIsDupable+*                                                                      *+************************************************************************++Note [exprIsDupable]+~~~~~~~~~~~~~~~~~~~~+@exprIsDupable@ is true of expressions that can be duplicated at a modest+                cost in code size.  This will only happen in different case+                branches, so there's no issue about duplicating work.++                That is, exprIsDupable returns True of (f x) even if+                f is very very expensive to call.++                Its only purpose is to avoid fruitless let-binding+                and then inlining of case join points+-}++exprIsDupable :: DynFlags -> CoreExpr -> Bool+exprIsDupable dflags e+  = isJust (go dupAppSize e)+  where+    go :: Int -> CoreExpr -> Maybe Int+    go n (Type {})     = Just n+    go n (Coercion {}) = Just n+    go n (Var {})      = decrement n+    go n (Tick _ e)    = go n e+    go n (Cast e _)    = go n e+    go n (App f a) | Just n' <- go n a = go n' f+    go n (Lit lit) | litIsDupable dflags lit = decrement n+    go _ _ = Nothing++    decrement :: Int -> Maybe Int+    decrement 0 = Nothing+    decrement n = Just (n-1)++dupAppSize :: Int+dupAppSize = 8   -- Size of term we are prepared to duplicate+                 -- This is *just* big enough to make test MethSharing+                 -- inline enough join points.  Really it should be+                 -- smaller, and could be if we fixed #4960.++{-+************************************************************************+*                                                                      *+             exprIsCheap, exprIsExpandable+*                                                                      *+************************************************************************++Note [exprIsWorkFree]+~~~~~~~~~~~~~~~~~~~~~+exprIsWorkFree is used when deciding whether to inline something; we+don't inline it if doing so might duplicate work, by peeling off a+complete copy of the expression.  Here we do not want even to+duplicate a primop (#5623):+   eg   let x = a #+ b in x +# x+   we do not want to inline/duplicate x++Previously we were a bit more liberal, which led to the primop-duplicating+problem.  However, being more conservative did lead to a big regression in+one nofib benchmark, wheel-sieve1.  The situation looks like this:++   let noFactor_sZ3 :: GHC.Types.Int -> GHC.Types.Bool+       noFactor_sZ3 = case s_adJ of _ { GHC.Types.I# x_aRs ->+         case GHC.Prim.<=# x_aRs 2 of _ {+           GHC.Types.False -> notDivBy ps_adM qs_adN;+           GHC.Types.True -> lvl_r2Eb }}+       go = \x. ...(noFactor (I# y))....(go x')...++The function 'noFactor' is heap-allocated and then called.  Turns out+that 'notDivBy' is strict in its THIRD arg, but that is invisible to+the caller of noFactor, which therefore cannot do w/w and+heap-allocates noFactor's argument.  At the moment (May 12) we are just+going to put up with this, because the previous more aggressive inlining+(which treated 'noFactor' as work-free) was duplicating primops, which+in turn was making inner loops of array calculations runs slow (#5623)++Note [Case expressions are work-free]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Are case-expressions work-free?  Consider+    let v = case x of (p,q) -> p+        go = \y -> ...case v of ...+Should we inline 'v' at its use site inside the loop?  At the moment+we do.  I experimented with saying that case are *not* work-free, but+that increased allocation slightly.  It's a fairly small effect, and at+the moment we go for the slightly more aggressive version which treats+(case x of ....) as work-free if the alternatives are.++Moreover it improves arities of overloaded functions where+there is only dictionary selection (no construction) involved++Note [exprIsCheap]   See also Note [Interaction of exprIsCheap and lone variables]+~~~~~~~~~~~~~~~~~~   in CoreUnfold.hs+@exprIsCheap@ looks at a Core expression and returns \tr{True} if+it is obviously in weak head normal form, or is cheap to get to WHNF.+[Note that that's not the same as exprIsDupable; an expression might be+big, and hence not dupable, but still cheap.]++By ``cheap'' we mean a computation we're willing to:+        push inside a lambda, or+        inline at more than one place+That might mean it gets evaluated more than once, instead of being+shared.  The main examples of things which aren't WHNF but are+``cheap'' are:++  *     case e of+          pi -> ei+        (where e, and all the ei are cheap)++  *     let x = e in b+        (where e and b are cheap)++  *     op x1 ... xn+        (where op is a cheap primitive operator)++  *     error "foo"+        (because we are happy to substitute it inside a lambda)++Notice that a variable is considered 'cheap': we can push it inside a lambda,+because sharing will make sure it is only evaluated once.++Note [exprIsCheap and exprIsHNF]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Note that exprIsHNF does not imply exprIsCheap.  Eg+        let x = fac 20 in Just x+This responds True to exprIsHNF (you can discard a seq), but+False to exprIsCheap.++Note [Arguments and let-bindings exprIsCheapX]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+What predicate should we apply to the argument of an application, or the+RHS of a let-binding?++We used to say "exprIsTrivial arg" due to concerns about duplicating+nested constructor applications, but see #4978.  So now we just recursively+use exprIsCheapX.++We definitely want to treat let and app the same.  The principle here is+that+   let x = blah in f x+should behave equivalently to+   f blah++This in turn means that the 'letrec g' does not prevent eta expansion+in this (which it previously was):+    f = \x. let v = case x of+                      True -> letrec g = \w. blah+                              in g+                      False -> \x. x+            in \w. v True+-}++--------------------+exprIsWorkFree :: CoreExpr -> Bool   -- See Note [exprIsWorkFree]+exprIsWorkFree = exprIsCheapX isWorkFreeApp++exprIsCheap :: CoreExpr -> Bool+exprIsCheap = exprIsCheapX isCheapApp++exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool+exprIsCheapX ok_app e+  = ok e+  where+    ok e = go 0 e++    -- n is the number of value arguments+    go n (Var v)                      = ok_app v n+    go _ (Lit {})                     = True+    go _ (Type {})                    = True+    go _ (Coercion {})                = True+    go n (Cast e _)                   = go n e+    go n (Case scrut _ _ alts)        = ok scrut &&+                                        and [ go n rhs | (_,_,rhs) <- alts ]+    go n (Tick t e) | tickishCounts t = False+                    | otherwise       = go n e+    go n (Lam x e)  | isRuntimeVar x  = n==0 || go (n-1) e+                    | otherwise       = go n e+    go n (App f e)  | isRuntimeArg e  = go (n+1) f && ok e+                    | otherwise       = go n f+    go n (Let (NonRec _ r) e)         = go n e && ok r+    go n (Let (Rec prs) e)            = go n e && all (ok . snd) prs++      -- Case: see Note [Case expressions are work-free]+      -- App, Let: see Note [Arguments and let-bindings exprIsCheapX]+++{- Note [exprIsExpandable]+~~~~~~~~~~~~~~~~~~~~~~~~~~+An expression is "expandable" if we are willing to duplicate it, if doing+so might make a RULE or case-of-constructor fire.  Consider+   let x = (a,b)+       y = build g+   in ....(case x of (p,q) -> rhs)....(foldr k z y)....++We don't inline 'x' or 'y' (see Note [Lone variables] in CoreUnfold),+but we do want++ * the case-expression to simplify+   (via exprIsConApp_maybe, exprIsLiteral_maybe)++ * the foldr/build RULE to fire+   (by expanding the unfolding during rule matching)++So we classify the unfolding of a let-binding as "expandable" (via the+uf_expandable field) if we want to do this kind of on-the-fly+expansion.  Specifically:++* True of constructor applications (K a b)++* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in BasicTypes.+  (NB: exprIsCheap might not be true of this)++* False of case-expressions.  If we have+    let x = case ... in ...(case x of ...)...+  we won't simplify.  We have to inline x.  See #14688.++* False of let-expressions (same reason); and in any case we+  float lets out of an RHS if doing so will reveal an expandable+  application (see SimplEnv.doFloatFromRhs).++* Take care: exprIsExpandable should /not/ be true of primops.  I+  found this in test T5623a:+    let q = /\a. Ptr a (a +# b)+    in case q @ Float of Ptr v -> ...q...++  q's inlining should not be expandable, else exprIsConApp_maybe will+  say that (q @ Float) expands to (Ptr a (a +# b)), and that will+  duplicate the (a +# b) primop, which we should not do lightly.+  (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.)+-}++-------------------------------------+exprIsExpandable :: CoreExpr -> Bool+-- See Note [exprIsExpandable]+exprIsExpandable e+  = ok e+  where+    ok e = go 0 e++    -- n is the number of value arguments+    go n (Var v)                      = isExpandableApp v n+    go _ (Lit {})                     = True+    go _ (Type {})                    = True+    go _ (Coercion {})                = True+    go n (Cast e _)                   = go n e+    go n (Tick t e) | tickishCounts t = False+                    | otherwise       = go n e+    go n (Lam x e)  | isRuntimeVar x  = n==0 || go (n-1) e+                    | otherwise       = go n e+    go n (App f e)  | isRuntimeArg e  = go (n+1) f && ok e+                    | otherwise       = go n f+    go _ (Case {})                    = False+    go _ (Let {})                     = False+++-------------------------------------+type CheapAppFun = Id -> Arity -> Bool+  -- Is an application of this function to n *value* args+  -- always cheap, assuming the arguments are cheap?+  -- True mainly of data constructors, partial applications;+  -- but with minor variations:+  --    isWorkFreeApp+  --    isCheapApp+  --    isExpandableApp++isWorkFreeApp :: CheapAppFun+isWorkFreeApp fn n_val_args+  | n_val_args == 0           -- No value args+  = True+  | n_val_args < idArity fn   -- Partial application+  = True+  | otherwise+  = case idDetails fn of+      DataConWorkId {} -> True+      _                -> False++isCheapApp :: CheapAppFun+isCheapApp fn n_val_args+  | isWorkFreeApp fn n_val_args = True+  | isBottomingId fn            = True  -- See Note [isCheapApp: bottoming functions]+  | otherwise+  = case idDetails fn of+      DataConWorkId {} -> True  -- Actually handled by isWorkFreeApp+      RecSelId {}      -> n_val_args == 1  -- See Note [Record selection]+      ClassOpId {}     -> n_val_args == 1+      PrimOpId op      -> primOpIsCheap op+      _                -> False+        -- In principle we should worry about primops+        -- that return a type variable, since the result+        -- might be applied to something, but I'm not going+        -- to bother to check the number of args++isExpandableApp :: CheapAppFun+isExpandableApp fn n_val_args+  | isWorkFreeApp fn n_val_args = True+  | otherwise+  = case idDetails fn of+      DataConWorkId {} -> True  -- Actually handled by isWorkFreeApp+      RecSelId {}      -> n_val_args == 1  -- See Note [Record selection]+      ClassOpId {}     -> n_val_args == 1+      PrimOpId {}      -> False+      _ | isBottomingId fn               -> False+          -- See Note [isExpandableApp: bottoming functions]+        | isConLike (idRuleMatchInfo fn) -> True+        | all_args_are_preds             -> True+        | otherwise                      -> False++  where+     -- See if all the arguments are PredTys (implicit params or classes)+     -- If so we'll regard it as expandable; see Note [Expandable overloadings]+     all_args_are_preds = all_pred_args n_val_args (idType fn)++     all_pred_args n_val_args ty+       | n_val_args == 0+       = True++       | Just (bndr, ty) <- splitPiTy_maybe ty+       = case bndr of+           Named {}        -> all_pred_args n_val_args ty+           Anon InvisArg _ -> all_pred_args (n_val_args-1) ty+           Anon VisArg _   -> False++       | otherwise+       = False++{- Note [isCheapApp: bottoming functions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+I'm not sure why we have a special case for bottoming+functions in isCheapApp.  Maybe we don't need it.++Note [isExpandableApp: bottoming functions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+It's important that isExpandableApp does not respond True to bottoming+functions.  Recall  undefined :: HasCallStack => a+Suppose isExpandableApp responded True to (undefined d), and we had:++  x = undefined <dict-expr>++Then Simplify.prepareRhs would ANF the RHS:++  d = <dict-expr>+  x = undefined d++This is already bad: we gain nothing from having x bound to (undefined+var), unlike the case for data constructors.  Worse, we get the+simplifier loop described in OccurAnal Note [Cascading inlines].+Suppose x occurs just once; OccurAnal.occAnalNonRecRhs decides x will+certainly_inline; so we end up inlining d right back into x; but in+the end x doesn't inline because it is bottom (preInlineUnconditionally);+so the process repeats.. We could elaborate the certainly_inline logic+some more, but it's better just to treat bottoming bindings as+non-expandable, because ANFing them is a bad idea in the first place.++Note [Record selection]+~~~~~~~~~~~~~~~~~~~~~~~~~~+I'm experimenting with making record selection+look cheap, so we will substitute it inside a+lambda.  Particularly for dictionary field selection.++BUT: Take care with (sel d x)!  The (sel d) might be cheap, but+there's no guarantee that (sel d x) will be too.  Hence (n_val_args == 1)++Note [Expandable overloadings]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose the user wrote this+   {-# RULE  forall x. foo (negate x) = h x #-}+   f x = ....(foo (negate x))....+He'd expect the rule to fire. But since negate is overloaded, we might+get this:+    f = \d -> let n = negate d in \x -> ...foo (n x)...+So we treat the application of a function (negate in this case) to a+*dictionary* as expandable.  In effect, every function is CONLIKE when+it's applied only to dictionaries.+++************************************************************************+*                                                                      *+             exprOkForSpeculation+*                                                                      *+************************************************************************+-}++-----------------------------+-- | 'exprOkForSpeculation' returns True of an expression that is:+--+--  * Safe to evaluate even if normal order eval might not+--    evaluate the expression at all, or+--+--  * Safe /not/ to evaluate even if normal order would do so+--+-- It is usually called on arguments of unlifted type, but not always+-- In particular, Simplify.rebuildCase calls it on lifted types+-- when a 'case' is a plain 'seq'. See the example in+-- Note [exprOkForSpeculation: case expressions] below+--+-- Precisely, it returns @True@ iff:+--  a) The expression guarantees to terminate,+--  b) soon,+--  c) without causing a write side effect (e.g. writing a mutable variable)+--  d) without throwing a Haskell exception+--  e) without risking an unchecked runtime exception (array out of bounds,+--     divide by zero)+--+-- For @exprOkForSideEffects@ the list is the same, but omitting (e).+--+-- Note that+--    exprIsHNF            implies exprOkForSpeculation+--    exprOkForSpeculation implies exprOkForSideEffects+--+-- See Note [PrimOp can_fail and has_side_effects] in PrimOp+-- and Note [Transformations affected by can_fail and has_side_effects]+--+-- As an example of the considerations in this test, consider:+--+-- > let x = case y# +# 1# of { r# -> I# r# }+-- > in E+--+-- being translated to:+--+-- > case y# +# 1# of { r# ->+-- >    let x = I# r#+-- >    in E+-- > }+--+-- We can only do this if the @y + 1@ is ok for speculation: it has no+-- side effects, and can't diverge or raise an exception.++exprOkForSpeculation, exprOkForSideEffects :: CoreExpr -> Bool+exprOkForSpeculation = expr_ok primOpOkForSpeculation+exprOkForSideEffects = expr_ok primOpOkForSideEffects++expr_ok :: (PrimOp -> Bool) -> CoreExpr -> Bool+expr_ok _ (Lit _)      = True+expr_ok _ (Type _)     = True+expr_ok _ (Coercion _) = True++expr_ok primop_ok (Var v)    = app_ok primop_ok v []+expr_ok primop_ok (Cast e _) = expr_ok primop_ok e+expr_ok primop_ok (Lam b e)+                 | isTyVar b = expr_ok primop_ok  e+                 | otherwise = True++-- Tick annotations that *tick* cannot be speculated, because these+-- are meant to identify whether or not (and how often) the particular+-- source expression was evaluated at runtime.+expr_ok primop_ok (Tick tickish e)+   | tickishCounts tickish = False+   | otherwise             = expr_ok primop_ok e++expr_ok _ (Let {}) = False+  -- Lets can be stacked deeply, so just give up.+  -- In any case, the argument of exprOkForSpeculation is+  -- usually in a strict context, so any lets will have been+  -- floated away.++expr_ok primop_ok (Case scrut bndr _ alts)+  =  -- See Note [exprOkForSpeculation: case expressions]+     expr_ok primop_ok scrut+  && isUnliftedType (idType bndr)+  && all (\(_,_,rhs) -> expr_ok primop_ok rhs) alts+  && altsAreExhaustive alts++expr_ok primop_ok other_expr+  | (expr, args) <- collectArgs other_expr+  = case stripTicksTopE (not . tickishCounts) expr of+        Var f   -> app_ok primop_ok f args+        -- 'LitRubbish' is the only literal that can occur in the head of an+        -- application and will not be matched by the above case (Var /= Lit).+        Lit lit -> ASSERT( lit == rubbishLit ) True+        _       -> False++-----------------------------+app_ok :: (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool+app_ok primop_ok fun args+  = case idDetails fun of+      DFunId new_type ->  not new_type+         -- DFuns terminate, unless the dict is implemented+         -- with a newtype in which case they may not++      DataConWorkId {} -> True+                -- The strictness of the constructor has already+                -- been expressed by its "wrapper", so we don't need+                -- to take the arguments into account++      PrimOpId op+        | isDivOp op+        , [arg1, Lit lit] <- args+        -> not (isZeroLit lit) && expr_ok primop_ok arg1+              -- Special case for dividing operations that fail+              -- In general they are NOT ok-for-speculation+              -- (which primop_ok will catch), but they ARE OK+              -- if the divisor is definitely non-zero.+              -- Often there is a literal divisor, and this+              -- can get rid of a thunk in an inner loop++        | SeqOp <- op  -- See Note [exprOkForSpeculation and SeqOp/DataToTagOp]+        -> False       --     for the special cases for SeqOp and DataToTagOp+        | DataToTagOp <- op+        -> False++        | otherwise+        -> primop_ok op  -- Check the primop itself+        && and (zipWith primop_arg_ok arg_tys args)  -- Check the arguments++      _other -> isUnliftedType (idType fun)          -- c.f. the Var case of exprIsHNF+             || idArity fun > n_val_args             -- Partial apps+             -- NB: even in the nullary case, do /not/ check+             --     for evaluated-ness of the fun;+             --     see Note [exprOkForSpeculation and evaluated variables]+             where+               n_val_args = valArgCount args+  where+    (arg_tys, _) = splitPiTys (idType fun)++    primop_arg_ok :: TyBinder -> CoreExpr -> Bool+    primop_arg_ok (Named _) _ = True   -- A type argument+    primop_arg_ok (Anon _ ty) arg      -- A term argument+       | isUnliftedType ty = expr_ok primop_ok arg+       | otherwise         = True  -- See Note [Primops with lifted arguments]++-----------------------------+altsAreExhaustive :: [Alt b] -> Bool+-- True  <=> the case alternatives are definiely exhaustive+-- False <=> they may or may not be+altsAreExhaustive []+  = False    -- Should not happen+altsAreExhaustive ((con1,_,_) : alts)+  = case con1 of+      DEFAULT   -> True+      LitAlt {} -> False+      DataAlt c -> alts `lengthIs` (tyConFamilySize (dataConTyCon c) - 1)+      -- It is possible to have an exhaustive case that does not+      -- enumerate all constructors, notably in a GADT match, but+      -- we behave conservatively here -- I don't think it's important+      -- enough to deserve special treatment++-- | True of dyadic operators that can fail only if the second arg is zero!+isDivOp :: PrimOp -> Bool+-- This function probably belongs in PrimOp, or even in+-- an automagically generated file.. but it's such a+-- special case I thought I'd leave it here for now.+isDivOp IntQuotOp        = True+isDivOp IntRemOp         = True+isDivOp WordQuotOp       = True+isDivOp WordRemOp        = True+isDivOp FloatDivOp       = True+isDivOp DoubleDivOp      = True+isDivOp _                = False++{- Note [exprOkForSpeculation: case expressions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+exprOkForSpeculation accepts very special case expressions.+Reason: (a ==# b) is ok-for-speculation, but the litEq rules+in PrelRules convert it (a ==# 3#) to+   case a of { DEFAULT -> 0#; 3# -> 1# }+for excellent reasons described in+  PrelRules Note [The litEq rule: converting equality to case].+So, annoyingly, we want that case expression to be+ok-for-speculation too. Bother.++But we restrict it sharply:++* We restrict it to unlifted scrutinees. Consider this:+     case x of y {+       DEFAULT -> ... (let v::Int# = case y of { True  -> e1+                                               ; False -> e2 }+                       in ...) ...++  Does the RHS of v satisfy the let/app invariant?  Previously we said+  yes, on the grounds that y is evaluated.  But the binder-swap done+  by SetLevels would transform the inner alternative to+     DEFAULT -> ... (let v::Int# = case x of { ... }+                     in ...) ....+  which does /not/ satisfy the let/app invariant, because x is+  not evaluated. See Note [Binder-swap during float-out]+  in SetLevels.  To avoid this awkwardness it seems simpler+  to stick to unlifted scrutinees where the issue does not+  arise.++* We restrict it to exhaustive alternatives. A non-exhaustive+  case manifestly isn't ok-for-speculation. for example,+  this is a valid program (albeit a slightly dodgy one)+    let v = case x of { B -> ...; C -> ... }+    in case x of+         A -> ...+         _ ->  ...v...v....+  Should v be considered ok-for-speculation?  Its scrutinee may be+  evaluated, but the alternatives are incomplete so we should not+  evaluate it strictly.++  Now, all this is for lifted types, but it'd be the same for any+  finite unlifted type. We don't have many of them, but we might+  add unlifted algebraic types in due course.+++----- Historical note: #15696: --------+  Previously SetLevels used exprOkForSpeculation to guide+  floating of single-alternative cases; it now uses exprIsHNF+  Note [Floating single-alternative cases].++  But in those days, consider+    case e of x { DEAFULT ->+      ...(case x of y+            A -> ...+            _ -> ...(case (case x of { B -> p; C -> p }) of+                       I# r -> blah)...+  If SetLevels considers the inner nested case as+  ok-for-speculation it can do case-floating (in SetLevels).+  So we'd float to:+    case e of x { DEAFULT ->+    case (case x of { B -> p; C -> p }) of I# r ->+    ...(case x of y+            A -> ...+            _ -> ...blah...)...+  which is utterly bogus (seg fault); see #5453.++----- Historical note: #3717: --------+    foo :: Int -> Int+    foo 0 = 0+    foo n = (if n < 5 then 1 else 2) `seq` foo (n-1)++In earlier GHCs, we got this:+    T.$wfoo =+      \ (ww :: GHC.Prim.Int#) ->+        case ww of ds {+          __DEFAULT -> case (case <# ds 5 of _ {+                          GHC.Types.False -> lvl1;+                          GHC.Types.True -> lvl})+                       of _ { __DEFAULT ->+                       T.$wfoo (GHC.Prim.-# ds_XkE 1) };+          0 -> 0 }++Before join-points etc we could only get rid of two cases (which are+redundant) by recognising that the (case <# ds 5 of { ... }) is+ok-for-speculation, even though it has /lifted/ type.  But now join+points do the job nicely.+------- End of historical note ------------+++Note [Primops with lifted arguments]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Is this ok-for-speculation (see #13027)?+   reallyUnsafePtrEq# a b+Well, yes.  The primop accepts lifted arguments and does not+evaluate them.  Indeed, in general primops are, well, primitive+and do not perform evaluation.++Bottom line:+  * In exprOkForSpeculation we simply ignore all lifted arguments.+  * In the rare case of primops that /do/ evaluate their arguments,+    (namely DataToTagOp and SeqOp) return False; see+    Note [exprOkForSpeculation and evaluated variables]++Note [exprOkForSpeculation and SeqOp/DataToTagOp]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Most primops with lifted arguments don't evaluate them+(see Note [Primops with lifted arguments]), so we can ignore+that argument entirely when doing exprOkForSpeculation.++But DataToTagOp and SeqOp are exceptions to that rule.+For reasons described in Note [exprOkForSpeculation and+evaluated variables], we simply return False for them.++Not doing this made #5129 go bad.+Lots of discussion in #15696.++Note [exprOkForSpeculation and evaluated variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Recall that+  seq#       :: forall a s. a -> State# s -> (# State# s, a #)+  dataToTag# :: forall a.   a -> Int#+must always evaluate their first argument.++Now consider these examples:+ * case x of y { DEFAULT -> ....y.... }+   Should 'y' (alone) be considered ok-for-speculation?++ * case x of y { DEFAULT -> ....f (dataToTag# y)... }+   Should (dataToTag# y) be considered ok-for-spec?++You could argue 'yes', because in the case alternative we know that+'y' is evaluated.  But the binder-swap transformation, which is+extremely useful for float-out, changes these expressions to+   case x of y { DEFAULT -> ....x.... }+   case x of y { DEFAULT -> ....f (dataToTag# x)... }++And now the expression does not obey the let/app invariant!  Yikes!+Moreover we really might float (f (dataToTag# x)) outside the case,+and then it really, really doesn't obey the let/app invariant.++The solution is simple: exprOkForSpeculation does not try to take+advantage of the evaluated-ness of (lifted) variables.  And it returns+False (always) for DataToTagOp and SeqOp.++Note that exprIsHNF /can/ and does take advantage of evaluated-ness;+it doesn't have the trickiness of the let/app invariant to worry about.++************************************************************************+*                                                                      *+             exprIsHNF, exprIsConLike+*                                                                      *+************************************************************************+-}++-- Note [exprIsHNF]             See also Note [exprIsCheap and exprIsHNF]+-- ~~~~~~~~~~~~~~~~+-- | exprIsHNF returns true for expressions that are certainly /already/+-- evaluated to /head/ normal form.  This is used to decide whether it's ok+-- to change:+--+-- > case x of _ -> e+--+--    into:+--+-- > e+--+-- and to decide whether it's safe to discard a 'seq'.+--+-- So, it does /not/ treat variables as evaluated, unless they say they are.+-- However, it /does/ treat partial applications and constructor applications+-- as values, even if their arguments are non-trivial, provided the argument+-- type is lifted. For example, both of these are values:+--+-- > (:) (f x) (map f xs)+-- > map (...redex...)+--+-- because 'seq' on such things completes immediately.+--+-- For unlifted argument types, we have to be careful:+--+-- > C (f x :: Int#)+--+-- Suppose @f x@ diverges; then @C (f x)@ is not a value. However this can't+-- happen: see "CoreSyn#let_app_invariant". This invariant states that arguments of+-- unboxed type must be ok-for-speculation (or trivial).+exprIsHNF :: CoreExpr -> Bool           -- True => Value-lambda, constructor, PAP+exprIsHNF = exprIsHNFlike isDataConWorkId isEvaldUnfolding++-- | Similar to 'exprIsHNF' but includes CONLIKE functions as well as+-- data constructors. Conlike arguments are considered interesting by the+-- inliner.+exprIsConLike :: CoreExpr -> Bool       -- True => lambda, conlike, PAP+exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding++-- | Returns true for values or value-like expressions. These are lambdas,+-- constructors / CONLIKE functions (as determined by the function argument)+-- or PAPs.+--+exprIsHNFlike :: (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool+exprIsHNFlike is_con is_con_unf = is_hnf_like+  where+    is_hnf_like (Var v) -- NB: There are no value args at this point+      =  id_app_is_value v 0 -- Catches nullary constructors,+                             --      so that [] and () are values, for example+                             -- and (e.g.) primops that don't have unfoldings+      || is_con_unf (idUnfolding v)+        -- Check the thing's unfolding; it might be bound to a value+        --   or to a guaranteed-evaluated variable (isEvaldUnfolding)+        --   Contrast with Note [exprOkForSpeculation and evaluated variables]+        -- We don't look through loop breakers here, which is a bit conservative+        -- but otherwise I worry that if an Id's unfolding is just itself,+        -- we could get an infinite loop++    is_hnf_like (Lit _)          = True+    is_hnf_like (Type _)         = True       -- Types are honorary Values;+                                              -- we don't mind copying them+    is_hnf_like (Coercion _)     = True       -- Same for coercions+    is_hnf_like (Lam b e)        = isRuntimeVar b || is_hnf_like e+    is_hnf_like (Tick tickish e) = not (tickishCounts tickish)+                                   && is_hnf_like e+                                      -- See Note [exprIsHNF Tick]+    is_hnf_like (Cast e _)       = is_hnf_like e+    is_hnf_like (App e a)+      | isValArg a               = app_is_value e 1+      | otherwise                = is_hnf_like e+    is_hnf_like (Let _ e)        = is_hnf_like e  -- Lazy let(rec)s don't affect us+    is_hnf_like _                = False++    -- 'n' is the number of value args to which the expression is applied+    -- And n>0: there is at least one value argument+    app_is_value :: CoreExpr -> Int -> Bool+    app_is_value (Var f)    nva = id_app_is_value f nva+    app_is_value (Tick _ f) nva = app_is_value f nva+    app_is_value (Cast f _) nva = app_is_value f nva+    app_is_value (App f a)  nva+      | isValArg a              = app_is_value f (nva + 1)+      | otherwise               = app_is_value f nva+    app_is_value _          _   = False++    id_app_is_value id n_val_args+       = is_con id+       || idArity id > n_val_args+       || id `hasKey` absentErrorIdKey  -- See Note [aBSENT_ERROR_ID] in MkCore+                      -- absentError behaves like an honorary data constructor+++{-+Note [exprIsHNF Tick]++We can discard source annotations on HNFs as long as they aren't+tick-like:++  scc c (\x . e)    =>  \x . e+  scc c (C x1..xn)  =>  C x1..xn++So we regard these as HNFs.  Tick annotations that tick are not+regarded as HNF if the expression they surround is HNF, because the+tick is there to tell us that the expression was evaluated, so we+don't want to discard a seq on it.+-}++-- | Can we bind this 'CoreExpr' at the top level?+exprIsTopLevelBindable :: CoreExpr -> Type -> Bool+-- See Note [CoreSyn top-level string literals]+-- Precondition: exprType expr = ty+-- Top-level literal strings can't even be wrapped in ticks+--   see Note [CoreSyn top-level string literals] in CoreSyn+exprIsTopLevelBindable expr ty+  = not (isUnliftedType ty)+  || exprIsTickedString expr++-- | Check if the expression is zero or more Ticks wrapped around a literal+-- string.+exprIsTickedString :: CoreExpr -> Bool+exprIsTickedString = isJust . exprIsTickedString_maybe++-- | Extract a literal string from an expression that is zero or more Ticks+-- wrapped around a literal string. Returns Nothing if the expression has a+-- different shape.+-- Used to "look through" Ticks in places that need to handle literal strings.+exprIsTickedString_maybe :: CoreExpr -> Maybe ByteString+exprIsTickedString_maybe (Lit (LitString bs)) = Just bs+exprIsTickedString_maybe (Tick t e)+  -- we don't tick literals with CostCentre ticks, compare to mkTick+  | tickishPlace t == PlaceCostCentre = Nothing+  | otherwise = exprIsTickedString_maybe e+exprIsTickedString_maybe _ = Nothing++{-+************************************************************************+*                                                                      *+             Instantiating data constructors+*                                                                      *+************************************************************************++These InstPat functions go here to avoid circularity between DataCon and Id+-}++dataConRepInstPat   ::                 [Unique] -> DataCon -> [Type] -> ([TyCoVar], [Id])+dataConRepFSInstPat :: [FastString] -> [Unique] -> DataCon -> [Type] -> ([TyCoVar], [Id])++dataConRepInstPat   = dataConInstPat (repeat ((fsLit "ipv")))+dataConRepFSInstPat = dataConInstPat++dataConInstPat :: [FastString]          -- A long enough list of FSs to use for names+               -> [Unique]              -- An equally long list of uniques, at least one for each binder+               -> DataCon+               -> [Type]                -- Types to instantiate the universally quantified tyvars+               -> ([TyCoVar], [Id])     -- Return instantiated variables+-- dataConInstPat arg_fun fss us con inst_tys returns a tuple+-- (ex_tvs, arg_ids),+--+--   ex_tvs are intended to be used as binders for existential type args+--+--   arg_ids are indended to be used as binders for value arguments,+--     and their types have been instantiated with inst_tys and ex_tys+--     The arg_ids include both evidence and+--     programmer-specified arguments (both after rep-ing)+--+-- Example.+--  The following constructor T1+--+--  data T a where+--    T1 :: forall b. Int -> b -> T(a,b)+--    ...+--+--  has representation type+--   forall a. forall a1. forall b. (a ~ (a1,b)) =>+--     Int -> b -> T a+--+--  dataConInstPat fss us T1 (a1',b') will return+--+--  ([a1'', b''], [c :: (a1', b')~(a1'', b''), x :: Int, y :: b''])+--+--  where the double-primed variables are created with the FastStrings and+--  Uniques given as fss and us+dataConInstPat fss uniqs con inst_tys+  = ASSERT( univ_tvs `equalLength` inst_tys )+    (ex_bndrs, arg_ids)+  where+    univ_tvs = dataConUnivTyVars con+    ex_tvs   = dataConExTyCoVars con+    arg_tys  = dataConRepArgTys con+    arg_strs = dataConRepStrictness con  -- 1-1 with arg_tys+    n_ex = length ex_tvs++      -- split the Uniques and FastStrings+    (ex_uniqs, id_uniqs) = splitAt n_ex uniqs+    (ex_fss,   id_fss)   = splitAt n_ex fss++      -- Make the instantiating substitution for universals+    univ_subst = zipTvSubst univ_tvs inst_tys++      -- Make existential type variables, applying and extending the substitution+    (full_subst, ex_bndrs) = mapAccumL mk_ex_var univ_subst+                                       (zip3 ex_tvs ex_fss ex_uniqs)++    mk_ex_var :: TCvSubst -> (TyCoVar, FastString, Unique) -> (TCvSubst, TyCoVar)+    mk_ex_var subst (tv, fs, uniq) = (Type.extendTCvSubstWithClone subst tv+                                       new_tv+                                     , new_tv)+      where+        new_tv | isTyVar tv+               = mkTyVar (mkSysTvName uniq fs) kind+               | otherwise+               = mkCoVar (mkSystemVarName uniq fs) kind+        kind   = Type.substTyUnchecked subst (varType tv)++      -- Make value vars, instantiating types+    arg_ids = zipWith4 mk_id_var id_uniqs id_fss arg_tys arg_strs+    mk_id_var uniq fs ty str+      = setCaseBndrEvald str $  -- See Note [Mark evaluated arguments]+        mkLocalIdOrCoVar name (Type.substTy full_subst ty)+      where+        name = mkInternalName uniq (mkVarOccFS fs) noSrcSpan++{-+Note [Mark evaluated arguments]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When pattern matching on a constructor with strict fields, the binder+can have an 'evaldUnfolding'.  Moreover, it *should* have one, so that+when loading an interface file unfolding like:+  data T = MkT !Int+  f x = case x of { MkT y -> let v::Int# = case y of I# n -> n+1+                             in ... }+we don't want Lint to complain.  The 'y' is evaluated, so the+case in the RHS of the binding for 'v' is fine.  But only if we+*know* that 'y' is evaluated.++c.f. add_evals in Simplify.simplAlt++************************************************************************+*                                                                      *+         Equality+*                                                                      *+************************************************************************+-}++-- | A cheap equality test which bales out fast!+--      If it returns @True@ the arguments are definitely equal,+--      otherwise, they may or may not be equal.+--+-- See also 'exprIsBig'+cheapEqExpr :: Expr b -> Expr b -> Bool+cheapEqExpr = cheapEqExpr' (const False)++-- | Cheap expression equality test, can ignore ticks by type.+cheapEqExpr' :: (Tickish Id -> Bool) -> Expr b -> Expr b -> Bool+cheapEqExpr' ignoreTick = go_s+  where go_s = go `on` stripTicksTopE ignoreTick+        go (Var v1)   (Var v2)   = v1 == v2+        go (Lit lit1) (Lit lit2) = lit1 == lit2+        go (Type t1)  (Type t2)  = t1 `eqType` t2+        go (Coercion c1) (Coercion c2) = c1 `eqCoercion` c2++        go (App f1 a1) (App f2 a2)+          = f1 `go_s` f2 && a1 `go_s` a2++        go (Cast e1 t1) (Cast e2 t2)+          = e1 `go_s` e2 && t1 `eqCoercion` t2++        go (Tick t1 e1) (Tick t2 e2)+          = t1 == t2 && e1 `go_s` e2++        go _ _ = False+        {-# INLINE go #-}+{-# INLINE cheapEqExpr' #-}++exprIsBig :: Expr b -> Bool+-- ^ Returns @True@ of expressions that are too big to be compared by 'cheapEqExpr'+exprIsBig (Lit _)      = False+exprIsBig (Var _)      = False+exprIsBig (Type _)     = False+exprIsBig (Coercion _) = False+exprIsBig (Lam _ e)    = exprIsBig e+exprIsBig (App f a)    = exprIsBig f || exprIsBig a+exprIsBig (Cast e _)   = exprIsBig e    -- Hopefully coercions are not too big!+exprIsBig (Tick _ e)   = exprIsBig e+exprIsBig _            = True++eqExpr :: InScopeSet -> CoreExpr -> CoreExpr -> Bool+-- Compares for equality, modulo alpha+eqExpr in_scope e1 e2+  = go (mkRnEnv2 in_scope) e1 e2+  where+    go env (Var v1) (Var v2)+      | rnOccL env v1 == rnOccR env v2+      = True++    go _   (Lit lit1)    (Lit lit2)      = lit1 == lit2+    go env (Type t1)    (Type t2)        = eqTypeX env t1 t2+    go env (Coercion co1) (Coercion co2) = eqCoercionX env co1 co2+    go env (Cast e1 co1) (Cast e2 co2) = eqCoercionX env co1 co2 && go env e1 e2+    go env (App f1 a1)   (App f2 a2)   = go env f1 f2 && go env a1 a2+    go env (Tick n1 e1)  (Tick n2 e2)  = eqTickish env n1 n2 && go env e1 e2++    go env (Lam b1 e1)  (Lam b2 e2)+      =  eqTypeX env (varType b1) (varType b2)   -- False for Id/TyVar combination+      && go (rnBndr2 env b1 b2) e1 e2++    go env (Let (NonRec v1 r1) e1) (Let (NonRec v2 r2) e2)+      =  go env r1 r2  -- No need to check binder types, since RHSs match+      && go (rnBndr2 env v1 v2) e1 e2++    go env (Let (Rec ps1) e1) (Let (Rec ps2) e2)+      = equalLength ps1 ps2+      && all2 (go env') rs1 rs2 && go env' e1 e2+      where+        (bs1,rs1) = unzip ps1+        (bs2,rs2) = unzip ps2+        env' = rnBndrs2 env bs1 bs2++    go env (Case e1 b1 t1 a1) (Case e2 b2 t2 a2)+      | null a1   -- See Note [Empty case alternatives] in TrieMap+      = null a2 && go env e1 e2 && eqTypeX env t1 t2+      | otherwise+      =  go env e1 e2 && all2 (go_alt (rnBndr2 env b1 b2)) a1 a2++    go _ _ _ = False++    -----------+    go_alt env (c1, bs1, e1) (c2, bs2, e2)+      = c1 == c2 && go (rnBndrs2 env bs1 bs2) e1 e2++eqTickish :: RnEnv2 -> Tickish Id -> Tickish Id -> Bool+eqTickish env (Breakpoint lid lids) (Breakpoint rid rids)+      = lid == rid  &&  map (rnOccL env) lids == map (rnOccR env) rids+eqTickish _ l r = l == r++-- | Finds differences between core expressions, modulo alpha and+-- renaming. Setting @top@ means that the @IdInfo@ of bindings will be+-- checked for differences as well.+diffExpr :: Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]+diffExpr _   env (Var v1)   (Var v2)   | rnOccL env v1 == rnOccR env v2 = []+diffExpr _   _   (Lit lit1) (Lit lit2) | lit1 == lit2                   = []+diffExpr _   env (Type t1)  (Type t2)  | eqTypeX env t1 t2              = []+diffExpr _   env (Coercion co1) (Coercion co2)+                                       | eqCoercionX env co1 co2        = []+diffExpr top env (Cast e1 co1)  (Cast e2 co2)+  | eqCoercionX env co1 co2                = diffExpr top env e1 e2+diffExpr top env (Tick n1 e1)   e2+  | not (tickishIsCode n1)                 = diffExpr top env e1 e2+diffExpr top env e1             (Tick n2 e2)+  | not (tickishIsCode n2)                 = diffExpr top env e1 e2+diffExpr top env (Tick n1 e1)   (Tick n2 e2)+  | eqTickish env n1 n2                    = diffExpr top env e1 e2+ -- The error message of failed pattern matches will contain+ -- generated names, which are allowed to differ.+diffExpr _   _   (App (App (Var absent) _) _)+                 (App (App (Var absent2) _) _)+  | isBottomingId absent && isBottomingId absent2 = []+diffExpr top env (App f1 a1)    (App f2 a2)+  = diffExpr top env f1 f2 ++ diffExpr top env a1 a2+diffExpr top env (Lam b1 e1)  (Lam b2 e2)+  | eqTypeX env (varType b1) (varType b2)   -- False for Id/TyVar combination+  = diffExpr top (rnBndr2 env b1 b2) e1 e2+diffExpr top env (Let bs1 e1) (Let bs2 e2)+  = let (ds, env') = diffBinds top env (flattenBinds [bs1]) (flattenBinds [bs2])+    in ds ++ diffExpr top env' e1 e2+diffExpr top env (Case e1 b1 t1 a1) (Case e2 b2 t2 a2)+  | equalLength a1 a2 && not (null a1) || eqTypeX env t1 t2+    -- See Note [Empty case alternatives] in TrieMap+  = diffExpr top env e1 e2 ++ concat (zipWith diffAlt a1 a2)+  where env' = rnBndr2 env b1 b2+        diffAlt (c1, bs1, e1) (c2, bs2, e2)+          | c1 /= c2  = [text "alt-cons " <> ppr c1 <> text " /= " <> ppr c2]+          | otherwise = diffExpr top (rnBndrs2 env' bs1 bs2) e1 e2+diffExpr _  _ e1 e2+  = [fsep [ppr e1, text "/=", ppr e2]]++-- | Finds differences between core bindings, see @diffExpr@.+--+-- The main problem here is that while we expect the binds to have the+-- same order in both lists, this is not guaranteed. To do this+-- properly we'd either have to do some sort of unification or check+-- all possible mappings, which would be seriously expensive. So+-- instead we simply match single bindings as far as we can. This+-- leaves us just with mutually recursive and/or mismatching bindings,+-- which we then speculatively match by ordering them. It's by no means+-- perfect, but gets the job done well enough.+diffBinds :: Bool -> RnEnv2 -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]+          -> ([SDoc], RnEnv2)+diffBinds top env binds1 = go (length binds1) env binds1+ where go _    env []     []+          = ([], env)+       go fuel env binds1 binds2+          -- No binds left to compare? Bail out early.+          | null binds1 || null binds2+          = (warn env binds1 binds2, env)+          -- Iterated over all binds without finding a match? Then+          -- try speculatively matching binders by order.+          | fuel == 0+          = if not $ env `inRnEnvL` fst (head binds1)+            then let env' = uncurry (rnBndrs2 env) $ unzip $+                            zip (sort $ map fst binds1) (sort $ map fst binds2)+                 in go (length binds1) env' binds1 binds2+            -- If we have already tried that, give up+            else (warn env binds1 binds2, env)+       go fuel env ((bndr1,expr1):binds1) binds2+          | let matchExpr (bndr,expr) =+                  (not top || null (diffIdInfo env bndr bndr1)) &&+                  null (diffExpr top (rnBndr2 env bndr1 bndr) expr1 expr)+          , (binds2l, (bndr2,_):binds2r) <- break matchExpr binds2+          = go (length binds1) (rnBndr2 env bndr1 bndr2)+                binds1 (binds2l ++ binds2r)+          | otherwise -- No match, so push back (FIXME O(n^2))+          = go (fuel-1) env (binds1++[(bndr1,expr1)]) binds2+       go _ _ _ _ = panic "diffBinds: impossible" -- GHC isn't smart enough++       -- We have tried everything, but couldn't find a good match. So+       -- now we just return the comparison results when we pair up+       -- the binds in a pseudo-random order.+       warn env binds1 binds2 =+         concatMap (uncurry (diffBind env)) (zip binds1' binds2') +++         unmatched "unmatched left-hand:" (drop l binds1') +++         unmatched "unmatched right-hand:" (drop l binds2')+        where binds1' = sortBy (comparing fst) binds1+              binds2' = sortBy (comparing fst) binds2+              l = min (length binds1') (length binds2')+       unmatched _   [] = []+       unmatched txt bs = [text txt $$ ppr (Rec bs)]+       diffBind env (bndr1,expr1) (bndr2,expr2)+         | ds@(_:_) <- diffExpr top env expr1 expr2+         = locBind "in binding" bndr1 bndr2 ds+         | otherwise+         = diffIdInfo env bndr1 bndr2++-- | Find differences in @IdInfo@. We will especially check whether+-- the unfoldings match, if present (see @diffUnfold@).+diffIdInfo :: RnEnv2 -> Var -> Var -> [SDoc]+diffIdInfo env bndr1 bndr2+  | arityInfo info1 == arityInfo info2+    && cafInfo info1 == cafInfo info2+    && oneShotInfo info1 == oneShotInfo info2+    && inlinePragInfo info1 == inlinePragInfo info2+    && occInfo info1 == occInfo info2+    && demandInfo info1 == demandInfo info2+    && callArityInfo info1 == callArityInfo info2+    && levityInfo info1 == levityInfo info2+  = locBind "in unfolding of" bndr1 bndr2 $+    diffUnfold env (unfoldingInfo info1) (unfoldingInfo info2)+  | otherwise+  = locBind "in Id info of" bndr1 bndr2+    [fsep [pprBndr LetBind bndr1, text "/=", pprBndr LetBind bndr2]]+  where info1 = idInfo bndr1; info2 = idInfo bndr2++-- | Find differences in unfoldings. Note that we will not check for+-- differences of @IdInfo@ in unfoldings, as this is generally+-- redundant, and can lead to an exponential blow-up in complexity.+diffUnfold :: RnEnv2 -> Unfolding -> Unfolding -> [SDoc]+diffUnfold _   NoUnfolding    NoUnfolding                 = []+diffUnfold _   BootUnfolding  BootUnfolding               = []+diffUnfold _   (OtherCon cs1) (OtherCon cs2) | cs1 == cs2 = []+diffUnfold env (DFunUnfolding bs1 c1 a1)+               (DFunUnfolding bs2 c2 a2)+  | c1 == c2 && equalLength bs1 bs2+  = concatMap (uncurry (diffExpr False env')) (zip a1 a2)+  where env' = rnBndrs2 env bs1 bs2+diffUnfold env (CoreUnfolding t1 _ _ v1 cl1 wf1 x1 g1)+               (CoreUnfolding t2 _ _ v2 cl2 wf2 x2 g2)+  | v1 == v2 && cl1 == cl2+    && wf1 == wf2 && x1 == x2 && g1 == g2+  = diffExpr False env t1 t2+diffUnfold _   uf1 uf2+  = [fsep [ppr uf1, text "/=", ppr uf2]]++-- | Add location information to diff messages+locBind :: String -> Var -> Var -> [SDoc] -> [SDoc]+locBind loc b1 b2 diffs = map addLoc diffs+  where addLoc d            = d $$ nest 2 (parens (text loc <+> bindLoc))+        bindLoc | b1 == b2  = ppr b1+                | otherwise = ppr b1 <> char '/' <> ppr b2++{-+************************************************************************+*                                                                      *+                Eta reduction+*                                                                      *+************************************************************************++Note [Eta reduction conditions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We try for eta reduction here, but *only* if we get all the way to an+trivial expression.  We don't want to remove extra lambdas unless we+are going to avoid allocating this thing altogether.++There are some particularly delicate points here:++* We want to eta-reduce if doing so leaves a trivial expression,+  *including* a cast.  For example+       \x. f |> co  -->  f |> co+  (provided co doesn't mention x)++* Eta reduction is not valid in general:+        \x. bot  /=  bot+  This matters, partly for old-fashioned correctness reasons but,+  worse, getting it wrong can yield a seg fault. Consider+        f = \x.f x+        h y = case (case y of { True -> f `seq` True; False -> False }) of+                True -> ...; False -> ...++  If we (unsoundly) eta-reduce f to get f=f, the strictness analyser+  says f=bottom, and replaces the (f `seq` True) with just+  (f `cast` unsafe-co).  BUT, as thing stand, 'f' got arity 1, and it+  *keeps* arity 1 (perhaps also wrongly).  So CorePrep eta-expands+  the definition again, so that it does not termninate after all.+  Result: seg-fault because the boolean case actually gets a function value.+  See #1947.++  So it's important to do the right thing.++* Note [Arity care]: we need to be careful if we just look at f's+  arity. Currently (Dec07), f's arity is visible in its own RHS (see+  Note [Arity robustness] in SimplEnv) so we must *not* trust the+  arity when checking that 'f' is a value.  Otherwise we will+  eta-reduce+      f = \x. f x+  to+      f = f+  Which might change a terminating program (think (f `seq` e)) to a+  non-terminating one.  So we check for being a loop breaker first.++  However for GlobalIds we can look at the arity; and for primops we+  must, since they have no unfolding.++* Regardless of whether 'f' is a value, we always want to+  reduce (/\a -> f a) to f+  This came up in a RULE: foldr (build (/\a -> g a))+  did not match           foldr (build (/\b -> ...something complex...))+  The type checker can insert these eta-expanded versions,+  with both type and dictionary lambdas; hence the slightly+  ad-hoc isDictId++* Never *reduce* arity. For example+      f = \xy. g x y+  Then if h has arity 1 we don't want to eta-reduce because then+  f's arity would decrease, and that is bad++These delicacies are why we don't use exprIsTrivial and exprIsHNF here.+Alas.++Note [Eta reduction with casted arguments]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+    (\(x:t3). f (x |> g)) :: t3 -> t2+  where+    f :: t1 -> t2+    g :: t3 ~ t1+This should be eta-reduced to++    f |> (sym g -> t2)++So we need to accumulate a coercion, pushing it inward (past+variable arguments only) thus:+   f (x |> co_arg) |> co  -->  (f |> (sym co_arg -> co)) x+   f (x:t)         |> co  -->  (f |> (t -> co)) x+   f @ a           |> co  -->  (f |> (forall a.co)) @ a+   f @ (g:t1~t2)   |> co  -->  (f |> (t1~t2 => co)) @ (g:t1~t2)+These are the equations for ok_arg.++It's true that we could also hope to eta reduce these:+    (\xy. (f x |> g) y)+    (\xy. (f x y) |> g)+But the simplifier pushes those casts outwards, so we don't+need to address that here.+-}++tryEtaReduce :: [Var] -> CoreExpr -> Maybe CoreExpr+tryEtaReduce bndrs body+  = go (reverse bndrs) body (mkRepReflCo (exprType body))+  where+    incoming_arity = count isId bndrs++    go :: [Var]            -- Binders, innermost first, types [a3,a2,a1]+       -> CoreExpr         -- Of type tr+       -> Coercion         -- Of type tr ~ ts+       -> Maybe CoreExpr   -- Of type a1 -> a2 -> a3 -> ts+    -- See Note [Eta reduction with casted arguments]+    -- for why we have an accumulating coercion+    go [] fun co+      | ok_fun fun+      , let used_vars = exprFreeVars fun `unionVarSet` tyCoVarsOfCo co+      , not (any (`elemVarSet` used_vars) bndrs)+      = Just (mkCast fun co)   -- Check for any of the binders free in the result+                               -- including the accumulated coercion++    go bs (Tick t e) co+      | tickishFloatable t+      = fmap (Tick t) $ go bs e co+      -- Float app ticks: \x -> Tick t (e x) ==> Tick t e++    go (b : bs) (App fun arg) co+      | Just (co', ticks) <- ok_arg b arg co+      = fmap (flip (foldr mkTick) ticks) $ go bs fun co'+            -- Float arg ticks: \x -> e (Tick t x) ==> Tick t e++    go _ _ _  = Nothing         -- Failure!++    ---------------+    -- Note [Eta reduction conditions]+    ok_fun (App fun (Type {})) = ok_fun fun+    ok_fun (Cast fun _)        = ok_fun fun+    ok_fun (Tick _ expr)       = ok_fun expr+    ok_fun (Var fun_id)        = ok_fun_id fun_id || all ok_lam bndrs+    ok_fun _fun                = False++    ---------------+    ok_fun_id fun = fun_arity fun >= incoming_arity++    ---------------+    fun_arity fun             -- See Note [Arity care]+       | isLocalId fun+       , isStrongLoopBreaker (idOccInfo fun) = 0+       | arity > 0                           = arity+       | isEvaldUnfolding (idUnfolding fun)  = 1+            -- See Note [Eta reduction of an eval'd function]+       | otherwise                           = 0+       where+         arity = idArity fun++    ---------------+    ok_lam v = isTyVar v || isEvVar v++    ---------------+    ok_arg :: Var              -- Of type bndr_t+           -> CoreExpr         -- Of type arg_t+           -> Coercion         -- Of kind (t1~t2)+           -> Maybe (Coercion  -- Of type (arg_t -> t1 ~  bndr_t -> t2)+                               --   (and similarly for tyvars, coercion args)+                    , [Tickish Var])+    -- See Note [Eta reduction with casted arguments]+    ok_arg bndr (Type ty) co+       | Just tv <- getTyVar_maybe ty+       , bndr == tv  = Just (mkHomoForAllCos [tv] co, [])+    ok_arg bndr (Var v) co+       | bndr == v   = let reflCo = mkRepReflCo (idType bndr)+                       in Just (mkFunCo Representational reflCo co, [])+    ok_arg bndr (Cast e co_arg) co+       | (ticks, Var v) <- stripTicksTop tickishFloatable e+       , bndr == v+       = Just (mkFunCo Representational (mkSymCo co_arg) co, ticks)+       -- The simplifier combines multiple casts into one,+       -- so we can have a simple-minded pattern match here+    ok_arg bndr (Tick t arg) co+       | tickishFloatable t, Just (co', ticks) <- ok_arg bndr arg co+       = Just (co', t:ticks)++    ok_arg _ _ _ = Nothing++{-+Note [Eta reduction of an eval'd function]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In Haskell it is not true that    f = \x. f x+because f might be bottom, and 'seq' can distinguish them.++But it *is* true that   f = f `seq` \x. f x+and we'd like to simplify the latter to the former.  This amounts+to the rule that+  * when there is just *one* value argument,+  * f is not bottom+we can eta-reduce    \x. f x  ===>  f++This turned up in #7542.+++************************************************************************+*                                                                      *+\subsection{Determining non-updatable right-hand-sides}+*                                                                      *+************************************************************************++Top-level constructor applications can usually be allocated+statically, but they can't if the constructor, or any of the+arguments, come from another DLL (because we can't refer to static+labels in other DLLs).++If this happens we simply make the RHS into an updatable thunk,+and 'execute' it rather than allocating it statically.+-}++-- | This function is called only on *top-level* right-hand sides.+-- Returns @True@ if the RHS can be allocated statically in the output,+-- with no thunks involved at all.+rhsIsStatic+   :: Platform+   -> (Name -> Bool)         -- Which names are dynamic+   -> (LitNumType -> Integer -> Maybe CoreExpr)+      -- Desugaring for some literals (disgusting)+      -- C.f. Note [Disgusting computation of CafRefs] in TidyPgm+   -> CoreExpr -> Bool+-- It's called (i) in TidyPgm.hasCafRefs to decide if the rhs is, or+-- refers to, CAFs; (ii) in CoreToStg to decide whether to put an+-- update flag on it and (iii) in DsExpr to decide how to expand+-- list literals+--+-- The basic idea is that rhsIsStatic returns True only if the RHS is+--      (a) a value lambda+--      (b) a saturated constructor application with static args+--+-- BUT watch out for+--  (i) Any cross-DLL references kill static-ness completely+--      because they must be 'executed' not statically allocated+--      ("DLL" here really only refers to Windows DLLs, on other platforms,+--      this is not necessary)+--+-- (ii) We treat partial applications as redexes, because in fact we+--      make a thunk for them that runs and builds a PAP+--      at run-time.  The only applications that are treated as+--      static are *saturated* applications of constructors.++-- We used to try to be clever with nested structures like this:+--              ys = (:) w ((:) w [])+-- on the grounds that CorePrep will flatten ANF-ise it later.+-- But supporting this special case made the function much more+-- complicated, because the special case only applies if there are no+-- enclosing type lambdas:+--              ys = /\ a -> Foo (Baz ([] a))+-- Here the nested (Baz []) won't float out to top level in CorePrep.+--+-- But in fact, even without -O, nested structures at top level are+-- flattened by the simplifier, so we don't need to be super-clever here.+--+-- Examples+--+--      f = \x::Int. x+7        TRUE+--      p = (True,False)        TRUE+--+--      d = (fst p, False)      FALSE because there's a redex inside+--                              (this particular one doesn't happen but...)+--+--      h = D# (1.0## /## 2.0##)        FALSE (redex again)+--      n = /\a. Nil a                  TRUE+--+--      t = /\a. (:) (case w a of ...) (Nil a)  FALSE (redex)+--+--+-- This is a bit like CoreUtils.exprIsHNF, with the following differences:+--    a) scc "foo" (\x -> ...) is updatable (so we catch the right SCC)+--+--    b) (C x xs), where C is a constructor is updatable if the application is+--         dynamic+--+--    c) don't look through unfolding of f in (f x).++rhsIsStatic platform is_dynamic_name cvt_literal rhs = is_static False rhs+  where+  is_static :: Bool     -- True <=> in a constructor argument; must be atomic+            -> CoreExpr -> Bool++  is_static False  (Lam b e)              = isRuntimeVar b || is_static False e+  is_static in_arg (Tick n e)             = not (tickishIsCode n)+                                              && is_static in_arg e+  is_static in_arg (Cast e _)             = is_static in_arg e+  is_static _      (Coercion {})          = True   -- Behaves just like a literal+  is_static in_arg (Lit (LitNumber nt i _)) = case cvt_literal nt i of+    Just e  -> is_static in_arg e+    Nothing -> True+  is_static _      (Lit (LitLabel {}))    = False+  is_static _      (Lit _)                = True+        -- A LitLabel (foreign import "&foo") in an argument+        -- prevents a constructor application from being static.  The+        -- reason is that it might give rise to unresolvable symbols+        -- in the object file: under Linux, references to "weak"+        -- symbols from the data segment give rise to "unresolvable+        -- relocation" errors at link time This might be due to a bug+        -- in the linker, but we'll work around it here anyway.+        -- SDM 24/2/2004++  is_static in_arg other_expr = go other_expr 0+   where+    go (Var f) n_val_args+        | (platformOS platform /= OSMinGW32) ||+          not (is_dynamic_name (idName f))+        =  saturated_data_con f n_val_args+        || (in_arg && n_val_args == 0)+                -- A naked un-applied variable is *not* deemed a static RHS+                -- E.g.         f = g+                -- Reason: better to update so that the indirection gets shorted+                --         out, and the true value will be seen+                -- NB: if you change this, you'll break the invariant that THUNK_STATICs+                --     are always updatable.  If you do so, make sure that non-updatable+                --     ones have enough space for their static link field!++    go (App f a) n_val_args+        | isTypeArg a                    = go f n_val_args+        | not in_arg && is_static True a = go f (n_val_args + 1)+        -- The (not in_arg) checks that we aren't in a constructor argument;+        -- if we are, we don't allow (value) applications of any sort+        --+        -- NB. In case you wonder, args are sometimes not atomic.  eg.+        --   x = D# (1.0## /## 2.0##)+        -- can't float because /## can fail.++    go (Tick n f) n_val_args = not (tickishIsCode n) && go f n_val_args+    go (Cast e _) n_val_args = go e n_val_args+    go _          _          = False++    saturated_data_con f n_val_args+        = case isDataConWorkId_maybe f of+            Just dc -> n_val_args == dataConRepArity dc+            Nothing -> False++{-+************************************************************************+*                                                                      *+\subsection{Type utilities}+*                                                                      *+************************************************************************+-}++-- | True if the type has no non-bottom elements, e.g. when it is an empty+-- datatype, or a GADT with non-satisfiable type parameters, e.g. Int :~: Bool.+-- See Note [Bottoming expressions]+--+-- See Note [No alternatives lint check] for another use of this function.+isEmptyTy :: Type -> Bool+isEmptyTy ty+    -- Data types where, given the particular type parameters, no data+    -- constructor matches, are empty.+    -- This includes data types with no constructors, e.g. Data.Void.Void.+    | Just (tc, inst_tys) <- splitTyConApp_maybe ty+    , Just dcs <- tyConDataCons_maybe tc+    , all (dataConCannotMatch inst_tys) dcs+    = True+    | otherwise+    = False++{-+*****************************************************+*+* StaticPtr+*+*****************************************************+-}++-- | @collectMakeStaticArgs (makeStatic t srcLoc e)@ yields+-- @Just (makeStatic, t, srcLoc, e)@.+--+-- Returns @Nothing@ for every other expression.+collectMakeStaticArgs+  :: CoreExpr -> Maybe (CoreExpr, Type, CoreExpr, CoreExpr)+collectMakeStaticArgs e+    | (fun@(Var b), [Type t, loc, arg], _) <- collectArgsTicks (const True) e+    , idName b == makeStaticName = Just (fun, t, loc, arg)+collectMakeStaticArgs _          = Nothing++{-+************************************************************************+*                                                                      *+\subsection{Join points}+*                                                                      *+************************************************************************+-}++-- | Does this binding bind a join point (or a recursive group of join points)?+isJoinBind :: CoreBind -> Bool+isJoinBind (NonRec b _)       = isJoinId b+isJoinBind (Rec ((b, _) : _)) = isJoinId b+isJoinBind _                  = False
+ compiler/coreSyn/MkCore.hs view
@@ -0,0 +1,911 @@+{-# LANGUAGE CPP #-}++-- | Handy functions for creating much Core syntax+module MkCore (+        -- * Constructing normal syntax+        mkCoreLet, mkCoreLets,+        mkCoreApp, mkCoreApps, mkCoreConApps,+        mkCoreLams, mkWildCase, mkIfThenElse,+        mkWildValBinder, mkWildEvBinder,+        sortQuantVars, castBottomExpr,++        -- * Constructing boxed literals+        mkWordExpr, mkWordExprWord,+        mkIntExpr, mkIntExprInt,+        mkIntegerExpr, mkNaturalExpr,+        mkFloatExpr, mkDoubleExpr,+        mkCharExpr, mkStringExpr, mkStringExprFS, mkStringExprFSWith,++        -- * Floats+        FloatBind(..), wrapFloat, wrapFloats, floatBindings,++        -- * Constructing small tuples+        mkCoreVarTup, mkCoreVarTupTy, mkCoreTup, mkCoreUbxTup,+        mkCoreTupBoxity, unitExpr,++        -- * Constructing big tuples+        mkBigCoreVarTup, mkBigCoreVarTup1,+        mkBigCoreVarTupTy, mkBigCoreTupTy,+        mkBigCoreTup,++        -- * Deconstructing small tuples+        mkSmallTupleSelector, mkSmallTupleCase,++        -- * Deconstructing big tuples+        mkTupleSelector, mkTupleSelector1, mkTupleCase,++        -- * Constructing list expressions+        mkNilExpr, mkConsExpr, mkListExpr,+        mkFoldrExpr, mkBuildExpr,++        -- * Constructing Maybe expressions+        mkNothingExpr, mkJustExpr,++        -- * Error Ids+        mkRuntimeErrorApp, mkImpossibleExpr, mkAbsentErrorApp, errorIds,+        rEC_CON_ERROR_ID, rUNTIME_ERROR_ID,+        nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,+        pAT_ERROR_ID, rEC_SEL_ERROR_ID, aBSENT_ERROR_ID,+        tYPE_ERROR_ID, aBSENT_SUM_FIELD_ERROR_ID+    ) where++#include "HsVersions.h"++import GhcPrelude++import Id+import Var      ( EvVar, setTyVarUnique )++import CoreSyn+import CoreUtils        ( exprType, needsCaseBinding, bindNonRec )+import Literal+import HscTypes++import TysWiredIn+import PrelNames++import HsUtils          ( mkChunkified, chunkify )+import Type+import Coercion         ( isCoVar )+import TysPrim+import DataCon          ( DataCon, dataConWorkId )+import IdInfo+import Demand+import Name      hiding ( varName )+import Outputable+import FastString+import UniqSupply+import BasicTypes+import Util+import DynFlags+import Data.List++import Data.Char        ( ord )+import Control.Monad.Fail as MonadFail ( MonadFail )++infixl 4 `mkCoreApp`, `mkCoreApps`++{-+************************************************************************+*                                                                      *+\subsection{Basic CoreSyn construction}+*                                                                      *+************************************************************************+-}+sortQuantVars :: [Var] -> [Var]+-- Sort the variables, putting type and covars first, in scoped order,+-- and then other Ids+-- It is a deterministic sort, meaining it doesn't look at the values of+-- Uniques. For explanation why it's important See Note [Unique Determinism]+-- in Unique.+sortQuantVars vs = sorted_tcvs ++ ids+  where+    (tcvs, ids) = partition (isTyVar <||> isCoVar) vs+    sorted_tcvs = scopedSort tcvs++-- | Bind a binding group over an expression, using a @let@ or @case@ as+-- appropriate (see "CoreSyn#let_app_invariant")+mkCoreLet :: CoreBind -> CoreExpr -> CoreExpr+mkCoreLet (NonRec bndr rhs) body        -- See Note [CoreSyn let/app invariant]+  = bindNonRec bndr rhs body+mkCoreLet bind body+  = Let bind body++-- | Bind a list of binding groups over an expression. The leftmost binding+-- group becomes the outermost group in the resulting expression+mkCoreLets :: [CoreBind] -> CoreExpr -> CoreExpr+mkCoreLets binds body = foldr mkCoreLet body binds++-- | Construct an expression which represents the application of one expression+-- paired with its type to an argument. The result is paired with its type. This+-- function is not exported and used in the definition of 'mkCoreApp' and+-- 'mkCoreApps'.+-- Respects the let/app invariant by building a case expression where necessary+--   See CoreSyn Note [CoreSyn let/app invariant]+mkCoreAppTyped :: SDoc -> (CoreExpr, Type) -> CoreExpr -> (CoreExpr, Type)+mkCoreAppTyped _ (fun, fun_ty) (Type ty)+  = (App fun (Type ty), piResultTy fun_ty ty)+mkCoreAppTyped _ (fun, fun_ty) (Coercion co)+  = (App fun (Coercion co), res_ty)+  where+    (_, res_ty) = splitFunTy fun_ty+mkCoreAppTyped d (fun, fun_ty) arg+  = ASSERT2( isFunTy fun_ty, ppr fun $$ ppr arg $$ d )+    (mk_val_app fun arg arg_ty res_ty, res_ty)+  where+    (arg_ty, res_ty) = splitFunTy fun_ty++-- | Construct an expression which represents the application of one expression+-- to the other+-- Respects the let/app invariant by building a case expression where necessary+--   See CoreSyn Note [CoreSyn let/app invariant]+mkCoreApp :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr+mkCoreApp s fun arg+  = fst $ mkCoreAppTyped s (fun, exprType fun) arg++-- | Construct an expression which represents the application of a number of+-- expressions to another. The leftmost expression in the list is applied first+-- Respects the let/app invariant by building a case expression where necessary+--   See CoreSyn Note [CoreSyn let/app invariant]+mkCoreApps :: CoreExpr -> [CoreExpr] -> CoreExpr+mkCoreApps fun args+  = fst $+    foldl' (mkCoreAppTyped doc_string) (fun, fun_ty) args+  where+    doc_string = ppr fun_ty $$ ppr fun $$ ppr args+    fun_ty = exprType fun++-- | Construct an expression which represents the application of a number of+-- expressions to that of a data constructor expression. The leftmost expression+-- in the list is applied first+mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr+mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args++mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr+-- Build an application (e1 e2),+-- or a strict binding  (case e2 of x -> e1 x)+-- using the latter when necessary to respect the let/app invariant+--   See Note [CoreSyn let/app invariant]+mk_val_app fun arg arg_ty res_ty+  | not (needsCaseBinding arg_ty arg)+  = App fun arg                -- The vastly common case++  | otherwise+  = Case arg arg_id res_ty [(DEFAULT,[],App fun (Var arg_id))]+  where+    arg_id = mkWildValBinder arg_ty+        -- Lots of shadowing, but it doesn't matter,+        -- because 'fun ' should not have a free wild-id+        --+        -- This is Dangerous.  But this is the only place we play this+        -- game, mk_val_app returns an expression that does not have+        -- a free wild-id.  So the only thing that can go wrong+        -- is if you take apart this case expression, and pass a+        -- fragment of it as the fun part of a 'mk_val_app'.++-----------+mkWildEvBinder :: PredType -> EvVar+mkWildEvBinder pred = mkWildValBinder pred++-- | Make a /wildcard binder/. This is typically used when you need a binder+-- that you expect to use only at a *binding* site.  Do not use it at+-- occurrence sites because it has a single, fixed unique, and it's very+-- easy to get into difficulties with shadowing.  That's why it is used so little.+-- See Note [WildCard binders] in SimplEnv+mkWildValBinder :: Type -> Id+mkWildValBinder ty = mkLocalIdOrCoVar wildCardName ty++mkWildCase :: CoreExpr -> Type -> Type -> [CoreAlt] -> CoreExpr+-- Make a case expression whose case binder is unused+-- The alts should not have any occurrences of WildId+mkWildCase scrut scrut_ty res_ty alts+  = Case scrut (mkWildValBinder scrut_ty) res_ty alts++mkIfThenElse :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr+mkIfThenElse guard then_expr else_expr+-- Not going to be refining, so okay to take the type of the "then" clause+  = mkWildCase guard boolTy (exprType then_expr)+         [ (DataAlt falseDataCon, [], else_expr),       -- Increasing order of tag!+           (DataAlt trueDataCon,  [], then_expr) ]++castBottomExpr :: CoreExpr -> Type -> CoreExpr+-- (castBottomExpr e ty), assuming that 'e' diverges,+-- return an expression of type 'ty'+-- See Note [Empty case alternatives] in CoreSyn+castBottomExpr e res_ty+  | e_ty `eqType` res_ty = e+  | otherwise            = Case e (mkWildValBinder e_ty) res_ty []+  where+    e_ty = exprType e++{-+The functions from this point don't really do anything cleverer than+their counterparts in CoreSyn, but they are here for consistency+-}++-- | Create a lambda where the given expression has a number of variables+-- bound over it. The leftmost binder is that bound by the outermost+-- lambda in the result+mkCoreLams :: [CoreBndr] -> CoreExpr -> CoreExpr+mkCoreLams = mkLams++{-+************************************************************************+*                                                                      *+\subsection{Making literals}+*                                                                      *+************************************************************************+-}++-- | Create a 'CoreExpr' which will evaluate to the given @Int@+mkIntExpr :: DynFlags -> Integer -> CoreExpr        -- Result = I# i :: Int+mkIntExpr dflags i = mkCoreConApps intDataCon  [mkIntLit dflags i]++-- | Create a 'CoreExpr' which will evaluate to the given @Int@+mkIntExprInt :: DynFlags -> Int -> CoreExpr         -- Result = I# i :: Int+mkIntExprInt dflags i = mkCoreConApps intDataCon  [mkIntLitInt dflags i]++-- | Create a 'CoreExpr' which will evaluate to the a @Word@ with the given value+mkWordExpr :: DynFlags -> Integer -> CoreExpr+mkWordExpr dflags w = mkCoreConApps wordDataCon [mkWordLit dflags w]++-- | Create a 'CoreExpr' which will evaluate to the given @Word@+mkWordExprWord :: DynFlags -> Word -> CoreExpr+mkWordExprWord dflags w = mkCoreConApps wordDataCon [mkWordLitWord dflags w]++-- | Create a 'CoreExpr' which will evaluate to the given @Integer@+mkIntegerExpr  :: MonadThings m => Integer -> m CoreExpr  -- Result :: Integer+mkIntegerExpr i = do t <- lookupTyCon integerTyConName+                     return (Lit (mkLitInteger i (mkTyConTy t)))++-- | Create a 'CoreExpr' which will evaluate to the given @Natural@+mkNaturalExpr  :: MonadThings m => Integer -> m CoreExpr+mkNaturalExpr i = do t <- lookupTyCon naturalTyConName+                     return (Lit (mkLitNatural i (mkTyConTy t)))++-- | Create a 'CoreExpr' which will evaluate to the given @Float@+mkFloatExpr :: Float -> CoreExpr+mkFloatExpr f = mkCoreConApps floatDataCon [mkFloatLitFloat f]++-- | Create a 'CoreExpr' which will evaluate to the given @Double@+mkDoubleExpr :: Double -> CoreExpr+mkDoubleExpr d = mkCoreConApps doubleDataCon [mkDoubleLitDouble d]+++-- | Create a 'CoreExpr' which will evaluate to the given @Char@+mkCharExpr     :: Char             -> CoreExpr      -- Result = C# c :: Int+mkCharExpr c = mkCoreConApps charDataCon [mkCharLit c]++-- | Create a 'CoreExpr' which will evaluate to the given @String@+mkStringExpr   :: MonadThings m => String     -> m CoreExpr  -- Result :: String++-- | Create a 'CoreExpr' which will evaluate to a string morally equivalent to the given @FastString@+mkStringExprFS :: MonadThings m => FastString -> m CoreExpr  -- Result :: String++mkStringExpr str = mkStringExprFS (mkFastString str)++mkStringExprFS = mkStringExprFSWith lookupId++mkStringExprFSWith :: Monad m => (Name -> m Id) -> FastString -> m CoreExpr+mkStringExprFSWith lookupM str+  | nullFS str+  = return (mkNilExpr charTy)++  | all safeChar chars+  = do unpack_id <- lookupM unpackCStringName+       return (App (Var unpack_id) lit)++  | otherwise+  = do unpack_utf8_id <- lookupM unpackCStringUtf8Name+       return (App (Var unpack_utf8_id) lit)++  where+    chars = unpackFS str+    safeChar c = ord c >= 1 && ord c <= 0x7F+    lit = Lit (LitString (bytesFS str))++{-+************************************************************************+*                                                                      *+\subsection{Tuple constructors}+*                                                                      *+************************************************************************+-}++{-+Creating tuples and their types for Core expressions++@mkBigCoreVarTup@ builds a tuple; the inverse to @mkTupleSelector@.++* If it has only one element, it is the identity function.++* If there are more elements than a big tuple can have, it nests+  the tuples.++Note [Flattening one-tuples]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+This family of functions creates a tuple of variables/expressions/types.+  mkCoreTup [e1,e2,e3] = (e1,e2,e3)+What if there is just one variable/expression/type in the argument?+We could do one of two things:++* Flatten it out, so that+    mkCoreTup [e1] = e1++* Build a one-tuple (see Note [One-tuples] in TysWiredIn)+    mkCoreTup1 [e1] = Unit e1+  We use a suffix "1" to indicate this.++Usually we want the former, but occasionally the latter.+-}++-- | Build a small tuple holding the specified variables+-- One-tuples are flattened; see Note [Flattening one-tuples]+mkCoreVarTup :: [Id] -> CoreExpr+mkCoreVarTup ids = mkCoreTup (map Var ids)++-- | Build the type of a small tuple that holds the specified variables+-- One-tuples are flattened; see Note [Flattening one-tuples]+mkCoreVarTupTy :: [Id] -> Type+mkCoreVarTupTy ids = mkBoxedTupleTy (map idType ids)++-- | Build a small tuple holding the specified expressions+-- One-tuples are flattened; see Note [Flattening one-tuples]+mkCoreTup :: [CoreExpr] -> CoreExpr+mkCoreTup []  = Var unitDataConId+mkCoreTup [c] = c+mkCoreTup cs  = mkCoreConApps (tupleDataCon Boxed (length cs))+                              (map (Type . exprType) cs ++ cs)++-- | Build a small unboxed tuple holding the specified expressions,+-- with the given types. The types must be the types of the expressions.+-- Do not include the RuntimeRep specifiers; this function calculates them+-- for you.+-- Does /not/ flatten one-tuples; see Note [Flattening one-tuples]+mkCoreUbxTup :: [Type] -> [CoreExpr] -> CoreExpr+mkCoreUbxTup tys exps+  = ASSERT( tys `equalLength` exps)+    mkCoreConApps (tupleDataCon Unboxed (length tys))+             (map (Type . getRuntimeRep) tys ++ map Type tys ++ exps)++-- | Make a core tuple of the given boxity+mkCoreTupBoxity :: Boxity -> [CoreExpr] -> CoreExpr+mkCoreTupBoxity Boxed   exps = mkCoreTup exps+mkCoreTupBoxity Unboxed exps = mkCoreUbxTup (map exprType exps) exps++-- | Build a big tuple holding the specified variables+-- One-tuples are flattened; see Note [Flattening one-tuples]+mkBigCoreVarTup :: [Id] -> CoreExpr+mkBigCoreVarTup ids = mkBigCoreTup (map Var ids)++mkBigCoreVarTup1 :: [Id] -> CoreExpr+-- Same as mkBigCoreVarTup, but one-tuples are NOT flattened+--                          see Note [Flattening one-tuples]+mkBigCoreVarTup1 [id] = mkCoreConApps (tupleDataCon Boxed 1)+                                      [Type (idType id), Var id]+mkBigCoreVarTup1 ids  = mkBigCoreTup (map Var ids)++-- | Build the type of a big tuple that holds the specified variables+-- One-tuples are flattened; see Note [Flattening one-tuples]+mkBigCoreVarTupTy :: [Id] -> Type+mkBigCoreVarTupTy ids = mkBigCoreTupTy (map idType ids)++-- | Build a big tuple holding the specified expressions+-- One-tuples are flattened; see Note [Flattening one-tuples]+mkBigCoreTup :: [CoreExpr] -> CoreExpr+mkBigCoreTup = mkChunkified mkCoreTup++-- | Build the type of a big tuple that holds the specified type of thing+-- One-tuples are flattened; see Note [Flattening one-tuples]+mkBigCoreTupTy :: [Type] -> Type+mkBigCoreTupTy = mkChunkified mkBoxedTupleTy++-- | The unit expression+unitExpr :: CoreExpr+unitExpr = Var unitDataConId++{-+************************************************************************+*                                                                      *+\subsection{Tuple destructors}+*                                                                      *+************************************************************************+-}++-- | Builds a selector which scrutises the given+-- expression and extracts the one name from the list given.+-- If you want the no-shadowing rule to apply, the caller+-- is responsible for making sure that none of these names+-- are in scope.+--+-- If there is just one 'Id' in the tuple, then the selector is+-- just the identity.+--+-- If necessary, we pattern match on a \"big\" tuple.+mkTupleSelector, mkTupleSelector1+    :: [Id]         -- ^ The 'Id's to pattern match the tuple against+    -> Id           -- ^ The 'Id' to select+    -> Id           -- ^ A variable of the same type as the scrutinee+    -> CoreExpr     -- ^ Scrutinee+    -> CoreExpr     -- ^ Selector expression++-- mkTupleSelector [a,b,c,d] b v e+--          = case e of v {+--                (p,q) -> case p of p {+--                           (a,b) -> b }}+-- We use 'tpl' vars for the p,q, since shadowing does not matter.+--+-- In fact, it's more convenient to generate it innermost first, getting+--+--        case (case e of v+--                (p,q) -> p) of p+--          (a,b) -> b+mkTupleSelector vars the_var scrut_var scrut+  = mk_tup_sel (chunkify vars) the_var+  where+    mk_tup_sel [vars] the_var = mkSmallTupleSelector vars the_var scrut_var scrut+    mk_tup_sel vars_s the_var = mkSmallTupleSelector group the_var tpl_v $+                                mk_tup_sel (chunkify tpl_vs) tpl_v+        where+          tpl_tys = [mkBoxedTupleTy (map idType gp) | gp <- vars_s]+          tpl_vs  = mkTemplateLocals tpl_tys+          [(tpl_v, group)] = [(tpl,gp) | (tpl,gp) <- zipEqual "mkTupleSelector" tpl_vs vars_s,+                                         the_var `elem` gp ]+-- ^ 'mkTupleSelector1' is like 'mkTupleSelector'+-- but one-tuples are NOT flattened (see Note [Flattening one-tuples])+mkTupleSelector1 vars the_var scrut_var scrut+  | [_] <- vars+  = mkSmallTupleSelector1 vars the_var scrut_var scrut+  | otherwise+  = mkTupleSelector vars the_var scrut_var scrut++-- | Like 'mkTupleSelector' but for tuples that are guaranteed+-- never to be \"big\".+--+-- > mkSmallTupleSelector [x] x v e = [| e |]+-- > mkSmallTupleSelector [x,y,z] x v e = [| case e of v { (x,y,z) -> x } |]+mkSmallTupleSelector, mkSmallTupleSelector1+          :: [Id]        -- The tuple args+          -> Id          -- The selected one+          -> Id          -- A variable of the same type as the scrutinee+          -> CoreExpr    -- Scrutinee+          -> CoreExpr+mkSmallTupleSelector [var] should_be_the_same_var _ scrut+  = ASSERT(var == should_be_the_same_var)+    scrut  -- Special case for 1-tuples+mkSmallTupleSelector vars the_var scrut_var scrut+  = mkSmallTupleSelector1 vars the_var scrut_var scrut++-- ^ 'mkSmallTupleSelector1' is like 'mkSmallTupleSelector'+-- but one-tuples are NOT flattened (see Note [Flattening one-tuples])+mkSmallTupleSelector1 vars the_var scrut_var scrut+  = ASSERT( notNull vars )+    Case scrut scrut_var (idType the_var)+         [(DataAlt (tupleDataCon Boxed (length vars)), vars, Var the_var)]++-- | A generalization of 'mkTupleSelector', allowing the body+-- of the case to be an arbitrary expression.+--+-- To avoid shadowing, we use uniques to invent new variables.+--+-- If necessary we pattern match on a \"big\" tuple.+mkTupleCase :: UniqSupply       -- ^ For inventing names of intermediate variables+            -> [Id]             -- ^ The tuple identifiers to pattern match on+            -> CoreExpr         -- ^ Body of the case+            -> Id               -- ^ A variable of the same type as the scrutinee+            -> CoreExpr         -- ^ Scrutinee+            -> CoreExpr+-- ToDo: eliminate cases where none of the variables are needed.+--+--         mkTupleCase uniqs [a,b,c,d] body v e+--           = case e of v { (p,q) ->+--             case p of p { (a,b) ->+--             case q of q { (c,d) ->+--             body }}}+mkTupleCase uniqs vars body scrut_var scrut+  = mk_tuple_case uniqs (chunkify vars) body+  where+    -- This is the case where don't need any nesting+    mk_tuple_case _ [vars] body+      = mkSmallTupleCase vars body scrut_var scrut++    -- This is the case where we must make nest tuples at least once+    mk_tuple_case us vars_s body+      = let (us', vars', body') = foldr one_tuple_case (us, [], body) vars_s+            in mk_tuple_case us' (chunkify vars') body'++    one_tuple_case chunk_vars (us, vs, body)+      = let (uniq, us') = takeUniqFromSupply us+            scrut_var = mkSysLocal (fsLit "ds") uniq+              (mkBoxedTupleTy (map idType chunk_vars))+            body' = mkSmallTupleCase chunk_vars body scrut_var (Var scrut_var)+        in (us', scrut_var:vs, body')++-- | As 'mkTupleCase', but for a tuple that is small enough to be guaranteed+-- not to need nesting.+mkSmallTupleCase+        :: [Id]         -- ^ The tuple args+        -> CoreExpr     -- ^ Body of the case+        -> Id           -- ^ A variable of the same type as the scrutinee+        -> CoreExpr     -- ^ Scrutinee+        -> CoreExpr++mkSmallTupleCase [var] body _scrut_var scrut+  = bindNonRec var scrut body+mkSmallTupleCase vars body scrut_var scrut+-- One branch no refinement?+  = Case scrut scrut_var (exprType body)+         [(DataAlt (tupleDataCon Boxed (length vars)), vars, body)]++{-+************************************************************************+*                                                                      *+                Floats+*                                                                      *+************************************************************************+-}++data FloatBind+  = FloatLet  CoreBind+  | FloatCase CoreExpr Id AltCon [Var]+      -- case e of y { C ys -> ... }+      -- See Note [Floating single-alternative cases] in SetLevels++instance Outputable FloatBind where+  ppr (FloatLet b) = text "LET" <+> ppr b+  ppr (FloatCase e b c bs) = hang (text "CASE" <+> ppr e <+> ptext (sLit "of") <+> ppr b)+                                2 (ppr c <+> ppr bs)++wrapFloat :: FloatBind -> CoreExpr -> CoreExpr+wrapFloat (FloatLet defns)       body = Let defns body+wrapFloat (FloatCase e b con bs) body = Case e b (exprType body) [(con, bs, body)]++-- | Applies the floats from right to left. That is @wrapFloats [b1, b2, …, bn]+-- u = let b1 in let b2 in … in let bn in u@+wrapFloats :: [FloatBind] -> CoreExpr -> CoreExpr+wrapFloats floats expr = foldr wrapFloat expr floats++bindBindings :: CoreBind -> [Var]+bindBindings (NonRec b _) = [b]+bindBindings (Rec bnds) = map fst bnds++floatBindings :: FloatBind -> [Var]+floatBindings (FloatLet bnd) = bindBindings bnd+floatBindings (FloatCase _ b _ bs) = b:bs++{-+************************************************************************+*                                                                      *+\subsection{Common list manipulation expressions}+*                                                                      *+************************************************************************++Call the constructor Ids when building explicit lists, so that they+interact well with rules.+-}++-- | Makes a list @[]@ for lists of the specified type+mkNilExpr :: Type -> CoreExpr+mkNilExpr ty = mkCoreConApps nilDataCon [Type ty]++-- | Makes a list @(:)@ for lists of the specified type+mkConsExpr :: Type -> CoreExpr -> CoreExpr -> CoreExpr+mkConsExpr ty hd tl = mkCoreConApps consDataCon [Type ty, hd, tl]++-- | Make a list containing the given expressions, where the list has the given type+mkListExpr :: Type -> [CoreExpr] -> CoreExpr+mkListExpr ty xs = foldr (mkConsExpr ty) (mkNilExpr ty) xs++-- | Make a fully applied 'foldr' expression+mkFoldrExpr :: MonadThings m+            => Type             -- ^ Element type of the list+            -> Type             -- ^ Fold result type+            -> CoreExpr         -- ^ "Cons" function expression for the fold+            -> CoreExpr         -- ^ "Nil" expression for the fold+            -> CoreExpr         -- ^ List expression being folded acress+            -> m CoreExpr+mkFoldrExpr elt_ty result_ty c n list = do+    foldr_id <- lookupId foldrName+    return (Var foldr_id `App` Type elt_ty+           `App` Type result_ty+           `App` c+           `App` n+           `App` list)++-- | Make a 'build' expression applied to a locally-bound worker function+mkBuildExpr :: (MonadFail.MonadFail m, MonadThings m, MonadUnique m)+            => Type                                     -- ^ Type of list elements to be built+            -> ((Id, Type) -> (Id, Type) -> m CoreExpr) -- ^ Function that, given information about the 'Id's+                                                        -- of the binders for the build worker function, returns+                                                        -- the body of that worker+            -> m CoreExpr+mkBuildExpr elt_ty mk_build_inside = do+    [n_tyvar] <- newTyVars [alphaTyVar]+    let n_ty = mkTyVarTy n_tyvar+        c_ty = mkVisFunTys [elt_ty, n_ty] n_ty+    [c, n] <- sequence [mkSysLocalM (fsLit "c") c_ty, mkSysLocalM (fsLit "n") n_ty]++    build_inside <- mk_build_inside (c, c_ty) (n, n_ty)++    build_id <- lookupId buildName+    return $ Var build_id `App` Type elt_ty `App` mkLams [n_tyvar, c, n] build_inside+  where+    newTyVars tyvar_tmpls = do+      uniqs <- getUniquesM+      return (zipWith setTyVarUnique tyvar_tmpls uniqs)++{-+************************************************************************+*                                                                      *+             Manipulating Maybe data type+*                                                                      *+************************************************************************+-}+++-- | Makes a Nothing for the specified type+mkNothingExpr :: Type -> CoreExpr+mkNothingExpr ty = mkConApp nothingDataCon [Type ty]++-- | Makes a Just from a value of the specified type+mkJustExpr :: Type -> CoreExpr -> CoreExpr+mkJustExpr ty val = mkConApp justDataCon [Type ty, val]+++{-+************************************************************************+*                                                                      *+                      Error expressions+*                                                                      *+************************************************************************+-}++mkRuntimeErrorApp+        :: Id           -- Should be of type (forall a. Addr# -> a)+                        --      where Addr# points to a UTF8 encoded string+        -> Type         -- The type to instantiate 'a'+        -> String       -- The string to print+        -> CoreExpr++mkRuntimeErrorApp err_id res_ty err_msg+  = mkApps (Var err_id) [ Type (getRuntimeRep res_ty)+                        , Type res_ty, err_string ]+  where+    err_string = Lit (mkLitString err_msg)++mkImpossibleExpr :: Type -> CoreExpr+mkImpossibleExpr res_ty+  = mkRuntimeErrorApp rUNTIME_ERROR_ID res_ty "Impossible case alternative"++{-+************************************************************************+*                                                                      *+                     Error Ids+*                                                                      *+************************************************************************++GHC randomly injects these into the code.++@patError@ is just a version of @error@ for pattern-matching+failures.  It knows various ``codes'' which expand to longer+strings---this saves space!++@absentErr@ is a thing we put in for ``absent'' arguments.  They jolly+well shouldn't be yanked on, but if one is, then you will get a+friendly message from @absentErr@ (rather than a totally random+crash).++@parError@ is a special version of @error@ which the compiler does+not know to be a bottoming Id.  It is used in the @_par_@ and @_seq_@+templates, but we don't ever expect to generate code for it.+-}++errorIds :: [Id]+errorIds+  = [ rUNTIME_ERROR_ID,+      nON_EXHAUSTIVE_GUARDS_ERROR_ID,+      nO_METHOD_BINDING_ERROR_ID,+      pAT_ERROR_ID,+      rEC_CON_ERROR_ID,+      rEC_SEL_ERROR_ID,+      aBSENT_ERROR_ID,+      tYPE_ERROR_ID   -- Used with Opt_DeferTypeErrors, see #10284+      ]++recSelErrorName, runtimeErrorName, absentErrorName :: Name+recConErrorName, patErrorName :: Name+nonExhaustiveGuardsErrorName, noMethodBindingErrorName :: Name+typeErrorName :: Name+absentSumFieldErrorName :: Name++recSelErrorName     = err_nm "recSelError"     recSelErrorIdKey     rEC_SEL_ERROR_ID+absentErrorName     = err_nm "absentError"     absentErrorIdKey     aBSENT_ERROR_ID+absentSumFieldErrorName = err_nm "absentSumFieldError"  absentSumFieldErrorIdKey+                            aBSENT_SUM_FIELD_ERROR_ID+runtimeErrorName    = err_nm "runtimeError"    runtimeErrorIdKey    rUNTIME_ERROR_ID+recConErrorName     = err_nm "recConError"     recConErrorIdKey     rEC_CON_ERROR_ID+patErrorName        = err_nm "patError"        patErrorIdKey        pAT_ERROR_ID+typeErrorName       = err_nm "typeError"       typeErrorIdKey       tYPE_ERROR_ID++noMethodBindingErrorName     = err_nm "noMethodBindingError"+                                  noMethodBindingErrorIdKey nO_METHOD_BINDING_ERROR_ID+nonExhaustiveGuardsErrorName = err_nm "nonExhaustiveGuardsError"+                                  nonExhaustiveGuardsErrorIdKey nON_EXHAUSTIVE_GUARDS_ERROR_ID++err_nm :: String -> Unique -> Id -> Name+err_nm str uniq id = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit str) uniq id++rEC_SEL_ERROR_ID, rUNTIME_ERROR_ID, rEC_CON_ERROR_ID :: Id+pAT_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id+tYPE_ERROR_ID, aBSENT_ERROR_ID, aBSENT_SUM_FIELD_ERROR_ID :: Id+rEC_SEL_ERROR_ID                = mkRuntimeErrorId recSelErrorName+rUNTIME_ERROR_ID                = mkRuntimeErrorId runtimeErrorName+rEC_CON_ERROR_ID                = mkRuntimeErrorId recConErrorName+pAT_ERROR_ID                    = mkRuntimeErrorId patErrorName+nO_METHOD_BINDING_ERROR_ID      = mkRuntimeErrorId noMethodBindingErrorName+nON_EXHAUSTIVE_GUARDS_ERROR_ID  = mkRuntimeErrorId nonExhaustiveGuardsErrorName+tYPE_ERROR_ID                   = mkRuntimeErrorId typeErrorName++-- Note [aBSENT_SUM_FIELD_ERROR_ID]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- Absent argument error for unused unboxed sum fields are different than absent+-- error used in dummy worker functions (see `mkAbsentErrorApp`):+--+-- - `absentSumFieldError` can't take arguments because it's used in unarise for+--   unused pointer fields in unboxed sums, and applying an argument would+--   require allocating a thunk.+--+-- - `absentSumFieldError` can't be CAFFY because that would mean making some+--   non-CAFFY definitions that use unboxed sums CAFFY in unarise.+--+--   To make `absentSumFieldError` non-CAFFY we get a stable pointer to it in+--   RtsStartup.c and mark it as non-CAFFY here.+--+-- Getting this wrong causes hard-to-debug runtime issues, see #15038.+--+-- TODO: Remove stable pointer hack after fixing #9718.+--       However, we should still be careful about not making things CAFFY just+--       because they use unboxed sums. Unboxed objects are supposed to be+--       efficient, and none of the other unboxed literals make things CAFFY.++aBSENT_SUM_FIELD_ERROR_ID+  = mkVanillaGlobalWithInfo absentSumFieldErrorName+      (mkSpecForAllTys [alphaTyVar] (mkTyVarTy alphaTyVar)) -- forall a . a+      (vanillaIdInfo `setStrictnessInfo` mkClosedStrictSig [] botRes+                     `setArityInfo` 0+                     `setCafInfo` NoCafRefs) -- #15038++mkRuntimeErrorId :: Name -> Id+-- Error function+--   with type:  forall (r:RuntimeRep) (a:TYPE r). Addr# -> a+--   with arity: 1+-- which diverges after being given one argument+-- The Addr# is expected to be the address of+--   a UTF8-encoded error string+mkRuntimeErrorId name+ = mkVanillaGlobalWithInfo name runtimeErrorTy bottoming_info+ where+    bottoming_info = vanillaIdInfo `setStrictnessInfo`    strict_sig+                                   `setArityInfo`         1+                        -- Make arity and strictness agree++        -- Do *not* mark them as NoCafRefs, because they can indeed have+        -- CAF refs.  For example, pAT_ERROR_ID calls GHC.Err.untangle,+        -- which has some CAFs+        -- In due course we may arrange that these error-y things are+        -- regarded by the GC as permanently live, in which case we+        -- can give them NoCaf info.  As it is, any function that calls+        -- any pc_bottoming_Id will itself have CafRefs, which bloats+        -- SRTs.++    strict_sig = mkClosedStrictSig [evalDmd] botRes++runtimeErrorTy :: Type+-- forall (rr :: RuntimeRep) (a :: rr). Addr# -> a+--   See Note [Error and friends have an "open-tyvar" forall]+runtimeErrorTy = mkSpecForAllTys [runtimeRep1TyVar, openAlphaTyVar]+                                 (mkVisFunTy addrPrimTy openAlphaTy)++{- Note [Error and friends have an "open-tyvar" forall]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+'error' and 'undefined' have types+        error     :: forall (v :: RuntimeRep) (a :: TYPE v). String -> a+        undefined :: forall (v :: RuntimeRep) (a :: TYPE v). a+Notice the runtime-representation polymorphism. This ensures that+"error" can be instantiated at unboxed as well as boxed types.+This is OK because it never returns, so the return type is irrelevant.+++************************************************************************+*                                                                      *+                     aBSENT_ERROR_ID+*                                                                      *+************************************************************************++Note [aBSENT_ERROR_ID]+~~~~~~~~~~~~~~~~~~~~~~+We use aBSENT_ERROR_ID to build dummy values in workers.  E.g.++   f x = (case x of (a,b) -> b) + 1::Int++The demand analyser figures ot that only the second component of x is+used, and does a w/w split thus++   f x = case x of (a,b) -> $wf b++   $wf b = let a = absentError "blah"+               x = (a,b)+           in <the original RHS of f>++After some simplification, the (absentError "blah") thunk goes away.++------ Tricky wrinkle -------+#14285 had, roughly++   data T a = MkT a !a+   {-# INLINABLE f #-}+   f x = case x of MkT a b -> g (MkT b a)++It turned out that g didn't use the second component, and hence f doesn't use+the first.  But the stable-unfolding for f looks like+   \x. case x of MkT a b -> g ($WMkT b a)+where $WMkT is the wrapper for MkT that evaluates its arguments.  We+apply the same w/w split to this unfolding (see Note [Worker-wrapper+for INLINEABLE functions] in WorkWrap) so the template ends up like+   \b. let a = absentError "blah"+           x = MkT a b+        in case x of MkT a b -> g ($WMkT b a)++After doing case-of-known-constructor, and expanding $WMkT we get+   \b -> g (case absentError "blah" of a -> MkT b a)++Yikes!  That bogusly appears to evaluate the absentError!++This is extremely tiresome.  Another way to think of this is that, in+Core, it is an invariant that a strict data contructor, like MkT, must+be applied only to an argument in HNF. So (absentError "blah") had+better be non-bottom.++So the "solution" is to add a special case for absentError to exprIsHNFlike.+This allows Simplify.rebuildCase, in the Note [Case to let transformation]+branch, to convert the case on absentError into a let. We also make+absentError *not* be diverging, unlike the other error-ids, so that we+can be sure not to remove the case branches before converting the case to+a let.++If, by some bug or bizarre happenstance, we ever call absentError, we should+throw an exception.  This should never happen, of course, but we definitely+can't return anything.  e.g. if somehow we had+    case absentError "foo" of+       Nothing -> ...+       Just x  -> ...+then if we return, the case expression will select a field and continue.+Seg fault city. Better to throw an exception. (Even though we've said+it is in HNF :-)++It might seem a bit surprising that seq on absentError is simply erased++    absentError "foo" `seq` x ==> x++but that should be okay; since there's no pattern match we can't really+be relying on anything from it.+-}++aBSENT_ERROR_ID+ = mkVanillaGlobalWithInfo absentErrorName absent_ty arity_info+ where+   absent_ty = mkSpecForAllTys [alphaTyVar] (mkVisFunTy addrPrimTy alphaTy)+   -- Not runtime-rep polymorphic. aBSENT_ERROR_ID is only used for+   -- lifted-type things; see Note [Absent errors] in WwLib+   arity_info = vanillaIdInfo `setArityInfo` 1+   -- NB: no bottoming strictness info, unlike other error-ids.+   -- See Note [aBSENT_ERROR_ID]++mkAbsentErrorApp :: Type         -- The type to instantiate 'a'+                 -> String       -- The string to print+                 -> CoreExpr++mkAbsentErrorApp res_ty err_msg+  = mkApps (Var aBSENT_ERROR_ID) [ Type res_ty, err_string ]+  where+    err_string = Lit (mkLitString err_msg)
+ compiler/coreSyn/PprCore.hs view
@@ -0,0 +1,620 @@+{-+(c) The University of Glasgow 2006+(c) The AQUA Project, Glasgow University, 1996-1998+++Printing of Core syntax+-}++{-# LANGUAGE MultiWayIf #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module PprCore (+        pprCoreExpr, pprParendExpr,+        pprCoreBinding, pprCoreBindings, pprCoreAlt,+        pprCoreBindingWithSize, pprCoreBindingsWithSize,+        pprRules, pprOptCo+    ) where++import GhcPrelude++import CoreSyn+import CoreStats (exprStats)+import Literal( pprLiteral )+import Name( pprInfixName, pprPrefixName )+import Var+import Id+import IdInfo+import Demand+import DataCon+import TyCon+import Type+import Coercion+import DynFlags+import BasicTypes+import Maybes+import Util+import Outputable+import FastString+import SrcLoc      ( pprUserRealSpan )++{-+************************************************************************+*                                                                      *+\subsection{Public interfaces for Core printing (excluding instances)}+*                                                                      *+************************************************************************++@pprParendCoreExpr@ puts parens around non-atomic Core expressions.+-}++pprCoreBindings :: OutputableBndr b => [Bind b] -> SDoc+pprCoreBinding  :: OutputableBndr b => Bind b  -> SDoc+pprCoreExpr     :: OutputableBndr b => Expr b  -> SDoc+pprParendExpr   :: OutputableBndr b => Expr b  -> SDoc++pprCoreBindings = pprTopBinds noAnn+pprCoreBinding  = pprTopBind noAnn++pprCoreBindingsWithSize :: [CoreBind] -> SDoc+pprCoreBindingWithSize  :: CoreBind  -> SDoc++pprCoreBindingsWithSize = pprTopBinds sizeAnn+pprCoreBindingWithSize = pprTopBind sizeAnn++instance OutputableBndr b => Outputable (Bind b) where+    ppr bind = ppr_bind noAnn bind++instance OutputableBndr b => Outputable (Expr b) where+    ppr expr = pprCoreExpr expr++{-+************************************************************************+*                                                                      *+\subsection{The guts}+*                                                                      *+************************************************************************+-}++-- | A function to produce an annotation for a given right-hand-side+type Annotation b = Expr b -> SDoc++-- | Annotate with the size of the right-hand-side+sizeAnn :: CoreExpr -> SDoc+sizeAnn e = text "-- RHS size:" <+> ppr (exprStats e)++-- | No annotation+noAnn :: Expr b -> SDoc+noAnn _ = empty++pprTopBinds :: OutputableBndr a+            => Annotation a -- ^ generate an annotation to place before the+                            -- binding+            -> [Bind a]     -- ^ bindings to show+            -> SDoc         -- ^ the pretty result+pprTopBinds ann binds = vcat (map (pprTopBind ann) binds)++pprTopBind :: OutputableBndr a => Annotation a -> Bind a -> SDoc+pprTopBind ann (NonRec binder expr)+ = ppr_binding ann (binder,expr) $$ blankLine++pprTopBind _ (Rec [])+  = text "Rec { }"+pprTopBind ann (Rec (b:bs))+  = vcat [text "Rec {",+          ppr_binding ann b,+          vcat [blankLine $$ ppr_binding ann b | b <- bs],+          text "end Rec }",+          blankLine]++ppr_bind :: OutputableBndr b => Annotation b -> Bind b -> SDoc++ppr_bind ann (NonRec val_bdr expr) = ppr_binding ann (val_bdr, expr)+ppr_bind ann (Rec binds)           = vcat (map pp binds)+                                    where+                                      pp bind = ppr_binding ann bind <> semi++ppr_binding :: OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc+ppr_binding ann (val_bdr, expr)+  = sdocWithDynFlags $ \dflags ->+      vcat [ ann expr+           , if gopt Opt_SuppressTypeSignatures dflags+               then empty+               else pprBndr LetBind val_bdr+           , pp_bind+           ]+  where+    pp_bind = case bndrIsJoin_maybe val_bdr of+                Nothing -> pp_normal_bind+                Just ar -> pp_join_bind ar++    pp_normal_bind = hang (ppr val_bdr) 2 (equals <+> pprCoreExpr expr)++      -- For a join point of join arity n, we want to print j = \x1 ... xn -> e+      -- as "j x1 ... xn = e" to differentiate when a join point returns a+      -- lambda (the first rendering looks like a nullary join point returning+      -- an n-argument function).+    pp_join_bind join_arity+      | bndrs `lengthAtLeast` join_arity+      = hang (ppr val_bdr <+> sep (map (pprBndr LambdaBind) lhs_bndrs))+           2 (equals <+> pprCoreExpr rhs)+      | otherwise -- Yikes!  A join-binding with too few lambda+                  -- Lint will complain, but we don't want to crash+                  -- the pretty-printer else we can't see what's wrong+                  -- So refer to printing  j = e+      = pp_normal_bind+      where+        (bndrs, body) = collectBinders expr+        lhs_bndrs = take join_arity bndrs+        rhs       = mkLams (drop join_arity bndrs) body++pprParendExpr expr = ppr_expr parens expr+pprCoreExpr   expr = ppr_expr noParens expr++noParens :: SDoc -> SDoc+noParens pp = pp++pprOptCo :: Coercion -> SDoc+-- Print a coercion optionally; i.e. honouring -dsuppress-coercions+pprOptCo co = sdocWithDynFlags $ \dflags ->+              if gopt Opt_SuppressCoercions dflags+              then angleBrackets (text "Co:" <> int (coercionSize co))+              else parens (sep [ppr co, dcolon <+> ppr (coercionType co)])++ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc+        -- The function adds parens in context that need+        -- an atomic value (e.g. function args)++ppr_expr add_par (Var name)+ | isJoinId name               = add_par ((text "jump") <+> ppr name)+ | otherwise                   = ppr name+ppr_expr add_par (Type ty)     = add_par (text "TYPE:" <+> ppr ty)       -- Weird+ppr_expr add_par (Coercion co) = add_par (text "CO:" <+> ppr co)+ppr_expr add_par (Lit lit)     = pprLiteral add_par lit++ppr_expr add_par (Cast expr co)+  = add_par $ sep [pprParendExpr expr, text "`cast`" <+> pprOptCo co]++ppr_expr add_par expr@(Lam _ _)+  = let+        (bndrs, body) = collectBinders expr+    in+    add_par $+    hang (text "\\" <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow)+         2 (pprCoreExpr body)++ppr_expr add_par expr@(App {})+  = sdocWithDynFlags $ \dflags ->+    case collectArgs expr of { (fun, args) ->+    let+        pp_args     = sep (map pprArg args)+        val_args    = dropWhile isTypeArg args   -- Drop the type arguments for tuples+        pp_tup_args = pprWithCommas pprCoreExpr val_args+        args'+          | gopt Opt_SuppressTypeApplications dflags = val_args+          | otherwise = args+        parens+          | null args' = id+          | otherwise  = add_par+    in+    case fun of+        Var f -> case isDataConWorkId_maybe f of+                        -- Notice that we print the *worker*+                        -- for tuples in paren'd format.+                   Just dc | saturated+                           , Just sort <- tyConTuple_maybe tc+                           -> tupleParens sort pp_tup_args+                           where+                             tc        = dataConTyCon dc+                             saturated = val_args `lengthIs` idArity f++                   _ -> parens (hang fun_doc 2 pp_args)+                   where+                     fun_doc | isJoinId f = text "jump" <+> ppr f+                             | otherwise  = ppr f++        _ -> parens (hang (pprParendExpr fun) 2 pp_args)+    }++ppr_expr add_par (Case expr var ty [(con,args,rhs)])+  = sdocWithDynFlags $ \dflags ->+    if gopt Opt_PprCaseAsLet dflags+    then add_par $  -- See Note [Print case as let]+         sep [ sep [ text "let! {"+                     <+> ppr_case_pat con args+                     <+> text "~"+                     <+> ppr_bndr var+                   , text "<-" <+> ppr_expr id expr+                     <+> text "} in" ]+             , pprCoreExpr rhs+             ]+    else add_par $+         sep [sep [sep [ text "case" <+> pprCoreExpr expr+                       , whenPprDebug (text "return" <+> ppr ty)+                       , text "of" <+> ppr_bndr var+                       ]+                  , char '{' <+> ppr_case_pat con args <+> arrow+                  ]+              , pprCoreExpr rhs+              , char '}'+              ]+  where+    ppr_bndr = pprBndr CaseBind++ppr_expr add_par (Case expr var ty alts)+  = add_par $+    sep [sep [text "case"+                <+> pprCoreExpr expr+                <+> whenPprDebug (text "return" <+> ppr ty),+              text "of" <+> ppr_bndr var <+> char '{'],+         nest 2 (vcat (punctuate semi (map pprCoreAlt alts))),+         char '}'+    ]+  where+    ppr_bndr = pprBndr CaseBind+++-- special cases: let ... in let ...+-- ("disgusting" SLPJ)++{-+ppr_expr add_par (Let bind@(NonRec val_bdr rhs@(Let _ _)) body)+  = add_par $+    vcat [+      hsep [text "let {", (pprBndr LetBind val_bdr $$ ppr val_bndr), equals],+      nest 2 (pprCoreExpr rhs),+      text "} in",+      pprCoreExpr body ]++ppr_expr add_par (Let bind@(NonRec val_bdr rhs) expr@(Let _ _))+  = add_par+    (hang (text "let {")+          2 (hsep [ppr_binding (val_bdr,rhs),+                   text "} in"])+     $$+     pprCoreExpr expr)+-}+++-- General case (recursive case, too)+ppr_expr add_par (Let bind expr)+  = add_par $+    sep [hang (keyword bind <+> char '{') 2 (ppr_bind noAnn bind <+> text "} in"),+         pprCoreExpr expr]+  where+    keyword (NonRec b _)+     | isJust (bndrIsJoin_maybe b) = text "join"+     | otherwise                   = text "let"+    keyword (Rec pairs)+     | ((b,_):_) <- pairs+     , isJust (bndrIsJoin_maybe b) = text "joinrec"+     | otherwise                   = text "letrec"++ppr_expr add_par (Tick tickish expr)+  = sdocWithDynFlags $ \dflags ->+  if gopt Opt_SuppressTicks dflags+  then ppr_expr add_par expr+  else add_par (sep [ppr tickish, pprCoreExpr expr])++pprCoreAlt :: OutputableBndr a => (AltCon, [a] , Expr a) -> SDoc+pprCoreAlt (con, args, rhs)+  = hang (ppr_case_pat con args <+> arrow) 2 (pprCoreExpr rhs)++ppr_case_pat :: OutputableBndr a => AltCon -> [a] -> SDoc+ppr_case_pat (DataAlt dc) args+  | Just sort <- tyConTuple_maybe tc+  = tupleParens sort (pprWithCommas ppr_bndr args)+  where+    ppr_bndr = pprBndr CasePatBind+    tc = dataConTyCon dc++ppr_case_pat con args+  = ppr con <+> (fsep (map ppr_bndr args))+  where+    ppr_bndr = pprBndr CasePatBind+++-- | Pretty print the argument in a function application.+pprArg :: OutputableBndr a => Expr a -> SDoc+pprArg (Type ty)+ = sdocWithDynFlags $ \dflags ->+   if gopt Opt_SuppressTypeApplications dflags+   then empty+   else text "@" <+> pprParendType ty+pprArg (Coercion co) = text "@~" <+> pprOptCo co+pprArg expr          = pprParendExpr expr++{-+Note [Print case as let]+~~~~~~~~~~~~~~~~~~~~~~~~+Single-branch case expressions are very common:+   case x of y { I# x' ->+   case p of q { I# p' -> ... } }+These are, in effect, just strict let's, with pattern matching.+With -dppr-case-as-let we print them as such:+   let! { I# x' ~ y <- x } in+   let! { I# p' ~ q <- p } in ...+++Other printing bits-and-bobs used with the general @pprCoreBinding@+and @pprCoreExpr@ functions.+++Note [Binding-site specific printing]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++pprCoreBinder and pprTypedLamBinder receive a BindingSite argument to adjust+the information printed.++Let-bound binders are printed with their full type and idInfo.++Case-bound variables (both the case binder and pattern variables) are printed+without a type and without their unfolding.++Furthermore, a dead case-binder is completely ignored, while otherwise, dead+binders are printed as "_".+-}++-- These instances are sadly orphans++instance OutputableBndr Var where+  pprBndr = pprCoreBinder+  pprInfixOcc  = pprInfixName  . varName+  pprPrefixOcc = pprPrefixName . varName+  bndrIsJoin_maybe = isJoinId_maybe++instance Outputable b => OutputableBndr (TaggedBndr b) where+  pprBndr _    b = ppr b   -- Simple+  pprInfixOcc  b = ppr b+  pprPrefixOcc b = ppr b+  bndrIsJoin_maybe (TB b _) = isJoinId_maybe b++pprCoreBinder :: BindingSite -> Var -> SDoc+pprCoreBinder LetBind binder+  | isTyVar binder = pprKindedTyVarBndr binder+  | otherwise      = pprTypedLetBinder binder $$+                     ppIdInfo binder (idInfo binder)++-- Lambda bound type variables are preceded by "@"+pprCoreBinder bind_site bndr+  = getPprStyle $ \ sty ->+    pprTypedLamBinder bind_site (debugStyle sty) bndr++pprUntypedBinder :: Var -> SDoc+pprUntypedBinder binder+  | isTyVar binder = text "@" <+> ppr binder    -- NB: don't print kind+  | otherwise      = pprIdBndr binder++pprTypedLamBinder :: BindingSite -> Bool -> Var -> SDoc+-- For lambda and case binders, show the unfolding info (usually none)+pprTypedLamBinder bind_site debug_on var+  = sdocWithDynFlags $ \dflags ->+    case () of+    _+      | not debug_on            -- Show case-bound wild binders only if debug is on+      , CaseBind <- bind_site+      , isDeadBinder var        -> empty++      | not debug_on            -- Even dead binders can be one-shot+      , isDeadBinder var        -> char '_' <+> ppWhen (isId var)+                                                (pprIdBndrInfo (idInfo var))++      | not debug_on            -- No parens, no kind info+      , CaseBind <- bind_site   -> pprUntypedBinder var++      | not debug_on+      , CasePatBind <- bind_site    -> pprUntypedBinder var++      | suppress_sigs dflags    -> pprUntypedBinder var++      | isTyVar var  -> parens (pprKindedTyVarBndr var)++      | otherwise    -> parens (hang (pprIdBndr var)+                                   2 (vcat [ dcolon <+> pprType (idType var)+                                           , pp_unf]))+  where+    suppress_sigs = gopt Opt_SuppressTypeSignatures++    unf_info = unfoldingInfo (idInfo var)+    pp_unf | hasSomeUnfolding unf_info = text "Unf=" <> ppr unf_info+           | otherwise                 = empty++pprTypedLetBinder :: Var -> SDoc+-- Print binder with a type or kind signature (not paren'd)+pprTypedLetBinder binder+  = sdocWithDynFlags $ \dflags ->+    case () of+    _+      | isTyVar binder                         -> pprKindedTyVarBndr binder+      | gopt Opt_SuppressTypeSignatures dflags -> pprIdBndr binder+      | otherwise                              -> hang (pprIdBndr binder) 2 (dcolon <+> pprType (idType binder))++pprKindedTyVarBndr :: TyVar -> SDoc+-- Print a type variable binder with its kind (but not if *)+pprKindedTyVarBndr tyvar+  = text "@" <+> pprTyVar tyvar++-- pprIdBndr does *not* print the type+-- When printing any Id binder in debug mode, we print its inline pragma and one-shot-ness+pprIdBndr :: Id -> SDoc+pprIdBndr id = ppr id <+> pprIdBndrInfo (idInfo id)++pprIdBndrInfo :: IdInfo -> SDoc+pprIdBndrInfo info+  = sdocWithDynFlags $ \dflags ->+    ppUnless (gopt Opt_SuppressIdInfo dflags) $+    info `seq` doc -- The seq is useful for poking on black holes+  where+    prag_info = inlinePragInfo info+    occ_info  = occInfo info+    dmd_info  = demandInfo info+    lbv_info  = oneShotInfo info++    has_prag  = not (isDefaultInlinePragma prag_info)+    has_occ   = not (isManyOccs occ_info)+    has_dmd   = not $ isTopDmd dmd_info+    has_lbv   = not (hasNoOneShotInfo lbv_info)++    doc = showAttributes+          [ (has_prag, text "InlPrag=" <> pprInlineDebug prag_info)+          , (has_occ,  text "Occ=" <> ppr occ_info)+          , (has_dmd,  text "Dmd=" <> ppr dmd_info)+          , (has_lbv , text "OS=" <> ppr lbv_info)+          ]++{-+-----------------------------------------------------+--      IdDetails and IdInfo+-----------------------------------------------------+-}++ppIdInfo :: Id -> IdInfo -> SDoc+ppIdInfo id info+  = sdocWithDynFlags $ \dflags ->+    ppUnless (gopt Opt_SuppressIdInfo dflags) $+    showAttributes+    [ (True, pp_scope <> ppr (idDetails id))+    , (has_arity,        text "Arity=" <> int arity)+    , (has_called_arity, text "CallArity=" <> int called_arity)+    , (has_caf_info,     text "Caf=" <> ppr caf_info)+    , (has_str_info,     text "Str=" <> pprStrictness str_info)+    , (has_unf,          text "Unf=" <> ppr unf_info)+    , (not (null rules), text "RULES:" <+> vcat (map pprRule rules))+    ]   -- Inline pragma, occ, demand, one-shot info+        -- printed out with all binders (when debug is on);+        -- see PprCore.pprIdBndr+  where+    pp_scope | isGlobalId id   = text "GblId"+             | isExportedId id = text "LclIdX"+             | otherwise       = text "LclId"++    arity = arityInfo info+    has_arity = arity /= 0++    called_arity = callArityInfo info+    has_called_arity = called_arity /= 0++    caf_info = cafInfo info+    has_caf_info = not (mayHaveCafRefs caf_info)++    str_info = strictnessInfo info+    has_str_info = not (isTopSig str_info)++    unf_info = unfoldingInfo info+    has_unf = hasSomeUnfolding unf_info++    rules = ruleInfoRules (ruleInfo info)++showAttributes :: [(Bool,SDoc)] -> SDoc+showAttributes stuff+  | null docs = empty+  | otherwise = brackets (sep (punctuate comma docs))+  where+    docs = [d | (True,d) <- stuff]++{-+-----------------------------------------------------+--      Unfolding and UnfoldingGuidance+-----------------------------------------------------+-}++instance Outputable UnfoldingGuidance where+    ppr UnfNever  = text "NEVER"+    ppr (UnfWhen { ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok })+      = text "ALWAYS_IF" <>+        parens (text "arity="     <> int arity    <> comma <>+                text "unsat_ok="  <> ppr unsat_ok <> comma <>+                text "boring_ok=" <> ppr boring_ok)+    ppr (UnfIfGoodArgs { ug_args = cs, ug_size = size, ug_res = discount })+      = hsep [ text "IF_ARGS",+               brackets (hsep (map int cs)),+               int size,+               int discount ]++instance Outputable UnfoldingSource where+  ppr InlineCompulsory  = text "Compulsory"+  ppr InlineStable      = text "InlineStable"+  ppr InlineRhs         = text "<vanilla>"++instance Outputable Unfolding where+  ppr NoUnfolding                = text "No unfolding"+  ppr BootUnfolding              = text "No unfolding (from boot)"+  ppr (OtherCon cs)              = text "OtherCon" <+> ppr cs+  ppr (DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = args })+       = hang (text "DFun:" <+> ptext (sLit "\\")+                <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow)+            2 (ppr con <+> sep (map ppr args))+  ppr (CoreUnfolding { uf_src = src+                     , uf_tmpl=rhs, uf_is_top=top, uf_is_value=hnf+                     , uf_is_conlike=conlike, uf_is_work_free=wf+                     , uf_expandable=exp, uf_guidance=g })+        = text "Unf" <> braces (pp_info $$ pp_rhs)+    where+      pp_info = fsep $ punctuate comma+                [ text "Src="        <> ppr src+                , text "TopLvl="     <> ppr top+                , text "Value="      <> ppr hnf+                , text "ConLike="    <> ppr conlike+                , text "WorkFree="   <> ppr wf+                , text "Expandable=" <> ppr exp+                , text "Guidance="   <> ppr g ]+      pp_tmpl = sdocWithDynFlags $ \dflags ->+                ppUnless (gopt Opt_SuppressUnfoldings dflags) $+                text "Tmpl=" <+> ppr rhs+      pp_rhs | isStableSource src = pp_tmpl+             | otherwise          = empty+            -- Don't print the RHS or we get a quadratic+            -- blowup in the size of the printout!++{-+-----------------------------------------------------+--      Rules+-----------------------------------------------------+-}++instance Outputable CoreRule where+   ppr = pprRule++pprRules :: [CoreRule] -> SDoc+pprRules rules = vcat (map pprRule rules)++pprRule :: CoreRule -> SDoc+pprRule (BuiltinRule { ru_fn = fn, ru_name = name})+  = text "Built in rule for" <+> ppr fn <> colon <+> doubleQuotes (ftext name)++pprRule (Rule { ru_name = name, ru_act = act, ru_fn = fn,+                ru_bndrs = tpl_vars, ru_args = tpl_args,+                ru_rhs = rhs })+  = hang (doubleQuotes (ftext name) <+> ppr act)+       4 (sep [text "forall" <+>+                  sep (map (pprCoreBinder LambdaBind) tpl_vars) <> dot,+               nest 2 (ppr fn <+> sep (map pprArg tpl_args)),+               nest 2 (text "=" <+> pprCoreExpr rhs)+            ])++{-+-----------------------------------------------------+--      Tickish+-----------------------------------------------------+-}++instance Outputable id => Outputable (Tickish id) where+  ppr (HpcTick modl ix) =+      hcat [text "hpc<",+            ppr modl, comma,+            ppr ix,+            text ">"]+  ppr (Breakpoint ix vars) =+      hcat [text "break<",+            ppr ix,+            text ">",+            parens (hcat (punctuate comma (map ppr vars)))]+  ppr (ProfNote { profNoteCC = cc,+                  profNoteCount = tick,+                  profNoteScope = scope }) =+      case (tick,scope) of+         (True,True)  -> hcat [text "scctick<", ppr cc, char '>']+         (True,False) -> hcat [text "tick<",    ppr cc, char '>']+         _            -> hcat [text "scc<",     ppr cc, char '>']+  ppr (SourceNote span _) =+      hcat [ text "src<", pprUserRealSpan True span, char '>']+
+ compiler/deSugar/PmExpr.hs view
@@ -0,0 +1,466 @@+{-+Author: George Karachalias <george.karachalias@cs.kuleuven.be>++Haskell expressions (as used by the pattern matching checker) and utilities.+-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE ViewPatterns #-}++module PmExpr (+        PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit,+        truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther,+        lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex,+        pprPmExprWithParens, runPmPprM+    ) where++#include "HsVersions.h"++import GhcPrelude++import BasicTypes (SourceText)+import FastString (FastString, unpackFS)+import HsSyn+import Id+import Name+import NameSet+import DataCon+import ConLike+import TcType (isStringTy)+import TysWiredIn+import Outputable+import Util+import SrcLoc++import Data.Maybe (mapMaybe)+import Data.List (groupBy, sortBy, nubBy)+import Control.Monad.Trans.State.Lazy++{-+%************************************************************************+%*                                                                      *+                         Lifted Expressions+%*                                                                      *+%************************************************************************+-}++{- Note [PmExprOther in PmExpr]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Since there is no plan to extend the (currently pretty naive) term oracle in+the near future, instead of playing with the verbose (HsExpr Id), we lift it to+PmExpr. All expressions the term oracle does not handle are wrapped by the+constructor PmExprOther. Note that we do not perform substitution in+PmExprOther. Because of this, we do not even print PmExprOther, since they may+refer to variables that are otherwise substituted away.+-}++-- ----------------------------------------------------------------------------+-- ** Types++-- | Lifted expressions for pattern match checking.+data PmExpr = PmExprVar   Name+            | PmExprCon   ConLike [PmExpr]+            | PmExprLit   PmLit+            | PmExprEq    PmExpr PmExpr  -- Syntactic equality+            | PmExprOther (HsExpr GhcTc)  -- Note [PmExprOther in PmExpr]+++mkPmExprData :: DataCon -> [PmExpr] -> PmExpr+mkPmExprData dc args = PmExprCon (RealDataCon dc) args++-- | Literals (simple and overloaded ones) for pattern match checking.+data PmLit = PmSLit (HsLit GhcTc)                               -- simple+           | PmOLit Bool {- is it negated? -} (HsOverLit GhcTc) -- overloaded++-- | Equality between literals for pattern match checking.+eqPmLit :: PmLit -> PmLit -> Bool+eqPmLit (PmSLit    l1) (PmSLit    l2) = l1 == l2+eqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2+  -- See Note [Undecidable Equality for Overloaded Literals]+eqPmLit _              _              = False++{- Note [Undecidable Equality for Overloaded Literals]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Equality on overloaded literals is undecidable in the general case. Consider+the following example:++  instance Num Bool where+    ...+    fromInteger 0 = False -- C-like representation of booleans+    fromInteger _ = True++    f :: Bool -> ()+    f 1 = ()        -- Clause A+    f 2 = ()        -- Clause B++Clause B is redundant but to detect this, we should be able to solve the+constraint: False ~ (fromInteger 2 ~ fromInteger 1) which means that we+have to look through function `fromInteger`, whose implementation could+be anything. This poses difficulties for:++1. The expressive power of the check.+   We cannot expect a reasonable implementation of pattern matching to detect+   that fromInteger 2 ~ fromInteger 1 is True, unless we unfold function+   fromInteger. This puts termination at risk and is undecidable in the+   general case.++2. Performance.+   Having an unresolved constraint False ~ (fromInteger 2 ~ fromInteger 1)+   lying around could become expensive really fast. Ticket #11161 illustrates+   how heavy use of overloaded literals can generate plenty of those+   constraints, effectively undermining the term oracle's performance.++3. Error nessages/Warnings.+   What should our message for `f` above be? A reasonable approach would be+   to issue:++     Pattern matches are (potentially) redundant:+       f 2 = ...    under the assumption that 1 == 2++   but seems to complex and confusing for the user.++We choose to treat overloaded literals that look different as different. The+impact of this is the following:++  * Redundancy checking is rather conservative, since it cannot see that clause+    B above is redundant.++  * We have instant equality check for overloaded literals (we do not rely on+    the term oracle which is rather expensive, both in terms of performance and+    memory). This significantly improves the performance of functions `covered`+    `uncovered` and `divergent` in deSugar/Check.hs and effectively addresses+    #11161.++  * The warnings issued are simpler.++  * We do not play on the safe side, strictly speaking. The assumption that+    1 /= 2 makes the redundancy check more conservative but at the same time+    makes its dual (exhaustiveness check) unsafe. This we can live with, mainly+    for two reasons:+    1. At the moment we do not use the results of the check during compilation+       where this would be a disaster (could result in runtime errors even if+       our function was deemed exhaustive).+    2. Pattern matcing on literals can never be considered exhaustive unless we+       have a catch-all clause. Hence, this assumption affects mainly the+       appearance of the warnings and is, in practice safe.+-}++nubPmLit :: [PmLit] -> [PmLit]+nubPmLit = nubBy eqPmLit++-- | Term equalities+type SimpleEq  = (Id, PmExpr) -- We always use this orientation+type ComplexEq = (PmExpr, PmExpr)++-- | Lift a `SimpleEq` to a `ComplexEq`+toComplex :: SimpleEq -> ComplexEq+toComplex (x,e) = (PmExprVar (idName x), e)++-- | Expression `True'+truePmExpr :: PmExpr+truePmExpr = mkPmExprData trueDataCon []++-- | Expression `False'+falsePmExpr :: PmExpr+falsePmExpr = mkPmExprData falseDataCon []++-- ----------------------------------------------------------------------------+-- ** Predicates on PmExpr++-- | Check if an expression is lifted or not+isNotPmExprOther :: PmExpr -> Bool+isNotPmExprOther (PmExprOther _) = False+isNotPmExprOther _expr           = True++-- | Check whether a literal is negated+isNegatedPmLit :: PmLit -> Bool+isNegatedPmLit (PmOLit b _) = b+isNegatedPmLit _other_lit   = False++-- | Check whether a PmExpr is syntactically equal to term `True'.+isTruePmExpr :: PmExpr -> Bool+isTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon+isTruePmExpr _other_expr      = False++-- | Check whether a PmExpr is syntactically equal to term `False'.+isFalsePmExpr :: PmExpr -> Bool+isFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon+isFalsePmExpr _other_expr      = False++-- | Check whether a PmExpr is syntactically e+isNilPmExpr :: PmExpr -> Bool+isNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon+isNilPmExpr _other_expr     = False++-- | Check whether a PmExpr is syntactically equal to (x == y).+-- Since (==) is overloaded and can have an arbitrary implementation, we use+-- the PmExprEq constructor to represent only equalities with non-overloaded+-- literals where it coincides with a syntactic equality check.+isPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr)+isPmExprEq (PmExprEq e1 e2) = Just (e1,e2)+isPmExprEq _other_expr      = Nothing++-- | Check if a DataCon is (:).+isConsDataCon :: DataCon -> Bool+isConsDataCon con = consDataCon == con++-- ----------------------------------------------------------------------------+-- ** Substitution in PmExpr++-- | We return a boolean along with the expression. Hence, if substitution was+-- a no-op, we know that the expression still cannot progress.+substPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool)+substPmExpr x e1 e =+  case e of+    PmExprVar z | x == z    -> (e1, True)+                | otherwise -> (e, False)+    PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps+                      in  (PmExprCon c ps', or bs)+    PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex+                          (ey', by) = substPmExpr x e1 ey+                      in  (PmExprEq ex' ey', bx || by)+    _other_expr    -> (e, False) -- The rest are terminals (We silently ignore+                                 -- Other). See Note [PmExprOther in PmExpr]++-- | Substitute in a complex equality. We return (Left eq) if the substitution+-- affected the equality or (Right eq) if nothing happened.+substComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq+substComplexEq x e (ex, ey)+  | bx || by  = Left  (ex', ey')+  | otherwise = Right (ex', ey')+  where+    (ex', bx) = substPmExpr x e ex+    (ey', by) = substPmExpr x e ey++-- -----------------------------------------------------------------------+-- ** Lift source expressions (HsExpr Id) to PmExpr++lhsExprToPmExpr :: LHsExpr GhcTc -> PmExpr+lhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e++hsExprToPmExpr :: HsExpr GhcTc -> PmExpr++hsExprToPmExpr (HsVar        _ x) = PmExprVar (idName (unLoc x))+hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c)++-- Desugar literal strings as a list of characters. For other literal values,+-- keep it as it is.+-- See `translatePat` in Check.hs (the `NPat` and `LitPat` case), and+-- Note [Translate Overloaded Literal for Exhaustiveness Checking].+hsExprToPmExpr (HsOverLit _ olit)+  | OverLit (OverLitTc False ty) (HsIsString src s) _ <- olit, isStringTy ty+  = stringExprToList src s+  | otherwise = PmExprLit (PmOLit False olit)+hsExprToPmExpr (HsLit     _ lit)+  | HsString src s <- lit+  = stringExprToList src s+  | otherwise = PmExprLit (PmSLit lit)++hsExprToPmExpr e@(NegApp _ (dL->L _ neg_expr) _)+  | PmExprLit (PmOLit False olit) <- hsExprToPmExpr neg_expr+    -- NB: DON'T simply @(NegApp (NegApp olit))@ as @x@. when extension+    -- @RebindableSyntax@ enabled, (-(-x)) may not equals to x.+  = PmExprLit (PmOLit True olit)+  | otherwise = PmExprOther e++hsExprToPmExpr (HsPar _ (dL->L _ e)) = hsExprToPmExpr e++hsExprToPmExpr e@(ExplicitTuple _ ps boxity)+  | all tupArgPresent ps = mkPmExprData tuple_con tuple_args+  | otherwise            = PmExprOther e+  where+    tuple_con  = tupleDataCon boxity (length ps)+    tuple_args = [ lhsExprToPmExpr e | (dL->L _ (Present _ e)) <- ps ]++hsExprToPmExpr e@(ExplicitList _  mb_ol elems)+  | Nothing <- mb_ol = foldr cons nil (map lhsExprToPmExpr elems)+  | otherwise        = PmExprOther e {- overloaded list: No PmExprApp -}+  where+    cons x xs = mkPmExprData consDataCon [x,xs]+    nil       = mkPmExprData nilDataCon  []++-- we want this but we would have to make everything monadic :/+-- ./compiler/deSugar/DsMonad.hs:397:dsLookupDataCon :: Name -> DsM DataCon+--+-- hsExprToPmExpr (RecordCon   c _ binds) = do+--   con  <- dsLookupDataCon (unLoc c)+--   args <- mapM lhsExprToPmExpr (hsRecFieldsArgs binds)+--   return (PmExprCon con args)+hsExprToPmExpr e@(RecordCon {}) = PmExprOther e++hsExprToPmExpr (HsTick           _ _ e) = lhsExprToPmExpr e+hsExprToPmExpr (HsBinTick      _ _ _ e) = lhsExprToPmExpr e+hsExprToPmExpr (HsTickPragma _ _ _ _ e) = lhsExprToPmExpr e+hsExprToPmExpr (HsSCC          _ _ _ e) = lhsExprToPmExpr e+hsExprToPmExpr (HsCoreAnn      _ _ _ e) = lhsExprToPmExpr e+hsExprToPmExpr (ExprWithTySig    _ e _) = lhsExprToPmExpr e+hsExprToPmExpr (HsWrap           _ _ e) =  hsExprToPmExpr e+hsExprToPmExpr e = PmExprOther e -- the rest are not handled by the oracle++stringExprToList :: SourceText -> FastString -> PmExpr+stringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s))+  where+    cons x xs      = mkPmExprData consDataCon [x,xs]+    nil            = mkPmExprData nilDataCon  []+    charToPmExpr c = PmExprLit (PmSLit (HsChar src c))++{-+%************************************************************************+%*                                                                      *+                            Pretty printing+%*                                                                      *+%************************************************************************+-}++{- 1. Literals+~~~~~~~~~~~~~~+Starting with a function definition like:++    f :: Int -> Bool+    f 5 = True+    f 6 = True++The uncovered set looks like:+    { var |> False == (var == 5), False == (var == 6) }++Yet, we would like to print this nicely as follows:+   x , where x not one of {5,6}++Function `filterComplex' takes the set of residual constraints and packs+together the negative constraints that refer to the same variable so we can do+just this. Since these variables will be shown to the programmer, we also give+them better names (t1, t2, ..), hence the SDoc in PmNegLitCt.++2. Residual Constraints+~~~~~~~~~~~~~~~~~~~~~~~+Unhandled constraints that refer to HsExpr are typically ignored by the solver+(it does not even substitute in HsExpr so they are even printed as wildcards).+Additionally, the oracle returns a substitution if it succeeds so we apply this+substitution to the vectors before printing them out (see function `pprOne' in+Check.hs) to be more precice.+-}++-- -----------------------------------------------------------------------------+-- ** Transform residual constraints in appropriate form for pretty printing++type PmNegLitCt = (Name, (SDoc, [PmLit]))++filterComplex :: [ComplexEq] -> [PmNegLitCt]+filterComplex = zipWith rename nameList . map mkGroup+              . groupBy name . sortBy order . mapMaybe isNegLitCs+  where+    order x y = compare (fst x) (fst y)+    name  x y = fst x == fst y+    mkGroup l = (fst (head l), nubPmLit $ map snd l)+    rename new (old, lits) = (old, (new, lits))++    isNegLitCs (e1,e2)+      | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y+      | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y+      | otherwise = Nothing++    isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l)+    isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l)+    isNegLitCs' _ _             = Nothing++    -- Try nice names p,q,r,s,t before using the (ugly) t_i+    nameList :: [SDoc]+    nameList = map text ["p","q","r","s","t"] +++                 [ text ('t':show u) | u <- [(0 :: Int)..] ]++-- ----------------------------------------------------------------------------++runPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])])+runPmPprM m lit_env = (result, mapMaybe is_used lit_env)+  where+    (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet)++    is_used (x,(name, lits))+      | elemNameSet x used = Just (name, lits)+      | otherwise         = Nothing++type PmPprM a = State ([PmNegLitCt], NameSet) a+-- (the first part of the state is read only. make it a reader?)++addUsed :: Name -> PmPprM ()+addUsed x = modify (\(negated, used) -> (negated, extendNameSet used x))++checkNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated+checkNegation x = do+  negated <- gets fst+  return $ case lookup x negated of+    Just (new, _) -> Just new+    Nothing       -> Nothing++-- | Pretty print a pmexpr, but remember to prettify the names of the variables+-- that refer to neg-literals. The ones that cannot be shown are printed as+-- underscores.+pprPmExpr :: PmExpr -> PmPprM SDoc+pprPmExpr (PmExprVar x) = do+  mb_name <- checkNegation x+  case mb_name of+    Just name -> addUsed x >> return name+    Nothing   -> return underscore++pprPmExpr (PmExprCon con args) = pprPmExprCon con args+pprPmExpr (PmExprLit l)        = return (ppr l)+pprPmExpr (PmExprEq _ _)       = return underscore -- don't show+pprPmExpr (PmExprOther _)      = return underscore -- don't show++needsParens :: PmExpr -> Bool+needsParens (PmExprVar   {}) = False+needsParens (PmExprLit    l) = isNegatedPmLit l+needsParens (PmExprEq    {}) = False -- will become a wildcard+needsParens (PmExprOther {}) = False -- will become a wildcard+needsParens (PmExprCon (RealDataCon c) es)+  | isTupleDataCon c+  || isConsDataCon c || null es = False+  | otherwise                   = True+needsParens (PmExprCon (PatSynCon _) es) = not (null es)++pprPmExprWithParens :: PmExpr -> PmPprM SDoc+pprPmExprWithParens expr+  | needsParens expr = parens <$> pprPmExpr expr+  | otherwise        =            pprPmExpr expr++pprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc+pprPmExprCon (RealDataCon con) args+  | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args+  | isConsDataCon con  = pretty_list+  where+    mkTuple :: [SDoc] -> SDoc+    mkTuple = parens     . fsep . punctuate comma++    -- lazily, to be used in the list case only+    pretty_list :: PmPprM SDoc+    pretty_list = case isNilPmExpr (last list) of+      True  -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list)+      False -> parens   . hcat . punctuate colon <$> mapM pprPmExpr list++    list = list_elements args++    list_elements [x,y]+      | PmExprCon c es <- y,  RealDataCon nilDataCon == c+          = ASSERT(null es) [x,y]+      | PmExprCon c es <- y, RealDataCon consDataCon == c+          = x : list_elements es+      | otherwise = [x,y]+    list_elements list  = pprPanic "list_elements:" (ppr list)+pprPmExprCon cl args+  | conLikeIsInfix cl = case args of+      [x, y] -> do x' <- pprPmExprWithParens x+                   y' <- pprPmExprWithParens y+                   return (x' <+> ppr cl <+> y')+      -- can it be infix but have more than two arguments?+      list   -> pprPanic "pprPmExprCon:" (ppr list)+  | null args = return (ppr cl)+  | otherwise = do args' <- mapM pprPmExprWithParens args+                   return (fsep (ppr cl : args'))++instance Outputable PmLit where+  ppr (PmSLit     l) = pmPprHsLit l+  ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l++-- not really useful for pmexprs per se+instance Outputable PmExpr where+  ppr e = fst $ runPmPprM (pprPmExpr e) []
+ compiler/ghci/ByteCodeTypes.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-}+--+--  (c) The University of Glasgow 2002-2006+--++-- | Bytecode assembler types+module ByteCodeTypes+  ( CompiledByteCode(..), seqCompiledByteCode, FFIInfo(..)+  , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..)+  , ItblEnv, ItblPtr(..)+  , CgBreakInfo(..)+  , ModBreaks (..), BreakIndex, emptyModBreaks+  , CCostCentre+  ) where++import GhcPrelude++import FastString+import Id+import Name+import NameEnv+import Outputable+import PrimOp+import SizedSeq+import Type+import SrcLoc+import GHCi.BreakArray+import GHCi.RemoteTypes+import GHCi.FFI+import Control.DeepSeq++import Foreign+import Data.Array+import Data.Array.Base  ( UArray(..) )+import Data.ByteString (ByteString)+import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap+import GHC.Exts.Heap+import GHC.Stack.CCS++-- -----------------------------------------------------------------------------+-- Compiled Byte Code++data CompiledByteCode = CompiledByteCode+  { bc_bcos   :: [UnlinkedBCO]  -- Bunch of interpretable bindings+  , bc_itbls  :: ItblEnv        -- A mapping from DataCons to their itbls+  , bc_ffis   :: [FFIInfo]      -- ffi blocks we allocated+  , bc_strs   :: [RemotePtr ()] -- malloc'd strings+  , bc_breaks :: Maybe ModBreaks -- breakpoint info (Nothing if we're not+                                 -- creating breakpoints, for some reason)+  }+                -- ToDo: we're not tracking strings that we malloc'd+newtype FFIInfo = FFIInfo (RemotePtr C_ffi_cif)+  deriving (Show, NFData)++instance Outputable CompiledByteCode where+  ppr CompiledByteCode{..} = ppr bc_bcos++-- Not a real NFData instance, because ModBreaks contains some things+-- we can't rnf+seqCompiledByteCode :: CompiledByteCode -> ()+seqCompiledByteCode CompiledByteCode{..} =+  rnf bc_bcos `seq`+  rnf (nameEnvElts bc_itbls) `seq`+  rnf bc_ffis `seq`+  rnf bc_strs `seq`+  rnf (fmap seqModBreaks bc_breaks)++type ItblEnv = NameEnv (Name, ItblPtr)+        -- We need the Name in the range so we know which+        -- elements to filter out when unloading a module++newtype ItblPtr = ItblPtr (RemotePtr StgInfoTable)+  deriving (Show, NFData)++data UnlinkedBCO+   = UnlinkedBCO {+        unlinkedBCOName   :: !Name,+        unlinkedBCOArity  :: {-# UNPACK #-} !Int,+        unlinkedBCOInstrs :: !(UArray Int Word16),      -- insns+        unlinkedBCOBitmap :: !(UArray Int Word64),      -- bitmap+        unlinkedBCOLits   :: !(SizedSeq BCONPtr),       -- non-ptrs+        unlinkedBCOPtrs   :: !(SizedSeq BCOPtr)         -- ptrs+   }++instance NFData UnlinkedBCO where+  rnf UnlinkedBCO{..} =+    rnf unlinkedBCOLits `seq`+    rnf unlinkedBCOPtrs++data BCOPtr+  = BCOPtrName   !Name+  | BCOPtrPrimOp !PrimOp+  | BCOPtrBCO    !UnlinkedBCO+  | BCOPtrBreakArray  -- a pointer to this module's BreakArray++instance NFData BCOPtr where+  rnf (BCOPtrBCO bco) = rnf bco+  rnf x = x `seq` ()++data BCONPtr+  = BCONPtrWord  {-# UNPACK #-} !Word+  | BCONPtrLbl   !FastString+  | BCONPtrItbl  !Name+  | BCONPtrStr   !ByteString++instance NFData BCONPtr where+  rnf x = x `seq` ()++-- | Information about a breakpoint that we know at code-generation time+data CgBreakInfo+   = CgBreakInfo+   { cgb_vars   :: [(Id,Word16)]+   , cgb_resty  :: Type+   }++-- Not a real NFData instance because we can't rnf Id or Type+seqCgBreakInfo :: CgBreakInfo -> ()+seqCgBreakInfo CgBreakInfo{..} =+  rnf (map snd cgb_vars) `seq`+  seqType cgb_resty++instance Outputable UnlinkedBCO where+   ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)+      = sep [text "BCO", ppr nm, text "with",+             ppr (sizeSS lits), text "lits",+             ppr (sizeSS ptrs), text "ptrs" ]++instance Outputable CgBreakInfo where+   ppr info = text "CgBreakInfo" <+>+              parens (ppr (cgb_vars info) <+>+                      ppr (cgb_resty info))++-- -----------------------------------------------------------------------------+-- Breakpoints++-- | Breakpoint index+type BreakIndex = Int++-- | C CostCentre type+data CCostCentre++-- | All the information about the breakpoints for a module+data ModBreaks+   = ModBreaks+   { modBreaks_flags :: ForeignRef BreakArray+        -- ^ The array of flags, one per breakpoint,+        -- indicating which breakpoints are enabled.+   , modBreaks_locs :: !(Array BreakIndex SrcSpan)+        -- ^ An array giving the source span of each breakpoint.+   , modBreaks_vars :: !(Array BreakIndex [OccName])+        -- ^ An array giving the names of the free variables at each breakpoint.+   , modBreaks_decls :: !(Array BreakIndex [String])+        -- ^ An array giving the names of the declarations enclosing each breakpoint.+   , modBreaks_ccs :: !(Array BreakIndex (RemotePtr CostCentre))+        -- ^ Array pointing to cost centre for each breakpoint+   , modBreaks_breakInfo :: IntMap CgBreakInfo+        -- ^ info about each breakpoint from the bytecode generator+   }++seqModBreaks :: ModBreaks -> ()+seqModBreaks ModBreaks{..} =+  rnf modBreaks_flags `seq`+  rnf modBreaks_locs `seq`+  rnf modBreaks_vars `seq`+  rnf modBreaks_decls `seq`+  rnf modBreaks_ccs `seq`+  rnf (fmap seqCgBreakInfo modBreaks_breakInfo)++-- | Construct an empty ModBreaks+emptyModBreaks :: ModBreaks+emptyModBreaks = ModBreaks+   { modBreaks_flags = error "ModBreaks.modBreaks_array not initialised"+         -- ToDo: can we avoid this?+   , modBreaks_locs  = array (0,-1) []+   , modBreaks_vars  = array (0,-1) []+   , modBreaks_decls = array (0,-1) []+   , modBreaks_ccs = array (0,-1) []+   , modBreaks_breakInfo = IntMap.empty+   }
+ compiler/ghci/keepCAFsForGHCi.c view
@@ -0,0 +1,15 @@+#include "Rts.h"++// This file is only included in the dynamic library.+// It contains an __attribute__((constructor)) function (run prior to main())+// which sets the keepCAFs flag in the RTS, before any Haskell code is run.+// This is required so that GHCi can use dynamic libraries instead of HSxyz.o+// files.++static void keepCAFsForGHCi(void) __attribute__((constructor));++static void keepCAFsForGHCi(void)+{+    keepCAFs = 1;+}+
+ compiler/hsSyn/HsBinds.hs view
@@ -0,0 +1,1316 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[HsBinds]{Abstract syntax: top-level bindings and signatures}++Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.+-}++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]+                                      -- in module PlaceHolder+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TypeFamilies #-}++module HsBinds where++import GhcPrelude++import {-# SOURCE #-} HsExpr ( pprExpr, LHsExpr,+                               MatchGroup, pprFunBind,+                               GRHSs, pprPatBind )+import {-# SOURCE #-} HsPat  ( LPat )++import HsExtension+import HsTypes+import PprCore ()+import CoreSyn+import TcEvidence+import Type+import NameSet+import BasicTypes+import Outputable+import SrcLoc+import Var+import Bag+import FastString+import BooleanFormula (LBooleanFormula)+import DynFlags++import Data.Data hiding ( Fixity )+import Data.List hiding ( foldr )+import Data.Ord++{-+************************************************************************+*                                                                      *+\subsection{Bindings: @BindGroup@}+*                                                                      *+************************************************************************++Global bindings (where clauses)+-}++-- During renaming, we need bindings where the left-hand sides+-- have been renamed but the right-hand sides have not.+-- the ...LR datatypes are parametrized by two id types,+-- one for the left and one for the right.+-- Other than during renaming, these will be the same.++-- | Haskell Local Bindings+type HsLocalBinds id = HsLocalBindsLR id id++-- | Located Haskell local bindings+type LHsLocalBinds id = Located (HsLocalBinds id)++-- | Haskell Local Bindings with separate Left and Right identifier types+--+-- Bindings in a 'let' expression+-- or a 'where' clause+data HsLocalBindsLR idL idR+  = HsValBinds+        (XHsValBinds idL idR)+        (HsValBindsLR idL idR)+      -- ^ Haskell Value Bindings++         -- There should be no pattern synonyms in the HsValBindsLR+         -- These are *local* (not top level) bindings+         -- The parser accepts them, however, leaving the+         -- renamer to report them++  | HsIPBinds+        (XHsIPBinds idL idR)+        (HsIPBinds idR)+      -- ^ Haskell Implicit Parameter Bindings++  | EmptyLocalBinds (XEmptyLocalBinds idL idR)+      -- ^ Empty Local Bindings++  | XHsLocalBindsLR+        (XXHsLocalBindsLR idL idR)++type instance XHsValBinds      (GhcPass pL) (GhcPass pR) = NoExt+type instance XHsIPBinds       (GhcPass pL) (GhcPass pR) = NoExt+type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExt+type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExt++type LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR)+++-- | Haskell Value Bindings+type HsValBinds id = HsValBindsLR id id++-- | Haskell Value bindings with separate Left and Right identifier types+-- (not implicit parameters)+-- Used for both top level and nested bindings+-- May contain pattern synonym bindings+data HsValBindsLR idL idR+  = -- | Value Bindings In+    --+    -- Before renaming RHS; idR is always RdrName+    -- Not dependency analysed+    -- Recursive by default+    ValBinds+        (XValBinds idL idR)+        (LHsBindsLR idL idR) [LSig idR]++    -- | Value Bindings Out+    --+    -- After renaming RHS; idR can be Name or Id Dependency analysed,+    -- later bindings in the list may depend on earlier ones.+  | XValBindsLR+      (XXValBindsLR idL idR)++-- ---------------------------------------------------------------------+-- Deal with ValBindsOut++-- TODO: make this the only type for ValBinds+data NHsValBindsLR idL+  = NValBinds+      [(RecFlag, LHsBinds idL)]+      [LSig GhcRn]++type instance XValBinds    (GhcPass pL) (GhcPass pR) = NoExt+type instance XXValBindsLR (GhcPass pL) (GhcPass pR)+            = NHsValBindsLR (GhcPass pL)++-- ---------------------------------------------------------------------++-- | Located Haskell Binding+type LHsBind  id = LHsBindLR  id id++-- | Located Haskell Bindings+type LHsBinds id = LHsBindsLR id id++-- | Haskell Binding+type HsBind   id = HsBindLR   id id++-- | Located Haskell Bindings with separate Left and Right identifier types+type LHsBindsLR idL idR = Bag (LHsBindLR idL idR)++-- | Located Haskell Binding with separate Left and Right identifier types+type LHsBindLR  idL idR = Located (HsBindLR idL idR)++{- Note [FunBind vs PatBind]+   ~~~~~~~~~~~~~~~~~~~~~~~~~+The distinction between FunBind and PatBind is a bit subtle. FunBind covers+patterns which resemble function bindings and simple variable bindings.++    f x = e+    f !x = e+    f = e+    !x = e          -- FunRhs has SrcStrict+    x `f` y = e     -- FunRhs has Infix++The actual patterns and RHSs of a FunBind are encoding in fun_matches.+The m_ctxt field of each Match in fun_matches will be FunRhs and carries+two bits of information about the match,++  * The mc_fixity field on each Match describes the fixity of the+    function binder in that match.  E.g. this is legal:+         f True False  = e1+         True `f` True = e2++  * The mc_strictness field is used /only/ for nullary FunBinds: ones+    with one Match, which has no pats. For these, it describes whether+    the match is decorated with a bang (e.g. `!x = e`).++By contrast, PatBind represents data constructor patterns, as well as a few+other interesting cases. Namely,++    Just x = e+    (x) = e+    x :: Ty = e+-}++-- | Haskell Binding with separate Left and Right id's+data HsBindLR idL idR+  = -- | Function-like Binding+    --+    -- FunBind is used for both functions     @f x = e@+    -- and variables                          @f = \x -> e@+    -- and strict variables                   @!x = x + 1@+    --+    -- Reason 1: Special case for type inference: see 'TcBinds.tcMonoBinds'.+    --+    -- Reason 2: Instance decls can only have FunBinds, which is convenient.+    --           If you change this, you'll need to change e.g. rnMethodBinds+    --+    -- But note that the form                 @f :: a->a = ...@+    -- parses as a pattern binding, just like+    --                                        @(f :: a -> a) = ... @+    --+    -- Strict bindings have their strictness recorded in the 'SrcStrictness' of their+    -- 'MatchContext'. See Note [FunBind vs PatBind] for+    -- details about the relationship between FunBind and PatBind.+    --+    --  'ApiAnnotation.AnnKeywordId's+    --+    --  - 'ApiAnnotation.AnnFunId', attached to each element of fun_matches+    --+    --  - 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',+    --    'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',++    -- For details on above see note [Api annotations] in ApiAnnotation+    FunBind {++        fun_ext :: XFunBind idL idR, -- ^ After the renamer, this contains+                                --  the locally-bound+                                -- free variables of this defn.+                                -- See Note [Bind free vars]++        fun_id :: Located (IdP idL), -- Note [fun_id in Match] in HsExpr++        fun_matches :: MatchGroup idR (LHsExpr idR),  -- ^ The payload++        fun_co_fn :: HsWrapper, -- ^ Coercion from the type of the MatchGroup to the type of+                                -- the Id.  Example:+                                --+                                -- @+                                --      f :: Int -> forall a. a -> a+                                --      f x y = y+                                -- @+                                --+                                -- Then the MatchGroup will have type (Int -> a' -> a')+                                -- (with a free type variable a').  The coercion will take+                                -- a CoreExpr of this type and convert it to a CoreExpr of+                                -- type         Int -> forall a'. a' -> a'+                                -- Notice that the coercion captures the free a'.++        fun_tick :: [Tickish Id] -- ^ Ticks to put on the rhs, if any+    }++  -- | Pattern Binding+  --+  -- The pattern is never a simple variable;+  -- That case is done by FunBind.+  -- See Note [FunBind vs PatBind] for details about the+  -- relationship between FunBind and PatBind.++  --+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang',+  --       'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',+  --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',++  -- For details on above see note [Api annotations] in ApiAnnotation+  | PatBind {+        pat_ext    :: XPatBind idL idR, -- ^ See Note [Bind free vars]+        pat_lhs    :: LPat idL,+        pat_rhs    :: GRHSs idR (LHsExpr idR),+        pat_ticks  :: ([Tickish Id], [[Tickish Id]])+               -- ^ Ticks to put on the rhs, if any, and ticks to put on+               -- the bound variables.+    }++  -- | Variable Binding+  --+  -- Dictionary binding and suchlike.+  -- All VarBinds are introduced by the type checker+  | VarBind {+        var_ext    :: XVarBind idL idR,+        var_id     :: IdP idL,+        var_rhs    :: LHsExpr idR,   -- ^ Located only for consistency+        var_inline :: Bool           -- ^ True <=> inline this binding regardless+                                     -- (used for implication constraints only)+    }++  -- | Abstraction Bindings+  | AbsBinds {                      -- Binds abstraction; TRANSLATION+        abs_ext     :: XAbsBinds idL idR,+        abs_tvs     :: [TyVar],+        abs_ev_vars :: [EvVar],  -- ^ Includes equality constraints++       -- | AbsBinds only gets used when idL = idR after renaming,+       -- but these need to be idL's for the collect... code in HsUtil+       -- to have the right type+        abs_exports :: [ABExport idL],++        -- | Evidence bindings+        -- Why a list? See TcInstDcls+        -- Note [Typechecking plan for instance declarations]+        abs_ev_binds :: [TcEvBinds],++        -- | Typechecked user bindings+        abs_binds    :: LHsBinds idL,++        abs_sig :: Bool  -- See Note [The abs_sig field of AbsBinds]+    }++  -- | Patterns Synonym Binding+  | PatSynBind+        (XPatSynBind idL idR)+        (PatSynBind idL idR)+        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',+        --          'ApiAnnotation.AnnLarrow','ApiAnnotation.AnnEqual',+        --          'ApiAnnotation.AnnWhere'+        --          'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@++        -- For details on above see note [Api annotations] in ApiAnnotation++  | XHsBindsLR (XXHsBindsLR idL idR)++data NPatBindTc = NPatBindTc {+     pat_fvs :: NameSet, -- ^ Free variables+     pat_rhs_ty :: Type  -- ^ Type of the GRHSs+     } deriving Data++type instance XFunBind    (GhcPass pL) GhcPs = NoExt+type instance XFunBind    (GhcPass pL) GhcRn = NameSet -- Free variables+type instance XFunBind    (GhcPass pL) GhcTc = NameSet -- Free variables++type instance XPatBind    GhcPs (GhcPass pR) = NoExt+type instance XPatBind    GhcRn (GhcPass pR) = NameSet -- Free variables+type instance XPatBind    GhcTc (GhcPass pR) = NPatBindTc++type instance XVarBind    (GhcPass pL) (GhcPass pR) = NoExt+type instance XAbsBinds   (GhcPass pL) (GhcPass pR) = NoExt+type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExt+type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExt+++        -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]+        --+        -- Creates bindings for (polymorphic, overloaded) poly_f+        -- in terms of monomorphic, non-overloaded mono_f+        --+        -- Invariants:+        --      1. 'binds' binds mono_f+        --      2. ftvs is a subset of tvs+        --      3. ftvs includes all tyvars free in ds+        --+        -- See Note [AbsBinds]++-- | Abtraction Bindings Export+data ABExport p+  = ABE { abe_ext       :: XABE p+        , abe_poly      :: IdP p -- ^ Any INLINE pragma is attached to this Id+        , abe_mono      :: IdP p+        , abe_wrap      :: HsWrapper    -- ^ See Note [ABExport wrapper]+             -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly+        , abe_prags     :: TcSpecPrags  -- ^ SPECIALISE pragmas+        }+   | XABExport (XXABExport p)++type instance XABE       (GhcPass p) = NoExt+type instance XXABExport (GhcPass p) = NoExt+++-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',+--             'ApiAnnotation.AnnEqual','ApiAnnotation.AnnLarrow'+--             'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen' @'{'@,+--             'ApiAnnotation.AnnClose' @'}'@,++-- For details on above see note [Api annotations] in ApiAnnotation++-- | Pattern Synonym binding+data PatSynBind idL idR+  = PSB { psb_ext  :: XPSB idL idR,            -- ^ Post renaming, FVs.+                                               -- See Note [Bind free vars]+          psb_id   :: Located (IdP idL),       -- ^ Name of the pattern synonym+          psb_args :: HsPatSynDetails (Located (IdP idR)),+                                               -- ^ Formal parameter names+          psb_def  :: LPat idR,                -- ^ Right-hand side+          psb_dir  :: HsPatSynDir idR          -- ^ Directionality+     }+   | XPatSynBind (XXPatSynBind idL idR)++type instance XPSB         (GhcPass idL) GhcPs = NoExt+type instance XPSB         (GhcPass idL) GhcRn = NameSet+type instance XPSB         (GhcPass idL) GhcTc = NameSet++type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExt++{-+Note [AbsBinds]+~~~~~~~~~~~~~~~+The AbsBinds constructor is used in the output of the type checker, to+record *typechecked* and *generalised* bindings.  Specifically++         AbsBinds { abs_tvs      = tvs+                  , abs_ev_vars  = [d1,d2]+                  , abs_exports  = [ABE { abe_poly = fp, abe_mono = fm+                                        , abe_wrap = fwrap }+                                    ABE { slly for g } ]+                  , abs_ev_binds = DBINDS+                  , abs_binds    = BIND[fm,gm] }++where 'BIND' binds the monomorphic Ids 'fm' and 'gm', means++        fp = fwrap [/\ tvs. \d1 d2. letrec { DBINDS        ]+                   [                       ; BIND[fm,gm] } ]+                   [                 in fm                 ]++        gp = ...same again, with gm instead of fm++The 'fwrap' is an impedence-matcher that typically does nothing; see+Note [ABExport wrapper].++This is a pretty bad translation, because it duplicates all the bindings.+So the desugarer tries to do a better job:++        fp = /\ [a,b] -> \ [d1,d2] -> case tp [a,b] [d1,d2] of+                                        (fm,gm) -> fm+        ..ditto for gp..++        tp = /\ [a,b] -> \ [d1,d2] -> letrec { DBINDS; BIND }+                                      in (fm,gm)++In general:++  * abs_tvs are the type variables over which the binding group is+    generalised+  * abs_ev_var are the evidence variables (usually dictionaries)+    over which the binding group is generalised+  * abs_binds are the monomorphic bindings+  * abs_ex_binds are the evidence bindings that wrap the abs_binds+  * abs_exports connects the monomorphic Ids bound by abs_binds+    with the polymorphic Ids bound by the AbsBinds itself.++For example, consider a module M, with this top-level binding, where+there is no type signature for M.reverse,+    M.reverse []     = []+    M.reverse (x:xs) = M.reverse xs ++ [x]++In Hindley-Milner, a recursive binding is typechecked with the+*recursive* uses being *monomorphic*.  So after typechecking *and*+desugaring we will get something like this++    M.reverse :: forall a. [a] -> [a]+      = /\a. letrec+                reverse :: [a] -> [a] = \xs -> case xs of+                                                []     -> []+                                                (x:xs) -> reverse xs ++ [x]+             in reverse++Notice that 'M.reverse' is polymorphic as expected, but there is a local+definition for plain 'reverse' which is *monomorphic*.  The type variable+'a' scopes over the entire letrec.++That's after desugaring.  What about after type checking but before+desugaring?  That's where AbsBinds comes in.  It looks like this:++   AbsBinds { abs_tvs     = [a]+            , abs_ev_vars = []+            , abs_exports = [ABE { abe_poly = M.reverse :: forall a. [a] -> [a],+                                 , abe_mono = reverse :: [a] -> [a]}]+            , abs_ev_binds = {}+            , abs_binds = { reverse :: [a] -> [a]+                               = \xs -> case xs of+                                            []     -> []+                                            (x:xs) -> reverse xs ++ [x] } }++Here,++  * abs_tvs says what type variables are abstracted over the binding+    group, just 'a' in this case.+  * abs_binds is the *monomorphic* bindings of the group+  * abs_exports describes how to get the polymorphic Id 'M.reverse'+    from the monomorphic one 'reverse'++Notice that the *original* function (the polymorphic one you thought+you were defining) appears in the abe_poly field of the+abs_exports. The bindings in abs_binds are for fresh, local, Ids with+a *monomorphic* Id.++If there is a group of mutually recursive (see Note [Polymorphic+recursion]) functions without type signatures, we get one AbsBinds+with the monomorphic versions of the bindings in abs_binds, and one+element of abe_exports for each variable bound in the mutually+recursive group.  This is true even for pattern bindings.  Example:+        (f,g) = (\x -> x, f)+After type checking we get+   AbsBinds { abs_tvs     = [a]+            , abs_exports = [ ABE { abe_poly = M.f :: forall a. a -> a+                                  , abe_mono = f :: a -> a }+                            , ABE { abe_poly = M.g :: forall a. a -> a+                                  , abe_mono = g :: a -> a }]+            , abs_binds = { (f,g) = (\x -> x, f) }++Note [Polymorphic recursion]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+   Rec { f x = ...(g ef)...++       ; g :: forall a. [a] -> [a]+       ; g y = ...(f eg)...  }++These bindings /are/ mutually recursive (f calls g, and g calls f).+But we can use the type signature for g to break the recursion,+like this:++  1. Add g :: forall a. [a] -> [a] to the type environment++  2. Typecheck the definition of f, all by itself,+     including generalising it to find its most general+     type, say f :: forall b. b -> b -> [b]++  3. Extend the type environment with that type for f++  4. Typecheck the definition of g, all by itself,+     checking that it has the type claimed by its signature++Steps 2 and 4 each generate a separate AbsBinds, so we end+up with+   Rec { AbsBinds { ...for f ... }+       ; AbsBinds { ...for g ... } }++This approach allows both f and to call each other+polymorphically, even though only g has a signature.++We get an AbsBinds that encompasses multiple source-program+bindings only when+ * Each binding in the group has at least one binder that+   lacks a user type signature+ * The group forms a strongly connected component+++Note [The abs_sig field of AbsBinds]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The abs_sig field supports a couple of special cases for bindings.+Consider++  x :: Num a => (# a, a #)+  x = (# 3, 4 #)++The general desugaring for AbsBinds would give++  x = /\a. \ ($dNum :: Num a) ->+      letrec xm = (# fromInteger $dNum 3, fromInteger $dNum 4 #) in+      xm++But that has an illegal let-binding for an unboxed tuple.  In this+case we'd prefer to generate the (more direct)++  x = /\ a. \ ($dNum :: Num a) ->+     (# fromInteger $dNum 3, fromInteger $dNum 4 #)++A similar thing happens with representation-polymorphic defns+(#11405):++  undef :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a+  undef = error "undef"++Again, the vanilla desugaring gives a local let-binding for a+representation-polymorphic (undefm :: a), which is illegal.  But+again we can desugar without a let:++  undef = /\ a. \ (d:HasCallStack) -> error a d "undef"++The abs_sig field supports this direct desugaring, with no local+let-bining.  When abs_sig = True++ * the abs_binds is single FunBind++ * the abs_exports is a singleton++ * we have a complete type sig for binder+   and hence the abs_binds is non-recursive+   (it binds the mono_id but refers to the poly_id++These properties are exploited in DsBinds.dsAbsBinds to+generate code without a let-binding.++Note [ABExport wrapper]+~~~~~~~~~~~~~~~~~~~~~~~+Consider+   (f,g) = (\x.x, \y.y)+This ultimately desugars to something like this:+   tup :: forall a b. (a->a, b->b)+   tup = /\a b. (\x:a.x, \y:b.y)+   f :: forall a. a -> a+   f = /\a. case tup a Any of+               (fm::a->a,gm:Any->Any) -> fm+   ...similarly for g...++The abe_wrap field deals with impedance-matching between+    (/\a b. case tup a b of { (f,g) -> f })+and the thing we really want, which may have fewer type+variables.  The action happens in TcBinds.mkExport.++Note [Bind free vars]+~~~~~~~~~~~~~~~~~~~~~+The bind_fvs field of FunBind and PatBind records the free variables+of the definition.  It is used for the following purposes++a) Dependency analysis prior to type checking+    (see TcBinds.tc_group)++b) Deciding whether we can do generalisation of the binding+    (see TcBinds.decideGeneralisationPlan)++c) Deciding whether the binding can be used in static forms+    (see TcExpr.checkClosedInStaticForm for the HsStatic case and+     TcBinds.isClosedBndrGroup).++Specifically,++  * bind_fvs includes all free vars that are defined in this module+    (including top-level things and lexically scoped type variables)++  * bind_fvs excludes imported vars; this is just to keep the set smaller++  * Before renaming, and after typechecking, the field is unused;+    it's just an error thunk+-}++instance (idL ~ GhcPass pl, idR ~ GhcPass pr,+          OutputableBndrId idL, OutputableBndrId idR)+        => Outputable (HsLocalBindsLR idL idR) where+  ppr (HsValBinds _ bs)   = ppr bs+  ppr (HsIPBinds _ bs)    = ppr bs+  ppr (EmptyLocalBinds _) = empty+  ppr (XHsLocalBindsLR x) = ppr x++instance (idL ~ GhcPass pl, idR ~ GhcPass pr,+          OutputableBndrId idL, OutputableBndrId idR)+        => Outputable (HsValBindsLR idL idR) where+  ppr (ValBinds _ binds sigs)+   = pprDeclList (pprLHsBindsForUser binds sigs)++  ppr (XValBindsLR (NValBinds sccs sigs))+    = getPprStyle $ \ sty ->+      if debugStyle sty then    -- Print with sccs showing+        vcat (map ppr sigs) $$ vcat (map ppr_scc sccs)+     else+        pprDeclList (pprLHsBindsForUser (unionManyBags (map snd sccs)) sigs)+   where+     ppr_scc (rec_flag, binds) = pp_rec rec_flag <+> pprLHsBinds binds+     pp_rec Recursive    = text "rec"+     pp_rec NonRecursive = text "nonrec"++pprLHsBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))+            => LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc+pprLHsBinds binds+  | isEmptyLHsBinds binds = empty+  | otherwise = pprDeclList (map ppr (bagToList binds))++pprLHsBindsForUser :: (OutputableBndrId (GhcPass idL),+                       OutputableBndrId (GhcPass idR),+                       OutputableBndrId (GhcPass id2))+     => LHsBindsLR (GhcPass idL) (GhcPass idR) -> [LSig (GhcPass id2)] -> [SDoc]+--  pprLHsBindsForUser is different to pprLHsBinds because+--  a) No braces: 'let' and 'where' include a list of HsBindGroups+--     and we don't want several groups of bindings each+--     with braces around+--  b) Sort by location before printing+--  c) Include signatures+pprLHsBindsForUser binds sigs+  = map snd (sort_by_loc decls)+  where++    decls :: [(SrcSpan, SDoc)]+    decls = [(loc, ppr sig)  | L loc sig <- sigs] +++            [(loc, ppr bind) | L loc bind <- bagToList binds]++    sort_by_loc decls = sortBy (comparing fst) decls++pprDeclList :: [SDoc] -> SDoc   -- Braces with a space+-- Print a bunch of declarations+-- One could choose  { d1; d2; ... }, using 'sep'+-- or      d1+--         d2+--         ..+--    using vcat+-- At the moment we chose the latter+-- Also we do the 'pprDeeperList' thing.+pprDeclList ds = pprDeeperList vcat ds++------------+emptyLocalBinds :: HsLocalBindsLR (GhcPass a) (GhcPass b)+emptyLocalBinds = EmptyLocalBinds noExt++-- AZ:These functions do not seem to be used at all?+isEmptyLocalBindsTc :: HsLocalBindsLR (GhcPass a) GhcTc -> Bool+isEmptyLocalBindsTc (HsValBinds _ ds)   = isEmptyValBinds ds+isEmptyLocalBindsTc (HsIPBinds _ ds)    = isEmptyIPBindsTc ds+isEmptyLocalBindsTc (EmptyLocalBinds _) = True+isEmptyLocalBindsTc (XHsLocalBindsLR _) = True++isEmptyLocalBindsPR :: HsLocalBindsLR (GhcPass a) (GhcPass b) -> Bool+isEmptyLocalBindsPR (HsValBinds _ ds)   = isEmptyValBinds ds+isEmptyLocalBindsPR (HsIPBinds _ ds)    = isEmptyIPBindsPR ds+isEmptyLocalBindsPR (EmptyLocalBinds _) = True+isEmptyLocalBindsPR (XHsLocalBindsLR _) = True++eqEmptyLocalBinds :: HsLocalBindsLR a b -> Bool+eqEmptyLocalBinds (EmptyLocalBinds _) = True+eqEmptyLocalBinds _                   = False++isEmptyValBinds :: HsValBindsLR (GhcPass a) (GhcPass b) -> Bool+isEmptyValBinds (ValBinds _ ds sigs)  = isEmptyLHsBinds ds && null sigs+isEmptyValBinds (XValBindsLR (NValBinds ds sigs)) = null ds && null sigs++emptyValBindsIn, emptyValBindsOut :: HsValBindsLR (GhcPass a) (GhcPass b)+emptyValBindsIn  = ValBinds noExt emptyBag []+emptyValBindsOut = XValBindsLR (NValBinds [] [])++emptyLHsBinds :: LHsBindsLR idL idR+emptyLHsBinds = emptyBag++isEmptyLHsBinds :: LHsBindsLR idL idR -> Bool+isEmptyLHsBinds = isEmptyBag++------------+plusHsValBinds :: HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)+               -> HsValBinds(GhcPass a)+plusHsValBinds (ValBinds _ ds1 sigs1) (ValBinds _ ds2 sigs2)+  = ValBinds noExt (ds1 `unionBags` ds2) (sigs1 ++ sigs2)+plusHsValBinds (XValBindsLR (NValBinds ds1 sigs1))+               (XValBindsLR (NValBinds ds2 sigs2))+  = XValBindsLR (NValBinds (ds1 ++ ds2) (sigs1 ++ sigs2))+plusHsValBinds _ _+  = panic "HsBinds.plusHsValBinds"++instance (idL ~ GhcPass pl, idR ~ GhcPass pr,+          OutputableBndrId idL, OutputableBndrId idR)+         => Outputable (HsBindLR idL idR) where+    ppr mbind = ppr_monobind mbind++ppr_monobind :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))+             => HsBindLR (GhcPass idL) (GhcPass idR) -> SDoc++ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })+  = pprPatBind pat grhss+ppr_monobind (VarBind { var_id = var, var_rhs = rhs })+  = sep [pprBndr CasePatBind var, nest 2 $ equals <+> pprExpr (unLoc rhs)]+ppr_monobind (FunBind { fun_id = fun,+                        fun_co_fn = wrap,+                        fun_matches = matches,+                        fun_tick = ticks })+  = pprTicks empty (if null ticks then empty+                    else text "-- ticks = " <> ppr ticks)+    $$  whenPprDebug (pprBndr LetBind (unLoc fun))+    $$  pprFunBind  matches+    $$  whenPprDebug (ppr wrap)+ppr_monobind (PatSynBind _ psb) = ppr psb+ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars+                       , abs_exports = exports, abs_binds = val_binds+                       , abs_ev_binds = ev_binds })+  = sdocWithDynFlags $ \ dflags ->+    if gopt Opt_PrintTypecheckerElaboration dflags then+      -- Show extra information (bug number: #10662)+      hang (text "AbsBinds" <+> brackets (interpp'SP tyvars)+                                    <+> brackets (interpp'SP dictvars))+         2 $ braces $ vcat+      [ text "Exports:" <+>+          brackets (sep (punctuate comma (map ppr exports)))+      , text "Exported types:" <+>+          vcat [pprBndr LetBind (abe_poly ex) | ex <- exports]+      , text "Binds:" <+> pprLHsBinds val_binds+      , text "Evidence:" <+> ppr ev_binds ]+    else+      pprLHsBinds val_binds+ppr_monobind (XHsBindsLR x) = ppr x++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ABExport p) where+  ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags })+    = vcat [ ppr gbl <+> text "<=" <+> ppr lcl+           , nest 2 (pprTcSpecPrags prags)+           , nest 2 (text "wrap:" <+> ppr wrap)]+  ppr (XABExport x) = ppr x++instance (idR ~ GhcPass pr,OutputableBndrId idL, OutputableBndrId idR,+         Outputable (XXPatSynBind idL idR))+          => Outputable (PatSynBind idL idR) where+  ppr (PSB{ psb_id = (L _ psyn), psb_args = details, psb_def = pat,+            psb_dir = dir })+      = ppr_lhs <+> ppr_rhs+    where+      ppr_lhs = text "pattern" <+> ppr_details+      ppr_simple syntax = syntax <+> ppr pat++      ppr_details = case details of+          InfixCon v1 v2 -> hsep [ppr v1, pprInfixOcc psyn, ppr v2]+          PrefixCon vs   -> hsep (pprPrefixOcc psyn : map ppr vs)+          RecCon vs      -> pprPrefixOcc psyn+                            <> braces (sep (punctuate comma (map ppr vs)))++      ppr_rhs = case dir of+          Unidirectional           -> ppr_simple (text "<-")+          ImplicitBidirectional    -> ppr_simple equals+          ExplicitBidirectional mg -> ppr_simple (text "<-") <+> ptext (sLit "where") $$+                                      (nest 2 $ pprFunBind mg)+  ppr (XPatSynBind x) = ppr x++pprTicks :: SDoc -> SDoc -> SDoc+-- Print stuff about ticks only when -dppr-debug is on, to avoid+-- them appearing in error messages (from the desugarer); see # 3263+-- Also print ticks in dumpStyle, so that -ddump-hpc actually does+-- something useful.+pprTicks pp_no_debug pp_when_debug+  = getPprStyle (\ sty -> if debugStyle sty || dumpStyle sty+                             then pp_when_debug+                             else pp_no_debug)++{-+************************************************************************+*                                                                      *+                Implicit parameter bindings+*                                                                      *+************************************************************************+-}++-- | Haskell Implicit Parameter Bindings+data HsIPBinds id+  = IPBinds+        (XIPBinds id)+        [LIPBind id]+        -- TcEvBinds       -- Only in typechecker output; binds+        --                 -- uses of the implicit parameters+  | XHsIPBinds (XXHsIPBinds id)++type instance XIPBinds       GhcPs = NoExt+type instance XIPBinds       GhcRn = NoExt+type instance XIPBinds       GhcTc = TcEvBinds -- binds uses of the+                                               -- implicit parameters+++type instance XXHsIPBinds    (GhcPass p) = NoExt++isEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool+isEmptyIPBindsPR (IPBinds _ is) = null is+isEmptyIPBindsPR (XHsIPBinds _) = True++isEmptyIPBindsTc :: HsIPBinds GhcTc -> Bool+isEmptyIPBindsTc (IPBinds ds is) = null is && isEmptyTcEvBinds ds+isEmptyIPBindsTc (XHsIPBinds _) = True++-- | Located Implicit Parameter Binding+type LIPBind id = Located (IPBind id)+-- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a+--   list++-- For details on above see note [Api annotations] in ApiAnnotation++-- | Implicit parameter bindings.+--+-- These bindings start off as (Left "x") in the parser and stay+-- that way until after type-checking when they are replaced with+-- (Right d), where "d" is the name of the dictionary holding the+-- evidence for the implicit parameter.+--+-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'++-- For details on above see note [Api annotations] in ApiAnnotation+data IPBind id+  = IPBind+        (XCIPBind id)+        (Either (Located HsIPName) (IdP id))+        (LHsExpr id)+  | XIPBind (XXIPBind id)++type instance XCIPBind    (GhcPass p) = NoExt+type instance XXIPBind    (GhcPass p) = NoExt++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (HsIPBinds p) where+  ppr (IPBinds ds bs) = pprDeeperList vcat (map ppr bs)+                        $$ whenPprDebug (ppr ds)+  ppr (XHsIPBinds x) = ppr x++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (IPBind p) where+  ppr (IPBind _ lr rhs) = name <+> equals <+> pprExpr (unLoc rhs)+    where name = case lr of+                   Left (L _ ip) -> pprBndr LetBind ip+                   Right     id  -> pprBndr LetBind id+  ppr (XIPBind x) = ppr x++{-+************************************************************************+*                                                                      *+\subsection{@Sig@: type signatures and value-modifying user pragmas}+*                                                                      *+************************************************************************++It is convenient to lump ``value-modifying'' user-pragmas (e.g.,+``specialise this function to these four types...'') in with type+signatures.  Then all the machinery to move them into place, etc.,+serves for both.+-}++-- | Located Signature+type LSig pass = Located (Sig pass)++-- | Signatures and pragmas+data Sig pass+  =   -- | An ordinary type signature+      --+      -- > f :: Num a => a -> a+      --+      -- After renaming, this list of Names contains the named+      -- wildcards brought into scope by this signature. For a signature+      -- @_ -> _a -> Bool@, the renamer will leave the unnamed wildcard @_@+      -- untouched, and the named wildcard @_a@ is then replaced with+      -- fresh meta vars in the type. Their names are stored in the type+      -- signature that brought them into scope, in this third field to be+      -- more specific.+      --+      --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon',+      --          'ApiAnnotation.AnnComma'++      -- For details on above see note [Api annotations] in ApiAnnotation+    TypeSig+       (XTypeSig pass)+       [Located (IdP pass)]  -- LHS of the signature; e.g.  f,g,h :: blah+       (LHsSigWcType pass)   -- RHS of the signature; can have wildcards++      -- | A pattern synonym type signature+      --+      -- > pattern Single :: () => (Show a) => a -> [a]+      --+      --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',+      --           'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnForall'+      --           'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'++      -- For details on above see note [Api annotations] in ApiAnnotation+  | PatSynSig (XPatSynSig pass) [Located (IdP pass)] (LHsSigType pass)+      -- P :: forall a b. Req => Prov => ty++      -- | A signature for a class method+      --   False: ordinary class-method signature+      --   True:  generic-default class method signature+      -- e.g.   class C a where+      --          op :: a -> a                   -- Ordinary+      --          default op :: Eq a => a -> a   -- Generic default+      -- No wildcards allowed here+      --+      --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDefault',+      --           'ApiAnnotation.AnnDcolon'+  | ClassOpSig (XClassOpSig pass) Bool [Located (IdP pass)] (LHsSigType pass)++        -- | A type signature in generated code, notably the code+        -- generated for record selectors.  We simply record+        -- the desired Id itself, replete with its name, type+        -- and IdDetails.  Otherwise it's just like a type+        -- signature: there should be an accompanying binding+  | IdSig (XIdSig pass) Id++        -- | An ordinary fixity declaration+        --+        -- >     infixl 8 ***+        --+        --+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInfix',+        --           'ApiAnnotation.AnnVal'++        -- For details on above see note [Api annotations] in ApiAnnotation+  | FixSig (XFixSig pass) (FixitySig pass)++        -- | An inline pragma+        --+        -- > {#- INLINE f #-}+        --+        --  - 'ApiAnnotation.AnnKeywordId' :+        --       'ApiAnnotation.AnnOpen' @'{-\# INLINE'@ and @'['@,+        --       'ApiAnnotation.AnnClose','ApiAnnotation.AnnOpen',+        --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnTilde',+        --       'ApiAnnotation.AnnClose'++        -- For details on above see note [Api annotations] in ApiAnnotation+  | InlineSig   (XInlineSig pass)+                (Located (IdP pass)) -- Function name+                InlinePragma         -- Never defaultInlinePragma++        -- | A specialisation pragma+        --+        -- > {-# SPECIALISE f :: Int -> Int #-}+        --+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',+        --      'ApiAnnotation.AnnOpen' @'{-\# SPECIALISE'@ and @'['@,+        --      'ApiAnnotation.AnnTilde',+        --      'ApiAnnotation.AnnVal',+        --      'ApiAnnotation.AnnClose' @']'@ and @'\#-}'@,+        --      'ApiAnnotation.AnnDcolon'++        -- For details on above see note [Api annotations] in ApiAnnotation+  | SpecSig     (XSpecSig pass)+                (Located (IdP pass)) -- Specialise a function or datatype  ...+                [LHsSigType pass]  -- ... to these types+                InlinePragma       -- The pragma on SPECIALISE_INLINE form.+                                   -- If it's just defaultInlinePragma, then we said+                                   --    SPECIALISE, not SPECIALISE_INLINE++        -- | A specialisation pragma for instance declarations only+        --+        -- > {-# SPECIALISE instance Eq [Int] #-}+        --+        -- (Class tys); should be a specialisation of the+        -- current instance declaration+        --+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',+        --      'ApiAnnotation.AnnInstance','ApiAnnotation.AnnClose'++        -- For details on above see note [Api annotations] in ApiAnnotation+  | SpecInstSig (XSpecInstSig pass) SourceText (LHsSigType pass)+                  -- Note [Pragma source text] in BasicTypes++        -- | A minimal complete definition pragma+        --+        -- > {-# MINIMAL a | (b, c | (d | e)) #-}+        --+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',+        --      'ApiAnnotation.AnnVbar','ApiAnnotation.AnnComma',+        --      'ApiAnnotation.AnnClose'++        -- For details on above see note [Api annotations] in ApiAnnotation+  | MinimalSig (XMinimalSig pass)+               SourceText (LBooleanFormula (Located (IdP pass)))+               -- Note [Pragma source text] in BasicTypes++        -- | A "set cost centre" pragma for declarations+        --+        -- > {-# SCC funName #-}+        --+        -- or+        --+        -- > {-# SCC funName "cost_centre_name" #-}++  | SCCFunSig  (XSCCFunSig pass)+               SourceText      -- Note [Pragma source text] in BasicTypes+               (Located (IdP pass))  -- Function name+               (Maybe (Located StringLiteral))+       -- | A complete match pragma+       --+       -- > {-# COMPLETE C, D [:: T] #-}+       --+       -- Used to inform the pattern match checker about additional+       -- complete matchings which, for example, arise from pattern+       -- synonym definitions.+  | CompleteMatchSig (XCompleteMatchSig pass)+                     SourceText+                     (Located [Located (IdP pass)])+                     (Maybe (Located (IdP pass)))+  | XSig (XXSig pass)++type instance XTypeSig          (GhcPass p) = NoExt+type instance XPatSynSig        (GhcPass p) = NoExt+type instance XClassOpSig       (GhcPass p) = NoExt+type instance XIdSig            (GhcPass p) = NoExt+type instance XFixSig           (GhcPass p) = NoExt+type instance XInlineSig        (GhcPass p) = NoExt+type instance XSpecSig          (GhcPass p) = NoExt+type instance XSpecInstSig      (GhcPass p) = NoExt+type instance XMinimalSig       (GhcPass p) = NoExt+type instance XSCCFunSig        (GhcPass p) = NoExt+type instance XCompleteMatchSig (GhcPass p) = NoExt+type instance XXSig             (GhcPass p) = NoExt++-- | Located Fixity Signature+type LFixitySig pass = Located (FixitySig pass)++-- | Fixity Signature+data FixitySig pass = FixitySig (XFixitySig pass) [Located (IdP pass)] Fixity+                    | XFixitySig (XXFixitySig pass)++type instance XFixitySig  (GhcPass p) = NoExt+type instance XXFixitySig (GhcPass p) = NoExt++-- | Type checker Specialisation Pragmas+--+-- 'TcSpecPrags' conveys @SPECIALISE@ pragmas from the type checker to the desugarer+data TcSpecPrags+  = IsDefaultMethod     -- ^ Super-specialised: a default method should+                        -- be macro-expanded at every call site+  | SpecPrags [LTcSpecPrag]+  deriving Data++-- | Located Type checker Specification Pragmas+type LTcSpecPrag = Located TcSpecPrag++-- | Type checker Specification Pragma+data TcSpecPrag+  = SpecPrag+        Id+        HsWrapper+        InlinePragma+  -- ^ The Id to be specialised, a wrapper that specialises the+  -- polymorphic function, and inlining spec for the specialised function+  deriving Data++noSpecPrags :: TcSpecPrags+noSpecPrags = SpecPrags []++hasSpecPrags :: TcSpecPrags -> Bool+hasSpecPrags (SpecPrags ps) = not (null ps)+hasSpecPrags IsDefaultMethod = False++isDefaultMethod :: TcSpecPrags -> Bool+isDefaultMethod IsDefaultMethod = True+isDefaultMethod (SpecPrags {})  = False+++isFixityLSig :: LSig name -> Bool+isFixityLSig (L _ (FixSig {})) = True+isFixityLSig _                 = False++isTypeLSig :: LSig name -> Bool  -- Type signatures+isTypeLSig (L _(TypeSig {}))    = True+isTypeLSig (L _(ClassOpSig {})) = True+isTypeLSig (L _(IdSig {}))      = True+isTypeLSig _                    = False++isSpecLSig :: LSig name -> Bool+isSpecLSig (L _(SpecSig {})) = True+isSpecLSig _                 = False++isSpecInstLSig :: LSig name -> Bool+isSpecInstLSig (L _ (SpecInstSig {})) = True+isSpecInstLSig _                      = False++isPragLSig :: LSig name -> Bool+-- Identifies pragmas+isPragLSig (L _ (SpecSig {}))   = True+isPragLSig (L _ (InlineSig {})) = True+isPragLSig (L _ (SCCFunSig {})) = True+isPragLSig (L _ (CompleteMatchSig {})) = True+isPragLSig _                    = False++isInlineLSig :: LSig name -> Bool+-- Identifies inline pragmas+isInlineLSig (L _ (InlineSig {})) = True+isInlineLSig _                    = False++isMinimalLSig :: LSig name -> Bool+isMinimalLSig (L _ (MinimalSig {})) = True+isMinimalLSig _                     = False++isSCCFunSig :: LSig name -> Bool+isSCCFunSig (L _ (SCCFunSig {})) = True+isSCCFunSig _                    = False++isCompleteMatchSig :: LSig name -> Bool+isCompleteMatchSig (L _ (CompleteMatchSig {} )) = True+isCompleteMatchSig _                            = False++hsSigDoc :: Sig name -> SDoc+hsSigDoc (TypeSig {})           = text "type signature"+hsSigDoc (PatSynSig {})         = text "pattern synonym signature"+hsSigDoc (ClassOpSig _ is_deflt _ _)+ | is_deflt                     = text "default type signature"+ | otherwise                    = text "class method signature"+hsSigDoc (IdSig {})             = text "id signature"+hsSigDoc (SpecSig {})           = text "SPECIALISE pragma"+hsSigDoc (InlineSig _ _ prag)   = ppr (inlinePragmaSpec prag) <+> text "pragma"+hsSigDoc (SpecInstSig {})       = text "SPECIALISE instance pragma"+hsSigDoc (FixSig {})            = text "fixity declaration"+hsSigDoc (MinimalSig {})        = text "MINIMAL pragma"+hsSigDoc (SCCFunSig {})         = text "SCC pragma"+hsSigDoc (CompleteMatchSig {})  = text "COMPLETE pragma"+hsSigDoc (XSig {})              = text "XSIG TTG extension"++{-+Check if signatures overlap; this is used when checking for duplicate+signatures. Since some of the signatures contain a list of names, testing for+equality is not enough -- we have to check if they overlap.+-}++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (Sig p) where+    ppr sig = ppr_sig sig++ppr_sig :: (OutputableBndrId (GhcPass p)) => Sig (GhcPass p) -> SDoc+ppr_sig (TypeSig _ vars ty)  = pprVarSig (map unLoc vars) (ppr ty)+ppr_sig (ClassOpSig _ is_deflt vars ty)+  | is_deflt                 = text "default" <+> pprVarSig (map unLoc vars) (ppr ty)+  | otherwise                = pprVarSig (map unLoc vars) (ppr ty)+ppr_sig (IdSig _ id)         = pprVarSig [id] (ppr (varType id))+ppr_sig (FixSig _ fix_sig)   = ppr fix_sig+ppr_sig (SpecSig _ var ty inl@(InlinePragma { inl_inline = spec }))+  = pragSrcBrackets (inl_src inl) pragmaSrc (pprSpec (unLoc var)+                                             (interpp'SP ty) inl)+    where+      pragmaSrc = case spec of+        NoUserInline -> "{-# SPECIALISE"+        _            -> "{-# SPECIALISE_INLINE"+ppr_sig (InlineSig _ var inl)+  = pragSrcBrackets (inl_src inl) "{-# INLINE"  (pprInline inl+                                   <+> pprPrefixOcc (unLoc var))+ppr_sig (SpecInstSig _ src ty)+  = pragSrcBrackets src "{-# SPECIALISE" (text "instance" <+> ppr ty)+ppr_sig (MinimalSig _ src bf)+  = pragSrcBrackets src "{-# MINIMAL" (pprMinimalSig bf)+ppr_sig (PatSynSig _ names sig_ty)+  = text "pattern" <+> pprVarSig (map unLoc names) (ppr sig_ty)+ppr_sig (SCCFunSig _ src fn mlabel)+  = pragSrcBrackets src "{-# SCC" (ppr fn <+> maybe empty ppr mlabel )+ppr_sig (CompleteMatchSig _ src cs mty)+  = pragSrcBrackets src "{-# COMPLETE"+      ((hsep (punctuate comma (map ppr (unLoc cs))))+        <+> opt_sig)+  where+    opt_sig = maybe empty ((\t -> dcolon <+> ppr t) . unLoc) mty+ppr_sig (XSig x) = ppr x++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (FixitySig p) where+  ppr (FixitySig _ names fixity) = sep [ppr fixity, pprops]+    where+      pprops = hsep $ punctuate comma (map (pprInfixOcc . unLoc) names)+  ppr (XFixitySig x) = ppr x++pragBrackets :: SDoc -> SDoc+pragBrackets doc = text "{-#" <+> doc <+> text "#-}"++-- | Using SourceText in case the pragma was spelled differently or used mixed+-- case+pragSrcBrackets :: SourceText -> String -> SDoc -> SDoc+pragSrcBrackets (SourceText src) _   doc = text src <+> doc <+> text "#-}"+pragSrcBrackets NoSourceText     alt doc = text alt <+> doc <+> text "#-}"++pprVarSig :: (OutputableBndr id) => [id] -> SDoc -> SDoc+pprVarSig vars pp_ty = sep [pprvars <+> dcolon, nest 2 pp_ty]+  where+    pprvars = hsep $ punctuate comma (map pprPrefixOcc vars)++pprSpec :: (OutputableBndr id) => id -> SDoc -> InlinePragma -> SDoc+pprSpec var pp_ty inl = pp_inl <+> pprVarSig [var] pp_ty+  where+    pp_inl | isDefaultInlinePragma inl = empty+           | otherwise = pprInline inl++pprTcSpecPrags :: TcSpecPrags -> SDoc+pprTcSpecPrags IsDefaultMethod = text "<default method>"+pprTcSpecPrags (SpecPrags ps)  = vcat (map (ppr . unLoc) ps)++instance Outputable TcSpecPrag where+  ppr (SpecPrag var _ inl)+    = text "SPECIALIZE" <+> pprSpec var (text "<type>") inl++pprMinimalSig :: (OutputableBndr name)+              => LBooleanFormula (Located name) -> SDoc+pprMinimalSig (L _ bf) = ppr (fmap unLoc bf)++{-+************************************************************************+*                                                                      *+\subsection[PatSynBind]{A pattern synonym definition}+*                                                                      *+************************************************************************+-}++-- | Haskell Pattern Synonym Details+type HsPatSynDetails arg = HsConDetails arg [RecordPatSynField arg]++-- See Note [Record PatSyn Fields]+-- | Record Pattern Synonym Field+data RecordPatSynField a+  = RecordPatSynField {+      recordPatSynSelectorId :: a  -- Selector name visible in rest of the file+      , recordPatSynPatVar :: a+      -- Filled in by renamer, the name used internally+      -- by the pattern+      } deriving Data++++{-+Note [Record PatSyn Fields]++Consider the following two pattern synonyms.++pattern P x y = ([x,True], [y,'v'])+pattern Q{ x, y } =([x,True], [y,'v'])++In P, we just have two local binders, x and y.++In Q, we have local binders but also top-level record selectors+x :: ([Bool], [Char]) -> Bool and similarly for y.++It would make sense to support record-like syntax++pattern Q{ x=x1, y=y1 } = ([x1,True], [y1,'v'])++when we have a different name for the local and top-level binder+the distinction between the two names clear++-}+instance Functor RecordPatSynField where+    fmap f (RecordPatSynField { recordPatSynSelectorId = visible+                              , recordPatSynPatVar = hidden })+      = RecordPatSynField { recordPatSynSelectorId = f visible+                          , recordPatSynPatVar = f hidden }++instance Outputable a => Outputable (RecordPatSynField a) where+    ppr (RecordPatSynField { recordPatSynSelectorId = v }) = ppr v++instance Foldable RecordPatSynField  where+    foldMap f (RecordPatSynField { recordPatSynSelectorId = visible+                                 , recordPatSynPatVar = hidden })+      = f visible `mappend` f hidden++instance Traversable RecordPatSynField where+    traverse f (RecordPatSynField { recordPatSynSelectorId =visible+                                  , recordPatSynPatVar = hidden })+      = (\ sel_id pat_var -> RecordPatSynField { recordPatSynSelectorId = sel_id+                                               , recordPatSynPatVar = pat_var })+          <$> f visible <*> f hidden+++-- | Haskell Pattern Synonym Direction+data HsPatSynDir id+  = Unidirectional+  | ImplicitBidirectional+  | ExplicitBidirectional (MatchGroup id (LHsExpr id))
+ compiler/hsSyn/HsDecls.hs view
@@ -0,0 +1,2412 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}++{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable,+             DeriveTraversable #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]+                                      -- in module PlaceHolder+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeFamilies #-}++-- | Abstract syntax of global declarations.+--+-- Definitions for: @SynDecl@ and @ConDecl@, @ClassDecl@,+-- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.+module HsDecls (+  -- * Toplevel declarations+  HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep,+  HsDerivingClause(..), LHsDerivingClause, NewOrData(..), newOrDataToFlavour,++  -- ** Class or type declarations+  TyClDecl(..), LTyClDecl, DataDeclRn(..),+  TyClGroup(..), mkTyClGroup, emptyTyClGroup,+  tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls,+  isClassDecl, isDataDecl, isSynDecl, tcdName,+  isFamilyDecl, isTypeFamilyDecl, isDataFamilyDecl,+  isOpenTypeFamilyInfo, isClosedTypeFamilyInfo,+  tyFamInstDeclName, tyFamInstDeclLName,+  countTyClDecls, pprTyClDeclFlavour,+  tyClDeclLName, tyClDeclTyVars,+  hsDeclHasCusk, famDeclHasCusk,+  FamilyDecl(..), LFamilyDecl,++  -- ** Instance declarations+  InstDecl(..), LInstDecl, FamilyInfo(..),+  TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,+  DataFamInstDecl(..), LDataFamInstDecl,+  pprDataFamInstFlavour, pprHsFamInstLHS,+  FamInstEqn, LFamInstEqn, FamEqn(..),+  TyFamInstEqn, LTyFamInstEqn, TyFamDefltEqn, LTyFamDefltEqn,+  HsTyPats,+  LClsInstDecl, ClsInstDecl(..),++  -- ** Standalone deriving declarations+  DerivDecl(..), LDerivDecl,+  -- ** Deriving strategies+  DerivStrategy(..), LDerivStrategy, derivStrategyName,+  -- ** @RULE@ declarations+  LRuleDecls,RuleDecls(..),RuleDecl(..),LRuleDecl,HsRuleRn(..),+  RuleBndr(..),LRuleBndr,+  collectRuleBndrSigTys,+  flattenRuleDecls, pprFullRuleName,+  -- ** @default@ declarations+  DefaultDecl(..), LDefaultDecl,+  -- ** Template haskell declaration splice+  SpliceExplicitFlag(..),+  SpliceDecl(..), LSpliceDecl,+  -- ** Foreign function interface declarations+  ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),+  CImportSpec(..),+  -- ** Data-constructor declarations+  ConDecl(..), LConDecl,+  HsConDeclDetails, hsConDeclArgTys, hsConDeclTheta,+  getConNames, getConArgs,+  -- ** Document comments+  DocDecl(..), LDocDecl, docDeclDoc,+  -- ** Deprecations+  WarnDecl(..),  LWarnDecl,+  WarnDecls(..), LWarnDecls,+  -- ** Annotations+  AnnDecl(..), LAnnDecl,+  AnnProvenance(..), annProvenanceName_maybe,+  -- ** Role annotations+  RoleAnnotDecl(..), LRoleAnnotDecl, roleAnnotDeclName,+  -- ** Injective type families+  FamilyResultSig(..), LFamilyResultSig, InjectivityAnn(..), LInjectivityAnn,+  resultVariableName,++  -- * Grouping+  HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups, hsGroupInstDecls++    ) where++-- friends:+import GhcPrelude++import {-# SOURCE #-}   HsExpr( HsExpr, HsSplice, pprExpr,+                                pprSpliceDecl )+        -- Because Expr imports Decls via HsBracket++import HsBinds+import HsTypes+import HsDoc+import TyCon+import BasicTypes+import Coercion+import ForeignCall+import HsExtension+import NameSet++-- others:+import Class+import Outputable+import Util+import SrcLoc+import Type++import Bag+import Maybes+import Data.Data        hiding (TyCon,Fixity, Infix)++{-+************************************************************************+*                                                                      *+\subsection[HsDecl]{Declarations}+*                                                                      *+************************************************************************+-}++type LHsDecl p = Located (HsDecl p)+        -- ^ When in a list this may have+        --+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'+        --++-- For details on above see note [Api annotations] in ApiAnnotation++-- | A Haskell Declaration+data HsDecl p+  = TyClD      (XTyClD p)      (TyClDecl p)      -- ^ Type or Class Declaration+  | InstD      (XInstD p)      (InstDecl  p)     -- ^ Instance declaration+  | DerivD     (XDerivD p)     (DerivDecl p)     -- ^ Deriving declaration+  | ValD       (XValD p)       (HsBind p)        -- ^ Value declaration+  | SigD       (XSigD p)       (Sig p)           -- ^ Signature declaration+  | DefD       (XDefD p)       (DefaultDecl p)   -- ^ 'default' declaration+  | ForD       (XForD p)       (ForeignDecl p)   -- ^ Foreign declaration+  | WarningD   (XWarningD p)   (WarnDecls p)     -- ^ Warning declaration+  | AnnD       (XAnnD p)       (AnnDecl p)       -- ^ Annotation declaration+  | RuleD      (XRuleD p)      (RuleDecls p)     -- ^ Rule declaration+  | SpliceD    (XSpliceD p)    (SpliceDecl p)    -- ^ Splice declaration+                                                 -- (Includes quasi-quotes)+  | DocD       (XDocD p)       (DocDecl)  -- ^ Documentation comment declaration+  | RoleAnnotD (XRoleAnnotD p) (RoleAnnotDecl p) -- ^Role annotation declaration+  | XHsDecl    (XXHsDecl p)++type instance XTyClD      (GhcPass _) = NoExt+type instance XInstD      (GhcPass _) = NoExt+type instance XDerivD     (GhcPass _) = NoExt+type instance XValD       (GhcPass _) = NoExt+type instance XSigD       (GhcPass _) = NoExt+type instance XDefD       (GhcPass _) = NoExt+type instance XForD       (GhcPass _) = NoExt+type instance XWarningD   (GhcPass _) = NoExt+type instance XAnnD       (GhcPass _) = NoExt+type instance XRuleD      (GhcPass _) = NoExt+type instance XSpliceD    (GhcPass _) = NoExt+type instance XDocD       (GhcPass _) = NoExt+type instance XRoleAnnotD (GhcPass _) = NoExt+type instance XXHsDecl    (GhcPass _) = NoExt++-- NB: all top-level fixity decls are contained EITHER+-- EITHER SigDs+-- OR     in the ClassDecls in TyClDs+--+-- The former covers+--      a) data constructors+--      b) class methods (but they can be also done in the+--              signatures of class decls)+--      c) imported functions (that have an IfacSig)+--      d) top level decls+--+-- The latter is for class methods only++-- | Haskell Group+--+-- A 'HsDecl' is categorised into a 'HsGroup' before being+-- fed to the renamer.+data HsGroup p+  = HsGroup {+        hs_ext    :: XCHsGroup p,+        hs_valds  :: HsValBinds p,+        hs_splcds :: [LSpliceDecl p],++        hs_tyclds :: [TyClGroup p],+                -- A list of mutually-recursive groups;+                -- This includes `InstDecl`s as well;+                -- Parser generates a singleton list;+                -- renamer does dependency analysis++        hs_derivds :: [LDerivDecl p],++        hs_fixds  :: [LFixitySig p],+                -- Snaffled out of both top-level fixity signatures,+                -- and those in class declarations++        hs_defds  :: [LDefaultDecl p],+        hs_fords  :: [LForeignDecl p],+        hs_warnds :: [LWarnDecls p],+        hs_annds  :: [LAnnDecl p],+        hs_ruleds :: [LRuleDecls p],++        hs_docs   :: [LDocDecl]+    }+  | XHsGroup (XXHsGroup p)++type instance XCHsGroup (GhcPass _) = NoExt+type instance XXHsGroup (GhcPass _) = NoExt+++emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p)+emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }+emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }++hsGroupInstDecls :: HsGroup id -> [LInstDecl id]+hsGroupInstDecls = (=<<) group_instds . hs_tyclds++emptyGroup = HsGroup { hs_ext = noExt,+                       hs_tyclds = [],+                       hs_derivds = [],+                       hs_fixds = [], hs_defds = [], hs_annds = [],+                       hs_fords = [], hs_warnds = [], hs_ruleds = [],+                       hs_valds = error "emptyGroup hs_valds: Can't happen",+                       hs_splcds = [],+                       hs_docs = [] }++appendGroups :: HsGroup (GhcPass p) -> HsGroup (GhcPass p)+             -> HsGroup (GhcPass p)+appendGroups+    HsGroup {+        hs_valds  = val_groups1,+        hs_splcds = spliceds1,+        hs_tyclds = tyclds1,+        hs_derivds = derivds1,+        hs_fixds  = fixds1,+        hs_defds  = defds1,+        hs_annds  = annds1,+        hs_fords  = fords1,+        hs_warnds = warnds1,+        hs_ruleds = rulds1,+        hs_docs   = docs1 }+    HsGroup {+        hs_valds  = val_groups2,+        hs_splcds = spliceds2,+        hs_tyclds = tyclds2,+        hs_derivds = derivds2,+        hs_fixds  = fixds2,+        hs_defds  = defds2,+        hs_annds  = annds2,+        hs_fords  = fords2,+        hs_warnds = warnds2,+        hs_ruleds = rulds2,+        hs_docs   = docs2 }+  =+    HsGroup {+        hs_ext    = noExt,+        hs_valds  = val_groups1 `plusHsValBinds` val_groups2,+        hs_splcds = spliceds1 ++ spliceds2,+        hs_tyclds = tyclds1 ++ tyclds2,+        hs_derivds = derivds1 ++ derivds2,+        hs_fixds  = fixds1 ++ fixds2,+        hs_annds  = annds1 ++ annds2,+        hs_defds  = defds1 ++ defds2,+        hs_fords  = fords1 ++ fords2,+        hs_warnds = warnds1 ++ warnds2,+        hs_ruleds = rulds1 ++ rulds2,+        hs_docs   = docs1  ++ docs2 }+appendGroups _ _ = panic "appendGroups"++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsDecl p) where+    ppr (TyClD _ dcl)             = ppr dcl+    ppr (ValD _ binds)            = ppr binds+    ppr (DefD _ def)              = ppr def+    ppr (InstD _ inst)            = ppr inst+    ppr (DerivD _ deriv)          = ppr deriv+    ppr (ForD _ fd)               = ppr fd+    ppr (SigD _ sd)               = ppr sd+    ppr (RuleD _ rd)              = ppr rd+    ppr (WarningD _ wd)           = ppr wd+    ppr (AnnD _ ad)               = ppr ad+    ppr (SpliceD _ dd)            = ppr dd+    ppr (DocD _ doc)              = ppr doc+    ppr (RoleAnnotD _ ra)         = ppr ra+    ppr (XHsDecl x)               = ppr x++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsGroup p) where+    ppr (HsGroup { hs_valds  = val_decls,+                   hs_tyclds = tycl_decls,+                   hs_derivds = deriv_decls,+                   hs_fixds  = fix_decls,+                   hs_warnds = deprec_decls,+                   hs_annds  = ann_decls,+                   hs_fords  = foreign_decls,+                   hs_defds  = default_decls,+                   hs_ruleds = rule_decls })+        = vcat_mb empty+            [ppr_ds fix_decls, ppr_ds default_decls,+             ppr_ds deprec_decls, ppr_ds ann_decls,+             ppr_ds rule_decls,+             if isEmptyValBinds val_decls+                then Nothing+                else Just (ppr val_decls),+             ppr_ds (tyClGroupTyClDecls tycl_decls),+             ppr_ds (tyClGroupInstDecls tycl_decls),+             ppr_ds deriv_decls,+             ppr_ds foreign_decls]+        where+          ppr_ds :: Outputable a => [a] -> Maybe SDoc+          ppr_ds [] = Nothing+          ppr_ds ds = Just (vcat (map ppr ds))++          vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc+          -- Concatenate vertically with white-space between non-blanks+          vcat_mb _    []             = empty+          vcat_mb gap (Nothing : ds) = vcat_mb gap ds+          vcat_mb gap (Just d  : ds) = gap $$ d $$ vcat_mb blankLine ds+    ppr (XHsGroup x) = ppr x++-- | Located Splice Declaration+type LSpliceDecl pass = Located (SpliceDecl pass)++-- | Splice Declaration+data SpliceDecl p+  = SpliceDecl                  -- Top level splice+        (XSpliceDecl p)+        (Located (HsSplice p))+        SpliceExplicitFlag+  | XSpliceDecl (XXSpliceDecl p)++type instance XSpliceDecl      (GhcPass _) = NoExt+type instance XXSpliceDecl     (GhcPass _) = NoExt++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (SpliceDecl p) where+   ppr (SpliceDecl _ (L _ e) f) = pprSpliceDecl e f+   ppr (XSpliceDecl x) = ppr x++{-+************************************************************************+*                                                                      *+            Type and class declarations+*                                                                      *+************************************************************************++Note [The Naming story]+~~~~~~~~~~~~~~~~~~~~~~~+Here is the story about the implicit names that go with type, class,+and instance decls.  It's a bit tricky, so pay attention!++"Implicit" (or "system") binders+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+  Each data type decl defines+        a worker name for each constructor+        to-T and from-T convertors+  Each class decl defines+        a tycon for the class+        a data constructor for that tycon+        the worker for that constructor+        a selector for each superclass++All have occurrence names that are derived uniquely from their parent+declaration.++None of these get separate definitions in an interface file; they are+fully defined by the data or class decl.  But they may *occur* in+interface files, of course.  Any such occurrence must haul in the+relevant type or class decl.++Plan of attack:+ - Ensure they "point to" the parent data/class decl+   when loading that decl from an interface file+   (See RnHiFiles.getSysBinders)++ - When typechecking the decl, we build the implicit TyCons and Ids.+   When doing so we look them up in the name cache (RnEnv.lookupSysName),+   to ensure correct module and provenance is set++These are the two places that we have to conjure up the magic derived+names.  (The actual magic is in OccName.mkWorkerOcc, etc.)++Default methods+~~~~~~~~~~~~~~~+ - Occurrence name is derived uniquely from the method name+   E.g. $dmmax++ - If there is a default method name at all, it's recorded in+   the ClassOpSig (in HsBinds), in the DefMethInfo field.+   (DefMethInfo is defined in Class.hs)++Source-code class decls and interface-code class decls are treated subtly+differently, which has given me a great deal of confusion over the years.+Here's the deal.  (We distinguish the two cases because source-code decls+have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.++In *source-code* class declarations:++ - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName+   This is done by RdrHsSyn.mkClassOpSigDM++ - The renamer renames it to a Name++ - During typechecking, we generate a binding for each $dm for+   which there's a programmer-supplied default method:+        class Foo a where+          op1 :: <type>+          op2 :: <type>+          op1 = ...+   We generate a binding for $dmop1 but not for $dmop2.+   The Class for Foo has a Nothing for op2 and+                         a Just ($dm_op1, VanillaDM) for op1.+   The Name for $dmop2 is simply discarded.++In *interface-file* class declarations:+  - When parsing, we see if there's an explicit programmer-supplied default method+    because there's an '=' sign to indicate it:+        class Foo a where+          op1 = :: <type>       -- NB the '='+          op2   :: <type>+    We use this info to generate a DefMeth with a suitable RdrName for op1,+    and a NoDefMeth for op2+  - The interface file has a separate definition for $dmop1, with unfolding etc.+  - The renamer renames it to a Name.+  - The renamer treats $dmop1 as a free variable of the declaration, so that+    the binding for $dmop1 will be sucked in.  (See RnHsSyn.tyClDeclFVs)+    This doesn't happen for source code class decls, because they *bind* the default method.++Dictionary functions+~~~~~~~~~~~~~~~~~~~~+Each instance declaration gives rise to one dictionary function binding.++The type checker makes up new source-code instance declarations+(e.g. from 'deriving' or generic default methods --- see+TcInstDcls.tcInstDecls1).  So we can't generate the names for+dictionary functions in advance (we don't know how many we need).++On the other hand for interface-file instance declarations, the decl+specifies the name of the dictionary function, and it has a binding elsewhere+in the interface file:+        instance {Eq Int} = dEqInt+        dEqInt :: {Eq Int} <pragma info>++So again we treat source code and interface file code slightly differently.++Source code:+  - Source code instance decls have a Nothing in the (Maybe name) field+    (see data InstDecl below)++  - The typechecker makes up a Local name for the dict fun for any source-code+    instance decl, whether it comes from a source-code instance decl, or whether+    the instance decl is derived from some other construct (e.g. 'deriving').++  - The occurrence name it chooses is derived from the instance decl (just for+    documentation really) --- e.g. dNumInt.  Two dict funs may share a common+    occurrence name, but will have different uniques.  E.g.+        instance Foo [Int]  where ...+        instance Foo [Bool] where ...+    These might both be dFooList++  - The CoreTidy phase externalises the name, and ensures the occurrence name is+    unique (this isn't special to dict funs).  So we'd get dFooList and dFooList1.++  - We can take this relaxed approach (changing the occurrence name later)+    because dict fun Ids are not captured in a TyCon or Class (unlike default+    methods, say).  Instead, they are kept separately in the InstEnv.  This+    makes it easy to adjust them after compiling a module.  (Once we've finished+    compiling that module, they don't change any more.)+++Interface file code:+  - The instance decl gives the dict fun name, so the InstDecl has a (Just name)+    in the (Maybe name) field.++  - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we+    suck in the dfun binding+-}++-- | Located Declaration of a Type or Class+type LTyClDecl pass = Located (TyClDecl pass)++-- | A type or class declaration.+data TyClDecl pass+  = -- | @type/data family T :: *->*@+    --+    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',+    --             'ApiAnnotation.AnnData',+    --             'ApiAnnotation.AnnFamily','ApiAnnotation.AnnDcolon',+    --             'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpenP',+    --             'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnCloseP',+    --             'ApiAnnotation.AnnEqual','ApiAnnotation.AnnRarrow',+    --             'ApiAnnotation.AnnVbar'++    -- For details on above see note [Api annotations] in ApiAnnotation+    FamDecl { tcdFExt :: XFamDecl pass, tcdFam :: FamilyDecl pass }++  | -- | @type@ declaration+    --+    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',+    --             'ApiAnnotation.AnnEqual',++    -- For details on above see note [Api annotations] in ApiAnnotation+    SynDecl { tcdSExt   :: XSynDecl pass          -- ^ Post renameer, FVs+            , tcdLName  :: Located (IdP pass)     -- ^ Type constructor+            , tcdTyVars :: LHsQTyVars pass        -- ^ Type variables; for an+                                                  -- associated type these+                                                  -- include outer binders+            , tcdFixity :: LexicalFixity    -- ^ Fixity used in the declaration+            , tcdRhs    :: LHsType pass }         -- ^ RHS of type declaration++  | -- | @data@ declaration+    --+    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',+    --              'ApiAnnotation.AnnFamily',+    --              'ApiAnnotation.AnnNewType',+    --              'ApiAnnotation.AnnNewType','ApiAnnotation.AnnDcolon'+    --              'ApiAnnotation.AnnWhere',++    -- For details on above see note [Api annotations] in ApiAnnotation+    DataDecl { tcdDExt     :: XDataDecl pass       -- ^ Post renamer, CUSK flag, FVs+             , tcdLName    :: Located (IdP pass)   -- ^ Type constructor+             , tcdTyVars   :: LHsQTyVars pass      -- ^ Type variables+                              -- See Note [TyVar binders for associated declarations]+             , tcdFixity   :: LexicalFixity        -- ^ Fixity used in the declaration+             , tcdDataDefn :: HsDataDefn pass }++  | ClassDecl { tcdCExt    :: XClassDecl pass,         -- ^ Post renamer, FVs+                tcdCtxt    :: LHsContext pass,         -- ^ Context...+                tcdLName   :: Located (IdP pass),      -- ^ Name of the class+                tcdTyVars  :: LHsQTyVars pass,         -- ^ Class type variables+                tcdFixity  :: LexicalFixity, -- ^ Fixity used in the declaration+                tcdFDs     :: [LHsFunDep pass],         -- ^ Functional deps+                tcdSigs    :: [LSig pass],              -- ^ Methods' signatures+                tcdMeths   :: LHsBinds pass,            -- ^ Default methods+                tcdATs     :: [LFamilyDecl pass],       -- ^ Associated types;+                tcdATDefs  :: [LTyFamDefltEqn pass],    -- ^ Associated type defaults+                tcdDocs    :: [LDocDecl]                -- ^ Haddock docs+    }+        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnClass',+        --           'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',+        --           'ApiAnnotation.AnnClose'+        --   - The tcdFDs will have 'ApiAnnotation.AnnVbar',+        --                          'ApiAnnotation.AnnComma'+        --                          'ApiAnnotation.AnnRarrow'++        -- For details on above see note [Api annotations] in ApiAnnotation+  | XTyClDecl (XXTyClDecl pass)++type LHsFunDep pass = Located (FunDep (Located (IdP pass)))++data DataDeclRn = DataDeclRn+             { tcdDataCusk :: Bool    -- ^ does this have a CUSK?+             , tcdFVs      :: NameSet }+  deriving Data++{- Note [TyVar binders for associated decls]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For an /associated/ data, newtype, or type-family decl, the LHsQTyVars+/includes/ outer binders.  For example+    class T a where+       data D a c+       type F a b :: *+       type F a b = a -> a+Here the data decl for 'D', and type-family decl for 'F', both include 'a'+in their LHsQTyVars (tcdTyVars and fdTyVars resp).++Ditto any implicit binders in the hsq_implicit field of the LHSQTyVars.++The idea is that the associated type is really a top-level decl in its+own right.  However we are careful to use the same name 'a', so that+we can match things up.++c.f. Note [Associated type tyvar names] in Class.hs+     Note [Family instance declaration binders]+-}++type instance XFamDecl      (GhcPass _) = NoExt++type instance XSynDecl      GhcPs = NoExt+type instance XSynDecl      GhcRn = NameSet -- FVs+type instance XSynDecl      GhcTc = NameSet -- FVs++type instance XDataDecl     GhcPs = NoExt+type instance XDataDecl     GhcRn = DataDeclRn+type instance XDataDecl     GhcTc = DataDeclRn++type instance XClassDecl    GhcPs = NoExt+type instance XClassDecl    GhcRn = NameSet -- FVs+type instance XClassDecl    GhcTc = NameSet -- FVs++type instance XXTyClDecl    (GhcPass _) = NoExt++-- Simple classifiers for TyClDecl+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++-- | @True@ <=> argument is a @data@\/@newtype@+-- declaration.+isDataDecl :: TyClDecl pass -> Bool+isDataDecl (DataDecl {}) = True+isDataDecl _other        = False++-- | type or type instance declaration+isSynDecl :: TyClDecl pass -> Bool+isSynDecl (SynDecl {})   = True+isSynDecl _other        = False++-- | type class+isClassDecl :: TyClDecl pass -> Bool+isClassDecl (ClassDecl {}) = True+isClassDecl _              = False++-- | type/data family declaration+isFamilyDecl :: TyClDecl pass -> Bool+isFamilyDecl (FamDecl {})  = True+isFamilyDecl _other        = False++-- | type family declaration+isTypeFamilyDecl :: TyClDecl pass -> Bool+isTypeFamilyDecl (FamDecl _ (FamilyDecl { fdInfo = info })) = case info of+  OpenTypeFamily      -> True+  ClosedTypeFamily {} -> True+  _                   -> False+isTypeFamilyDecl _ = False++-- | open type family info+isOpenTypeFamilyInfo :: FamilyInfo pass -> Bool+isOpenTypeFamilyInfo OpenTypeFamily = True+isOpenTypeFamilyInfo _              = False++-- | closed type family info+isClosedTypeFamilyInfo :: FamilyInfo pass -> Bool+isClosedTypeFamilyInfo (ClosedTypeFamily {}) = True+isClosedTypeFamilyInfo _                     = False++-- | data family declaration+isDataFamilyDecl :: TyClDecl pass -> Bool+isDataFamilyDecl (FamDecl _ (FamilyDecl { fdInfo = DataFamily })) = True+isDataFamilyDecl _other      = False++-- Dealing with names++tyFamInstDeclName :: TyFamInstDecl pass -> (IdP pass)+tyFamInstDeclName = unLoc . tyFamInstDeclLName++tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass)+tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =+                     (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })+  = ln+tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn _)))+  = panic "tyFamInstDeclLName"+tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs _))+  = panic "tyFamInstDeclLName"++tyClDeclLName :: TyClDecl pass -> Located (IdP pass)+tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln+tyClDeclLName decl = tcdLName decl++tcdName :: TyClDecl pass -> (IdP pass)+tcdName = unLoc . tyClDeclLName++tyClDeclTyVars :: TyClDecl pass -> LHsQTyVars pass+tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs+tyClDeclTyVars d = tcdTyVars d++countTyClDecls :: [TyClDecl pass] -> (Int, Int, Int, Int, Int)+        -- class, synonym decls, data, newtype, family decls+countTyClDecls decls+ = (count isClassDecl    decls,+    count isSynDecl      decls,  -- excluding...+    count isDataTy       decls,  -- ...family...+    count isNewTy        decls,  -- ...instances+    count isFamilyDecl   decls)+ where+   isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = DataType } } = True+   isDataTy _                                                       = False++   isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True+   isNewTy _                                                      = False++-- | Does this declaration have a complete, user-supplied kind signature?+-- See Note [CUSKs: complete user-supplied kind signatures]+hsDeclHasCusk :: TyClDecl GhcRn -> Bool+hsDeclHasCusk (FamDecl { tcdFam = fam_decl })+  = famDeclHasCusk False fam_decl+    -- False: this is not: an associated type of a class with no cusk+hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })+  -- NB: Keep this synchronized with 'getInitialKind'+  = hsTvbAllKinded tyvars && rhs_annotated rhs+  where+    rhs_annotated (L _ ty) = case ty of+      HsParTy _ lty  -> rhs_annotated lty+      HsKindSig {}   -> True+      _              -> False+hsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk+hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars+hsDeclHasCusk (XTyClDecl _) = panic "hsDeclHasCusk"++-- Pretty-printing TyClDecl+-- ~~~~~~~~~~~~~~~~~~~~~~~~++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (TyClDecl p) where++    ppr (FamDecl { tcdFam = decl }) = ppr decl+    ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity+                 , tcdRhs = rhs })+      = hang (text "type" <+>+              pp_vanilla_decl_head ltycon tyvars fixity noLHsContext <+> equals)+          4 (ppr rhs)++    ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity+                  , tcdDataDefn = defn })+      = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn++    ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,+                    tcdFixity = fixity,+                    tcdFDs  = fds,+                    tcdSigs = sigs, tcdMeths = methods,+                    tcdATs = ats, tcdATDefs = at_defs})+      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part+      = top_matter++      | otherwise       -- Laid out+      = vcat [ top_matter <+> text "where"+             , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats +++                                     map ppr_fam_deflt_eqn at_defs +++                                     pprLHsBindsForUser methods sigs) ]+      where+        top_matter = text "class"+                    <+> pp_vanilla_decl_head lclas tyvars fixity context+                    <+> pprFundeps (map unLoc fds)++    ppr (XTyClDecl x) = ppr x++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (TyClGroup p) where+  ppr (TyClGroup { group_tyclds = tyclds+                 , group_roles = roles+                 , group_instds = instds+                 }+      )+    = ppr tyclds $$+      ppr roles $$+      ppr instds+  ppr (XTyClGroup x) = ppr x++pp_vanilla_decl_head :: (OutputableBndrId (GhcPass p))+   => Located (IdP (GhcPass p))+   -> LHsQTyVars (GhcPass p)+   -> LexicalFixity+   -> LHsContext (GhcPass p)+   -> SDoc+pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context+ = hsep [pprLHsContext context, pp_tyvars tyvars]+  where+    pp_tyvars (varl:varsr)+      | fixity == Infix && length varsr > 1+         = hsep [char '(',ppr (unLoc varl), pprInfixOcc (unLoc thing)+                , (ppr.unLoc) (head varsr), char ')'+                , hsep (map (ppr.unLoc) (tail varsr))]+      | fixity == Infix+         = hsep [ppr (unLoc varl), pprInfixOcc (unLoc thing)+         , hsep (map (ppr.unLoc) varsr)]+      | otherwise = hsep [ pprPrefixOcc (unLoc thing)+                  , hsep (map (ppr.unLoc) (varl:varsr))]+    pp_tyvars [] = pprPrefixOcc (unLoc thing)+pp_vanilla_decl_head _ (XLHsQTyVars x) _ _ = ppr x++pprTyClDeclFlavour :: TyClDecl (GhcPass p) -> SDoc+pprTyClDeclFlavour (ClassDecl {})   = text "class"+pprTyClDeclFlavour (SynDecl {})     = text "type"+pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})+  = pprFlavour info <+> text "family"+pprTyClDeclFlavour (FamDecl { tcdFam = XFamilyDecl x})+  = ppr x+pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })+  = ppr nd+pprTyClDeclFlavour (DataDecl { tcdDataDefn = XHsDataDefn x })+  = ppr x+pprTyClDeclFlavour (XTyClDecl x) = ppr x+++{- Note [CUSKs: complete user-supplied kind signatures]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We kind-check declarations differently if they have a complete, user-supplied+kind signature (CUSK). This is because we can safely generalise a CUSKed+declaration before checking all of the others, supporting polymorphic recursion.+See https://gitlab.haskell.org/ghc/ghc/wikis/ghc-kinds/kind-inference#proposed-new-strategy+and #9200 for lots of discussion of how we got here.++PRINCIPLE:+  a type declaration has a CUSK iff we could produce a separate kind signature+  for it, just like a type signature for a function,+  looking only at the header of the declaration.++Examples:+  * data T1 (a :: *->*) (b :: *) = ....+    -- Has CUSK; equivalant to   T1 :: (*->*) -> * -> *++ * data T2 a b = ...+   -- No CUSK; we do not want to guess T2 :: * -> * -> *+   -- because the full decl might be   data T a b = MkT (a b)++  * data T3 (a :: k -> *) (b :: *) = ...+    -- CUSK; equivalent to   T3 :: (k -> *) -> * -> *+    -- We lexically generalise over k to get+    --    T3 :: forall k. (k -> *) -> * -> *+    -- The generalisation is here is purely lexical, just like+    --    f3 :: a -> a+    -- means+    --    f3 :: forall a. a -> a++  * data T4 (a :: j k) = ...+     -- CUSK; equivalent to   T4 :: j k -> *+     -- which we lexically generalise to  T4 :: forall j k. j k -> *+     -- and then, if PolyKinds is on, we further generalise to+     --   T4 :: forall kk (j :: kk -> *) (k :: kk). j k -> *+     -- Again this is exactly like what happens as the term level+     -- when you write+     --    f4 :: forall a b. a b -> Int++NOTE THAT+  * A CUSK does /not/ mean that everything about the kind signature is+    fully specified by the user.  Look at T4 and f4: we had do do kind+    inference to figure out the kind-quantification.  But in both cases+    (T4 and f4) that inference is done looking /only/ at the header of T4+    (or signature for f4), not at the definition thereof.++  * The CUSK completely fixes the kind of the type constructor, forever.++  * The precise rules, for each declaration form, for whethher a declaration+    has a CUSK are given in the user manual section "Complete user-supplied+    kind signatures and polymorphic recursion".  BUt they simply implement+    PRINCIPLE above.++  * Open type families are interesting:+      type family T5 a b :: *+    There simply /is/ no accompanying declaration, so that info is all+    we'll ever get.  So we it has a CUSK by definition, and we default+    any un-fixed kind variables to *.++  * Associated types are a bit tricker:+      class C6 a where+         type family T6 a b :: *+         op :: a Int -> Int+    Here C6 does not have a CUSK (in fact we ultimately discover that+    a :: * -> *).  And hence neither does T6, the associated family,+    because we can't fix its kind until we have settled C6.  Another+    way to say it: unlike a top-level, we /may/ discover more about+    a's kind from C6's definition.++  * A data definition with a top-level :: must explicitly bind all+    kind variables to the right of the ::. See test+    dependent/should_compile/KindLevels, which requires this+    case. (Naturally, any kind variable mentioned before the :: should+    not be bound after it.)++    This last point is much more debatable than the others; see+    #15142 comment:22+-}+++{- *********************************************************************+*                                                                      *+                         TyClGroup+        Strongly connected components of+      type, class, instance, and role declarations+*                                                                      *+********************************************************************* -}++{- Note [TyClGroups and dependency analysis]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A TyClGroup represents a strongly connected components of type/class/instance+decls, together with the role annotations for the type/class declarations.++The hs_tyclds :: [TyClGroup] field of a HsGroup is a dependency-order+sequence of strongly-connected components.++Invariants+ * The type and class declarations, group_tyclds, may depend on each+   other, or earlier TyClGroups, but not on later ones++ * The role annotations, group_roles, are role-annotations for some or+   all of the types and classes in group_tyclds (only).++ * The instance declarations, group_instds, may (and usually will)+   depend on group_tyclds, or on earlier TyClGroups, but not on later+   ones.++See Note [Dependency analsis of type, class, and instance decls]+in RnSource for more info.+-}++-- | Type or Class Group+data TyClGroup pass  -- See Note [TyClGroups and dependency analysis]+  = TyClGroup { group_ext    :: XCTyClGroup pass+              , group_tyclds :: [LTyClDecl pass]+              , group_roles  :: [LRoleAnnotDecl pass]+              , group_instds :: [LInstDecl pass] }+  | XTyClGroup (XXTyClGroup pass)++type instance XCTyClGroup (GhcPass _) = NoExt+type instance XXTyClGroup (GhcPass _) = NoExt+++emptyTyClGroup :: TyClGroup (GhcPass p)+emptyTyClGroup = TyClGroup noExt [] [] []++tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass]+tyClGroupTyClDecls = concatMap group_tyclds++tyClGroupInstDecls :: [TyClGroup pass] -> [LInstDecl pass]+tyClGroupInstDecls = concatMap group_instds++tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass]+tyClGroupRoleDecls = concatMap group_roles++mkTyClGroup :: [LTyClDecl (GhcPass p)] -> [LInstDecl (GhcPass p)]+            -> TyClGroup (GhcPass p)+mkTyClGroup decls instds = TyClGroup+  { group_ext = noExt+  , group_tyclds = decls+  , group_roles = []+  , group_instds = instds+  }++++{- *********************************************************************+*                                                                      *+               Data and type family declarations+*                                                                      *+********************************************************************* -}++{- Note [FamilyResultSig]+~~~~~~~~~~~~~~~~~~~~~~~~~++This data type represents the return signature of a type family.  Possible+values are:++ * NoSig - the user supplied no return signature:+      type family Id a where ...++ * KindSig - the user supplied the return kind:+      type family Id a :: * where ...++ * TyVarSig - user named the result with a type variable and possibly+   provided a kind signature for that variable:+      type family Id a = r where ...+      type family Id a = (r :: *) where ...++   Naming result of a type family is required if we want to provide+   injectivity annotation for a type family:+      type family Id a = r | r -> a where ...++See also: Note [Injectivity annotation]++Note [Injectivity annotation]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++A user can declare a type family to be injective:++   type family Id a = r | r -> a where ...++ * The part after the "|" is called "injectivity annotation".+ * "r -> a" part is called "injectivity condition"; at the moment terms+   "injectivity annotation" and "injectivity condition" are synonymous+   because we only allow a single injectivity condition.+ * "r" is the "LHS of injectivity condition". LHS can only contain the+   variable naming the result of a type family.++ * "a" is the "RHS of injectivity condition". RHS contains space-separated+   type and kind variables representing the arguments of a type+   family. Variables can be omitted if a type family is not injective in+   these arguments. Example:+         type family Foo a b c = d | d -> a c where ...++Note that:+ (a) naming of type family result is required to provide injectivity+     annotation+ (b) for associated types if the result was named then injectivity annotation+     is mandatory. Otherwise result type variable is indistinguishable from+     associated type default.++It is possible that in the future this syntax will be extended to support+more complicated injectivity annotations. For example we could declare that+if we know the result of Plus and one of its arguments we can determine the+other argument:++   type family Plus a b = (r :: Nat) | r a -> b, r b -> a where ...++Here injectivity annotation would consist of two comma-separated injectivity+conditions.++See also Note [Injective type families] in TyCon+-}++-- | Located type Family Result Signature+type LFamilyResultSig pass = Located (FamilyResultSig pass)++-- | type Family Result Signature+data FamilyResultSig pass = -- see Note [FamilyResultSig]+    NoSig (XNoSig pass)+  -- ^ - 'ApiAnnotation.AnnKeywordId' :++  -- For details on above see note [Api annotations] in ApiAnnotation++  | KindSig  (XCKindSig pass) (LHsKind pass)+  -- ^ - 'ApiAnnotation.AnnKeywordId' :+  --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',+  --             'ApiAnnotation.AnnCloseP'++  -- For details on above see note [Api annotations] in ApiAnnotation++  | TyVarSig (XTyVarSig pass) (LHsTyVarBndr pass)+  -- ^ - 'ApiAnnotation.AnnKeywordId' :+  --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',+  --             'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual'+  | XFamilyResultSig (XXFamilyResultSig pass)++  -- For details on above see note [Api annotations] in ApiAnnotation++type instance XNoSig            (GhcPass _) = NoExt+type instance XCKindSig         (GhcPass _) = NoExt+type instance XTyVarSig         (GhcPass _) = NoExt+type instance XXFamilyResultSig (GhcPass _) = NoExt+++-- | Located type Family Declaration+type LFamilyDecl pass = Located (FamilyDecl pass)++-- | type Family Declaration+data FamilyDecl pass = FamilyDecl+  { fdExt            :: XCFamilyDecl pass+  , fdInfo           :: FamilyInfo pass              -- type/data, closed/open+  , fdLName          :: Located (IdP pass)           -- type constructor+  , fdTyVars         :: LHsQTyVars pass              -- type variables+                       -- See Note [TyVar binders for associated declarations]+  , fdFixity         :: LexicalFixity                -- Fixity used in the declaration+  , fdResultSig      :: LFamilyResultSig pass        -- result signature+  , fdInjectivityAnn :: Maybe (LInjectivityAnn pass) -- optional injectivity ann+  }+  | XFamilyDecl (XXFamilyDecl pass)+  -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',+  --             'ApiAnnotation.AnnData', 'ApiAnnotation.AnnFamily',+  --             'ApiAnnotation.AnnWhere', 'ApiAnnotation.AnnOpenP',+  --             'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnCloseP',+  --             'ApiAnnotation.AnnEqual', 'ApiAnnotation.AnnRarrow',+  --             'ApiAnnotation.AnnVbar'++  -- For details on above see note [Api annotations] in ApiAnnotation++type instance XCFamilyDecl    (GhcPass _) = NoExt+type instance XXFamilyDecl    (GhcPass _) = NoExt+++-- | Located Injectivity Annotation+type LInjectivityAnn pass = Located (InjectivityAnn pass)++-- | If the user supplied an injectivity annotation it is represented using+-- InjectivityAnn. At the moment this is a single injectivity condition - see+-- Note [Injectivity annotation]. `Located name` stores the LHS of injectivity+-- condition. `[Located name]` stores the RHS of injectivity condition. Example:+--+--   type family Foo a b c = r | r -> a c where ...+--+-- This will be represented as "InjectivityAnn `r` [`a`, `c`]"+data InjectivityAnn pass+  = InjectivityAnn (Located (IdP pass)) [Located (IdP pass)]+  -- ^ - 'ApiAnnotation.AnnKeywordId' :+  --             'ApiAnnotation.AnnRarrow', 'ApiAnnotation.AnnVbar'++  -- For details on above see note [Api annotations] in ApiAnnotation++data FamilyInfo pass+  = DataFamily+  | OpenTypeFamily+     -- | 'Nothing' if we're in an hs-boot file and the user+     -- said "type family Foo x where .."+  | ClosedTypeFamily (Maybe [LTyFamInstEqn pass])++-- | Does this family declaration have a complete, user-supplied kind signature?+-- See Note [CUSKs: complete user-supplied kind signatures]+famDeclHasCusk :: Bool -- ^ True <=> this is an associated type family,+                       --            and the parent class has /no/ CUSK+               -> FamilyDecl pass+               -> Bool+famDeclHasCusk assoc_with_no_cusk+               (FamilyDecl { fdInfo      = fam_info+                           , fdTyVars    = tyvars+                           , fdResultSig = L _ resultSig })+  = case fam_info of+      ClosedTypeFamily {} -> hsTvbAllKinded tyvars+                          && hasReturnKindSignature resultSig+      _ -> not assoc_with_no_cusk+            -- Un-associated open type/data families have CUSKs+            -- Associated type families have CUSKs iff the parent class does++famDeclHasCusk _ (XFamilyDecl {}) = panic "famDeclHasCusk"++-- | Does this family declaration have user-supplied return kind signature?+hasReturnKindSignature :: FamilyResultSig a -> Bool+hasReturnKindSignature (NoSig _)                        = False+hasReturnKindSignature (TyVarSig _ (L _ (UserTyVar{}))) = False+hasReturnKindSignature _                                = True++-- | Maybe return name of the result type variable+resultVariableName :: FamilyResultSig a -> Maybe (IdP a)+resultVariableName (TyVarSig _ sig) = Just $ hsLTyVarName sig+resultVariableName _                = Nothing++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (FamilyDecl p) where+  ppr = pprFamilyDecl TopLevel++pprFamilyDecl :: (OutputableBndrId (GhcPass p))+              => TopLevelFlag -> FamilyDecl (GhcPass p) -> SDoc+pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon+                                    , fdTyVars = tyvars+                                    , fdFixity = fixity+                                    , fdResultSig = L _ result+                                    , fdInjectivityAnn = mb_inj })+  = vcat [ pprFlavour info <+> pp_top_level <+>+           pp_vanilla_decl_head ltycon tyvars fixity noLHsContext <+>+           pp_kind <+> pp_inj <+> pp_where+         , nest 2 $ pp_eqns ]+  where+    pp_top_level = case top_level of+                     TopLevel    -> text "family"+                     NotTopLevel -> empty++    pp_kind = case result of+                NoSig    _         -> empty+                KindSig  _ kind    -> dcolon <+> ppr kind+                TyVarSig _ tv_bndr -> text "=" <+> ppr tv_bndr+                XFamilyResultSig x -> ppr x+    pp_inj = case mb_inj of+               Just (L _ (InjectivityAnn lhs rhs)) ->+                 hsep [ vbar, ppr lhs, text "->", hsep (map ppr rhs) ]+               Nothing -> empty+    (pp_where, pp_eqns) = case info of+      ClosedTypeFamily mb_eqns ->+        ( text "where"+        , case mb_eqns of+            Nothing   -> text ".."+            Just eqns -> vcat $ map (ppr_fam_inst_eqn . unLoc) eqns )+      _ -> (empty, empty)+pprFamilyDecl _ (XFamilyDecl x) = ppr x++pprFlavour :: FamilyInfo pass -> SDoc+pprFlavour DataFamily            = text "data"+pprFlavour OpenTypeFamily        = text "type"+pprFlavour (ClosedTypeFamily {}) = text "type"++instance Outputable (FamilyInfo pass) where+  ppr info = pprFlavour info <+> text "family"++++{- *********************************************************************+*                                                                      *+               Data types and data constructors+*                                                                      *+********************************************************************* -}++-- | Haskell Data type Definition+data HsDataDefn pass   -- The payload of a data type defn+                       -- Used *both* for vanilla data declarations,+                       --       *and* for data family instances+  = -- | Declares a data type or newtype, giving its constructors+    -- @+    --  data/newtype T a = <constrs>+    --  data/newtype instance T [a] = <constrs>+    -- @+    HsDataDefn { dd_ext    :: XCHsDataDefn pass,+                 dd_ND     :: NewOrData,+                 dd_ctxt   :: LHsContext pass,           -- ^ Context+                 dd_cType  :: Maybe (Located CType),+                 dd_kindSig:: Maybe (LHsKind pass),+                     -- ^ Optional kind signature.+                     --+                     -- @(Just k)@ for a GADT-style @data@,+                     -- or @data instance@ decl, with explicit kind sig+                     --+                     -- Always @Nothing@ for H98-syntax decls++                 dd_cons   :: [LConDecl pass],+                     -- ^ Data constructors+                     --+                     -- For @data T a = T1 | T2 a@+                     --   the 'LConDecl's all have 'ConDeclH98'.+                     -- For @data T a where { T1 :: T a }@+                     --   the 'LConDecls' all have 'ConDeclGADT'.++                 dd_derivs :: HsDeriving pass  -- ^ Optional 'deriving' claues++             -- For details on above see note [Api annotations] in ApiAnnotation+   }+  | XHsDataDefn (XXHsDataDefn pass)++type instance XCHsDataDefn    (GhcPass _) = NoExt+type instance XXHsDataDefn    (GhcPass _) = NoExt++-- | Haskell Deriving clause+type HsDeriving pass = Located [LHsDerivingClause pass]+  -- ^ The optional @deriving@ clauses of a data declaration. "Clauses" is+  -- plural because one can specify multiple deriving clauses using the+  -- @-XDerivingStrategies@ language extension.+  --+  -- The list of 'LHsDerivingClause's corresponds to exactly what the user+  -- requested to derive, in order. If no deriving clauses were specified,+  -- the list is empty.++type LHsDerivingClause pass = Located (HsDerivingClause pass)++-- | A single @deriving@ clause of a data declaration.+--+--  - 'ApiAnnotation.AnnKeywordId' :+--       'ApiAnnotation.AnnDeriving', 'ApiAnnotation.AnnStock',+--       'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',+--       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'+data HsDerivingClause pass+  -- See Note [Deriving strategies] in TcDeriv+  = HsDerivingClause+    { deriv_clause_ext :: XCHsDerivingClause pass+    , deriv_clause_strategy :: Maybe (LDerivStrategy pass)+      -- ^ The user-specified strategy (if any) to use when deriving+      -- 'deriv_clause_tys'.+    , deriv_clause_tys :: Located [LHsSigType pass]+      -- ^ The types to derive.+      --+      -- It uses 'LHsSigType's because, with @-XGeneralizedNewtypeDeriving@,+      -- we can mention type variables that aren't bound by the datatype, e.g.+      --+      -- > data T b = ... deriving (C [a])+      --+      -- should produce a derived instance for @C [a] (T b)@.+    }+  | XHsDerivingClause (XXHsDerivingClause pass)++type instance XCHsDerivingClause    (GhcPass _) = NoExt+type instance XXHsDerivingClause    (GhcPass _) = NoExt++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (HsDerivingClause p) where+  ppr (HsDerivingClause { deriv_clause_strategy = dcs+                        , deriv_clause_tys      = L _ dct })+    = hsep [ text "deriving"+           , pp_strat_before+           , pp_dct dct+           , pp_strat_after ]+      where+        -- This complexity is to distinguish between+        --    deriving Show+        --    deriving (Show)+        pp_dct [HsIB { hsib_body = ty }]+                 = ppr (parenthesizeHsType appPrec ty)+        pp_dct _ = parens (interpp'SP dct)++        -- @via@ is unique in that in comes /after/ the class being derived,+        -- so we must special-case it.+        (pp_strat_before, pp_strat_after) =+          case dcs of+            Just (L _ via@ViaStrategy{}) -> (empty, ppr via)+            _                            -> (ppDerivStrategy dcs, empty)+  ppr (XHsDerivingClause x) = ppr x++data NewOrData+  = NewType                     -- ^ @newtype Blah ...@+  | DataType                    -- ^ @data Blah ...@+  deriving( Eq, Data )                -- Needed because Demand derives Eq++-- | Convert a 'NewOrData' to a 'TyConFlavour'+newOrDataToFlavour :: NewOrData -> TyConFlavour+newOrDataToFlavour NewType  = NewtypeFlavour+newOrDataToFlavour DataType = DataTypeFlavour++-- | Located data Constructor Declaration+type LConDecl pass = Located (ConDecl pass)+      -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when+      --   in a GADT constructor list++  -- For details on above see note [Api annotations] in ApiAnnotation++-- |+--+-- @+-- data T b = forall a. Eq a => MkT a b+--   MkT :: forall b a. Eq a => MkT a b+--+-- data T b where+--      MkT1 :: Int -> T Int+--+-- data T = Int `MkT` Int+--        | MkT2+--+-- data T a where+--      Int `MkT` Int :: T Int+-- @+--+-- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',+--            'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnCLose',+--            'ApiAnnotation.AnnEqual','ApiAnnotation.AnnVbar',+--            'ApiAnnotation.AnnDarrow','ApiAnnotation.AnnDarrow',+--            'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot'++-- For details on above see note [Api annotations] in ApiAnnotation++-- | data Constructor Declaration+data ConDecl pass+  = ConDeclGADT+      { con_g_ext   :: XConDeclGADT pass+      , con_names   :: [Located (IdP pass)]++      -- The next four fields describe the type after the '::'+      -- See Note [GADT abstract syntax]+      -- The following field is Located to anchor API Annotations,+      -- AnnForall and AnnDot.+      , con_forall  :: Located Bool      -- ^ True <=> explicit forall+                                         --   False => hsq_explicit is empty+      , con_qvars   :: LHsQTyVars pass+                       -- Whether or not there is an /explicit/ forall, we still+                       -- need to capture the implicitly-bound type/kind variables++      , con_mb_cxt  :: Maybe (LHsContext pass) -- ^ User-written context (if any)+      , con_args    :: HsConDeclDetails pass   -- ^ Arguments; never InfixCon+      , con_res_ty  :: LHsType pass            -- ^ Result type++      , con_doc     :: Maybe LHsDocString+          -- ^ A possible Haddock comment.+      }++  | ConDeclH98+      { con_ext     :: XConDeclH98 pass+      , con_name    :: Located (IdP pass)++      , con_forall  :: Located Bool+                              -- ^ True <=> explicit user-written forall+                              --     e.g. data T a = forall b. MkT b (b->a)+                              --     con_ex_tvs = {b}+                              -- False => con_ex_tvs is empty+      , con_ex_tvs :: [LHsTyVarBndr pass]      -- ^ Existentials only+      , con_mb_cxt :: Maybe (LHsContext pass)  -- ^ User-written context (if any)+      , con_args   :: HsConDeclDetails pass    -- ^ Arguments; can be InfixCon++      , con_doc       :: Maybe LHsDocString+          -- ^ A possible Haddock comment.+      }+  | XConDecl (XXConDecl pass)++type instance XConDeclGADT (GhcPass _) = NoExt+type instance XConDeclH98  (GhcPass _) = NoExt+type instance XXConDecl    (GhcPass _) = NoExt++{- Note [GADT abstract syntax]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+There's a wrinkle in ConDeclGADT++* For record syntax, it's all uniform.  Given:+      data T a where+        K :: forall a. Ord a => { x :: [a], ... } -> T a+    we make the a ConDeclGADT for K with+       con_qvars  = {a}+       con_mb_cxt = Just [Ord a]+       con_args   = RecCon <the record fields>+       con_res_ty = T a++  We need the RecCon before the reanmer, so we can find the record field+  binders in HsUtils.hsConDeclsBinders.++* However for a GADT constr declaration which is not a record, it can+  be hard parse until we know operator fixities. Consider for example+     C :: a :*: b -> a :*: b -> a :+: b+  Initially this type will parse as+      a :*: (b -> (a :*: (b -> (a :+: b))))+  so it's hard to split up the arguments until we've done the precedence+  resolution (in the renamer).++  So:  - In the parser (RdrHsSyn.mkGadtDecl), we put the whole constr+         type into the res_ty for a ConDeclGADT for now, and use+         PrefixCon []+            con_args   = PrefixCon []+            con_res_ty = a :*: (b -> (a :*: (b -> (a :+: b))))++       - In the renamer (RnSource.rnConDecl), we unravel it afer+         operator fixities are sorted. So we generate. So we end+         up with+            con_args   = PrefixCon [ a :*: b, a :*: b ]+            con_res_ty = a :+: b+-}++-- | Haskell data Constructor Declaration Details+type HsConDeclDetails pass+   = HsConDetails (LBangType pass) (Located [LConDeclField pass])++getConNames :: ConDecl pass -> [Located (IdP pass)]+getConNames ConDeclH98  {con_name  = name}  = [name]+getConNames ConDeclGADT {con_names = names} = names+getConNames XConDecl {} = panic "getConNames"++getConArgs :: ConDecl pass -> HsConDeclDetails pass+getConArgs d = con_args d++hsConDeclArgTys :: HsConDeclDetails pass -> [LBangType pass]+hsConDeclArgTys (PrefixCon tys)    = tys+hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]+hsConDeclArgTys (RecCon flds)      = map (cd_fld_type . unLoc) (unLoc flds)++hsConDeclTheta :: Maybe (LHsContext pass) -> [LHsType pass]+hsConDeclTheta Nothing            = []+hsConDeclTheta (Just (L _ theta)) = theta++pp_data_defn :: (OutputableBndrId (GhcPass p))+                  => (LHsContext (GhcPass p) -> SDoc)   -- Printing the header+                  -> HsDataDefn (GhcPass p)+                  -> SDoc+pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = context+                                , dd_cType = mb_ct+                                , dd_kindSig = mb_sig+                                , dd_cons = condecls, dd_derivs = derivings })+  | null condecls+  = ppr new_or_data <+> pp_ct <+> pp_hdr context <+> pp_sig+    <+> pp_derivings derivings++  | otherwise+  = hang (ppr new_or_data <+> pp_ct  <+> pp_hdr context <+> pp_sig)+       2 (pp_condecls condecls $$ pp_derivings derivings)+  where+    pp_ct = case mb_ct of+               Nothing   -> empty+               Just ct -> ppr ct+    pp_sig = case mb_sig of+               Nothing   -> empty+               Just kind -> dcolon <+> ppr kind+    pp_derivings (L _ ds) = vcat (map ppr ds)+pp_data_defn _ (XHsDataDefn x) = ppr x++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (HsDataDefn p) where+   ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d++instance Outputable NewOrData where+  ppr NewType  = text "newtype"+  ppr DataType = text "data"++pp_condecls :: (OutputableBndrId (GhcPass p)) => [LConDecl (GhcPass p)] -> SDoc+pp_condecls cs@(L _ ConDeclGADT{} : _) -- In GADT syntax+  = hang (text "where") 2 (vcat (map ppr cs))+pp_condecls cs                    -- In H98 syntax+  = equals <+> sep (punctuate (text " |") (map ppr cs))++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ConDecl p) where+    ppr = pprConDecl++pprConDecl :: (OutputableBndrId (GhcPass p)) => ConDecl (GhcPass p) -> SDoc+pprConDecl (ConDeclH98 { con_name = L _ con+                       , con_ex_tvs = ex_tvs+                       , con_mb_cxt = mcxt+                       , con_args = args+                       , con_doc = doc })+  = sep [ppr_mbDoc doc, pprHsForAll ForallInvis ex_tvs cxt, ppr_details args]+  where+    ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprInfixOcc con, ppr t2]+    ppr_details (PrefixCon tys)  = hsep (pprPrefixOcc con+                                   : map (pprHsType . unLoc) tys)+    ppr_details (RecCon fields)  = pprPrefixOcc con+                                 <+> pprConDeclFields (unLoc fields)+    cxt = fromMaybe noLHsContext mcxt++pprConDecl (ConDeclGADT { con_names = cons, con_qvars = qvars+                        , con_mb_cxt = mcxt, con_args = args+                        , con_res_ty = res_ty, con_doc = doc })+  = ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon+    <+> (sep [pprHsForAll ForallInvis (hsq_explicit qvars) cxt,+              ppr_arrow_chain (get_args args ++ [ppr res_ty]) ])+  where+    get_args (PrefixCon args) = map ppr args+    get_args (RecCon fields)  = [pprConDeclFields (unLoc fields)]+    get_args (InfixCon {})    = pprPanic "pprConDecl:GADT" (ppr cons)++    cxt = fromMaybe noLHsContext mcxt++    ppr_arrow_chain (a:as) = sep (a : map (arrow <+>) as)+    ppr_arrow_chain []     = empty++pprConDecl (XConDecl x) = ppr x++ppr_con_names :: (OutputableBndr a) => [Located a] -> SDoc+ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc)++{-+************************************************************************+*                                                                      *+                Instance declarations+*                                                                      *+************************************************************************++Note [Type family instance declarations in HsSyn]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The data type FamEqn represents one equation of a type family instance.+Aside from the pass, it is also parameterised over two fields:+feqn_pats and feqn_rhs.++feqn_pats is either LHsTypes (for ordinary data/type family instances) or+LHsQTyVars (for associated type family default instances). In particular:++ * An ordinary type family instance declaration looks like this in source Haskell+      type instance T [a] Int = a -> a+   (or something similar for a closed family)+   It is represented by a FamInstEqn, with a *type* (LHsType) in the feqn_pats+   field.++ * On the other hand, the *default instance* of an associated type looks like+   this in source Haskell+      class C a where+        type T a b+        type T a b = a -> b   -- The default instance+   It is represented by a TyFamDefltEqn, with *type variables* (LHsQTyVars) in+   the feqn_pats field.++feqn_rhs is either an HsDataDefn (for data family instances) or an LHsType+(for type family instances).+-}++----------------- Type synonym family instances -------------++-- | Located Type Family Instance Equation+type LTyFamInstEqn pass = Located (TyFamInstEqn pass)+  -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'+  --   when in a list++-- For details on above see note [Api annotations] in ApiAnnotation++-- | Located Type Family Default Equation+type LTyFamDefltEqn pass = Located (TyFamDefltEqn pass)++-- | Haskell Type Patterns+type HsTyPats pass = [LHsTypeArg pass]++{- Note [Family instance declaration binders]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For ordinary data/type family instances, the feqn_pats field of FamEqn stores+the LHS type (and kind) patterns. Any type (and kind) variables contained+in these type patterns are bound in the hsib_vars field of the HsImplicitBndrs+in FamInstEqn depending on whether or not an explicit forall is present. In+the case of an explicit forall, the hsib_vars only includes kind variables not+bound in the forall. Otherwise, all type (and kind) variables are bound in+the hsib_vars. In the latter case, note that in particular++* The hsib_vars *includes* any anonymous wildcards.  For example+     type instance F a _ = a+  The hsib_vars will be {a, _}.  Remember that each separate wildcard+  '_' gets its own unique.  In this context wildcards behave just like+  an ordinary type variable, only anonymous.++* The hsib_vars *includes* type variables that are already in scope++   Eg   class C s t where+          type F t p :: *+        instance C w (a,b) where+          type F (a,b) x = x->a+   The hsib_vars of the F decl are {a,b,x}, even though the F decl+   is nested inside the 'instance' decl.++   However after the renamer, the uniques will match up:+        instance C w7 (a8,b9) where+          type F (a8,b9) x10 = x10->a8+   so that we can compare the type pattern in the 'instance' decl and+   in the associated 'type' decl++For associated type family default instances (TyFamDefltEqn), instead of using+type patterns with binders in a surrounding HsImplicitBndrs, we use raw type+variables (LHsQTyVars) in the feqn_pats field of FamEqn.++c.f. Note [TyVar binders for associated declarations]+-}++-- | Type Family Instance Equation+type TyFamInstEqn pass = FamInstEqn pass (LHsType pass)++-- | Type Family Default Equation+type TyFamDefltEqn pass = FamEqn pass (LHsQTyVars pass) (LHsType pass)+  -- See Note [Type family instance declarations in HsSyn]++-- | Located Type Family Instance Declaration+type LTyFamInstDecl pass = Located (TyFamInstDecl pass)++-- | Type Family Instance Declaration+newtype TyFamInstDecl pass = TyFamInstDecl { tfid_eqn :: TyFamInstEqn pass }+    -- ^+    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',+    --           'ApiAnnotation.AnnInstance',++    -- For details on above see note [Api annotations] in ApiAnnotation++----------------- Data family instances -------------++-- | Located Data Family Instance Declaration+type LDataFamInstDecl pass = Located (DataFamInstDecl pass)++-- | Data Family Instance Declaration+newtype DataFamInstDecl pass+  = DataFamInstDecl { dfid_eqn :: FamInstEqn pass (HsDataDefn pass) }+    -- ^+    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',+    --           'ApiAnnotation.AnnNewType','ApiAnnotation.AnnInstance',+    --           'ApiAnnotation.AnnDcolon'+    --           'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',+    --           'ApiAnnotation.AnnClose'++    -- For details on above see note [Api annotations] in ApiAnnotation++----------------- Family instances (common types) -------------++-- | Located Family Instance Equation+type LFamInstEqn pass rhs = Located (FamInstEqn pass rhs)++-- | Family Instance Equation+type FamInstEqn pass rhs+  = HsImplicitBndrs pass (FamEqn pass (HsTyPats pass) rhs)+            -- ^ Here, the @pats@ are type patterns (with kind and type bndrs).+            -- See Note [Family instance declaration binders]++-- | Family Equation+--+-- One equation in a type family instance declaration, data family instance+-- declaration, or type family default.+-- See Note [Type family instance declarations in HsSyn]+-- See Note [Family instance declaration binders]+data FamEqn pass pats rhs+  = FamEqn+       { feqn_ext    :: XCFamEqn pass pats rhs+       , feqn_tycon  :: Located (IdP pass)+       , feqn_bndrs  :: Maybe [LHsTyVarBndr pass] -- ^ Optional quantified type vars+       , feqn_pats   :: pats+       , feqn_fixity :: LexicalFixity -- ^ Fixity used in the declaration+       , feqn_rhs    :: rhs+       }+    -- ^+    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'+  | XFamEqn (XXFamEqn pass pats rhs)++    -- For details on above see note [Api annotations] in ApiAnnotation++type instance XCFamEqn    (GhcPass _) p r = NoExt+type instance XXFamEqn    (GhcPass _) p r = NoExt++----------------- Class instances -------------++-- | Located Class Instance Declaration+type LClsInstDecl pass = Located (ClsInstDecl pass)++-- | Class Instance Declaration+data ClsInstDecl pass+  = ClsInstDecl+      { cid_ext     :: XCClsInstDecl pass+      , cid_poly_ty :: LHsSigType pass    -- Context => Class Instance-type+                                          -- Using a polytype means that the renamer conveniently+                                          -- figures out the quantified type variables for us.+      , cid_binds         :: LHsBinds pass       -- Class methods+      , cid_sigs          :: [LSig pass]         -- User-supplied pragmatic info+      , cid_tyfam_insts   :: [LTyFamInstDecl pass]   -- Type family instances+      , cid_datafam_insts :: [LDataFamInstDecl pass] -- Data family instances+      , cid_overlap_mode  :: Maybe (Located OverlapMode)+         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',+         --                                    'ApiAnnotation.AnnClose',++        -- For details on above see note [Api annotations] in ApiAnnotation+      }+    -- ^+    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInstance',+    --           'ApiAnnotation.AnnWhere',+    --           'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',++    -- For details on above see note [Api annotations] in ApiAnnotation+  | XClsInstDecl (XXClsInstDecl pass)++type instance XCClsInstDecl    (GhcPass _) = NoExt+type instance XXClsInstDecl    (GhcPass _) = NoExt++----------------- Instances of all kinds -------------++-- | Located Instance Declaration+type LInstDecl pass = Located (InstDecl pass)++-- | Instance Declaration+data InstDecl pass  -- Both class and family instances+  = ClsInstD+      { cid_d_ext :: XClsInstD pass+      , cid_inst  :: ClsInstDecl pass }+  | DataFamInstD              -- data family instance+      { dfid_ext  :: XDataFamInstD pass+      , dfid_inst :: DataFamInstDecl pass }+  | TyFamInstD              -- type family instance+      { tfid_ext  :: XTyFamInstD pass+      , tfid_inst :: TyFamInstDecl pass }+  | XInstDecl (XXInstDecl pass)++type instance XClsInstD     (GhcPass _) = NoExt+type instance XDataFamInstD (GhcPass _) = NoExt+type instance XTyFamInstD   (GhcPass _) = NoExt+type instance XXInstDecl    (GhcPass _) = NoExt++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (TyFamInstDecl p) where+  ppr = pprTyFamInstDecl TopLevel++pprTyFamInstDecl :: (OutputableBndrId (GhcPass p))+                 => TopLevelFlag -> TyFamInstDecl (GhcPass p) -> SDoc+pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })+   = text "type" <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn++ppr_instance_keyword :: TopLevelFlag -> SDoc+ppr_instance_keyword TopLevel    = text "instance"+ppr_instance_keyword NotTopLevel = empty++ppr_fam_inst_eqn :: (OutputableBndrId (GhcPass p))+                 => TyFamInstEqn (GhcPass p) -> SDoc+ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon  = L _ tycon+                                            , feqn_bndrs  = bndrs+                                            , feqn_pats   = pats+                                            , feqn_fixity = fixity+                                            , feqn_rhs    = rhs }})+    = pprHsFamInstLHS tycon bndrs pats fixity noLHsContext <+> equals <+> ppr rhs+ppr_fam_inst_eqn (HsIB { hsib_body = XFamEqn x }) = ppr x+ppr_fam_inst_eqn (XHsImplicitBndrs x) = ppr x++ppr_fam_deflt_eqn :: (OutputableBndrId (GhcPass p))+                  => LTyFamDefltEqn (GhcPass p) -> SDoc+ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon  = tycon+                               , feqn_pats   = tvs+                               , feqn_fixity = fixity+                               , feqn_rhs    = rhs }))+    = text "type" <+> pp_vanilla_decl_head tycon tvs fixity noLHsContext+                  <+> equals <+> ppr rhs+ppr_fam_deflt_eqn (L _ (XFamEqn x)) = ppr x++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (DataFamInstDecl p) where+  ppr = pprDataFamInstDecl TopLevel++pprDataFamInstDecl :: (OutputableBndrId (GhcPass p))+                   => TopLevelFlag -> DataFamInstDecl (GhcPass p) -> SDoc+pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =+                             FamEqn { feqn_tycon  = L _ tycon+                                    , feqn_bndrs  = bndrs+                                    , feqn_pats   = pats+                                    , feqn_fixity = fixity+                                    , feqn_rhs    = defn }}})+  = pp_data_defn pp_hdr defn+  where+    pp_hdr ctxt = ppr_instance_keyword top_lvl+              <+> pprHsFamInstLHS tycon bndrs pats fixity ctxt+                  -- pp_data_defn pretty-prints the kind sig. See #14817.++pprDataFamInstDecl _ (DataFamInstDecl (HsIB _ (XFamEqn x)))+  = ppr x+pprDataFamInstDecl _ (DataFamInstDecl (XHsImplicitBndrs x))+  = ppr x++pprDataFamInstFlavour :: DataFamInstDecl (GhcPass p) -> SDoc+pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =+                        FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }}}})+  = ppr nd+pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =+                        FamEqn { feqn_rhs = XHsDataDefn x}}})+  = ppr x+pprDataFamInstFlavour (DataFamInstDecl (HsIB _ (XFamEqn x)))+  = ppr x+pprDataFamInstFlavour (DataFamInstDecl (XHsImplicitBndrs x))+  = ppr x++pprHsFamInstLHS :: (OutputableBndrId (GhcPass p))+   => IdP (GhcPass p)+   -> Maybe [LHsTyVarBndr (GhcPass p)]+   -> HsTyPats (GhcPass p)+   -> LexicalFixity+   -> LHsContext (GhcPass p)+   -> SDoc+pprHsFamInstLHS thing bndrs typats fixity mb_ctxt+   = hsep [ pprHsExplicitForAll ForallInvis bndrs+          , pprLHsContext mb_ctxt+          , pp_pats typats ]+   where+     pp_pats (patl:patr:pats)+       | Infix <- fixity+       = let pp_op_app = hsep [ ppr patl, pprInfixOcc thing, ppr patr ] in+         case pats of+           [] -> pp_op_app+           _  -> hsep (parens pp_op_app : map ppr pats)++     pp_pats pats = hsep [ pprPrefixOcc thing+                         , hsep (map ppr pats)]++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (ClsInstDecl p) where+    ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds+                     , cid_sigs = sigs, cid_tyfam_insts = ats+                     , cid_overlap_mode = mbOverlap+                     , cid_datafam_insts = adts })+      | null sigs, null ats, null adts, isEmptyBag binds  -- No "where" part+      = top_matter++      | otherwise       -- Laid out+      = vcat [ top_matter <+> text "where"+             , nest 2 $ pprDeclList $+               map (pprTyFamInstDecl NotTopLevel . unLoc)   ats +++               map (pprDataFamInstDecl NotTopLevel . unLoc) adts +++               pprLHsBindsForUser binds sigs ]+      where+        top_matter = text "instance" <+> ppOverlapPragma mbOverlap+                                             <+> ppr inst_ty+    ppr (XClsInstDecl x) = ppr x++ppDerivStrategy :: (p ~ GhcPass pass, OutputableBndrId p)+                => Maybe (LDerivStrategy p) -> SDoc+ppDerivStrategy mb =+  case mb of+    Nothing       -> empty+    Just (L _ ds) -> ppr ds++ppOverlapPragma :: Maybe (Located OverlapMode) -> SDoc+ppOverlapPragma mb =+  case mb of+    Nothing           -> empty+    Just (L _ (NoOverlap s))    -> maybe_stext s "{-# NO_OVERLAP #-}"+    Just (L _ (Overlappable s)) -> maybe_stext s "{-# OVERLAPPABLE #-}"+    Just (L _ (Overlapping s))  -> maybe_stext s "{-# OVERLAPPING #-}"+    Just (L _ (Overlaps s))     -> maybe_stext s "{-# OVERLAPS #-}"+    Just (L _ (Incoherent s))   -> maybe_stext s "{-# INCOHERENT #-}"+  where+    maybe_stext NoSourceText     alt = text alt+    maybe_stext (SourceText src) _   = text src <+> text "#-}"+++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (InstDecl p) where+    ppr (ClsInstD     { cid_inst  = decl }) = ppr decl+    ppr (TyFamInstD   { tfid_inst = decl }) = ppr decl+    ppr (DataFamInstD { dfid_inst = decl }) = ppr decl+    ppr (XInstDecl x) = ppr x++-- Extract the declarations of associated data types from an instance++instDeclDataFamInsts :: [LInstDecl pass] -> [DataFamInstDecl pass]+instDeclDataFamInsts inst_decls+  = concatMap do_one inst_decls+  where+    do_one (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fam_insts } }))+      = map unLoc fam_insts+    do_one (L _ (DataFamInstD { dfid_inst = fam_inst }))      = [fam_inst]+    do_one (L _ (TyFamInstD {}))                              = []+    do_one (L _ (ClsInstD _ (XClsInstDecl _))) = panic "instDeclDataFamInsts"+    do_one (L _ (XInstDecl _))                 = panic "instDeclDataFamInsts"++{-+************************************************************************+*                                                                      *+\subsection[DerivDecl]{A stand-alone instance deriving declaration}+*                                                                      *+************************************************************************+-}++-- | Located stand-alone 'deriving instance' declaration+type LDerivDecl pass = Located (DerivDecl pass)++-- | Stand-alone 'deriving instance' declaration+data DerivDecl pass = DerivDecl+        { deriv_ext          :: XCDerivDecl pass+        , deriv_type         :: LHsSigWcType pass+          -- ^ The instance type to derive.+          --+          -- It uses an 'LHsSigWcType' because the context is allowed to be a+          -- single wildcard:+          --+          -- > deriving instance _ => Eq (Foo a)+          --+          -- Which signifies that the context should be inferred.++          -- See Note [Inferring the instance context] in TcDerivInfer.++        , deriv_strategy     :: Maybe (LDerivStrategy pass)+        , deriv_overlap_mode :: Maybe (Located OverlapMode)+         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDeriving',+         --        'ApiAnnotation.AnnInstance', 'ApiAnnotation.AnnStock',+         --        'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',+         --        'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'++  -- For details on above see note [Api annotations] in ApiAnnotation+        }+  | XDerivDecl (XXDerivDecl pass)++type instance XCDerivDecl    (GhcPass _) = NoExt+type instance XXDerivDecl    (GhcPass _) = NoExt++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (DerivDecl p) where+    ppr (DerivDecl { deriv_type = ty+                   , deriv_strategy = ds+                   , deriv_overlap_mode = o })+        = hsep [ text "deriving"+               , ppDerivStrategy ds+               , text "instance"+               , ppOverlapPragma o+               , ppr ty ]+    ppr (XDerivDecl x) = ppr x++{-+************************************************************************+*                                                                      *+                Deriving strategies+*                                                                      *+************************************************************************+-}++-- | A 'Located' 'DerivStrategy'.+type LDerivStrategy pass = Located (DerivStrategy pass)++-- | Which technique the user explicitly requested when deriving an instance.+data DerivStrategy pass+  -- See Note [Deriving strategies] in TcDeriv+  = StockStrategy    -- ^ GHC's \"standard\" strategy, which is to implement a+                     --   custom instance for the data type. This only works+                     --   for certain types that GHC knows about (e.g., 'Eq',+                     --   'Show', 'Functor' when @-XDeriveFunctor@ is enabled,+                     --   etc.)+  | AnyclassStrategy -- ^ @-XDeriveAnyClass@+  | NewtypeStrategy  -- ^ @-XGeneralizedNewtypeDeriving@+  | ViaStrategy (XViaStrategy pass)+                     -- ^ @-XDerivingVia@++type instance XViaStrategy GhcPs = LHsSigType GhcPs+type instance XViaStrategy GhcRn = LHsSigType GhcRn+type instance XViaStrategy GhcTc = Type++instance (p ~ GhcPass pass, OutputableBndrId p)+        => Outputable (DerivStrategy p) where+    ppr StockStrategy    = text "stock"+    ppr AnyclassStrategy = text "anyclass"+    ppr NewtypeStrategy  = text "newtype"+    ppr (ViaStrategy ty) = text "via" <+> ppr ty++-- | A short description of a @DerivStrategy'@.+derivStrategyName :: DerivStrategy a -> SDoc+derivStrategyName = text . go+  where+    go StockStrategy    = "stock"+    go AnyclassStrategy = "anyclass"+    go NewtypeStrategy  = "newtype"+    go (ViaStrategy {}) = "via"++{-+************************************************************************+*                                                                      *+\subsection[DefaultDecl]{A @default@ declaration}+*                                                                      *+************************************************************************++There can only be one default declaration per module, but it is hard+for the parser to check that; we pass them all through in the abstract+syntax, and that restriction must be checked in the front end.+-}++-- | Located Default Declaration+type LDefaultDecl pass = Located (DefaultDecl pass)++-- | Default Declaration+data DefaultDecl pass+  = DefaultDecl (XCDefaultDecl pass) [LHsType pass]+        -- ^ - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnDefault',+        --          'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'++        -- For details on above see note [Api annotations] in ApiAnnotation+  | XDefaultDecl (XXDefaultDecl pass)++type instance XCDefaultDecl    (GhcPass _) = NoExt+type instance XXDefaultDecl    (GhcPass _) = NoExt++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (DefaultDecl p) where+    ppr (DefaultDecl _ tys)+      = text "default" <+> parens (interpp'SP tys)+    ppr (XDefaultDecl x) = ppr x++{-+************************************************************************+*                                                                      *+\subsection{Foreign function interface declaration}+*                                                                      *+************************************************************************+-}++-- foreign declarations are distinguished as to whether they define or use a+-- Haskell name+--+--  * the Boolean value indicates whether the pre-standard deprecated syntax+--   has been used++-- | Located Foreign Declaration+type LForeignDecl pass = Located (ForeignDecl pass)++-- | Foreign Declaration+data ForeignDecl pass+  = ForeignImport+      { fd_i_ext  :: XForeignImport pass   -- Post typechecker, rep_ty ~ sig_ty+      , fd_name   :: Located (IdP pass)    -- defines this name+      , fd_sig_ty :: LHsSigType pass       -- sig_ty+      , fd_fi     :: ForeignImport }++  | ForeignExport+      { fd_e_ext  :: XForeignExport pass   -- Post typechecker, rep_ty ~ sig_ty+      , fd_name   :: Located (IdP pass)    -- uses this name+      , fd_sig_ty :: LHsSigType pass       -- sig_ty+      , fd_fe     :: ForeignExport }+        -- ^+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForeign',+        --           'ApiAnnotation.AnnImport','ApiAnnotation.AnnExport',+        --           'ApiAnnotation.AnnDcolon'++        -- For details on above see note [Api annotations] in ApiAnnotation+  | XForeignDecl (XXForeignDecl pass)++{-+    In both ForeignImport and ForeignExport:+        sig_ty is the type given in the Haskell code+        rep_ty is the representation for this type, i.e. with newtypes+               coerced away and type functions evaluated.+    Thus if the declaration is valid, then rep_ty will only use types+    such as Int and IO that we know how to make foreign calls with.+-}++type instance XForeignImport   GhcPs = NoExt+type instance XForeignImport   GhcRn = NoExt+type instance XForeignImport   GhcTc = Coercion++type instance XForeignExport   GhcPs = NoExt+type instance XForeignExport   GhcRn = NoExt+type instance XForeignExport   GhcTc = Coercion++type instance XXForeignDecl    (GhcPass _) = NoExt++-- Specification Of an imported external entity in dependence on the calling+-- convention+--+data ForeignImport = -- import of a C entity+                     --+                     --  * the two strings specifying a header file or library+                     --   may be empty, which indicates the absence of a+                     --   header or object specification (both are not used+                     --   in the case of `CWrapper' and when `CFunction'+                     --   has a dynamic target)+                     --+                     --  * the calling convention is irrelevant for code+                     --   generation in the case of `CLabel', but is needed+                     --   for pretty printing+                     --+                     --  * `Safety' is irrelevant for `CLabel' and `CWrapper'+                     --+                     CImport  (Located CCallConv) -- ccall or stdcall+                              (Located Safety)  -- interruptible, safe or unsafe+                              (Maybe Header)       -- name of C header+                              CImportSpec          -- details of the C entity+                              (Located SourceText) -- original source text for+                                                   -- the C entity+  deriving Data++-- details of an external C entity+--+data CImportSpec = CLabel    CLabelString     -- import address of a C label+                 | CFunction CCallTarget      -- static or dynamic function+                 | CWrapper                   -- wrapper to expose closures+                                              -- (former f.e.d.)+  deriving Data++-- specification of an externally exported entity in dependence on the calling+-- convention+--+data ForeignExport = CExport  (Located CExportSpec) -- contains the calling+                                                    -- convention+                              (Located SourceText)  -- original source text for+                                                    -- the C entity+  deriving Data++-- pretty printing of foreign declarations+--++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (ForeignDecl p) where+  ppr (ForeignImport { fd_name = n, fd_sig_ty = ty, fd_fi = fimport })+    = hang (text "foreign import" <+> ppr fimport <+> ppr n)+         2 (dcolon <+> ppr ty)+  ppr (ForeignExport { fd_name = n, fd_sig_ty = ty, fd_fe = fexport }) =+    hang (text "foreign export" <+> ppr fexport <+> ppr n)+       2 (dcolon <+> ppr ty)+  ppr (XForeignDecl x) = ppr x++instance Outputable ForeignImport where+  ppr (CImport  cconv safety mHeader spec (L _ srcText)) =+    ppr cconv <+> ppr safety+      <+> pprWithSourceText srcText (pprCEntity spec "")+    where+      pp_hdr = case mHeader of+               Nothing -> empty+               Just (Header _ header) -> ftext header++      pprCEntity (CLabel lbl) _ =+        doubleQuotes $ text "static" <+> pp_hdr <+> char '&' <> ppr lbl+      pprCEntity (CFunction (StaticTarget st _lbl _ isFun)) src =+        if dqNeeded then doubleQuotes ce else empty+          where+            dqNeeded = (take 6 src == "static")+                    || isJust mHeader+                    || not isFun+                    || st /= NoSourceText+            ce =+                  -- We may need to drop leading spaces first+                  (if take 6 src == "static" then text "static" else empty)+              <+> pp_hdr+              <+> (if isFun then empty else text "value")+              <+> (pprWithSourceText st empty)+      pprCEntity (CFunction DynamicTarget) _ =+        doubleQuotes $ text "dynamic"+      pprCEntity CWrapper _ = doubleQuotes $ text "wrapper"++instance Outputable ForeignExport where+  ppr (CExport  (L _ (CExportStatic _ lbl cconv)) _) =+    ppr cconv <+> char '"' <> ppr lbl <> char '"'++{-+************************************************************************+*                                                                      *+\subsection{Transformation rules}+*                                                                      *+************************************************************************+-}++-- | Located Rule Declarations+type LRuleDecls pass = Located (RuleDecls pass)++  -- Note [Pragma source text] in BasicTypes+-- | Rule Declarations+data RuleDecls pass = HsRules { rds_ext   :: XCRuleDecls pass+                              , rds_src   :: SourceText+                              , rds_rules :: [LRuleDecl pass] }+  | XRuleDecls (XXRuleDecls pass)++type instance XCRuleDecls    (GhcPass _) = NoExt+type instance XXRuleDecls    (GhcPass _) = NoExt++-- | Located Rule Declaration+type LRuleDecl pass = Located (RuleDecl pass)++-- | Rule Declaration+data RuleDecl pass+  = HsRule -- Source rule+       { rd_ext  :: XHsRule pass+           -- ^ After renamer, free-vars from the LHS and RHS+       , rd_name :: Located (SourceText,RuleName)+           -- ^ Note [Pragma source text] in BasicTypes+       , rd_act  :: Activation+       , rd_tyvs :: Maybe [LHsTyVarBndr (NoGhcTc pass)]+           -- ^ Forall'd type vars+       , rd_tmvs :: [LRuleBndr pass]+           -- ^ Forall'd term vars, before typechecking; after typechecking+           --    this includes all forall'd vars+       , rd_lhs  :: Located (HsExpr pass)+       , rd_rhs  :: Located (HsExpr pass)+       }+    -- ^+    --  - 'ApiAnnotation.AnnKeywordId' :+    --           'ApiAnnotation.AnnOpen','ApiAnnotation.AnnTilde',+    --           'ApiAnnotation.AnnVal',+    --           'ApiAnnotation.AnnClose',+    --           'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot',+    --           'ApiAnnotation.AnnEqual',+  | XRuleDecl (XXRuleDecl pass)++data HsRuleRn = HsRuleRn NameSet NameSet -- Free-vars from the LHS and RHS+  deriving Data++type instance XHsRule       GhcPs = NoExt+type instance XHsRule       GhcRn = HsRuleRn+type instance XHsRule       GhcTc = HsRuleRn++type instance XXRuleDecl    (GhcPass _) = NoExt++flattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass]+flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls++-- | Located Rule Binder+type LRuleBndr pass = Located (RuleBndr pass)++-- | Rule Binder+data RuleBndr pass+  = RuleBndr (XCRuleBndr pass)  (Located (IdP pass))+  | RuleBndrSig (XRuleBndrSig pass) (Located (IdP pass)) (LHsSigWcType pass)+  | XRuleBndr (XXRuleBndr pass)+        -- ^+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',+        --     'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose'++        -- For details on above see note [Api annotations] in ApiAnnotation++type instance XCRuleBndr    (GhcPass _) = NoExt+type instance XRuleBndrSig  (GhcPass _) = NoExt+type instance XXRuleBndr    (GhcPass _) = NoExt++collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass]+collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs]++pprFullRuleName :: Located (SourceText, RuleName) -> SDoc+pprFullRuleName (L _ (st, n)) = pprWithSourceText st (doubleQuotes $ ftext n)++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleDecls p) where+  ppr (HsRules { rds_src = st+               , rds_rules = rules })+    = pprWithSourceText st (text "{-# RULES")+          <+> vcat (punctuate semi (map ppr rules)) <+> text "#-}"+  ppr (XRuleDecls x) = ppr x++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleDecl p) where+  ppr (HsRule { rd_name = name+              , rd_act  = act+              , rd_tyvs = tys+              , rd_tmvs = tms+              , rd_lhs  = lhs+              , rd_rhs  = rhs })+        = sep [pprFullRuleName name <+> ppr act,+               nest 4 (pp_forall_ty tys <+> pp_forall_tm tys+                                        <+> pprExpr (unLoc lhs)),+               nest 6 (equals <+> pprExpr (unLoc rhs)) ]+        where+          pp_forall_ty Nothing     = empty+          pp_forall_ty (Just qtvs) = forAllLit <+> fsep (map ppr qtvs) <> dot+          pp_forall_tm Nothing | null tms = empty+          pp_forall_tm _ = forAllLit <+> fsep (map ppr tms) <> dot+  ppr (XRuleDecl x) = ppr x++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleBndr p) where+   ppr (RuleBndr _ name) = ppr name+   ppr (RuleBndrSig _ name ty) = parens (ppr name <> dcolon <> ppr ty)+   ppr (XRuleBndr x) = ppr x++{-+************************************************************************+*                                                                      *+\subsection[DocDecl]{Document comments}+*                                                                      *+************************************************************************+-}++-- | Located Documentation comment Declaration+type LDocDecl = Located (DocDecl)++-- | Documentation comment Declaration+data DocDecl+  = DocCommentNext HsDocString+  | DocCommentPrev HsDocString+  | DocCommentNamed String HsDocString+  | DocGroup Int HsDocString+  deriving Data++-- Okay, I need to reconstruct the document comments, but for now:+instance Outputable DocDecl where+  ppr _ = text "<document comment>"++docDeclDoc :: DocDecl -> HsDocString+docDeclDoc (DocCommentNext d) = d+docDeclDoc (DocCommentPrev d) = d+docDeclDoc (DocCommentNamed _ d) = d+docDeclDoc (DocGroup _ d) = d++{-+************************************************************************+*                                                                      *+\subsection[DeprecDecl]{Deprecations}+*                                                                      *+************************************************************************++We use exported entities for things to deprecate.+-}++-- | Located Warning Declarations+type LWarnDecls pass = Located (WarnDecls pass)++ -- Note [Pragma source text] in BasicTypes+-- | Warning pragma Declarations+data WarnDecls pass = Warnings { wd_ext      :: XWarnings pass+                               , wd_src      :: SourceText+                               , wd_warnings :: [LWarnDecl pass]+                               }+  | XWarnDecls (XXWarnDecls pass)++type instance XWarnings      (GhcPass _) = NoExt+type instance XXWarnDecls    (GhcPass _) = NoExt++-- | Located Warning pragma Declaration+type LWarnDecl pass = Located (WarnDecl pass)++-- | Warning pragma Declaration+data WarnDecl pass = Warning (XWarning pass) [Located (IdP pass)] WarningTxt+                   | XWarnDecl (XXWarnDecl pass)++type instance XWarning      (GhcPass _) = NoExt+type instance XXWarnDecl    (GhcPass _) = NoExt+++instance (p ~ GhcPass pass,OutputableBndr (IdP p))+        => Outputable (WarnDecls p) where+    ppr (Warnings _ (SourceText src) decls)+      = text src <+> vcat (punctuate comma (map ppr decls)) <+> text "#-}"+    ppr (Warnings _ NoSourceText _decls) = panic "WarnDecls"+    ppr (XWarnDecls x) = ppr x++instance (p ~ GhcPass pass, OutputableBndr (IdP p))+       => Outputable (WarnDecl p) where+    ppr (Warning _ thing txt)+      = hsep ( punctuate comma (map ppr thing))+              <+> ppr txt+    ppr (XWarnDecl x) = ppr x++{-+************************************************************************+*                                                                      *+\subsection[AnnDecl]{Annotations}+*                                                                      *+************************************************************************+-}++-- | Located Annotation Declaration+type LAnnDecl pass = Located (AnnDecl pass)++-- | Annotation Declaration+data AnnDecl pass = HsAnnotation+                      (XHsAnnotation pass)+                      SourceText -- Note [Pragma source text] in BasicTypes+                      (AnnProvenance (IdP pass)) (Located (HsExpr pass))+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',+      --           'ApiAnnotation.AnnType'+      --           'ApiAnnotation.AnnModule'+      --           'ApiAnnotation.AnnClose'++      -- For details on above see note [Api annotations] in ApiAnnotation+  | XAnnDecl (XXAnnDecl pass)++type instance XHsAnnotation (GhcPass _) = NoExt+type instance XXAnnDecl     (GhcPass _) = NoExt++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (AnnDecl p) where+    ppr (HsAnnotation _ _ provenance expr)+      = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]+    ppr (XAnnDecl x) = ppr x++-- | Annotation Provenance+data AnnProvenance name = ValueAnnProvenance (Located name)+                        | TypeAnnProvenance (Located name)+                        | ModuleAnnProvenance+deriving instance Functor     AnnProvenance+deriving instance Foldable    AnnProvenance+deriving instance Traversable AnnProvenance+deriving instance (Data pass) => Data (AnnProvenance pass)++annProvenanceName_maybe :: AnnProvenance name -> Maybe name+annProvenanceName_maybe (ValueAnnProvenance (L _ name)) = Just name+annProvenanceName_maybe (TypeAnnProvenance (L _ name))  = Just name+annProvenanceName_maybe ModuleAnnProvenance       = Nothing++pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc+pprAnnProvenance ModuleAnnProvenance       = text "ANN module"+pprAnnProvenance (ValueAnnProvenance (L _ name))+  = text "ANN" <+> ppr name+pprAnnProvenance (TypeAnnProvenance (L _ name))+  = text "ANN type" <+> ppr name++{-+************************************************************************+*                                                                      *+\subsection[RoleAnnot]{Role annotations}+*                                                                      *+************************************************************************+-}++-- | Located Role Annotation Declaration+type LRoleAnnotDecl pass = Located (RoleAnnotDecl pass)++-- See #8185 for more info about why role annotations are+-- top-level declarations+-- | Role Annotation Declaration+data RoleAnnotDecl pass+  = RoleAnnotDecl (XCRoleAnnotDecl pass)+                  (Located (IdP pass))   -- type constructor+                  [Located (Maybe Role)] -- optional annotations+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',+      --           'ApiAnnotation.AnnRole'++      -- For details on above see note [Api annotations] in ApiAnnotation+  | XRoleAnnotDecl (XXRoleAnnotDecl pass)++type instance XCRoleAnnotDecl (GhcPass _) = NoExt+type instance XXRoleAnnotDecl (GhcPass _) = NoExt++instance (p ~ GhcPass pass, OutputableBndr (IdP p))+       => Outputable (RoleAnnotDecl p) where+  ppr (RoleAnnotDecl _ ltycon roles)+    = text "type role" <+> pprPrefixOcc (unLoc ltycon) <+>+      hsep (map (pp_role . unLoc) roles)+    where+      pp_role Nothing  = underscore+      pp_role (Just r) = ppr r+  ppr (XRoleAnnotDecl x) = ppr x++roleAnnotDeclName :: RoleAnnotDecl pass -> (IdP pass)+roleAnnotDeclName (RoleAnnotDecl _ (L _ name) _) = name+roleAnnotDeclName (XRoleAnnotDecl _) = panic "roleAnnotDeclName"
+ compiler/hsSyn/HsDoc.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module HsDoc+  ( HsDocString+  , LHsDocString+  , mkHsDocString+  , mkHsDocStringUtf8ByteString+  , unpackHDS+  , hsDocStringToByteString+  , ppr_mbDoc++  , appendDocs+  , concatDocs++  , DeclDocMap(..)+  , emptyDeclDocMap++  , ArgDocMap(..)+  , emptyArgDocMap+  ) where++#include "HsVersions.h"++import GhcPrelude++import Binary+import Encoding+import FastFunctions+import Name+import Outputable+import SrcLoc++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C8+import qualified Data.ByteString.Internal as BS+import Data.Data+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe+import Foreign++-- | Haskell Documentation String+--+-- Internally this is a UTF8-Encoded 'ByteString'.+newtype HsDocString = HsDocString ByteString+  -- There are at least two plausible Semigroup instances for this type:+  --+  -- 1. Simple string concatenation.+  -- 2. Concatenation as documentation paragraphs with newlines in between.+  --+  -- To avoid confusion, we pass on defining an instance at all.+  deriving (Eq, Show, Data)++-- | Located Haskell Documentation String+type LHsDocString = Located HsDocString++instance Binary HsDocString where+  put_ bh (HsDocString bs) = put_ bh bs+  get bh = HsDocString <$> get bh++instance Outputable HsDocString where+  ppr = doubleQuotes . text . unpackHDS++mkHsDocString :: String -> HsDocString+mkHsDocString s =+  inlinePerformIO $ do+    let len = utf8EncodedLength s+    buf <- mallocForeignPtrBytes len+    withForeignPtr buf $ \ptr -> do+      utf8EncodeString ptr s+      pure (HsDocString (BS.fromForeignPtr buf 0 len))++-- | Create a 'HsDocString' from a UTF8-encoded 'ByteString'.+mkHsDocStringUtf8ByteString :: ByteString -> HsDocString+mkHsDocStringUtf8ByteString = HsDocString++unpackHDS :: HsDocString -> String+unpackHDS = utf8DecodeByteString . hsDocStringToByteString++-- | Return the contents of a 'HsDocString' as a UTF8-encoded 'ByteString'.+hsDocStringToByteString :: HsDocString -> ByteString+hsDocStringToByteString (HsDocString bs) = bs++ppr_mbDoc :: Maybe LHsDocString -> SDoc+ppr_mbDoc (Just doc) = ppr doc+ppr_mbDoc Nothing    = empty++-- | Join two docstrings.+--+-- Non-empty docstrings are joined with two newlines in between,+-- resulting in separate paragraphs.+appendDocs :: HsDocString -> HsDocString -> HsDocString+appendDocs x y =+  fromMaybe+    (HsDocString BS.empty)+    (concatDocs [x, y])++-- | Concat docstrings with two newlines in between.+--+-- Empty docstrings are skipped.+--+-- If all inputs are empty, 'Nothing' is returned.+concatDocs :: [HsDocString] -> Maybe HsDocString+concatDocs xs =+    if BS.null b+      then Nothing+      else Just (HsDocString b)+  where+    b = BS.intercalate (C8.pack "\n\n")+      . filter (not . BS.null)+      . map hsDocStringToByteString+      $ xs++-- | Docs for declarations: functions, data types, instances, methods etc.+newtype DeclDocMap = DeclDocMap (Map Name HsDocString)++instance Binary DeclDocMap where+  put_ bh (DeclDocMap m) = put_ bh (Map.toList m)+  -- We can't rely on a deterministic ordering of the `Name`s here.+  -- See the comments on `Name`'s `Ord` instance for context.+  get bh = DeclDocMap . Map.fromList <$> get bh++instance Outputable DeclDocMap where+  ppr (DeclDocMap m) = vcat (map pprPair (Map.toAscList m))+    where+      pprPair (name, doc) = ppr name Outputable.<> colon $$ nest 2 (ppr doc)++emptyDeclDocMap :: DeclDocMap+emptyDeclDocMap = DeclDocMap Map.empty++-- | Docs for arguments. E.g. function arguments, method arguments.+newtype ArgDocMap = ArgDocMap (Map Name (Map Int HsDocString))++instance Binary ArgDocMap where+  put_ bh (ArgDocMap m) = put_ bh (Map.toList (Map.toAscList <$> m))+  -- We can't rely on a deterministic ordering of the `Name`s here.+  -- See the comments on `Name`'s `Ord` instance for context.+  get bh = ArgDocMap . fmap Map.fromDistinctAscList . Map.fromList <$> get bh++instance Outputable ArgDocMap where+  ppr (ArgDocMap m) = vcat (map pprPair (Map.toAscList m))+    where+      pprPair (name, int_map) =+        ppr name Outputable.<> colon $$ nest 2 (pprIntMap int_map)+      pprIntMap im = vcat (map pprIPair (Map.toAscList im))+      pprIPair (i, doc) = ppr i Outputable.<> colon $$ nest 2 (ppr doc)++emptyArgDocMap :: ArgDocMap+emptyArgDocMap = ArgDocMap Map.empty
+ compiler/hsSyn/HsExpr.hs view
@@ -0,0 +1,2873 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}++{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]+                                      -- in module PlaceHolder+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies #-}++-- | Abstract Haskell syntax for expressions.+module HsExpr where++#include "HsVersions.h"++-- friends:+import GhcPrelude++import HsDecls+import HsPat+import HsLit+import PlaceHolder ( NameOrRdrName )+import HsExtension+import HsTypes+import HsBinds++-- others:+import TcEvidence+import CoreSyn+import DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) )+import Name+import NameSet+import RdrName  ( GlobalRdrEnv )+import BasicTypes+import ConLike+import SrcLoc+import Util+import Outputable+import FastString+import Type+import TcType (TcType)+import {-# SOURCE #-} TcRnTypes (TcLclEnv)++-- libraries:+import Data.Data hiding (Fixity(..))+import qualified Data.Data as Data (Fixity(..))+import Data.Maybe (isNothing)++import GHCi.RemoteTypes ( ForeignRef )+import qualified Language.Haskell.TH as TH (Q)++{-+************************************************************************+*                                                                      *+\subsection{Expressions proper}+*                                                                      *+************************************************************************+-}++-- * Expressions proper++-- | Located Haskell Expression+type LHsExpr p = Located (HsExpr p)+  -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when+  --   in a list++  -- For details on above see note [Api annotations] in ApiAnnotation++-------------------------+-- | Post-Type checking Expression+--+-- PostTcExpr is an evidence expression attached to the syntax tree by the+-- type checker (c.f. postTcType).+type PostTcExpr  = HsExpr GhcTc++-- | Post-Type checking Table+--+-- We use a PostTcTable where there are a bunch of pieces of evidence, more+-- than is convenient to keep individually.+type PostTcTable = [(Name, PostTcExpr)]++-------------------------+-- | Syntax Expression+--+-- SyntaxExpr is like 'PostTcExpr', but it's filled in a little earlier,+-- by the renamer.  It's used for rebindable syntax.+--+-- E.g. @(>>=)@ is filled in before the renamer by the appropriate 'Name' for+--      @(>>=)@, and then instantiated by the type checker with its type args+--      etc+--+-- This should desugar to+--+-- > syn_res_wrap $ syn_expr (syn_arg_wraps[0] arg0)+-- >                         (syn_arg_wraps[1] arg1) ...+--+-- where the actual arguments come from elsewhere in the AST.+-- This could be defined using @GhcPass p@ and such, but it's+-- harder to get it all to work out that way. ('noSyntaxExpr' is hard to+-- write, for example.)+data SyntaxExpr p = SyntaxExpr { syn_expr      :: HsExpr p+                               , syn_arg_wraps :: [HsWrapper]+                               , syn_res_wrap  :: HsWrapper }++-- | This is used for rebindable-syntax pieces that are too polymorphic+-- for tcSyntaxOp (trS_fmap and the mzip in ParStmt)+noExpr :: HsExpr (GhcPass p)+noExpr = HsLit noExt (HsString (SourceText  "noExpr") (fsLit "noExpr"))++noSyntaxExpr :: SyntaxExpr (GhcPass p)+                              -- Before renaming, and sometimes after,+                              -- (if the syntax slot makes no sense)+noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit noExt (HsString NoSourceText+                                                        (fsLit "noSyntaxExpr"))+                          , syn_arg_wraps = []+                          , syn_res_wrap  = WpHole }++-- | Make a 'SyntaxExpr (HsExpr _)', missing its HsWrappers.+mkSyntaxExpr :: HsExpr (GhcPass p) -> SyntaxExpr (GhcPass p)+mkSyntaxExpr expr = SyntaxExpr { syn_expr      = expr+                               , syn_arg_wraps = []+                               , syn_res_wrap  = WpHole }++-- | Make a 'SyntaxExpr Name' (the "rn" is because this is used in the+-- renamer), missing its HsWrappers.+mkRnSyntaxExpr :: Name -> SyntaxExpr GhcRn+mkRnSyntaxExpr name = mkSyntaxExpr $ HsVar noExt $ noLoc name+  -- don't care about filling in syn_arg_wraps because we're clearly+  -- not past the typechecker++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (SyntaxExpr p) where+  ppr (SyntaxExpr { syn_expr      = expr+                  , syn_arg_wraps = arg_wraps+                  , syn_res_wrap  = res_wrap })+    = sdocWithDynFlags $ \ dflags ->+      getPprStyle $ \s ->+      if debugStyle s || gopt Opt_PrintExplicitCoercions dflags+      then ppr expr <> braces (pprWithCommas ppr arg_wraps)+                    <> braces (ppr res_wrap)+      else ppr expr++-- | Command Syntax Table (for Arrow syntax)+type CmdSyntaxTable p = [(Name, HsExpr p)]+-- See Note [CmdSyntaxTable]++{-+Note [CmdSyntaxtable]+~~~~~~~~~~~~~~~~~~~~~+Used only for arrow-syntax stuff (HsCmdTop), the CmdSyntaxTable keeps+track of the methods needed for a Cmd.++* Before the renamer, this list is an empty list++* After the renamer, it takes the form @[(std_name, HsVar actual_name)]@+  For example, for the 'arr' method+   * normal case:            (GHC.Control.Arrow.arr, HsVar GHC.Control.Arrow.arr)+   * with rebindable syntax: (GHC.Control.Arrow.arr, arr_22)+             where @arr_22@ is whatever 'arr' is in scope++* After the type checker, it takes the form [(std_name, <expression>)]+  where <expression> is the evidence for the method.  This evidence is+  instantiated with the class, but is still polymorphic in everything+  else.  For example, in the case of 'arr', the evidence has type+         forall b c. (b->c) -> a b c+  where 'a' is the ambient type of the arrow.  This polymorphism is+  important because the desugarer uses the same evidence at multiple+  different types.++This is Less Cool than what we normally do for rebindable syntax, which is to+make fully-instantiated piece of evidence at every use site.  The Cmd way+is Less Cool because+  * The renamer has to predict which methods are needed.+    See the tedious RnExpr.methodNamesCmd.++  * The desugarer has to know the polymorphic type of the instantiated+    method. This is checked by Inst.tcSyntaxName, but is less flexible+    than the rest of rebindable syntax, where the type is less+    pre-ordained.  (And this flexibility is useful; for example we can+    typecheck do-notation with (>>=) :: m1 a -> (a -> m2 b) -> m2 b.)+-}++-- | An unbound variable; used for treating+-- out-of-scope variables as expression holes+--+-- Either "x", "y"     Plain OutOfScope+-- or     "_", "_x"    A TrueExprHole+--+-- Both forms indicate an out-of-scope variable,  but the latter+-- indicates that the user /expects/ it to be out of scope, and+-- just wants GHC to report its type+data UnboundVar+  = OutOfScope OccName GlobalRdrEnv  -- ^ An (unqualified) out-of-scope+                                     -- variable, together with the GlobalRdrEnv+                                     -- with respect to which it is unbound++                                     -- See Note [OutOfScope and GlobalRdrEnv]++  | TrueExprHole OccName             -- ^ A "true" expression hole (_ or _x)++  deriving Data++instance Outputable UnboundVar where+    ppr (OutOfScope occ _) = text "OutOfScope" <> parens (ppr occ)+    ppr (TrueExprHole occ) = text "ExprHole"   <> parens (ppr occ)++unboundVarOcc :: UnboundVar -> OccName+unboundVarOcc (OutOfScope occ _) = occ+unboundVarOcc (TrueExprHole occ) = occ++{-+Note [OutOfScope and GlobalRdrEnv]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+To understand why we bundle a GlobalRdrEnv with an out-of-scope variable,+consider the following module:++    module A where++    foo :: ()+    foo = bar++    bat :: [Double]+    bat = [1.2, 3.4]++    $(return [])++    bar = ()+    bad = False++When A is compiled, the renamer determines that `bar` is not in scope in the+declaration of `foo` (since `bar` is declared in the following inter-splice+group).  Once it has finished typechecking the entire module, the typechecker+then generates the associated error message, which specifies both the type of+`bar` and a list of possible in-scope alternatives:++    A.hs:6:7: error:+        • Variable not in scope: bar :: ()+        • ‘bar’ (line 13) is not in scope before the splice on line 11+          Perhaps you meant ‘bat’ (line 9)++When it calls RnEnv.unknownNameSuggestions to identify these alternatives, the+typechecker must provide a GlobalRdrEnv.  If it provided the current one, which+contains top-level declarations for the entire module, the error message would+incorrectly suggest the out-of-scope `bar` and `bad` as possible alternatives+for `bar` (see #11680).  Instead, the typechecker must use the same+GlobalRdrEnv the renamer used when it determined that `bar` is out-of-scope.++To obtain this GlobalRdrEnv, can the typechecker simply use the out-of-scope+`bar`'s location to either reconstruct it (from the current GlobalRdrEnv) or to+look it up in some global store?  Unfortunately, no.  The problem is that+location information is not always sufficient for this task.  This is most+apparent when dealing with the TH function addTopDecls, which adds its+declarations to the FOLLOWING inter-splice group.  Consider these declarations:++    ex9 = cat               -- cat is NOT in scope here++    $(do -------------------------------------------------------------+        ds <- [d| f = cab   -- cat and cap are both in scope here+                  cat = ()+                |]+        addTopDecls ds+        [d| g = cab         -- only cap is in scope here+            cap = True+          |])++    ex10 = cat              -- cat is NOT in scope here++    $(return []) -----------------------------------------------------++    ex11 = cat              -- cat is in scope++Here, both occurrences of `cab` are out-of-scope, and so the typechecker needs+the GlobalRdrEnvs which were used when they were renamed.  These GlobalRdrEnvs+are different (`cat` is present only in the GlobalRdrEnv for f's `cab'), but the+locations of the two `cab`s are the same (they are both created in the same+splice).  Thus, we must include some additional information with each `cab` to+allow the typechecker to obtain the correct GlobalRdrEnv.  Clearly, the simplest+information to use is the GlobalRdrEnv itself.+-}++-- | A Haskell expression.+data HsExpr p+  = HsVar     (XVar p)+              (Located (IdP p)) -- ^ Variable++                             -- See Note [Located RdrNames]++  | HsUnboundVar (XUnboundVar p)+                 UnboundVar  -- ^ Unbound variable; also used for "holes"+                             --   (_ or _x).+                             -- Turned from HsVar to HsUnboundVar by the+                             --   renamer, when it finds an out-of-scope+                             --   variable or hole.+                             -- Turned into HsVar by type checker, to support+                             --   deferred type errors.++  | HsConLikeOut (XConLikeOut p)+                 ConLike     -- ^ After typechecker only; must be different+                             -- HsVar for pretty printing++  | HsRecFld  (XRecFld p)+              (AmbiguousFieldOcc p) -- ^ Variable pointing to record selector+                                    -- Not in use after typechecking++  | HsOverLabel (XOverLabel p)+                (Maybe (IdP p)) FastString+     -- ^ Overloaded label (Note [Overloaded labels] in GHC.OverloadedLabels)+     --   @Just id@ means @RebindableSyntax@ is in use, and gives the id of the+     --   in-scope 'fromLabel'.+     --   NB: Not in use after typechecking++  | HsIPVar   (XIPVar p)+              HsIPName   -- ^ Implicit parameter (not in use after typechecking)+  | HsOverLit (XOverLitE p)+              (HsOverLit p)  -- ^ Overloaded literals++  | HsLit     (XLitE p)+              (HsLit p)      -- ^ Simple (non-overloaded) literals++  | HsLam     (XLam p)+              (MatchGroup p (LHsExpr p))+                       -- ^ Lambda abstraction. Currently always a single match+       --+       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',+       --       'ApiAnnotation.AnnRarrow',++       -- For details on above see note [Api annotations] in ApiAnnotation++  | HsLamCase (XLamCase p) (MatchGroup p (LHsExpr p)) -- ^ Lambda-case+       --+       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',+       --           'ApiAnnotation.AnnCase','ApiAnnotation.AnnOpen',+       --           'ApiAnnotation.AnnClose'++       -- For details on above see note [Api annotations] in ApiAnnotation++  | HsApp     (XApp p) (LHsExpr p) (LHsExpr p) -- ^ Application++  | HsAppType (XAppTypeE p) (LHsExpr p) (LHsWcType (NoGhcTc p))  -- ^ Visible type application+       --+       -- Explicit type argument; e.g  f @Int x y+       -- NB: Has wildcards, but no implicit quantification+       --+       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt',++  -- | Operator applications:+  -- NB Bracketed ops such as (+) come out as Vars.++  -- NB We need an expr for the operator in an OpApp/Section since+  -- the typechecker may need to apply the operator to a few types.++  | OpApp       (XOpApp p)+                (LHsExpr p)       -- left operand+                (LHsExpr p)       -- operator+                (LHsExpr p)       -- right operand++  -- | Negation operator. Contains the negated expression and the name+  -- of 'negate'+  --+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnMinus'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | NegApp      (XNegApp p)+                (LHsExpr p)+                (SyntaxExpr p)++  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,+  --             'ApiAnnotation.AnnClose' @')'@++  -- For details on above see note [Api annotations] in ApiAnnotation+  | HsPar       (XPar p)+                (LHsExpr p)  -- ^ Parenthesised expr; see Note [Parens in HsSyn]++  | SectionL    (XSectionL p)+                (LHsExpr p)    -- operand; see Note [Sections in HsSyn]+                (LHsExpr p)    -- operator+  | SectionR    (XSectionR p)+                (LHsExpr p)    -- operator; see Note [Sections in HsSyn]+                (LHsExpr p)    -- operand++  -- | Used for explicit tuples and sections thereof+  --+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',+  --         'ApiAnnotation.AnnClose'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | ExplicitTuple+        (XExplicitTuple p)+        [LHsTupArg p]+        Boxity++  -- | Used for unboxed sum types+  --+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(#'@,+  --          'ApiAnnotation.AnnVbar', 'ApiAnnotation.AnnClose' @'#)'@,+  --+  --  There will be multiple 'ApiAnnotation.AnnVbar', (1 - alternative) before+  --  the expression, (arity - alternative) after it+  | ExplicitSum+          (XExplicitSum p)+          ConTag --  Alternative (one-based)+          Arity  --  Sum arity+          (LHsExpr p)++  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',+  --       'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,+  --       'ApiAnnotation.AnnClose' @'}'@++  -- For details on above see note [Api annotations] in ApiAnnotation+  | HsCase      (XCase p)+                (LHsExpr p)+                (MatchGroup p (LHsExpr p))++  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',+  --       'ApiAnnotation.AnnSemi',+  --       'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',+  --       'ApiAnnotation.AnnElse',++  -- For details on above see note [Api annotations] in ApiAnnotation+  | HsIf        (XIf p)+                (Maybe (SyntaxExpr p)) -- cond function+                                        -- Nothing => use the built-in 'if'+                                        -- See Note [Rebindable if]+                (LHsExpr p)    --  predicate+                (LHsExpr p)    --  then part+                (LHsExpr p)    --  else part++  -- | Multi-way if+  --+  -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf'+  --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',++  -- For details on above see note [Api annotations] in ApiAnnotation+  | HsMultiIf   (XMultiIf p) [LGRHS p (LHsExpr p)]++  -- | let(rec)+  --+  -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',+  --       'ApiAnnotation.AnnOpen' @'{'@,+  --       'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | HsLet       (XLet p)+                (LHsLocalBinds p)+                (LHsExpr  p)++  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',+  --             'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',+  --             'ApiAnnotation.AnnVbar',+  --             'ApiAnnotation.AnnClose'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | HsDo        (XDo p)                  -- Type of the whole expression+                (HsStmtContext Name)     -- The parameterisation is unimportant+                                         -- because in this context we never use+                                         -- the PatGuard or ParStmt variant+                (Located [ExprLStmt p]) -- "do":one or more stmts++  -- | Syntactic list: [a,b,c,...]+  --+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,+  --              'ApiAnnotation.AnnClose' @']'@++  -- For details on above see note [Api annotations] in ApiAnnotation+  | ExplicitList+                (XExplicitList p)  -- Gives type of components of list+                (Maybe (SyntaxExpr p))+                                   -- For OverloadedLists, the fromListN witness+                [LHsExpr p]++  -- | Record construction+  --+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,+  --         'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@++  -- For details on above see note [Api annotations] in ApiAnnotation+  | RecordCon+      { rcon_ext      :: XRecordCon p+      , rcon_con_name :: Located (IdP p)    -- The constructor name;+                                            --  not used after type checking+      , rcon_flds     :: HsRecordBinds p }  -- The fields++  -- | Record update+  --+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,+  --         'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@++  -- For details on above see note [Api annotations] in ApiAnnotation+  | RecordUpd+      { rupd_ext  :: XRecordUpd p+      , rupd_expr :: LHsExpr p+      , rupd_flds :: [LHsRecUpdField p]+      }+  -- For a type family, the arg types are of the *instance* tycon,+  -- not the family tycon++  -- | Expression with an explicit type signature. @e :: type@+  --+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | ExprWithTySig+                (XExprWithTySig p)++                (LHsExpr p)+                (LHsSigWcType (NoGhcTc p))++  -- | Arithmetic sequence+  --+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,+  --              'ApiAnnotation.AnnComma','ApiAnnotation.AnnDotdot',+  --              'ApiAnnotation.AnnClose' @']'@++  -- For details on above see note [Api annotations] in ApiAnnotation+  | ArithSeq+                (XArithSeq p)+                (Maybe (SyntaxExpr p))+                                  -- For OverloadedLists, the fromList witness+                (ArithSeqInfo p)++  -- For details on above see note [Api annotations] in ApiAnnotation+  | HsSCC       (XSCC p)+                SourceText            -- Note [Pragma source text] in BasicTypes+                StringLiteral         -- "set cost centre" SCC pragma+                (LHsExpr p)           -- expr whose cost is to be measured++  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# CORE'@,+  --             'ApiAnnotation.AnnVal', 'ApiAnnotation.AnnClose' @'\#-}'@++  -- For details on above see note [Api annotations] in ApiAnnotation+  | HsCoreAnn   (XCoreAnn p)+                SourceText            -- Note [Pragma source text] in BasicTypes+                StringLiteral         -- hdaume: core annotation+                (LHsExpr p)++  -----------------------------------------------------------+  -- MetaHaskell Extensions++  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',+  --         'ApiAnnotation.AnnOpenE','ApiAnnotation.AnnOpenEQ',+  --         'ApiAnnotation.AnnClose','ApiAnnotation.AnnCloseQ'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | HsBracket    (XBracket p) (HsBracket p)++    -- See Note [Pending Splices]+  | HsRnBracketOut+      (XRnBracketOut p)+      (HsBracket GhcRn)    -- Output of the renamer is the *original* renamed+                           -- expression, plus+      [PendingRnSplice]    -- _renamed_ splices to be type checked++  | HsTcBracketOut+      (XTcBracketOut p)+      (HsBracket GhcRn)    -- Output of the type checker is the *original*+                           -- renamed expression, plus+      [PendingTcSplice]    -- _typechecked_ splices to be+                           -- pasted back in by the desugarer++  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',+  --         'ApiAnnotation.AnnClose'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | HsSpliceE  (XSpliceE p) (HsSplice p)++  -----------------------------------------------------------+  -- Arrow notation extension++  -- | @proc@ notation for Arrows+  --+  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnProc',+  --          'ApiAnnotation.AnnRarrow'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | HsProc      (XProc p)+                (LPat p)               -- arrow abstraction, proc+                (LHsCmdTop p)          -- body of the abstraction+                                       -- always has an empty stack++  ---------------------------------------+  -- static pointers extension+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnStatic',++  -- For details on above see note [Api annotations] in ApiAnnotation+  | HsStatic (XStatic p) -- Free variables of the body+             (LHsExpr p)        -- Body++  ---------------------------------------+  -- Haskell program coverage (Hpc) Support++  | HsTick+     (XTick p)+     (Tickish (IdP p))+     (LHsExpr p)                       -- sub-expression++  | HsBinTick+     (XBinTick p)+     Int                                -- module-local tick number for True+     Int                                -- module-local tick number for False+     (LHsExpr p)                        -- sub-expression++  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',+  --       'ApiAnnotation.AnnOpen' @'{-\# GENERATED'@,+  --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnVal',+  --       'ApiAnnotation.AnnColon','ApiAnnotation.AnnVal',+  --       'ApiAnnotation.AnnMinus',+  --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnColon',+  --       'ApiAnnotation.AnnVal',+  --       'ApiAnnotation.AnnClose' @'\#-}'@++  -- For details on above see note [Api annotations] in ApiAnnotation+  | HsTickPragma                      -- A pragma introduced tick+     (XTickPragma p)+     SourceText                       -- Note [Pragma source text] in BasicTypes+     (StringLiteral,(Int,Int),(Int,Int))+                                      -- external span for this tick+     ((SourceText,SourceText),(SourceText,SourceText))+        -- Source text for the four integers used in the span.+        -- See note [Pragma source text] in BasicTypes+     (LHsExpr p)++  ---------------------------------------+  -- These constructors only appear temporarily in the parser.+  -- The renamer translates them into the Right Thing.++  | EWildPat (XEWildPat p)        -- wildcard++  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | EAsPat      (XEAsPat p)+                (Located (IdP p)) -- as pattern+                (LHsExpr p)++  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | EViewPat    (XEViewPat p)+                (LHsExpr p) -- view pattern+                (LHsExpr p)++  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | ELazyPat    (XELazyPat p) (LHsExpr p) -- ~ pattern+++  ---------------------------------------+  -- Finally, HsWrap appears only in typechecker output+  -- The contained Expr is *NOT* itself an HsWrap.+  -- See Note [Detecting forced eta expansion] in DsExpr. This invariant+  -- is maintained by HsUtils.mkHsWrap.++  |  HsWrap     (XWrap p)+                HsWrapper    -- TRANSLATION+                (HsExpr p)++  | XExpr       (XXExpr p) -- Note [Trees that Grow] extension constructor+++-- | Extra data fields for a 'RecordCon', added by the type checker+data RecordConTc = RecordConTc+      { rcon_con_like :: ConLike      -- The data constructor or pattern synonym+      , rcon_con_expr :: PostTcExpr   -- Instantiated constructor function+      }++-- | Extra data fields for a 'RecordUpd', added by the type checker+data RecordUpdTc = RecordUpdTc+      { rupd_cons :: [ConLike]+                -- Filled in by the type checker to the+                -- _non-empty_ list of DataCons that have+                -- all the upd'd fields++      , rupd_in_tys  :: [Type] -- Argument types of *input* record type+      , rupd_out_tys :: [Type] --             and  *output* record type+                               -- The original type can be reconstructed+                               -- with conLikeResTy+      , rupd_wrap :: HsWrapper -- See note [Record Update HsWrapper]+      } deriving Data++-- ---------------------------------------------------------------------++type instance XVar           (GhcPass _) = NoExt+type instance XUnboundVar    (GhcPass _) = NoExt+type instance XConLikeOut    (GhcPass _) = NoExt+type instance XRecFld        (GhcPass _) = NoExt+type instance XOverLabel     (GhcPass _) = NoExt+type instance XIPVar         (GhcPass _) = NoExt+type instance XOverLitE      (GhcPass _) = NoExt+type instance XLitE          (GhcPass _) = NoExt+type instance XLam           (GhcPass _) = NoExt+type instance XLamCase       (GhcPass _) = NoExt+type instance XApp           (GhcPass _) = NoExt++type instance XAppTypeE      (GhcPass _) = NoExt++type instance XOpApp         GhcPs = NoExt+type instance XOpApp         GhcRn = Fixity+type instance XOpApp         GhcTc = Fixity++type instance XNegApp        (GhcPass _) = NoExt+type instance XPar           (GhcPass _) = NoExt+type instance XSectionL      (GhcPass _) = NoExt+type instance XSectionR      (GhcPass _) = NoExt+type instance XExplicitTuple (GhcPass _) = NoExt++type instance XExplicitSum   GhcPs = NoExt+type instance XExplicitSum   GhcRn = NoExt+type instance XExplicitSum   GhcTc = [Type]++type instance XCase          (GhcPass _) = NoExt+type instance XIf            (GhcPass _) = NoExt++type instance XMultiIf       GhcPs = NoExt+type instance XMultiIf       GhcRn = NoExt+type instance XMultiIf       GhcTc = Type++type instance XLet           (GhcPass _) = NoExt++type instance XDo            GhcPs = NoExt+type instance XDo            GhcRn = NoExt+type instance XDo            GhcTc = Type++type instance XExplicitList  GhcPs = NoExt+type instance XExplicitList  GhcRn = NoExt+type instance XExplicitList  GhcTc = Type++type instance XRecordCon     GhcPs = NoExt+type instance XRecordCon     GhcRn = NoExt+type instance XRecordCon     GhcTc = RecordConTc++type instance XRecordUpd     GhcPs = NoExt+type instance XRecordUpd     GhcRn = NoExt+type instance XRecordUpd     GhcTc = RecordUpdTc++type instance XExprWithTySig (GhcPass _) = NoExt++type instance XArithSeq      GhcPs = NoExt+type instance XArithSeq      GhcRn = NoExt+type instance XArithSeq      GhcTc = PostTcExpr++type instance XSCC           (GhcPass _) = NoExt+type instance XCoreAnn       (GhcPass _) = NoExt+type instance XBracket       (GhcPass _) = NoExt++type instance XRnBracketOut  (GhcPass _) = NoExt+type instance XTcBracketOut  (GhcPass _) = NoExt++type instance XSpliceE       (GhcPass _) = NoExt+type instance XProc          (GhcPass _) = NoExt++type instance XStatic        GhcPs = NoExt+type instance XStatic        GhcRn = NameSet+type instance XStatic        GhcTc = NameSet++type instance XTick          (GhcPass _) = NoExt+type instance XBinTick       (GhcPass _) = NoExt+type instance XTickPragma    (GhcPass _) = NoExt+type instance XEWildPat      (GhcPass _) = NoExt+type instance XEAsPat        (GhcPass _) = NoExt+type instance XEViewPat      (GhcPass _) = NoExt+type instance XELazyPat      (GhcPass _) = NoExt+type instance XWrap          (GhcPass _) = NoExt+type instance XXExpr         (GhcPass _) = NoExt++-- ---------------------------------------------------------------------++-- | Located Haskell Tuple Argument+--+-- 'HsTupArg' is used for tuple sections+-- @(,a,)@ is represented by+-- @ExplicitTuple [Missing ty1, Present a, Missing ty3]@+-- Which in turn stands for @(\x:ty1 \y:ty2. (x,a,y))@+type LHsTupArg id = Located (HsTupArg id)+-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'++-- For details on above see note [Api annotations] in ApiAnnotation++-- | Haskell Tuple Argument+data HsTupArg id+  = Present (XPresent id) (LHsExpr id)     -- ^ The argument+  | Missing (XMissing id)    -- ^ The argument is missing, but this is its type+  | XTupArg (XXTupArg id)    -- ^ Note [Trees that Grow] extension point++type instance XPresent         (GhcPass _) = NoExt++type instance XMissing         GhcPs = NoExt+type instance XMissing         GhcRn = NoExt+type instance XMissing         GhcTc = Type++type instance XXTupArg         (GhcPass _) = NoExt++tupArgPresent :: LHsTupArg id -> Bool+tupArgPresent (L _ (Present {})) = True+tupArgPresent (L _ (Missing {})) = False+tupArgPresent (L _ (XTupArg {})) = False++{-+Note [Parens in HsSyn]+~~~~~~~~~~~~~~~~~~~~~~+HsPar (and ParPat in patterns, HsParTy in types) is used as follows++  * HsPar is required; the pretty printer does not add parens.++  * HsPars are respected when rearranging operator fixities.+    So   a * (b + c)  means what it says (where the parens are an HsPar)++  * For ParPat and HsParTy the pretty printer does add parens but this should be+    a no-op for ParsedSource, based on the pretty printer round trip feature+    introduced in+    https://phabricator.haskell.org/rGHC499e43824bda967546ebf95ee33ec1f84a114a7c++  * ParPat and HsParTy are pretty printed as '( .. )' regardless of whether or+    not they are strictly necessary. This should be addressed when #13238 is+    completed, to be treated the same as HsPar.+++Note [Sections in HsSyn]+~~~~~~~~~~~~~~~~~~~~~~~~+Sections should always appear wrapped in an HsPar, thus+         HsPar (SectionR ...)+The parser parses sections in a wider variety of situations+(See Note [Parsing sections]), but the renamer checks for those+parens.  This invariant makes pretty-printing easier; we don't need+a special case for adding the parens round sections.++Note [Rebindable if]+~~~~~~~~~~~~~~~~~~~~+The rebindable syntax for 'if' is a bit special, because when+rebindable syntax is *off* we do not want to treat+   (if c then t else e)+as if it was an application (ifThenElse c t e).  Why not?+Because we allow an 'if' to return *unboxed* results, thus+  if blah then 3# else 4#+whereas that would not be possible using a all to a polymorphic function+(because you can't call a polymorphic function at an unboxed type).++So we use Nothing to mean "use the old built-in typing rule".++Note [Record Update HsWrapper]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+There is a wrapper in RecordUpd which is used for the *required*+constraints for pattern synonyms. This wrapper is created in the+typechecking and is then directly used in the desugaring without+modification.++For example, if we have the record pattern synonym P,+  pattern P :: (Show a) => a -> Maybe a+  pattern P{x} = Just x++  foo = (Just True) { x = False }+then `foo` desugars to something like+  foo = case Just True of+          P x -> P False+hence we need to provide the correct dictionaries to P's matcher on+the RHS so that we can build the expression.++Note [Located RdrNames]+~~~~~~~~~~~~~~~~~~~~~~~+A number of syntax elements have seemingly redundant locations attached to them.+This is deliberate, to allow transformations making use of the API Annotations+to easily correlate a Located Name in the RenamedSource with a Located RdrName+in the ParsedSource.++There are unfortunately enough differences between the ParsedSource and the+RenamedSource that the API Annotations cannot be used directly with+RenamedSource, so this allows a simple mapping to be used based on the location.+-}++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsExpr p) where+    ppr expr = pprExpr expr++-----------------------+-- pprExpr, pprLExpr, pprBinds call pprDeeper;+-- the underscore versions do not+pprLExpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc+pprLExpr (L _ e) = pprExpr e++pprExpr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> SDoc+pprExpr e | isAtomicHsExpr e || isQuietHsExpr e =            ppr_expr e+          | otherwise                           = pprDeeper (ppr_expr e)++isQuietHsExpr :: HsExpr id -> Bool+-- Parentheses do display something, but it gives little info and+-- if we go deeper when we go inside them then we get ugly things+-- like (...)+isQuietHsExpr (HsPar {})        = True+-- applications don't display anything themselves+isQuietHsExpr (HsApp {})        = True+isQuietHsExpr (HsAppType {})    = True+isQuietHsExpr (OpApp {})        = True+isQuietHsExpr _ = False++pprBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))+         => HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> SDoc+pprBinds b = pprDeeper (ppr b)++-----------------------+ppr_lexpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc+ppr_lexpr e = ppr_expr (unLoc e)++ppr_expr :: forall p. (OutputableBndrId (GhcPass p))+         => HsExpr (GhcPass p) -> SDoc+ppr_expr (HsVar _ (L _ v))  = pprPrefixOcc v+ppr_expr (HsUnboundVar _ uv)= pprPrefixOcc (unboundVarOcc uv)+ppr_expr (HsConLikeOut _ c) = pprPrefixOcc c+ppr_expr (HsIPVar _ v)      = ppr v+ppr_expr (HsOverLabel _ _ l)= char '#' <> ppr l+ppr_expr (HsLit _ lit)      = ppr lit+ppr_expr (HsOverLit _ lit)  = ppr lit+ppr_expr (HsPar _ e)        = parens (ppr_lexpr e)++ppr_expr (HsCoreAnn _ stc (StringLiteral sta s) e)+  = vcat [pprWithSourceText stc (text "{-# CORE")+          <+> pprWithSourceText sta (doubleQuotes $ ftext s) <+> text "#-}"+         , ppr_lexpr e]++ppr_expr e@(HsApp {})        = ppr_apps e []+ppr_expr e@(HsAppType {})    = ppr_apps e []++ppr_expr (OpApp _ e1 op e2)+  | Just pp_op <- should_print_infix (unLoc op)+  = pp_infixly pp_op+  | otherwise+  = pp_prefixly++  where+    should_print_infix (HsVar _ (L _ v)) = Just (pprInfixOcc v)+    should_print_infix (HsConLikeOut _ c)= Just (pprInfixOcc (conLikeName c))+    should_print_infix (HsRecFld _ f)    = Just (pprInfixOcc f)+    should_print_infix (HsUnboundVar _ h@TrueExprHole{})+                                       = Just (pprInfixOcc (unboundVarOcc h))+    should_print_infix (EWildPat _)    = Just (text "`_`")+    should_print_infix (HsWrap _ _ e)  = should_print_infix e+    should_print_infix _               = Nothing++    pp_e1 = pprDebugParendExpr opPrec e1   -- In debug mode, add parens+    pp_e2 = pprDebugParendExpr opPrec e2   -- to make precedence clear++    pp_prefixly+      = hang (ppr op) 2 (sep [pp_e1, pp_e2])++    pp_infixly pp_op+      = hang pp_e1 2 (sep [pp_op, nest 2 pp_e2])++ppr_expr (NegApp _ e _) = char '-' <+> pprDebugParendExpr appPrec e++ppr_expr (SectionL _ expr op)+  = case unLoc op of+      HsVar _ (L _ v)  -> pp_infixly v+      HsConLikeOut _ c -> pp_infixly (conLikeName c)+      HsUnboundVar _ h@TrueExprHole{}+                       -> pp_infixly (unboundVarOcc h)+      _                -> pp_prefixly+  where+    pp_expr = pprDebugParendExpr opPrec expr++    pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])+                       4 (hsep [pp_expr, text "x_ )"])++    pp_infixly :: forall a. (OutputableBndr a) => a -> SDoc+    pp_infixly v = (sep [pp_expr, pprInfixOcc v])++ppr_expr (SectionR _ op expr)+  = case unLoc op of+      HsVar _ (L _ v)  -> pp_infixly v+      HsConLikeOut _ c -> pp_infixly (conLikeName c)+      HsUnboundVar _ h@TrueExprHole{}+                       -> pp_infixly (unboundVarOcc h)+      _                -> pp_prefixly+  where+    pp_expr = pprDebugParendExpr opPrec expr++    pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, text "x_"])+                       4 (pp_expr <> rparen)++    pp_infixly :: forall a. (OutputableBndr a) => a -> SDoc+    pp_infixly v = sep [pprInfixOcc v, pp_expr]++ppr_expr (ExplicitTuple _ exprs boxity)+  = tupleParens (boxityTupleSort boxity) (fcat (ppr_tup_args $ map unLoc exprs))+  where+    ppr_tup_args []               = []+    ppr_tup_args (Present _ e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es+    ppr_tup_args (Missing _   : es) = punc es : ppr_tup_args es+    ppr_tup_args (XTupArg x   : es) = (ppr x <> punc es) : ppr_tup_args es++    punc (Present {} : _) = comma <> space+    punc (Missing {} : _) = comma+    punc (XTupArg {} : _) = comma <> space+    punc []               = empty++ppr_expr (ExplicitSum _ alt arity expr)+  = text "(#" <+> ppr_bars (alt - 1) <+> ppr expr <+> ppr_bars (arity - alt) <+> text "#)"+  where+    ppr_bars n = hsep (replicate n (char '|'))++ppr_expr (HsLam _ matches)+  = pprMatches matches++ppr_expr (HsLamCase _ matches)+  = sep [ sep [text "\\case"],+          nest 2 (pprMatches matches) ]++ppr_expr (HsCase _ expr matches@(MG { mg_alts = L _ [_] }))+  = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of {")],+          nest 2 (pprMatches matches) <+> char '}']+ppr_expr (HsCase _ expr matches)+  = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of")],+          nest 2 (pprMatches matches) ]++ppr_expr (HsIf _ _ e1 e2 e3)+  = sep [hsep [text "if", nest 2 (ppr e1), ptext (sLit "then")],+         nest 4 (ppr e2),+         text "else",+         nest 4 (ppr e3)]++ppr_expr (HsMultiIf _ alts)+  = hang (text "if") 3  (vcat (map ppr_alt alts))+  where ppr_alt (L _ (GRHS _ guards expr)) =+          hang vbar 2 (ppr_one one_alt)+          where+            ppr_one [] = panic "ppr_exp HsMultiIf"+            ppr_one (h:t) = hang h 2 (sep t)+            one_alt = [ interpp'SP guards+                      , text "->" <+> pprDeeper (ppr expr) ]+        ppr_alt (L _ (XGRHS x)) = ppr x++-- special case: let ... in let ...+ppr_expr (HsLet _ (L _ binds) expr@(L _ (HsLet _ _ _)))+  = sep [hang (text "let") 2 (hsep [pprBinds binds, ptext (sLit "in")]),+         ppr_lexpr expr]++ppr_expr (HsLet _ (L _ binds) expr)+  = sep [hang (text "let") 2 (pprBinds binds),+         hang (text "in")  2 (ppr expr)]++ppr_expr (HsDo _ do_or_list_comp (L _ stmts)) = pprDo do_or_list_comp stmts++ppr_expr (ExplicitList _ _ exprs)+  = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))++ppr_expr (RecordCon { rcon_con_name = con_id, rcon_flds = rbinds })+  = hang (ppr con_id) 2 (ppr rbinds)++ppr_expr (RecordUpd { rupd_expr = L _ aexp, rupd_flds = rbinds })+  = hang (ppr aexp) 2 (braces (fsep (punctuate comma (map ppr rbinds))))++ppr_expr (ExprWithTySig _ expr sig)+  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)+         4 (ppr sig)++ppr_expr (ArithSeq _ _ info) = brackets (ppr info)++ppr_expr (EWildPat _)     = char '_'+ppr_expr (ELazyPat _ e)   = char '~' <> ppr e+ppr_expr (EAsPat _ (L _ v) e) = pprPrefixOcc v <> char '@' <> ppr e+ppr_expr (EViewPat _ p e) = ppr p <+> text "->" <+> ppr e++ppr_expr (HsSCC _ st (StringLiteral stl lbl) expr)+  = sep [ pprWithSourceText st (text "{-# SCC")+         -- no doublequotes if stl empty, for the case where the SCC was written+         -- without quotes.+          <+> pprWithSourceText stl (ftext lbl) <+> text "#-}",+          ppr expr ]++ppr_expr (HsWrap _ co_fn e)+  = pprHsWrapper co_fn (\parens -> if parens then pprExpr e+                                             else pprExpr e)++ppr_expr (HsSpliceE _ s)         = pprSplice s+ppr_expr (HsBracket _ b)         = pprHsBracket b+ppr_expr (HsRnBracketOut _ e []) = ppr e+ppr_expr (HsRnBracketOut _ e ps) = ppr e $$ text "pending(rn)" <+> ppr ps+ppr_expr (HsTcBracketOut _ e []) = ppr e+ppr_expr (HsTcBracketOut _ e ps) = ppr e $$ text "pending(tc)" <+> ppr ps++ppr_expr (HsProc _ pat (L _ (HsCmdTop _ cmd)))+  = hsep [text "proc", ppr pat, ptext (sLit "->"), ppr cmd]+ppr_expr (HsProc _ pat (L _ (XCmdTop x)))+  = hsep [text "proc", ppr pat, ptext (sLit "->"), ppr x]++ppr_expr (HsStatic _ e)+  = hsep [text "static", ppr e]++ppr_expr (HsTick _ tickish exp)+  = pprTicks (ppr exp) $+    ppr tickish <+> ppr_lexpr exp+ppr_expr (HsBinTick _ tickIdTrue tickIdFalse exp)+  = pprTicks (ppr exp) $+    hcat [text "bintick<",+          ppr tickIdTrue,+          text ",",+          ppr tickIdFalse,+          text ">(",+          ppr exp, text ")"]+ppr_expr (HsTickPragma _ _ externalSrcLoc _ exp)+  = pprTicks (ppr exp) $+    hcat [text "tickpragma<",+          pprExternalSrcLoc externalSrcLoc,+          text ">(",+          ppr exp,+          text ")"]++ppr_expr (HsRecFld _ f) = ppr f+ppr_expr (XExpr x) = ppr x++ppr_apps :: (OutputableBndrId (GhcPass p))+         => HsExpr (GhcPass p)+         -> [Either (LHsExpr (GhcPass p)) (LHsWcType (NoGhcTc (GhcPass p)))]+         -> SDoc+ppr_apps (HsApp _ (L _ fun) arg)        args+  = ppr_apps fun (Left arg : args)+ppr_apps (HsAppType _ (L _ fun) arg)    args+  = ppr_apps fun (Right arg : args)+ppr_apps fun args = hang (ppr_expr fun) 2 (sep (map pp args))+  where+    pp (Left arg)                             = ppr arg+    -- pp (Right (LHsWcTypeX (HsWC { hswc_body = L _ arg })))+    --   = char '@' <> pprHsType arg+    pp (Right arg)+      = char '@' <> ppr arg++pprExternalSrcLoc :: (StringLiteral,(Int,Int),(Int,Int)) -> SDoc+pprExternalSrcLoc (StringLiteral _ src,(n1,n2),(n3,n4))+  = ppr (src,(n1,n2),(n3,n4))++{-+HsSyn records exactly where the user put parens, with HsPar.+So generally speaking we print without adding any parens.+However, some code is internally generated, and in some places+parens are absolutely required; so for these places we use+pprParendLExpr (but don't print double parens of course).++For operator applications we don't add parens, because the operator+fixities should do the job, except in debug mode (-dppr-debug) so we+can see the structure of the parse tree.+-}++pprDebugParendExpr :: (OutputableBndrId (GhcPass p))+                   => PprPrec -> LHsExpr (GhcPass p) -> SDoc+pprDebugParendExpr p expr+  = getPprStyle (\sty ->+    if debugStyle sty then pprParendLExpr p expr+                      else pprLExpr      expr)++pprParendLExpr :: (OutputableBndrId (GhcPass p))+               => PprPrec -> LHsExpr (GhcPass p) -> SDoc+pprParendLExpr p (L _ e) = pprParendExpr p e++pprParendExpr :: (OutputableBndrId (GhcPass p))+              => PprPrec -> HsExpr (GhcPass p) -> SDoc+pprParendExpr p expr+  | hsExprNeedsParens p expr = parens (pprExpr expr)+  | otherwise                = pprExpr expr+        -- Using pprLExpr makes sure that we go 'deeper'+        -- I think that is usually (always?) right++-- | @'hsExprNeedsParens' p e@ returns 'True' if the expression @e@ needs+-- parentheses under precedence @p@.+hsExprNeedsParens :: PprPrec -> HsExpr p -> Bool+hsExprNeedsParens p = go+  where+    go (HsVar{})                      = False+    go (HsUnboundVar{})               = False+    go (HsConLikeOut{})               = False+    go (HsIPVar{})                    = False+    go (HsOverLabel{})                = False+    go (HsLit _ l)                    = hsLitNeedsParens p l+    go (HsOverLit _ ol)               = hsOverLitNeedsParens p ol+    go (HsPar{})                      = False+    go (HsCoreAnn _ _ _ (L _ e))      = go e+    go (HsApp{})                      = p >= appPrec+    go (HsAppType {})                 = p >= appPrec+    go (OpApp{})                      = p >= opPrec+    go (NegApp{})                     = p > topPrec+    go (SectionL{})                   = True+    go (SectionR{})                   = True+    go (ExplicitTuple{})              = False+    go (ExplicitSum{})                = False+    go (HsLam{})                      = p > topPrec+    go (HsLamCase{})                  = p > topPrec+    go (HsCase{})                     = p > topPrec+    go (HsIf{})                       = p > topPrec+    go (HsMultiIf{})                  = p > topPrec+    go (HsLet{})                      = p > topPrec+    go (HsDo _ sc _)+      | isComprehensionContext sc     = False+      | otherwise                     = p > topPrec+    go (ExplicitList{})               = False+    go (RecordUpd{})                  = False+    go (ExprWithTySig{})              = p >= sigPrec+    go (ArithSeq{})                   = False+    go (EWildPat{})                   = False+    go (ELazyPat{})                   = False+    go (EAsPat{})                     = False+    go (EViewPat{})                   = True+    go (HsSCC{})                      = p >= appPrec+    go (HsWrap _ _ e)                 = go e+    go (HsSpliceE{})                  = False+    go (HsBracket{})                  = False+    go (HsRnBracketOut{})             = False+    go (HsTcBracketOut{})             = False+    go (HsProc{})                     = p > topPrec+    go (HsStatic{})                   = p >= appPrec+    go (HsTick _ _ (L _ e))           = go e+    go (HsBinTick _ _ _ (L _ e))      = go e+    go (HsTickPragma _ _ _ _ (L _ e)) = go e+    go (RecordCon{})                  = False+    go (HsRecFld{})                   = False+    go (XExpr{})                      = True++-- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true,+-- and if so, surrounds @e@ with an 'HsPar'. Otherwise, it simply returns @e@.+parenthesizeHsExpr :: PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)+parenthesizeHsExpr p le@(L loc e)+  | hsExprNeedsParens p e = L loc (HsPar NoExt le)+  | otherwise             = le++isAtomicHsExpr :: HsExpr id -> Bool+-- True of a single token+isAtomicHsExpr (HsVar {})        = True+isAtomicHsExpr (HsConLikeOut {}) = True+isAtomicHsExpr (HsLit {})        = True+isAtomicHsExpr (HsOverLit {})    = True+isAtomicHsExpr (HsIPVar {})      = True+isAtomicHsExpr (HsOverLabel {})  = True+isAtomicHsExpr (HsUnboundVar {}) = True+isAtomicHsExpr (HsWrap _ _ e)    = isAtomicHsExpr e+isAtomicHsExpr (HsPar _ e)       = isAtomicHsExpr (unLoc e)+isAtomicHsExpr (HsRecFld{})      = True+isAtomicHsExpr _                 = False++{-+************************************************************************+*                                                                      *+\subsection{Commands (in arrow abstractions)}+*                                                                      *+************************************************************************++We re-use HsExpr to represent these.+-}++-- | Located Haskell Command (for arrow syntax)+type LHsCmd id = Located (HsCmd id)++-- | Haskell Command (e.g. a "statement" in an Arrow proc block)+data HsCmd id+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.Annlarrowtail',+  --          'ApiAnnotation.Annrarrowtail','ApiAnnotation.AnnLarrowtail',+  --          'ApiAnnotation.AnnRarrowtail'++  -- For details on above see note [Api annotations] in ApiAnnotation+  = HsCmdArrApp          -- Arrow tail, or arrow application (f -< arg)+        (XCmdArrApp id)  -- type of the arrow expressions f,+                         -- of the form a t t', where arg :: t+        (LHsExpr id)     -- arrow expression, f+        (LHsExpr id)     -- input expression, arg+        HsArrAppType     -- higher-order (-<<) or first-order (-<)+        Bool             -- True => right-to-left (f -< arg)+                         -- False => left-to-right (arg >- f)++  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpenB' @'(|'@,+  --         'ApiAnnotation.AnnCloseB' @'|)'@++  -- For details on above see note [Api annotations] in ApiAnnotation+  | HsCmdArrForm         -- Command formation,  (| e cmd1 .. cmdn |)+        (XCmdArrForm id)+        (LHsExpr id)     -- The operator.+                         -- After type-checking, a type abstraction to be+                         -- applied to the type of the local environment tuple+        LexicalFixity    -- Whether the operator appeared prefix or infix when+                         -- parsed.+        (Maybe Fixity)   -- fixity (filled in by the renamer), for forms that+                         -- were converted from OpApp's by the renamer+        [LHsCmdTop id]   -- argument commands++  | HsCmdApp    (XCmdApp id)+                (LHsCmd id)+                (LHsExpr id)++  | HsCmdLam    (XCmdLam id)+                (MatchGroup id (LHsCmd id))     -- kappa+       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',+       --       'ApiAnnotation.AnnRarrow',++       -- For details on above see note [Api annotations] in ApiAnnotation++  | HsCmdPar    (XCmdPar id)+                (LHsCmd id)                     -- parenthesised command+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,+    --             'ApiAnnotation.AnnClose' @')'@++    -- For details on above see note [Api annotations] in ApiAnnotation++  | HsCmdCase   (XCmdCase id)+                (LHsExpr id)+                (MatchGroup id (LHsCmd id))     -- bodies are HsCmd's+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',+    --       'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,+    --       'ApiAnnotation.AnnClose' @'}'@++    -- For details on above see note [Api annotations] in ApiAnnotation++  | HsCmdIf     (XCmdIf id)+                (Maybe (SyntaxExpr id))         -- cond function+                (LHsExpr id)                    -- predicate+                (LHsCmd id)                     -- then part+                (LHsCmd id)                     -- else part+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',+    --       'ApiAnnotation.AnnSemi',+    --       'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',+    --       'ApiAnnotation.AnnElse',++    -- For details on above see note [Api annotations] in ApiAnnotation++  | HsCmdLet    (XCmdLet id)+                (LHsLocalBinds id)      -- let(rec)+                (LHsCmd  id)+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',+    --       'ApiAnnotation.AnnOpen' @'{'@,+    --       'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'++    -- For details on above see note [Api annotations] in ApiAnnotation++  | HsCmdDo     (XCmdDo id)                     -- Type of the whole expression+                (Located [CmdLStmt id])+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',+    --             'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',+    --             'ApiAnnotation.AnnVbar',+    --             'ApiAnnotation.AnnClose'++    -- For details on above see note [Api annotations] in ApiAnnotation++  | HsCmdWrap   (XCmdWrap id)+                HsWrapper+                (HsCmd id)     -- If   cmd :: arg1 --> res+                               --      wrap :: arg1 "->" arg2+                               -- Then (HsCmdWrap wrap cmd) :: arg2 --> res+  | XCmd        (XXCmd id)     -- Note [Trees that Grow] extension point++type instance XCmdArrApp  GhcPs = NoExt+type instance XCmdArrApp  GhcRn = NoExt+type instance XCmdArrApp  GhcTc = Type++type instance XCmdArrForm (GhcPass _) = NoExt+type instance XCmdApp     (GhcPass _) = NoExt+type instance XCmdLam     (GhcPass _) = NoExt+type instance XCmdPar     (GhcPass _) = NoExt+type instance XCmdCase    (GhcPass _) = NoExt+type instance XCmdIf      (GhcPass _) = NoExt+type instance XCmdLet     (GhcPass _) = NoExt++type instance XCmdDo      GhcPs = NoExt+type instance XCmdDo      GhcRn = NoExt+type instance XCmdDo      GhcTc = Type++type instance XCmdWrap    (GhcPass _) = NoExt+type instance XXCmd       (GhcPass _) = NoExt++-- | Haskell Array Application Type+data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp+  deriving Data+++{- | Top-level command, introducing a new arrow.+This may occur inside a proc (where the stack is empty) or as an+argument of a command-forming operator.+-}++-- | Located Haskell Top-level Command+type LHsCmdTop p = Located (HsCmdTop p)++-- | Haskell Top-level Command+data HsCmdTop p+  = HsCmdTop (XCmdTop p)+             (LHsCmd p)+  | XCmdTop (XXCmdTop p)        -- Note [Trees that Grow] extension point++data CmdTopTc+  = CmdTopTc Type    -- Nested tuple of inputs on the command's stack+             Type    -- return type of the command+             (CmdSyntaxTable GhcTc) -- See Note [CmdSyntaxTable]++type instance XCmdTop  GhcPs = NoExt+type instance XCmdTop  GhcRn = CmdSyntaxTable GhcRn -- See Note [CmdSyntaxTable]+type instance XCmdTop  GhcTc = CmdTopTc++type instance XXCmdTop (GhcPass _) = NoExt++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p) where+    ppr cmd = pprCmd cmd++-----------------------+-- pprCmd and pprLCmd call pprDeeper;+-- the underscore versions do not+pprLCmd :: (OutputableBndrId (GhcPass p)) => LHsCmd (GhcPass p) -> SDoc+pprLCmd (L _ c) = pprCmd c++pprCmd :: (OutputableBndrId (GhcPass p)) => HsCmd (GhcPass p) -> SDoc+pprCmd c | isQuietHsCmd c =            ppr_cmd c+         | otherwise      = pprDeeper (ppr_cmd c)++isQuietHsCmd :: HsCmd id -> Bool+-- Parentheses do display something, but it gives little info and+-- if we go deeper when we go inside them then we get ugly things+-- like (...)+isQuietHsCmd (HsCmdPar {}) = True+-- applications don't display anything themselves+isQuietHsCmd (HsCmdApp {}) = True+isQuietHsCmd _ = False++-----------------------+ppr_lcmd :: (OutputableBndrId (GhcPass p)) => LHsCmd (GhcPass p) -> SDoc+ppr_lcmd c = ppr_cmd (unLoc c)++ppr_cmd :: forall p. (OutputableBndrId (GhcPass p)) => HsCmd (GhcPass p) -> SDoc+ppr_cmd (HsCmdPar _ c) = parens (ppr_lcmd c)++ppr_cmd (HsCmdApp _ c e)+  = let (fun, args) = collect_args c [e] in+    hang (ppr_lcmd fun) 2 (sep (map ppr args))+  where+    collect_args (L _ (HsCmdApp _ fun arg)) args = collect_args fun (arg:args)+    collect_args fun args = (fun, args)++ppr_cmd (HsCmdLam _ matches)+  = pprMatches matches++ppr_cmd (HsCmdCase _ expr matches)+  = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of")],+          nest 2 (pprMatches matches) ]++ppr_cmd (HsCmdIf _ _ e ct ce)+  = sep [hsep [text "if", nest 2 (ppr e), ptext (sLit "then")],+         nest 4 (ppr ct),+         text "else",+         nest 4 (ppr ce)]++-- special case: let ... in let ...+ppr_cmd (HsCmdLet _ (L _ binds) cmd@(L _ (HsCmdLet {})))+  = sep [hang (text "let") 2 (hsep [pprBinds binds, ptext (sLit "in")]),+         ppr_lcmd cmd]++ppr_cmd (HsCmdLet _ (L _ binds) cmd)+  = sep [hang (text "let") 2 (pprBinds binds),+         hang (text "in")  2 (ppr cmd)]++ppr_cmd (HsCmdDo _ (L _ stmts))  = pprDo ArrowExpr stmts++ppr_cmd (HsCmdWrap _ w cmd)+  = pprHsWrapper w (\_ -> parens (ppr_cmd cmd))+ppr_cmd (HsCmdArrApp _ arrow arg HsFirstOrderApp True)+  = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]+ppr_cmd (HsCmdArrApp _ arrow arg HsFirstOrderApp False)+  = hsep [ppr_lexpr arg, arrowt, ppr_lexpr arrow]+ppr_cmd (HsCmdArrApp _ arrow arg HsHigherOrderApp True)+  = hsep [ppr_lexpr arrow, larrowtt, ppr_lexpr arg]+ppr_cmd (HsCmdArrApp _ arrow arg HsHigherOrderApp False)+  = hsep [ppr_lexpr arg, arrowtt, ppr_lexpr arrow]++ppr_cmd (HsCmdArrForm _ (L _ (HsVar _ (L _ v))) _ (Just _) [arg1, arg2])+  = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc v+                                         , pprCmdArg (unLoc arg2)])+ppr_cmd (HsCmdArrForm _ (L _ (HsVar _ (L _ v))) Infix _    [arg1, arg2])+  = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc v+                                         , pprCmdArg (unLoc arg2)])+ppr_cmd (HsCmdArrForm _ (L _ (HsConLikeOut _ c)) _ (Just _) [arg1, arg2])+  = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc (conLikeName c)+                                         , pprCmdArg (unLoc arg2)])+ppr_cmd (HsCmdArrForm _ (L _ (HsConLikeOut _ c)) Infix _    [arg1, arg2])+  = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc (conLikeName c)+                                         , pprCmdArg (unLoc arg2)])+ppr_cmd (HsCmdArrForm _ op _ _ args)+  = hang (text "(|" <+> ppr_lexpr op)+         4 (sep (map (pprCmdArg.unLoc) args) <+> text "|)")+ppr_cmd (XCmd x) = ppr x++pprCmdArg :: (OutputableBndrId (GhcPass p)) => HsCmdTop (GhcPass p) -> SDoc+pprCmdArg (HsCmdTop _ cmd)+  = ppr_lcmd cmd+pprCmdArg (XCmdTop x) = ppr x++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmdTop p) where+    ppr = pprCmdArg++{-+************************************************************************+*                                                                      *+\subsection{Record binds}+*                                                                      *+************************************************************************+-}++-- | Haskell Record Bindings+type HsRecordBinds p = HsRecFields p (LHsExpr p)++{-+************************************************************************+*                                                                      *+\subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}+*                                                                      *+************************************************************************++@Match@es are sets of pattern bindings and right hand sides for+functions, patterns or case branches. For example, if a function @g@+is defined as:+\begin{verbatim}+g (x,y) = y+g ((x:ys),y) = y+1,+\end{verbatim}+then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.++It is always the case that each element of an @[Match]@ list has the+same number of @pats@s inside it.  This corresponds to saying that+a function defined by pattern matching must have the same number of+patterns in each equation.+-}++data MatchGroup p body+  = MG { mg_ext     :: XMG p body -- Posr typechecker, types of args and result+       , mg_alts    :: Located [LMatch p body]  -- The alternatives+       , mg_origin  :: Origin }+     -- The type is the type of the entire group+     --      t1 -> ... -> tn -> tr+     -- where there are n patterns+  | XMatchGroup (XXMatchGroup p body)++data MatchGroupTc+  = MatchGroupTc+       { mg_arg_tys :: [Type]  -- Types of the arguments, t1..tn+       , mg_res_ty  :: Type    -- Type of the result, tr+       } deriving Data++type instance XMG         GhcPs b = NoExt+type instance XMG         GhcRn b = NoExt+type instance XMG         GhcTc b = MatchGroupTc++type instance XXMatchGroup (GhcPass _) b = NoExt++-- | Located Match+type LMatch id body = Located (Match id body)+-- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a+--   list++-- For details on above see note [Api annotations] in ApiAnnotation+data Match p body+  = Match {+        m_ext :: XCMatch p body,+        m_ctxt :: HsMatchContext (NameOrRdrName (IdP p)),+          -- See note [m_ctxt in Match]+        m_pats :: [LPat p], -- The patterns+        m_grhss :: (GRHSs p body)+  }+  | XMatch (XXMatch p body)++type instance XCMatch (GhcPass _) b = NoExt+type instance XXMatch (GhcPass _) b = NoExt++instance (idR ~ GhcPass pr, OutputableBndrId idR, Outputable body)+            => Outputable (Match idR body) where+  ppr = pprMatch++{-+Note [m_ctxt in Match]+~~~~~~~~~~~~~~~~~~~~~~++A Match can occur in a number of contexts, such as a FunBind, HsCase, HsLam and+so on.++In order to simplify tooling processing and pretty print output, the provenance+is captured in an HsMatchContext.++This is particularly important for the API Annotations for a multi-equation+FunBind.++The parser initially creates a FunBind with a single Match in it for+every function definition it sees.++These are then grouped together by getMonoBind into a single FunBind,+where all the Matches are combined.++In the process, all the original FunBind fun_id's bar one are+discarded, including the locations.++This causes a problem for source to source conversions via API+Annotations, so the original fun_ids and infix flags are preserved in+the Match, when it originates from a FunBind.++Example infix function definition requiring individual API Annotations++    (&&&  ) [] [] =  []+    xs    &&&   [] =  xs+    (  &&&  ) [] ys =  ys++++-}+++isInfixMatch :: Match id body -> Bool+isInfixMatch match = case m_ctxt match of+  FunRhs {mc_fixity = Infix} -> True+  _                          -> False++isEmptyMatchGroup :: MatchGroup id body -> Bool+isEmptyMatchGroup (MG { mg_alts = ms }) = null $ unLoc ms+isEmptyMatchGroup (XMatchGroup{}) = panic "isEmptyMatchGroup"++-- | Is there only one RHS in this list of matches?+isSingletonMatchGroup :: [LMatch id body] -> Bool+isSingletonMatchGroup matches+  | [L _ match] <- matches+  , Match { m_grhss = GRHSs { grhssGRHSs = [_] } } <- match+  = True+  | otherwise+  = False++matchGroupArity :: MatchGroup id body -> Arity+-- Precondition: MatchGroup is non-empty+-- This is called before type checking, when mg_arg_tys is not set+matchGroupArity (MG { mg_alts = alts })+  | L _ (alt1:_) <- alts = length (hsLMatchPats alt1)+  | otherwise        = panic "matchGroupArity"+matchGroupArity (XMatchGroup{}) = panic "matchGroupArity"++hsLMatchPats :: LMatch id body -> [LPat id]+hsLMatchPats (L _ (Match { m_pats = pats })) = pats+hsLMatchPats (L _ (XMatch _)) = panic "hsLMatchPats"++-- | Guarded Right-Hand Sides+--+-- GRHSs are used both for pattern bindings and for Matches+--+--  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVbar',+--        'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',+--        'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'+--        'ApiAnnotation.AnnRarrow','ApiAnnotation.AnnSemi'++-- For details on above see note [Api annotations] in ApiAnnotation+data GRHSs p body+  = GRHSs {+      grhssExt :: XCGRHSs p body,+      grhssGRHSs :: [LGRHS p body],      -- ^ Guarded RHSs+      grhssLocalBinds :: LHsLocalBinds p -- ^ The where clause+    }+  | XGRHSs (XXGRHSs p body)++type instance XCGRHSs (GhcPass _) b = NoExt+type instance XXGRHSs (GhcPass _) b = NoExt++-- | Located Guarded Right-Hand Side+type LGRHS id body = Located (GRHS id body)++-- | Guarded Right Hand Side.+data GRHS p body = GRHS (XCGRHS p body)+                        [GuardLStmt p] -- Guards+                        body           -- Right hand side+                  | XGRHS (XXGRHS p body)++type instance XCGRHS (GhcPass _) b = NoExt+type instance XXGRHS (GhcPass _) b = NoExt++-- We know the list must have at least one @Match@ in it.++pprMatches :: (OutputableBndrId (GhcPass idR), Outputable body)+           => MatchGroup (GhcPass idR) body -> SDoc+pprMatches MG { mg_alts = matches }+    = vcat (map pprMatch (map unLoc (unLoc matches)))+      -- Don't print the type; it's only a place-holder before typechecking+pprMatches (XMatchGroup x) = ppr x++-- Exported to HsBinds, which can't see the defn of HsMatchContext+pprFunBind :: (OutputableBndrId (GhcPass idR), Outputable body)+           => MatchGroup (GhcPass idR) body -> SDoc+pprFunBind matches = pprMatches matches++-- Exported to HsBinds, which can't see the defn of HsMatchContext+pprPatBind :: forall bndr p body. (OutputableBndrId (GhcPass bndr),+                                   OutputableBndrId (GhcPass p),+                                   Outputable body)+           => LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc+pprPatBind pat (grhss)+ = sep [ppr pat,+       nest 2 (pprGRHSs (PatBindRhs :: HsMatchContext (IdP (GhcPass p))) grhss)]++pprMatch :: (OutputableBndrId (GhcPass idR), Outputable body)+         => Match (GhcPass idR) body -> SDoc+pprMatch match+  = sep [ sep (herald : map (nest 2 . pprParendLPat appPrec) other_pats)+        , nest 2 (pprGRHSs ctxt (m_grhss match)) ]+  where+    ctxt = m_ctxt match+    (herald, other_pats)+        = case ctxt of+            FunRhs {mc_fun=L _ fun, mc_fixity=fixity, mc_strictness=strictness}+                | strictness == SrcStrict -> ASSERT(null $ m_pats match)+                                             (char '!'<>pprPrefixOcc fun, m_pats match)+                        -- a strict variable binding+                | fixity == Prefix -> (pprPrefixOcc fun, m_pats match)+                        -- f x y z = e+                        -- Not pprBndr; the AbsBinds will+                        -- have printed the signature++                | null pats2 -> (pp_infix, [])+                        -- x &&& y = e++                | otherwise -> (parens pp_infix, pats2)+                        -- (x &&& y) z = e+                where+                  pp_infix = pprParendLPat opPrec pat1+                         <+> pprInfixOcc fun+                         <+> pprParendLPat opPrec pat2++            LambdaExpr -> (char '\\', m_pats match)++            _  -> if null (m_pats match)+                     then (empty, [])+                     else ASSERT2( null pats1, ppr ctxt $$ ppr pat1 $$ ppr pats1 )+                          (ppr pat1, [])        -- No parens around the single pat++    (pat1:pats1) = m_pats match+    (pat2:pats2) = pats1++pprGRHSs :: (OutputableBndrId (GhcPass idR), Outputable body)+         => HsMatchContext idL -> GRHSs (GhcPass idR) body -> SDoc+pprGRHSs ctxt (GRHSs _ grhss (L _ binds))+  = vcat (map (pprGRHS ctxt . unLoc) grhss)+  -- Print the "where" even if the contents of the binds is empty. Only+  -- EmptyLocalBinds means no "where" keyword+ $$ ppUnless (eqEmptyLocalBinds binds)+      (text "where" $$ nest 4 (pprBinds binds))+pprGRHSs _ (XGRHSs x) = ppr x++pprGRHS :: (OutputableBndrId (GhcPass idR), Outputable body)+        => HsMatchContext idL -> GRHS (GhcPass idR) body -> SDoc+pprGRHS ctxt (GRHS _ [] body)+ =  pp_rhs ctxt body++pprGRHS ctxt (GRHS _ guards body)+ = sep [vbar <+> interpp'SP guards, pp_rhs ctxt body]++pprGRHS _ (XGRHS x) = ppr x++pp_rhs :: Outputable body => HsMatchContext idL -> body -> SDoc+pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)++{-+************************************************************************+*                                                                      *+\subsection{Do stmts and list comprehensions}+*                                                                      *+************************************************************************+-}++-- | Located @do@ block Statement+type LStmt id body = Located (StmtLR id id body)++-- | Located Statement with separate Left and Right id's+type LStmtLR idL idR body = Located (StmtLR idL idR body)++-- | @do@ block Statement+type Stmt id body = StmtLR id id body++-- | Command Located Statement+type CmdLStmt   id = LStmt id (LHsCmd  id)++-- | Command Statement+type CmdStmt    id = Stmt  id (LHsCmd  id)++-- | Expression Located Statement+type ExprLStmt  id = LStmt id (LHsExpr id)++-- | Expression Statement+type ExprStmt   id = Stmt  id (LHsExpr id)++-- | Guard Located Statement+type GuardLStmt id = LStmt id (LHsExpr id)++-- | Guard Statement+type GuardStmt  id = Stmt  id (LHsExpr id)++-- | Ghci Located Statement+type GhciLStmt  id = LStmt id (LHsExpr id)++-- | Ghci Statement+type GhciStmt   id = Stmt  id (LHsExpr id)++-- The SyntaxExprs in here are used *only* for do-notation and monad+-- comprehensions, which have rebindable syntax. Otherwise they are unused.+-- | API Annotations when in qualifier lists or guards+--  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVbar',+--         'ApiAnnotation.AnnComma','ApiAnnotation.AnnThen',+--         'ApiAnnotation.AnnBy','ApiAnnotation.AnnBy',+--         'ApiAnnotation.AnnGroup','ApiAnnotation.AnnUsing'++-- For details on above see note [Api annotations] in ApiAnnotation+data StmtLR idL idR body -- body should always be (LHs**** idR)+  = LastStmt  -- Always the last Stmt in ListComp, MonadComp,+              -- and (after the renamer, see RnExpr.checkLastStmt) DoExpr, MDoExpr+              -- Not used for GhciStmtCtxt, PatGuard, which scope over other stuff+          (XLastStmt idL idR body)+          body+          Bool               -- True <=> return was stripped by ApplicativeDo+          (SyntaxExpr idR)   -- The return operator+            -- The return operator is used only for MonadComp+            -- For ListComp we use the baked-in 'return'+            -- For DoExpr, MDoExpr, we don't apply a 'return' at all+            -- See Note [Monad Comprehensions]+            -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLarrow'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | BindStmt (XBindStmt idL idR body) -- Post typechecking,+                                -- result type of the function passed to bind;+                                -- that is, S in (>>=) :: Q -> (R -> S) -> T+             (LPat idL)+             body+             (SyntaxExpr idR) -- The (>>=) operator; see Note [The type of bind in Stmts]+             (SyntaxExpr idR) -- The fail operator+             -- The fail operator is noSyntaxExpr+             -- if the pattern match can't fail++  -- | 'ApplicativeStmt' represents an applicative expression built with+  -- '<$>' and '<*>'.  It is generated by the renamer, and is desugared into the+  -- appropriate applicative expression by the desugarer, but it is intended+  -- to be invisible in error messages.+  --+  -- For full details, see Note [ApplicativeDo] in RnExpr+  --+  | ApplicativeStmt+             (XApplicativeStmt idL idR body) -- Post typecheck, Type of the body+             [ ( SyntaxExpr idR+               , ApplicativeArg idL) ]+                      -- [(<$>, e1), (<*>, e2), ..., (<*>, en)]+             (Maybe (SyntaxExpr idR))  -- 'join', if necessary++  | BodyStmt (XBodyStmt idL idR body) -- Post typecheck, element type+                                      -- of the RHS (used for arrows)+             body              -- See Note [BodyStmt]+             (SyntaxExpr idR)  -- The (>>) operator+             (SyntaxExpr idR)  -- The `guard` operator; used only in MonadComp+                               -- See notes [Monad Comprehensions]++  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet'+  --          'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@,++  -- For details on above see note [Api annotations] in ApiAnnotation+  | LetStmt  (XLetStmt idL idR body) (LHsLocalBindsLR idL idR)++  -- ParStmts only occur in a list/monad comprehension+  | ParStmt  (XParStmt idL idR body)    -- Post typecheck,+                                        -- S in (>>=) :: Q -> (R -> S) -> T+             [ParStmtBlock idL idR]+             (HsExpr idR)               -- Polymorphic `mzip` for monad comprehensions+             (SyntaxExpr idR)           -- The `>>=` operator+                                        -- See notes [Monad Comprehensions]+            -- After renaming, the ids are the binders+            -- bound by the stmts and used after themp++  | TransStmt {+      trS_ext   :: XTransStmt idL idR body, -- Post typecheck,+                                            -- R in (>>=) :: Q -> (R -> S) -> T+      trS_form  :: TransForm,+      trS_stmts :: [ExprLStmt idL],   -- Stmts to the *left* of the 'group'+                                      -- which generates the tuples to be grouped++      trS_bndrs :: [(IdP idR, IdP idR)], -- See Note [TransStmt binder map]++      trS_using :: LHsExpr idR,+      trS_by :: Maybe (LHsExpr idR),  -- "by e" (optional)+        -- Invariant: if trS_form = GroupBy, then grp_by = Just e++      trS_ret :: SyntaxExpr idR,      -- The monomorphic 'return' function for+                                      -- the inner monad comprehensions+      trS_bind :: SyntaxExpr idR,     -- The '(>>=)' operator+      trS_fmap :: HsExpr idR          -- The polymorphic 'fmap' function for desugaring+                                      -- Only for 'group' forms+                                      -- Just a simple HsExpr, because it's+                                      -- too polymorphic for tcSyntaxOp+    }                                 -- See Note [Monad Comprehensions]++  -- Recursive statement (see Note [How RecStmt works] below)+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRec'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | RecStmt+     { recS_ext :: XRecStmt idL idR body+     , recS_stmts :: [LStmtLR idL idR body]++        -- The next two fields are only valid after renaming+     , recS_later_ids :: [IdP idR]+                         -- The ids are a subset of the variables bound by the+                         -- stmts that are used in stmts that follow the RecStmt++     , recS_rec_ids :: [IdP idR]+                         -- Ditto, but these variables are the "recursive" ones,+                         -- that are used before they are bound in the stmts of+                         -- the RecStmt.+        -- An Id can be in both groups+        -- Both sets of Ids are (now) treated monomorphically+        -- See Note [How RecStmt works] for why they are separate++        -- Rebindable syntax+     , recS_bind_fn :: SyntaxExpr idR -- The bind function+     , recS_ret_fn  :: SyntaxExpr idR -- The return function+     , recS_mfix_fn :: SyntaxExpr idR -- The mfix function+      }+  | XStmtLR (XXStmtLR idL idR body)++-- Extra fields available post typechecking for RecStmt.+data RecStmtTc =+  RecStmtTc+     { recS_bind_ty :: Type       -- S in (>>=) :: Q -> (R -> S) -> T+     , recS_later_rets :: [PostTcExpr] -- (only used in the arrow version)+     , recS_rec_rets :: [PostTcExpr] -- These expressions correspond 1-to-1+                                  -- with recS_later_ids and recS_rec_ids,+                                  -- and are the expressions that should be+                                  -- returned by the recursion.+                                  -- They may not quite be the Ids themselves,+                                  -- because the Id may be *polymorphic*, but+                                  -- the returned thing has to be *monomorphic*,+                                  -- so they may be type applications++      , recS_ret_ty :: Type        -- The type of+                                   -- do { stmts; return (a,b,c) }+                                   -- With rebindable syntax the type might not+                                   -- be quite as simple as (m (tya, tyb, tyc)).+      }+++type instance XLastStmt        (GhcPass _) (GhcPass _) b = NoExt++type instance XBindStmt        (GhcPass _) GhcPs b = NoExt+type instance XBindStmt        (GhcPass _) GhcRn b = NoExt+type instance XBindStmt        (GhcPass _) GhcTc b = Type++type instance XApplicativeStmt (GhcPass _) GhcPs b = NoExt+type instance XApplicativeStmt (GhcPass _) GhcRn b = NoExt+type instance XApplicativeStmt (GhcPass _) GhcTc b = Type++type instance XBodyStmt        (GhcPass _) GhcPs b = NoExt+type instance XBodyStmt        (GhcPass _) GhcRn b = NoExt+type instance XBodyStmt        (GhcPass _) GhcTc b = Type++type instance XLetStmt         (GhcPass _) (GhcPass _) b = NoExt++type instance XParStmt         (GhcPass _) GhcPs b = NoExt+type instance XParStmt         (GhcPass _) GhcRn b = NoExt+type instance XParStmt         (GhcPass _) GhcTc b = Type++type instance XTransStmt       (GhcPass _) GhcPs b = NoExt+type instance XTransStmt       (GhcPass _) GhcRn b = NoExt+type instance XTransStmt       (GhcPass _) GhcTc b = Type++type instance XRecStmt         (GhcPass _) GhcPs b = NoExt+type instance XRecStmt         (GhcPass _) GhcRn b = NoExt+type instance XRecStmt         (GhcPass _) GhcTc b = RecStmtTc++type instance XXStmtLR         (GhcPass _) (GhcPass _) b = NoExt++data TransForm   -- The 'f' below is the 'using' function, 'e' is the by function+  = ThenForm     -- then f               or    then f by e             (depending on trS_by)+  | GroupForm    -- then group using f   or    then group by e using f (depending on trS_by)+  deriving Data++-- | Parenthesised Statement Block+data ParStmtBlock idL idR+  = ParStmtBlock+        (XParStmtBlock idL idR)+        [ExprLStmt idL]+        [IdP idR]          -- The variables to be returned+        (SyntaxExpr idR)   -- The return operator+  | XParStmtBlock (XXParStmtBlock idL idR)++type instance XParStmtBlock  (GhcPass pL) (GhcPass pR) = NoExt+type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExt++-- | Applicative Argument+data ApplicativeArg idL+  = ApplicativeArgOne      -- A single statement (BindStmt or BodyStmt)+      (XApplicativeArgOne idL)+      (LPat idL)           -- WildPat if it was a BodyStmt (see below)+      (LHsExpr idL)+      Bool                 -- True <=> was a BodyStmt+                           -- False <=> was a BindStmt+                           -- See Note [Applicative BodyStmt]++  | ApplicativeArgMany     -- do { stmts; return vars }+      (XApplicativeArgMany idL)+      [ExprLStmt idL]      -- stmts+      (HsExpr idL)         -- return (v1,..,vn), or just (v1,..,vn)+      (LPat idL)           -- (v1,...,vn)+  | XApplicativeArg (XXApplicativeArg idL)++type instance XApplicativeArgOne  (GhcPass _) = NoExt+type instance XApplicativeArgMany (GhcPass _) = NoExt+type instance XXApplicativeArg    (GhcPass _) = NoExt++{-+Note [The type of bind in Stmts]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Some Stmts, notably BindStmt, keep the (>>=) bind operator.+We do NOT assume that it has type+    (>>=) :: m a -> (a -> m b) -> m b+In some cases (see #303, #1537) it might have a more+exotic type, such as+    (>>=) :: m i j a -> (a -> m j k b) -> m i k b+So we must be careful not to make assumptions about the type.+In particular, the monad may not be uniform throughout.++Note [TransStmt binder map]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+The [(idR,idR)] in a TransStmt behaves as follows:++  * Before renaming: []++  * After renaming:+          [ (x27,x27), ..., (z35,z35) ]+    These are the variables+       bound by the stmts to the left of the 'group'+       and used either in the 'by' clause,+                or     in the stmts following the 'group'+    Each item is a pair of identical variables.++  * After typechecking:+          [ (x27:Int, x27:[Int]), ..., (z35:Bool, z35:[Bool]) ]+    Each pair has the same unique, but different *types*.++Note [BodyStmt]+~~~~~~~~~~~~~~~+BodyStmts are a bit tricky, because what they mean+depends on the context.  Consider the following contexts:++        A do expression of type (m res_ty)+        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+        * BodyStmt E any_ty:   do { ....; E; ... }+                E :: m any_ty+          Translation: E >> ...++        A list comprehensions of type [elt_ty]+        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+        * BodyStmt E Bool:   [ .. | .... E ]+                        [ .. | ..., E, ... ]+                        [ .. | .... | ..., E | ... ]+                E :: Bool+          Translation: if E then fail else ...++        A guard list, guarding a RHS of type rhs_ty+        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+        * BodyStmt E BooParStmtBlockl:   f x | ..., E, ... = ...rhs...+                E :: Bool+          Translation: if E then fail else ...++        A monad comprehension of type (m res_ty)+        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+        * BodyStmt E Bool:   [ .. | .... E ]+                E :: Bool+          Translation: guard E >> ...++Array comprehensions are handled like list comprehensions.++Note [How RecStmt works]+~~~~~~~~~~~~~~~~~~~~~~~~+Example:+   HsDo [ BindStmt x ex++        , RecStmt { recS_rec_ids   = [a, c]+                  , recS_stmts     = [ BindStmt b (return (a,c))+                                     , LetStmt a = ...b...+                                     , BindStmt c ec ]+                  , recS_later_ids = [a, b]++        , return (a b) ]++Here, the RecStmt binds a,b,c; but+  - Only a,b are used in the stmts *following* the RecStmt,+  - Only a,c are used in the stmts *inside* the RecStmt+        *before* their bindings++Why do we need *both* rec_ids and later_ids?  For monads they could be+combined into a single set of variables, but not for arrows.  That+follows from the types of the respective feedback operators:++        mfix :: MonadFix m => (a -> m a) -> m a+        loop :: ArrowLoop a => a (b,d) (c,d) -> a b c++* For mfix, the 'a' covers the union of the later_ids and the rec_ids+* For 'loop', 'c' is the later_ids and 'd' is the rec_ids++Note [Typing a RecStmt]+~~~~~~~~~~~~~~~~~~~~~~~+A (RecStmt stmts) types as if you had written++  (v1,..,vn, _, ..., _) <- mfix (\~(_, ..., _, r1, ..., rm) ->+                                 do { stmts+                                    ; return (v1,..vn, r1, ..., rm) })++where v1..vn are the later_ids+      r1..rm are the rec_ids++Note [Monad Comprehensions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Monad comprehensions require separate functions like 'return' and+'>>=' for desugaring. These functions are stored in the statements+used in monad comprehensions. For example, the 'return' of the 'LastStmt'+expression is used to lift the body of the monad comprehension:++  [ body | stmts ]+   =>+  stmts >>= \bndrs -> return body++In transform and grouping statements ('then ..' and 'then group ..') the+'return' function is required for nested monad comprehensions, for example:++  [ body | stmts, then f, rest ]+   =>+  f [ env | stmts ] >>= \bndrs -> [ body | rest ]++BodyStmts require the 'Control.Monad.guard' function for boolean+expressions:++  [ body | exp, stmts ]+   =>+  guard exp >> [ body | stmts ]++Parallel statements require the 'Control.Monad.Zip.mzip' function:++  [ body | stmts1 | stmts2 | .. ]+   =>+  mzip stmts1 (mzip stmts2 (..)) >>= \(bndrs1, (bndrs2, ..)) -> return body++In any other context than 'MonadComp', the fields for most of these+'SyntaxExpr's stay bottom.+++Note [Applicative BodyStmt]++(#12143) For the purposes of ApplicativeDo, we treat any BodyStmt+as if it was a BindStmt with a wildcard pattern.  For example,++  do+    x <- A+    B+    return x++is transformed as if it were++  do+    x <- A+    _ <- B+    return x++so it transforms to++  (\(x,_) -> x) <$> A <*> B++But we have to remember when we treat a BodyStmt like a BindStmt,+because in error messages we want to emit the original syntax the user+wrote, not our internal representation.  So ApplicativeArgOne has a+Bool flag that is True when the original statement was a BodyStmt, so+that we can pretty-print it correctly.+-}++instance (Outputable (StmtLR idL idL (LHsExpr idL)),+          Outputable (XXParStmtBlock idL idR))+        => Outputable (ParStmtBlock idL idR) where+  ppr (ParStmtBlock _ stmts _ _) = interpp'SP stmts+  ppr (XParStmtBlock x)          = ppr x++instance (idL ~ GhcPass pl,idR ~ GhcPass pr,+          OutputableBndrId idL, OutputableBndrId idR,+          Outputable body)+         => Outputable (StmtLR idL idR body) where+    ppr stmt = pprStmt stmt++pprStmt :: forall idL idR body . (OutputableBndrId (GhcPass idL),+                                  OutputableBndrId (GhcPass idR),+                                  Outputable body)+        => (StmtLR (GhcPass idL) (GhcPass idR) body) -> SDoc+pprStmt (LastStmt _ expr ret_stripped _)+  = whenPprDebug (text "[last]") <+>+       (if ret_stripped then text "return" else empty) <+>+       ppr expr+pprStmt (BindStmt _ pat expr _ _) = hsep [ppr pat, larrow, ppr expr]+pprStmt (LetStmt _ (L _ binds))   = hsep [text "let", pprBinds binds]+pprStmt (BodyStmt _ expr _ _)     = ppr expr+pprStmt (ParStmt _ stmtss _ _)   = sep (punctuate (text " | ") (map ppr stmtss))++pprStmt (TransStmt { trS_stmts = stmts, trS_by = by+                   , trS_using = using, trS_form = form })+  = sep $ punctuate comma (map ppr stmts ++ [pprTransStmt by using form])++pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids+                 , recS_later_ids = later_ids })+  = text "rec" <+>+    vcat [ ppr_do_stmts segment+         , whenPprDebug (vcat [ text "rec_ids=" <> ppr rec_ids+                            , text "later_ids=" <> ppr later_ids])]++pprStmt (ApplicativeStmt _ args mb_join)+  = getPprStyle $ \style ->+      if userStyle style+         then pp_for_user+         else pp_debug+  where+  -- make all the Applicative stuff invisible in error messages by+  -- flattening the whole ApplicativeStmt nest back to a sequence+  -- of statements.+   pp_for_user = vcat $ concatMap flattenArg args++   -- ppr directly rather than transforming here, because we need to+   -- inject a "return" which is hard when we're polymorphic in the id+   -- type.+   flattenStmt :: ExprLStmt (GhcPass idL) -> [SDoc]+   flattenStmt (L _ (ApplicativeStmt _ args _)) = concatMap flattenArg args+   flattenStmt stmt = [ppr stmt]++   flattenArg :: forall a . (a, ApplicativeArg (GhcPass idL)) -> [SDoc]+   flattenArg (_, ApplicativeArgOne _ pat expr isBody)+     | isBody =  -- See Note [Applicative BodyStmt]+     [ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr+             :: ExprStmt (GhcPass idL))]+     | otherwise =+     [ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr+             :: ExprStmt (GhcPass idL))]+   flattenArg (_, ApplicativeArgMany _ stmts _ _) =+     concatMap flattenStmt stmts+   flattenArg (_, XApplicativeArg _) = panic "flattenArg"++   pp_debug =+     let+         ap_expr = sep (punctuate (text " |") (map pp_arg args))+     in+       if isNothing mb_join+          then ap_expr+          else text "join" <+> parens ap_expr++   pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc+   pp_arg (_, ApplicativeArgOne _ pat expr isBody)+     | isBody =  -- See Note [Applicative BodyStmt]+     ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr+            :: ExprStmt (GhcPass idL))+     | otherwise =+     ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr+            :: ExprStmt (GhcPass idL))+   pp_arg (_, ApplicativeArgMany _ stmts return pat) =+     ppr pat <+>+     text "<-" <+>+     ppr (HsDo (panic "pprStmt") DoExpr (noLoc+               (stmts +++                   [noLoc (LastStmt noExt (noLoc return) False noSyntaxExpr)])))+   pp_arg (_, XApplicativeArg x) = ppr x++pprStmt (XStmtLR x) = ppr x++pprTransformStmt :: (OutputableBndrId (GhcPass p))+                 => [IdP (GhcPass p)] -> LHsExpr (GhcPass p)+                 -> Maybe (LHsExpr (GhcPass p)) -> SDoc+pprTransformStmt bndrs using by+  = sep [ text "then" <+> whenPprDebug (braces (ppr bndrs))+        , nest 2 (ppr using)+        , nest 2 (pprBy by)]++pprTransStmt :: Outputable body => Maybe body -> body -> TransForm -> SDoc+pprTransStmt by using ThenForm+  = sep [ text "then", nest 2 (ppr using), nest 2 (pprBy by)]+pprTransStmt by using GroupForm+  = sep [ text "then group", nest 2 (pprBy by), nest 2 (ptext (sLit "using") <+> ppr using)]++pprBy :: Outputable body => Maybe body -> SDoc+pprBy Nothing  = empty+pprBy (Just e) = text "by" <+> ppr e++pprDo :: (OutputableBndrId (GhcPass p), Outputable body)+      => HsStmtContext any -> [LStmt (GhcPass p) body] -> SDoc+pprDo DoExpr        stmts = text "do"  <+> ppr_do_stmts stmts+pprDo GhciStmtCtxt  stmts = text "do"  <+> ppr_do_stmts stmts+pprDo ArrowExpr     stmts = text "do"  <+> ppr_do_stmts stmts+pprDo MDoExpr       stmts = text "mdo" <+> ppr_do_stmts stmts+pprDo ListComp      stmts = brackets    $ pprComp stmts+pprDo MonadComp     stmts = brackets    $ pprComp stmts+pprDo _             _     = panic "pprDo" -- PatGuard, ParStmtCxt++ppr_do_stmts :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR),+                 Outputable body)+             => [LStmtLR (GhcPass idL) (GhcPass idR) body] -> SDoc+-- Print a bunch of do stmts+ppr_do_stmts stmts = pprDeeperList vcat (map ppr stmts)++pprComp :: (OutputableBndrId (GhcPass p), Outputable body)+        => [LStmt (GhcPass p) body] -> SDoc+pprComp quals     -- Prints:  body | qual1, ..., qualn+  | Just (initStmts, L _ (LastStmt _ body _ _)) <- snocView quals+  = if null initStmts+       -- If there are no statements in a list comprehension besides the last+       -- one, we simply treat it like a normal list. This does arise+       -- occasionally in code that GHC generates, e.g., in implementations of+       -- 'range' for derived 'Ix' instances for product datatypes with exactly+       -- one constructor (e.g., see #12583).+       then ppr body+       else hang (ppr body <+> vbar) 2 (pprQuals initStmts)+  | otherwise+  = pprPanic "pprComp" (pprQuals quals)++pprQuals :: (OutputableBndrId (GhcPass p), Outputable body)+         => [LStmt (GhcPass p) body] -> SDoc+-- Show list comprehension qualifiers separated by commas+pprQuals quals = interpp'SP quals++{-+************************************************************************+*                                                                      *+                Template Haskell quotation brackets+*                                                                      *+************************************************************************+-}++-- | Haskell Splice+data HsSplice id+   = HsTypedSplice       --  $$z  or $$(f 4)+        (XTypedSplice id)+        SpliceDecoration -- Whether $$( ) variant found, for pretty printing+        (IdP id)         -- A unique name to identify this splice point+        (LHsExpr id)     -- See Note [Pending Splices]++   | HsUntypedSplice     --  $z  or $(f 4)+        (XUntypedSplice id)+        SpliceDecoration -- Whether $( ) variant found, for pretty printing+        (IdP id)         -- A unique name to identify this splice point+        (LHsExpr id)     -- See Note [Pending Splices]++   | HsQuasiQuote        -- See Note [Quasi-quote overview] in TcSplice+        (XQuasiQuote id)+        (IdP id)         -- Splice point+        (IdP id)         -- Quoter+        SrcSpan          -- The span of the enclosed string+        FastString       -- The enclosed string++   -- AZ:TODO: use XSplice instead of HsSpliced+   | HsSpliced  -- See Note [Delaying modFinalizers in untyped splices] in+                -- RnSplice.+                -- This is the result of splicing a splice. It is produced by+                -- the renamer and consumed by the typechecker. It lives only+                -- between the two.+        (XSpliced id)+        ThModFinalizers     -- TH finalizers produced by the splice.+        (HsSplicedThing id) -- The result of splicing+   | HsSplicedT+      DelayedSplice+   | XSplice (XXSplice id)  -- Note [Trees that Grow] extension point++type instance XTypedSplice   (GhcPass _) = NoExt+type instance XUntypedSplice (GhcPass _) = NoExt+type instance XQuasiQuote    (GhcPass _) = NoExt+type instance XSpliced       (GhcPass _) = NoExt+type instance XXSplice       (GhcPass _) = NoExt++-- | A splice can appear with various decorations wrapped around it. This data+-- type captures explicitly how it was originally written, for use in the pretty+-- printer.+data SpliceDecoration+  = HasParens -- ^ $( splice ) or $$( splice )+  | HasDollar -- ^ $splice or $$splice+  | NoParens  -- ^ bare splice+  deriving (Data, Eq, Show)++instance Outputable SpliceDecoration where+  ppr x = text $ show x+++isTypedSplice :: HsSplice id -> Bool+isTypedSplice (HsTypedSplice {}) = True+isTypedSplice _                  = False   -- Quasi-quotes are untyped splices++-- | Finalizers produced by a splice with+-- 'Language.Haskell.TH.Syntax.addModFinalizer'+--+-- See Note [Delaying modFinalizers in untyped splices] in RnSplice. For how+-- this is used.+--+newtype ThModFinalizers = ThModFinalizers [ForeignRef (TH.Q ())]++-- A Data instance which ignores the argument of 'ThModFinalizers'.+instance Data ThModFinalizers where+  gunfold _ z _ = z $ ThModFinalizers []+  toConstr  a   = mkConstr (dataTypeOf a) "ThModFinalizers" [] Data.Prefix+  dataTypeOf a  = mkDataType "HsExpr.ThModFinalizers" [toConstr a]++-- See Note [Running typed splices in the zonker]+-- These are the arguments that are passed to `TcSplice.runTopSplice`+data DelayedSplice =+  DelayedSplice+    TcLclEnv          -- The local environment to run the splice in+    (LHsExpr GhcRn)   -- The original renamed expression+    TcType            -- The result type of running the splice, unzonked+    (LHsExpr GhcTcId) -- The typechecked expression to run and splice in the result++-- A Data instance which ignores the argument of 'DelayedSplice'.+instance Data DelayedSplice where+  gunfold _ _ _ = panic "DelayedSplice"+  toConstr  a   = mkConstr (dataTypeOf a) "DelayedSplice" [] Data.Prefix+  dataTypeOf a  = mkDataType "HsExpr.DelayedSplice" [toConstr a]++-- | Haskell Spliced Thing+--+-- Values that can result from running a splice.+data HsSplicedThing id+    = HsSplicedExpr (HsExpr id) -- ^ Haskell Spliced Expression+    | HsSplicedTy   (HsType id) -- ^ Haskell Spliced Type+    | HsSplicedPat  (Pat id)    -- ^ Haskell Spliced Pattern+++-- See Note [Pending Splices]+type SplicePointName = Name++-- | Pending Renamer Splice+data PendingRnSplice+  = PendingRnSplice UntypedSpliceFlavour SplicePointName (LHsExpr GhcRn)++data UntypedSpliceFlavour+  = UntypedExpSplice+  | UntypedPatSplice+  | UntypedTypeSplice+  | UntypedDeclSplice+  deriving Data++-- | Pending Type-checker Splice+data PendingTcSplice+  = PendingTcSplice SplicePointName (LHsExpr GhcTc)++{-+Note [Pending Splices]+~~~~~~~~~~~~~~~~~~~~~~+When we rename an untyped bracket, we name and lift out all the nested+splices, so that when the typechecker hits the bracket, it can+typecheck those nested splices without having to walk over the untyped+bracket code.  So for example+    [| f $(g x) |]+looks like++    HsBracket (HsApp (HsVar "f") (HsSpliceE _ (g x)))++which the renamer rewrites to++    HsRnBracketOut (HsApp (HsVar f) (HsSpliceE sn (g x)))+                   [PendingRnSplice UntypedExpSplice sn (g x)]++* The 'sn' is the Name of the splice point, the SplicePointName++* The PendingRnExpSplice gives the splice that splice-point name maps to;+  and the typechecker can now conveniently find these sub-expressions++* The other copy of the splice, in the second argument of HsSpliceE+                                in the renamed first arg of HsRnBracketOut+  is used only for pretty printing++There are four varieties of pending splices generated by the renamer,+distinguished by their UntypedSpliceFlavour++ * Pending expression splices (UntypedExpSplice), e.g.,+       [|$(f x) + 2|]++   UntypedExpSplice is also used for+     * quasi-quotes, where the pending expression expands to+          $(quoter "...blah...")+       (see RnSplice.makePending, HsQuasiQuote case)++     * cross-stage lifting, where the pending expression expands to+          $(lift x)+       (see RnSplice.checkCrossStageLifting)++ * Pending pattern splices (UntypedPatSplice), e.g.,+       [| \$(f x) -> x |]++ * Pending type splices (UntypedTypeSplice), e.g.,+       [| f :: $(g x) |]++ * Pending declaration (UntypedDeclSplice), e.g.,+       [| let $(f x) in ... |]++There is a fifth variety of pending splice, which is generated by the type+checker:++  * Pending *typed* expression splices, (PendingTcSplice), e.g.,+        [||1 + $$(f 2)||]++It would be possible to eliminate HsRnBracketOut and use HsBracketOut for the+output of the renamer. However, when pretty printing the output of the renamer,+e.g., in a type error message, we *do not* want to print out the pending+splices. In contrast, when pretty printing the output of the type checker, we+*do* want to print the pending splices. So splitting them up seems to make+sense, although I hate to add another constructor to HsExpr.+-}++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (HsSplicedThing p) where+  ppr (HsSplicedExpr e) = ppr_expr e+  ppr (HsSplicedTy   t) = ppr t+  ppr (HsSplicedPat  p) = ppr p++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsSplice p) where+  ppr s = pprSplice s++pprPendingSplice :: (OutputableBndrId (GhcPass p))+                 => SplicePointName -> LHsExpr (GhcPass p) -> SDoc+pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr e)++pprSpliceDecl ::  (OutputableBndrId (GhcPass p))+          => HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc+pprSpliceDecl e@HsQuasiQuote{} _ = pprSplice e+pprSpliceDecl e ExplicitSplice   = text "$(" <> ppr_splice_decl e <> text ")"+pprSpliceDecl e ImplicitSplice   = ppr_splice_decl e++ppr_splice_decl :: (OutputableBndrId (GhcPass p))+                => HsSplice (GhcPass p) -> SDoc+ppr_splice_decl (HsUntypedSplice _ _ n e) = ppr_splice empty n e empty+ppr_splice_decl e = pprSplice e++pprSplice :: (OutputableBndrId (GhcPass p)) => HsSplice (GhcPass p) -> SDoc+pprSplice (HsTypedSplice _ HasParens  n e)+  = ppr_splice (text "$$(") n e (text ")")+pprSplice (HsTypedSplice _ HasDollar n e)+  = ppr_splice (text "$$") n e empty+pprSplice (HsTypedSplice _ NoParens n e)+  = ppr_splice empty n e empty+pprSplice (HsUntypedSplice _ HasParens  n e)+  = ppr_splice (text "$(") n e (text ")")+pprSplice (HsUntypedSplice _ HasDollar n e)+  = ppr_splice (text "$")  n e empty+pprSplice (HsUntypedSplice _ NoParens n e)+  = ppr_splice empty  n e empty+pprSplice (HsQuasiQuote _ n q _ s)      = ppr_quasi n q s+pprSplice (HsSpliced _ _ thing)         = ppr thing+pprSplice (HsSplicedT {})               = text "Unevaluated typed splice"+pprSplice (XSplice x)                   = ppr x++ppr_quasi :: OutputableBndr p => p -> p -> FastString -> SDoc+ppr_quasi n quoter quote = whenPprDebug (brackets (ppr n)) <>+                           char '[' <> ppr quoter <> vbar <>+                           ppr quote <> text "|]"++ppr_splice :: (OutputableBndrId (GhcPass p))+           => SDoc -> (IdP (GhcPass p)) -> LHsExpr (GhcPass p) -> SDoc -> SDoc+ppr_splice herald n e trail+    = herald <> whenPprDebug (brackets (ppr n)) <> ppr e <> trail++-- | Haskell Bracket+data HsBracket p+  = ExpBr  (XExpBr p)   (LHsExpr p)    -- [|  expr  |]+  | PatBr  (XPatBr p)   (LPat p)      -- [p| pat   |]+  | DecBrL (XDecBrL p)  [LHsDecl p]   -- [d| decls |]; result of parser+  | DecBrG (XDecBrG p)  (HsGroup p)   -- [d| decls |]; result of renamer+  | TypBr  (XTypBr p)   (LHsType p)   -- [t| type  |]+  | VarBr  (XVarBr p)   Bool (IdP p)  -- True: 'x, False: ''T+                                -- (The Bool flag is used only in pprHsBracket)+  | TExpBr (XTExpBr p) (LHsExpr p)    -- [||  expr  ||]+  | XBracket (XXBracket p)            -- Note [Trees that Grow] extension point++type instance XExpBr      (GhcPass _) = NoExt+type instance XPatBr      (GhcPass _) = NoExt+type instance XDecBrL     (GhcPass _) = NoExt+type instance XDecBrG     (GhcPass _) = NoExt+type instance XTypBr      (GhcPass _) = NoExt+type instance XVarBr      (GhcPass _) = NoExt+type instance XTExpBr     (GhcPass _) = NoExt+type instance XXBracket   (GhcPass _) = NoExt++isTypedBracket :: HsBracket id -> Bool+isTypedBracket (TExpBr {}) = True+isTypedBracket _           = False++instance (p ~ GhcPass pass, OutputableBndrId p)+          => Outputable (HsBracket p) where+  ppr = pprHsBracket+++pprHsBracket :: (OutputableBndrId (GhcPass p)) => HsBracket (GhcPass p) -> SDoc+pprHsBracket (ExpBr _ e)   = thBrackets empty (ppr e)+pprHsBracket (PatBr _ p)   = thBrackets (char 'p') (ppr p)+pprHsBracket (DecBrG _ gp) = thBrackets (char 'd') (ppr gp)+pprHsBracket (DecBrL _ ds) = thBrackets (char 'd') (vcat (map ppr ds))+pprHsBracket (TypBr _ t)   = thBrackets (char 't') (ppr t)+pprHsBracket (VarBr _ True n)+  = char '\'' <> pprPrefixOcc n+pprHsBracket (VarBr _ False n)+  = text "''" <> pprPrefixOcc n+pprHsBracket (TExpBr _ e)  = thTyBrackets (ppr e)+pprHsBracket (XBracket e)  = ppr e++thBrackets :: SDoc -> SDoc -> SDoc+thBrackets pp_kind pp_body = char '[' <> pp_kind <> vbar <+>+                             pp_body <+> text "|]"++thTyBrackets :: SDoc -> SDoc+thTyBrackets pp_body = text "[||" <+> pp_body <+> ptext (sLit "||]")++instance Outputable PendingRnSplice where+  ppr (PendingRnSplice _ n e) = pprPendingSplice n e++instance Outputable PendingTcSplice where+  ppr (PendingTcSplice n e) = pprPendingSplice n e++{-+************************************************************************+*                                                                      *+\subsection{Enumerations and list comprehensions}+*                                                                      *+************************************************************************+-}++-- | Arithmetic Sequence Information+data ArithSeqInfo id+  = From            (LHsExpr id)+  | FromThen        (LHsExpr id)+                    (LHsExpr id)+  | FromTo          (LHsExpr id)+                    (LHsExpr id)+  | FromThenTo      (LHsExpr id)+                    (LHsExpr id)+                    (LHsExpr id)+-- AZ: Sould ArithSeqInfo have a TTG extension?++instance (p ~ GhcPass pass, OutputableBndrId p)+         => Outputable (ArithSeqInfo p) where+    ppr (From e1)             = hcat [ppr e1, pp_dotdot]+    ppr (FromThen e1 e2)      = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]+    ppr (FromTo e1 e3)        = hcat [ppr e1, pp_dotdot, ppr e3]+    ppr (FromThenTo e1 e2 e3)+      = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]++pp_dotdot :: SDoc+pp_dotdot = text " .. "++{-+************************************************************************+*                                                                      *+\subsection{HsMatchCtxt}+*                                                                      *+************************************************************************+-}++-- | Haskell Match Context+--+-- Context of a pattern match. This is more subtle than it would seem. See Note+-- [Varieties of pattern matches].+data HsMatchContext id -- Not an extensible tag+  = FunRhs { mc_fun        :: Located id    -- ^ function binder of @f@+           , mc_fixity     :: LexicalFixity -- ^ fixing of @f@+           , mc_strictness :: SrcStrictness -- ^ was @f@ banged?+                                            -- See Note [FunBind vs PatBind]+           }+                                -- ^A pattern matching on an argument of a+                                -- function binding+  | LambdaExpr                  -- ^Patterns of a lambda+  | CaseAlt                     -- ^Patterns and guards on a case alternative+  | IfAlt                       -- ^Guards of a multi-way if alternative+  | ProcExpr                    -- ^Patterns of a proc+  | PatBindRhs                  -- ^A pattern binding  eg [y] <- e = e+  | PatBindGuards               -- ^Guards of pattern bindings, e.g.,+                                --    (Just b) | Just _ <- x = e+                                --             | otherwise   = e'++  | RecUpd                      -- ^Record update [used only in DsExpr to+                                --    tell matchWrapper what sort of+                                --    runtime error message to generate]++  | StmtCtxt (HsStmtContext id) -- ^Pattern of a do-stmt, list comprehension,+                                -- pattern guard, etc++  | ThPatSplice            -- ^A Template Haskell pattern splice+  | ThPatQuote             -- ^A Template Haskell pattern quotation [p| (a,b) |]+  | PatSyn                 -- ^A pattern synonym declaration+  deriving Functor+deriving instance (Data id) => Data (HsMatchContext id)++instance OutputableBndr id => Outputable (HsMatchContext id) where+  ppr m@(FunRhs{})          = text "FunRhs" <+> ppr (mc_fun m) <+> ppr (mc_fixity m)+  ppr LambdaExpr            = text "LambdaExpr"+  ppr CaseAlt               = text "CaseAlt"+  ppr IfAlt                 = text "IfAlt"+  ppr ProcExpr              = text "ProcExpr"+  ppr PatBindRhs            = text "PatBindRhs"+  ppr PatBindGuards         = text "PatBindGuards"+  ppr RecUpd                = text "RecUpd"+  ppr (StmtCtxt _)          = text "StmtCtxt _"+  ppr ThPatSplice           = text "ThPatSplice"+  ppr ThPatQuote            = text "ThPatQuote"+  ppr PatSyn                = text "PatSyn"++isPatSynCtxt :: HsMatchContext id -> Bool+isPatSynCtxt ctxt =+  case ctxt of+    PatSyn -> True+    _      -> False++-- | Haskell Statement Context. It expects to be parameterised with one of+-- 'RdrName', 'Name' or 'Id'+data HsStmtContext id+  = ListComp+  | MonadComp++  | DoExpr                           -- ^do { ... }+  | MDoExpr                          -- ^mdo { ... }  ie recursive do-expression+  | ArrowExpr                        -- ^do-notation in an arrow-command context++  | GhciStmtCtxt                     -- ^A command-line Stmt in GHCi pat <- rhs+  | PatGuard (HsMatchContext id)     -- ^Pattern guard for specified thing+  | ParStmtCtxt (HsStmtContext id)   -- ^A branch of a parallel stmt+  | TransStmtCtxt (HsStmtContext id) -- ^A branch of a transform stmt+  deriving Functor+deriving instance (Data id) => Data (HsStmtContext id)++isComprehensionContext :: HsStmtContext id -> Bool+-- Uses comprehension syntax [ e | quals ]+isComprehensionContext ListComp          = True+isComprehensionContext MonadComp         = True+isComprehensionContext (ParStmtCtxt c)   = isComprehensionContext c+isComprehensionContext (TransStmtCtxt c) = isComprehensionContext c+isComprehensionContext _ = False++-- | Should pattern match failure in a 'HsStmtContext' be desugared using+-- 'MonadFail'?+isMonadFailStmtContext :: HsStmtContext id -> Bool+isMonadFailStmtContext MonadComp            = True+isMonadFailStmtContext DoExpr               = True+isMonadFailStmtContext MDoExpr              = True+isMonadFailStmtContext GhciStmtCtxt         = True+isMonadFailStmtContext (ParStmtCtxt ctxt)   = isMonadFailStmtContext ctxt+isMonadFailStmtContext (TransStmtCtxt ctxt) = isMonadFailStmtContext ctxt+isMonadFailStmtContext _ = False -- ListComp, PatGuard, ArrowExpr++isMonadCompContext :: HsStmtContext id -> Bool+isMonadCompContext MonadComp = True+isMonadCompContext _         = False++matchSeparator :: HsMatchContext id -> SDoc+matchSeparator (FunRhs {})   = text "="+matchSeparator CaseAlt       = text "->"+matchSeparator IfAlt         = text "->"+matchSeparator LambdaExpr    = text "->"+matchSeparator ProcExpr      = text "->"+matchSeparator PatBindRhs    = text "="+matchSeparator PatBindGuards = text "="+matchSeparator (StmtCtxt _)  = text "<-"+matchSeparator RecUpd        = text "=" -- This can be printed by the pattern+                                       -- match checker trace+matchSeparator ThPatSplice  = panic "unused"+matchSeparator ThPatQuote   = panic "unused"+matchSeparator PatSyn       = panic "unused"++pprMatchContext :: (Outputable (NameOrRdrName id),Outputable id)+                => HsMatchContext id -> SDoc+pprMatchContext ctxt+  | want_an ctxt = text "an" <+> pprMatchContextNoun ctxt+  | otherwise    = text "a"  <+> pprMatchContextNoun ctxt+  where+    want_an (FunRhs {}) = True  -- Use "an" in front+    want_an ProcExpr    = True+    want_an _           = False++pprMatchContextNoun :: (Outputable (NameOrRdrName id),Outputable id)+                    => HsMatchContext id -> SDoc+pprMatchContextNoun (FunRhs {mc_fun=L _ fun})+                                    = text "equation for"+                                      <+> quotes (ppr fun)+pprMatchContextNoun CaseAlt         = text "case alternative"+pprMatchContextNoun IfAlt           = text "multi-way if alternative"+pprMatchContextNoun RecUpd          = text "record-update construct"+pprMatchContextNoun ThPatSplice     = text "Template Haskell pattern splice"+pprMatchContextNoun ThPatQuote      = text "Template Haskell pattern quotation"+pprMatchContextNoun PatBindRhs      = text "pattern binding"+pprMatchContextNoun PatBindGuards   = text "pattern binding guards"+pprMatchContextNoun LambdaExpr      = text "lambda abstraction"+pprMatchContextNoun ProcExpr        = text "arrow abstraction"+pprMatchContextNoun (StmtCtxt ctxt) = text "pattern binding in"+                                      $$ pprAStmtContext ctxt+pprMatchContextNoun PatSyn          = text "pattern synonym declaration"++-----------------+pprAStmtContext, pprStmtContext :: (Outputable id,+                                    Outputable (NameOrRdrName id))+                                => HsStmtContext id -> SDoc+pprAStmtContext ctxt = article <+> pprStmtContext ctxt+  where+    pp_an = text "an"+    pp_a  = text "a"+    article = case ctxt of+                  MDoExpr       -> pp_an+                  GhciStmtCtxt  -> pp_an+                  _             -> pp_a+++-----------------+pprStmtContext GhciStmtCtxt    = text "interactive GHCi command"+pprStmtContext DoExpr          = text "'do' block"+pprStmtContext MDoExpr         = text "'mdo' block"+pprStmtContext ArrowExpr       = text "'do' block in an arrow command"+pprStmtContext ListComp        = text "list comprehension"+pprStmtContext MonadComp       = text "monad comprehension"+pprStmtContext (PatGuard ctxt) = text "pattern guard for" $$ pprMatchContext ctxt++-- Drop the inner contexts when reporting errors, else we get+--     Unexpected transform statement+--     in a transformed branch of+--          transformed branch of+--          transformed branch of monad comprehension+pprStmtContext (ParStmtCtxt c) =+  ifPprDebug (sep [text "parallel branch of", pprAStmtContext c])+             (pprStmtContext c)+pprStmtContext (TransStmtCtxt c) =+  ifPprDebug (sep [text "transformed branch of", pprAStmtContext c])+             (pprStmtContext c)++instance (Outputable p, Outputable (NameOrRdrName p))+      => Outputable (HsStmtContext p) where+    ppr = pprStmtContext++-- Used to generate the string for a *runtime* error message+matchContextErrString :: Outputable id+                      => HsMatchContext id -> SDoc+matchContextErrString (FunRhs{mc_fun=L _ fun})   = text "function" <+> ppr fun+matchContextErrString CaseAlt                    = text "case"+matchContextErrString IfAlt                      = text "multi-way if"+matchContextErrString PatBindRhs                 = text "pattern binding"+matchContextErrString PatBindGuards              = text "pattern binding guards"+matchContextErrString RecUpd                     = text "record update"+matchContextErrString LambdaExpr                 = text "lambda"+matchContextErrString ProcExpr                   = text "proc"+matchContextErrString ThPatSplice                = panic "matchContextErrString"  -- Not used at runtime+matchContextErrString ThPatQuote                 = panic "matchContextErrString"  -- Not used at runtime+matchContextErrString PatSyn                     = panic "matchContextErrString"  -- Not used at runtime+matchContextErrString (StmtCtxt (ParStmtCtxt c))   = matchContextErrString (StmtCtxt c)+matchContextErrString (StmtCtxt (TransStmtCtxt c)) = matchContextErrString (StmtCtxt c)+matchContextErrString (StmtCtxt (PatGuard _))      = text "pattern guard"+matchContextErrString (StmtCtxt GhciStmtCtxt)      = text "interactive GHCi command"+matchContextErrString (StmtCtxt DoExpr)            = text "'do' block"+matchContextErrString (StmtCtxt ArrowExpr)         = text "'do' block"+matchContextErrString (StmtCtxt MDoExpr)           = text "'mdo' block"+matchContextErrString (StmtCtxt ListComp)          = text "list comprehension"+matchContextErrString (StmtCtxt MonadComp)         = text "monad comprehension"++pprMatchInCtxt :: (OutputableBndrId (GhcPass idR),+                   -- TODO:AZ these constraints do not make sense+                 Outputable (NameOrRdrName (NameOrRdrName (IdP (GhcPass idR)))),+                 Outputable body)+               => Match (GhcPass idR) body -> SDoc+pprMatchInCtxt match  = hang (text "In" <+> pprMatchContext (m_ctxt match)+                                        <> colon)+                             4 (pprMatch match)++pprStmtInCtxt :: (OutputableBndrId (GhcPass idL),+                  OutputableBndrId (GhcPass idR),+                  Outputable body)+              => HsStmtContext (IdP (GhcPass idL))+              -> StmtLR (GhcPass idL) (GhcPass idR) body+              -> SDoc+pprStmtInCtxt ctxt (LastStmt _ e _ _)+  | isComprehensionContext ctxt      -- For [ e | .. ], do not mutter about "stmts"+  = hang (text "In the expression:") 2 (ppr e)++pprStmtInCtxt ctxt stmt+  = hang (text "In a stmt of" <+> pprAStmtContext ctxt <> colon)+       2 (ppr_stmt stmt)+  where+    -- For Group and Transform Stmts, don't print the nested stmts!+    ppr_stmt (TransStmt { trS_by = by, trS_using = using+                        , trS_form = form }) = pprTransStmt by using form+    ppr_stmt stmt = pprStmt stmt
+ compiler/hsSyn/HsExpr.hs-boot view
@@ -0,0 +1,51 @@+{-# LANGUAGE CPP, KindSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]+                                      -- in module PlaceHolder+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE TypeFamilies #-}++module HsExpr where++import SrcLoc     ( Located )+import Outputable ( SDoc, Outputable )+import {-# SOURCE #-} HsPat  ( LPat )+import BasicTypes ( SpliceExplicitFlag(..))+import HsExtension ( OutputableBndrId, GhcPass )++type role HsExpr nominal+type role HsCmd nominal+type role MatchGroup nominal nominal+type role GRHSs nominal nominal+type role HsSplice nominal+type role SyntaxExpr nominal+data HsExpr (i :: *)+data HsCmd  (i :: *)+data HsSplice (i :: *)+data MatchGroup (a :: *) (body :: *)+data GRHSs (a :: *) (body :: *)+data SyntaxExpr (i :: *)++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsExpr p)+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p)++type LHsExpr a = Located (HsExpr a)++pprLExpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc++pprExpr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> SDoc++pprSplice :: (OutputableBndrId (GhcPass p)) => HsSplice (GhcPass p) -> SDoc++pprSpliceDecl ::  (OutputableBndrId (GhcPass p))+          => HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc++pprPatBind :: forall bndr p body. (OutputableBndrId (GhcPass bndr),+                                   OutputableBndrId (GhcPass p),+                                   Outputable body)+           => LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc++pprFunBind :: (OutputableBndrId (GhcPass idR), Outputable body)+           => MatchGroup (GhcPass idR) body -> SDoc
+ compiler/hsSyn/HsExtension.hs view
@@ -0,0 +1,1111 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]+                                      -- in module PlaceHolder++module HsExtension where++-- This module captures the type families to precisely identify the extension+-- points for HsSyn++import GhcPrelude++import Data.Data hiding ( Fixity )+import PlaceHolder+import Name+import RdrName+import Var+import Outputable+import SrcLoc (Located)++import Data.Kind++{-+Note [Trees that grow]+~~~~~~~~~~~~~~~~~~~~~~++See https://gitlab.haskell.org/ghc/ghc/wikis/implementing-trees-that-grow++The hsSyn AST is reused across multiple compiler passes. We also have the+Template Haskell AST, and the haskell-src-exts one (outside of GHC)++Supporting multiple passes means the AST has various warts on it to cope with+the specifics for the phases, such as the 'ValBindsOut', 'ConPatOut',+'SigPatOut' etc.++The growable AST will allow each of these variants to be captured explicitly,+such that they only exist in the given compiler pass AST, as selected by the+type parameter to the AST.++In addition it will allow tool writers to define their own extensions to capture+additional information for the tool, in a natural way.++A further goal is to provide a means to harmonise the Template Haskell and+haskell-src-exts ASTs as well.++-}++-- | used as place holder in TTG values+data NoExt = NoExt+  deriving (Data,Eq,Ord)++instance Outputable NoExt where+  ppr _ = text "NoExt"++-- | Used when constructing a term with an unused extension point.+noExt :: NoExt+noExt = NoExt++-- | Used as a data type index for the hsSyn AST+data GhcPass (c :: Pass)+deriving instance Eq (GhcPass c)+deriving instance Typeable c => Data (GhcPass c)++data Pass = Parsed | Renamed | Typechecked+         deriving (Data)++-- Type synonyms as a shorthand for tagging+type GhcPs   = GhcPass 'Parsed      -- Old 'RdrName' type param+type GhcRn   = GhcPass 'Renamed     -- Old 'Name' type param+type GhcTc   = GhcPass 'Typechecked -- Old 'Id' type para,+type GhcTcId = GhcTc                -- Old 'TcId' type param++-- | Maps the "normal" id type for a given pass+type family IdP p+type instance IdP GhcPs = RdrName+type instance IdP GhcRn = Name+type instance IdP GhcTc = Id++type LIdP p = Located (IdP p)++-- | Marks that a field uses the GhcRn variant even when the pass+-- parameter is GhcTc. Useful for storing HsTypes in HsExprs, say, because+-- HsType GhcTc should never occur.+type family NoGhcTc (p :: Type) where+    -- this way, GHC can figure out that the result is a GhcPass+  NoGhcTc (GhcPass pass) = GhcPass (NoGhcTcPass pass)+  NoGhcTc other          = other++type family NoGhcTcPass (p :: Pass) :: Pass where+  NoGhcTcPass 'Typechecked = 'Renamed+  NoGhcTcPass other        = other++-- =====================================================================+-- Type families for the HsBinds extension points++-- HsLocalBindsLR type families+type family XHsValBinds      x x'+type family XHsIPBinds       x x'+type family XEmptyLocalBinds x x'+type family XXHsLocalBindsLR x x'++type ForallXHsLocalBindsLR (c :: * -> Constraint) (x :: *) (x' :: *) =+       ( c (XHsValBinds      x x')+       , c (XHsIPBinds       x x')+       , c (XEmptyLocalBinds x x')+       , c (XXHsLocalBindsLR x x')+       )++-- ValBindsLR type families+type family XValBinds    x x'+type family XXValBindsLR x x'++type ForallXValBindsLR (c :: * -> Constraint) (x :: *) (x' :: *) =+       ( c (XValBinds    x x')+       , c (XXValBindsLR x x')+       )+++-- HsBindsLR type families+type family XFunBind    x x'+type family XPatBind    x x'+type family XVarBind    x x'+type family XAbsBinds   x x'+type family XPatSynBind x x'+type family XXHsBindsLR x x'++type ForallXHsBindsLR (c :: * -> Constraint) (x :: *) (x' :: *) =+       ( c (XFunBind    x x')+       , c (XPatBind    x x')+       , c (XVarBind    x x')+       , c (XAbsBinds   x x')+       , c (XPatSynBind x x')+       , c (XXHsBindsLR x x')+       )++-- ABExport type families+type family XABE x+type family XXABExport x++type ForallXABExport (c :: * -> Constraint) (x :: *) =+       ( c (XABE       x)+       , c (XXABExport x)+       )++-- PatSynBind type families+type family XPSB x x'+type family XXPatSynBind x x'++type ForallXPatSynBind  (c :: * -> Constraint) (x :: *) (x' :: *) =+       ( c (XPSB         x x')+       , c (XXPatSynBind x x')+       )++-- HsIPBinds type families+type family XIPBinds    x+type family XXHsIPBinds x++type ForallXHsIPBinds (c :: * -> Constraint) (x :: *) =+       ( c (XIPBinds    x)+       , c (XXHsIPBinds x)+       )++-- IPBind type families+type family XCIPBind x+type family XXIPBind x++type ForallXIPBind (c :: * -> Constraint) (x :: *) =+       ( c (XCIPBind x)+       , c (XXIPBind x)+       )++-- Sig type families+type family XTypeSig          x+type family XPatSynSig        x+type family XClassOpSig       x+type family XIdSig            x+type family XFixSig           x+type family XInlineSig        x+type family XSpecSig          x+type family XSpecInstSig      x+type family XMinimalSig       x+type family XSCCFunSig        x+type family XCompleteMatchSig x+type family XXSig             x++type ForallXSig (c :: * -> Constraint) (x :: *) =+       ( c (XTypeSig          x)+       , c (XPatSynSig        x)+       , c (XClassOpSig       x)+       , c (XIdSig            x)+       , c (XFixSig           x)+       , c (XInlineSig        x)+       , c (XSpecSig          x)+       , c (XSpecInstSig      x)+       , c (XMinimalSig       x)+       , c (XSCCFunSig        x)+       , c (XCompleteMatchSig x)+       , c (XXSig             x)+       )++-- FixitySig type families+type family XFixitySig          x+type family XXFixitySig         x++type ForallXFixitySig (c :: * -> Constraint) (x :: *) =+       ( c (XFixitySig         x)+       , c (XXFixitySig        x)+       )++-- =====================================================================+-- Type families for the HsDecls extension points++-- HsDecl type families+type family XTyClD       x+type family XInstD       x+type family XDerivD      x+type family XValD        x+type family XSigD        x+type family XDefD        x+type family XForD        x+type family XWarningD    x+type family XAnnD        x+type family XRuleD       x+type family XSpliceD     x+type family XDocD        x+type family XRoleAnnotD  x+type family XXHsDecl     x++type ForallXHsDecl (c :: * -> Constraint) (x :: *) =+       ( c (XTyClD       x)+       , c (XInstD       x)+       , c (XDerivD      x)+       , c (XValD        x)+       , c (XSigD        x)+       , c (XDefD        x)+       , c (XForD        x)+       , c (XWarningD    x)+       , c (XAnnD        x)+       , c (XRuleD       x)+       , c (XSpliceD     x)+       , c (XDocD        x)+       , c (XRoleAnnotD  x)+       , c (XXHsDecl    x)+       )++-- -------------------------------------+-- HsGroup type families+type family XCHsGroup      x+type family XXHsGroup      x++type ForallXHsGroup (c :: * -> Constraint) (x :: *) =+       ( c (XCHsGroup       x)+       , c (XXHsGroup       x)+       )++-- -------------------------------------+-- SpliceDecl type families+type family XSpliceDecl       x+type family XXSpliceDecl      x++type ForallXSpliceDecl (c :: * -> Constraint) (x :: *) =+       ( c (XSpliceDecl        x)+       , c (XXSpliceDecl       x)+       )++-- -------------------------------------+-- TyClDecl type families+type family XFamDecl       x+type family XSynDecl       x+type family XDataDecl      x+type family XClassDecl     x+type family XXTyClDecl     x++type ForallXTyClDecl (c :: * -> Constraint) (x :: *) =+       ( c (XFamDecl       x)+       , c (XSynDecl       x)+       , c (XDataDecl      x)+       , c (XClassDecl     x)+       , c (XXTyClDecl     x)+       )++-- -------------------------------------+-- TyClGroup type families+type family XCTyClGroup      x+type family XXTyClGroup      x++type ForallXTyClGroup (c :: * -> Constraint) (x :: *) =+       ( c (XCTyClGroup       x)+       , c (XXTyClGroup       x)+       )++-- -------------------------------------+-- FamilyResultSig type families+type family XNoSig            x+type family XCKindSig         x -- Clashes with XKindSig above+type family XTyVarSig         x+type family XXFamilyResultSig x++type ForallXFamilyResultSig (c :: * -> Constraint) (x :: *) =+       ( c (XNoSig            x)+       , c (XCKindSig         x)+       , c (XTyVarSig         x)+       , c (XXFamilyResultSig x)+       )++-- -------------------------------------+-- FamilyDecl type families+type family XCFamilyDecl      x+type family XXFamilyDecl      x++type ForallXFamilyDecl (c :: * -> Constraint) (x :: *) =+       ( c (XCFamilyDecl       x)+       , c (XXFamilyDecl       x)+       )++-- -------------------------------------+-- HsDataDefn type families+type family XCHsDataDefn      x+type family XXHsDataDefn      x++type ForallXHsDataDefn (c :: * -> Constraint) (x :: *) =+       ( c (XCHsDataDefn       x)+       , c (XXHsDataDefn       x)+       )++-- -------------------------------------+-- HsDerivingClause type families+type family XCHsDerivingClause      x+type family XXHsDerivingClause      x++type ForallXHsDerivingClause (c :: * -> Constraint) (x :: *) =+       ( c (XCHsDerivingClause       x)+       , c (XXHsDerivingClause       x)+       )++-- -------------------------------------+-- ConDecl type families+type family XConDeclGADT   x+type family XConDeclH98    x+type family XXConDecl      x++type ForallXConDecl (c :: * -> Constraint) (x :: *) =+       ( c (XConDeclGADT    x)+       , c (XConDeclH98     x)+       , c (XXConDecl       x)+       )++-- -------------------------------------+-- FamEqn type families+type family XCFamEqn      x p r+type family XXFamEqn      x p r++type ForallXFamEqn (c :: * -> Constraint) (x :: *) (p :: *) (r :: *) =+       ( c (XCFamEqn       x p r)+       , c (XXFamEqn       x p r)+       )++-- -------------------------------------+-- ClsInstDecl type families+type family XCClsInstDecl      x+type family XXClsInstDecl      x++type ForallXClsInstDecl (c :: * -> Constraint) (x :: *) =+       ( c (XCClsInstDecl       x)+       , c (XXClsInstDecl       x)+       )++-- -------------------------------------+-- ClsInstDecl type families+type family XClsInstD      x+type family XDataFamInstD  x+type family XTyFamInstD    x+type family XXInstDecl     x++type ForallXInstDecl (c :: * -> Constraint) (x :: *) =+       ( c (XClsInstD       x)+       , c (XDataFamInstD   x)+       , c (XTyFamInstD     x)+       , c (XXInstDecl      x)+       )++-- -------------------------------------+-- DerivDecl type families+type family XCDerivDecl      x+type family XXDerivDecl      x++type ForallXDerivDecl (c :: * -> Constraint) (x :: *) =+       ( c (XCDerivDecl       x)+       , c (XXDerivDecl       x)+       )++-- -------------------------------------+-- DerivStrategy type family+type family XViaStrategy x++-- -------------------------------------+-- DefaultDecl type families+type family XCDefaultDecl      x+type family XXDefaultDecl      x++type ForallXDefaultDecl (c :: * -> Constraint) (x :: *) =+       ( c (XCDefaultDecl       x)+       , c (XXDefaultDecl       x)+       )++-- -------------------------------------+-- DefaultDecl type families+type family XForeignImport     x+type family XForeignExport     x+type family XXForeignDecl      x++type ForallXForeignDecl (c :: * -> Constraint) (x :: *) =+       ( c (XForeignImport      x)+       , c (XForeignExport      x)+       , c (XXForeignDecl       x)+       )++-- -------------------------------------+-- RuleDecls type families+type family XCRuleDecls      x+type family XXRuleDecls      x++type ForallXRuleDecls (c :: * -> Constraint) (x :: *) =+       ( c (XCRuleDecls       x)+       , c (XXRuleDecls       x)+       )+++-- -------------------------------------+-- RuleDecl type families+type family XHsRule          x+type family XXRuleDecl       x++type ForallXRuleDecl (c :: * -> Constraint) (x :: *) =+       ( c (XHsRule           x)+       , c (XXRuleDecl        x)+       )++-- -------------------------------------+-- RuleBndr type families+type family XCRuleBndr      x+type family XRuleBndrSig    x+type family XXRuleBndr      x++type ForallXRuleBndr (c :: * -> Constraint) (x :: *) =+       ( c (XCRuleBndr       x)+       , c (XRuleBndrSig     x)+       , c (XXRuleBndr       x)+       )++-- -------------------------------------+-- WarnDecls type families+type family XWarnings        x+type family XXWarnDecls      x++type ForallXWarnDecls (c :: * -> Constraint) (x :: *) =+       ( c (XWarnings        x)+       , c (XXWarnDecls      x)+       )++-- -------------------------------------+-- AnnDecl type families+type family XWarning        x+type family XXWarnDecl      x++type ForallXWarnDecl (c :: * -> Constraint) (x :: *) =+       ( c (XWarning        x)+       , c (XXWarnDecl      x)+       )++-- -------------------------------------+-- AnnDecl type families+type family XHsAnnotation  x+type family XXAnnDecl      x++type ForallXAnnDecl (c :: * -> Constraint) (x :: *) =+       ( c (XHsAnnotation  x)+       , c (XXAnnDecl      x)+       )++-- -------------------------------------+-- RoleAnnotDecl type families+type family XCRoleAnnotDecl  x+type family XXRoleAnnotDecl  x++type ForallXRoleAnnotDecl (c :: * -> Constraint) (x :: *) =+       ( c (XCRoleAnnotDecl  x)+       , c (XXRoleAnnotDecl  x)+       )++-- =====================================================================+-- Type families for the HsExpr extension points++type family XVar            x+type family XUnboundVar     x+type family XConLikeOut     x+type family XRecFld         x+type family XOverLabel      x+type family XIPVar          x+type family XOverLitE       x+type family XLitE           x+type family XLam            x+type family XLamCase        x+type family XApp            x+type family XAppTypeE       x+type family XOpApp          x+type family XNegApp         x+type family XPar            x+type family XSectionL       x+type family XSectionR       x+type family XExplicitTuple  x+type family XExplicitSum    x+type family XCase           x+type family XIf             x+type family XMultiIf        x+type family XLet            x+type family XDo             x+type family XExplicitList   x+type family XRecordCon      x+type family XRecordUpd      x+type family XExprWithTySig  x+type family XArithSeq       x+type family XSCC            x+type family XCoreAnn        x+type family XBracket        x+type family XRnBracketOut   x+type family XTcBracketOut   x+type family XSpliceE        x+type family XProc           x+type family XStatic         x+type family XTick           x+type family XBinTick        x+type family XTickPragma     x+type family XEWildPat       x+type family XEAsPat         x+type family XEViewPat       x+type family XELazyPat       x+type family XWrap           x+type family XXExpr          x++type ForallXExpr (c :: * -> Constraint) (x :: *) =+       ( c (XVar            x)+       , c (XUnboundVar     x)+       , c (XConLikeOut     x)+       , c (XRecFld         x)+       , c (XOverLabel      x)+       , c (XIPVar          x)+       , c (XOverLitE       x)+       , c (XLitE           x)+       , c (XLam            x)+       , c (XLamCase        x)+       , c (XApp            x)+       , c (XAppTypeE       x)+       , c (XOpApp          x)+       , c (XNegApp         x)+       , c (XPar            x)+       , c (XSectionL       x)+       , c (XSectionR       x)+       , c (XExplicitTuple  x)+       , c (XExplicitSum    x)+       , c (XCase           x)+       , c (XIf             x)+       , c (XMultiIf        x)+       , c (XLet            x)+       , c (XDo             x)+       , c (XExplicitList   x)+       , c (XRecordCon      x)+       , c (XRecordUpd      x)+       , c (XExprWithTySig  x)+       , c (XArithSeq       x)+       , c (XSCC            x)+       , c (XCoreAnn        x)+       , c (XBracket        x)+       , c (XRnBracketOut   x)+       , c (XTcBracketOut   x)+       , c (XSpliceE        x)+       , c (XProc           x)+       , c (XStatic         x)+       , c (XTick           x)+       , c (XBinTick        x)+       , c (XTickPragma     x)+       , c (XEWildPat       x)+       , c (XEAsPat         x)+       , c (XEViewPat       x)+       , c (XELazyPat       x)+       , c (XWrap           x)+       , c (XXExpr          x)+       )+-- ---------------------------------------------------------------------++type family XUnambiguous        x+type family XAmbiguous          x+type family XXAmbiguousFieldOcc x++type ForallXAmbiguousFieldOcc (c :: * -> Constraint) (x :: *) =+       ( c (XUnambiguous        x)+       , c (XAmbiguous          x)+       , c (XXAmbiguousFieldOcc x)+       )++-- ----------------------------------------------------------------------++type family XPresent  x+type family XMissing  x+type family XXTupArg  x++type ForallXTupArg (c :: * -> Constraint) (x :: *) =+       ( c (XPresent x)+       , c (XMissing x)+       , c (XXTupArg x)+       )++-- ---------------------------------------------------------------------++type family XTypedSplice   x+type family XUntypedSplice x+type family XQuasiQuote    x+type family XSpliced       x+type family XXSplice       x++type ForallXSplice (c :: * -> Constraint) (x :: *) =+       ( c (XTypedSplice   x)+       , c (XUntypedSplice x)+       , c (XQuasiQuote    x)+       , c (XSpliced       x)+       , c (XXSplice       x)+       )++-- ---------------------------------------------------------------------++type family XExpBr      x+type family XPatBr      x+type family XDecBrL     x+type family XDecBrG     x+type family XTypBr      x+type family XVarBr      x+type family XTExpBr     x+type family XXBracket   x++type ForallXBracket (c :: * -> Constraint) (x :: *) =+       ( c (XExpBr      x)+       , c (XPatBr      x)+       , c (XDecBrL     x)+       , c (XDecBrG     x)+       , c (XTypBr      x)+       , c (XVarBr      x)+       , c (XTExpBr     x)+       , c (XXBracket   x)+       )++-- ---------------------------------------------------------------------++type family XCmdTop  x+type family XXCmdTop x++type ForallXCmdTop (c :: * -> Constraint) (x :: *) =+       ( c (XCmdTop  x)+       , c (XXCmdTop x)+       )++-- -------------------------------------++type family XMG           x b+type family XXMatchGroup  x b++type ForallXMatchGroup (c :: * -> Constraint) (x :: *) (b :: *) =+       ( c (XMG          x b)+       , c (XXMatchGroup x b)+       )++-- -------------------------------------++type family XCMatch  x b+type family XXMatch  x b++type ForallXMatch (c :: * -> Constraint) (x :: *) (b :: *) =+       ( c (XCMatch  x b)+       , c (XXMatch  x b)+       )++-- -------------------------------------++type family XCGRHSs  x b+type family XXGRHSs  x b++type ForallXGRHSs (c :: * -> Constraint) (x :: *) (b :: *) =+       ( c (XCGRHSs  x b)+       , c (XXGRHSs  x b)+       )++-- -------------------------------------++type family XCGRHS  x b+type family XXGRHS  x b++type ForallXGRHS (c :: * -> Constraint) (x :: *) (b :: *) =+       ( c (XCGRHS  x b)+       , c (XXGRHS  x b)+       )++-- -------------------------------------++type family XLastStmt        x x' b+type family XBindStmt        x x' b+type family XApplicativeStmt x x' b+type family XBodyStmt        x x' b+type family XLetStmt         x x' b+type family XParStmt         x x' b+type family XTransStmt       x x' b+type family XRecStmt         x x' b+type family XXStmtLR         x x' b++type ForallXStmtLR (c :: * -> Constraint) (x :: *)  (x' :: *) (b :: *) =+       ( c (XLastStmt         x x' b)+       , c (XBindStmt         x x' b)+       , c (XApplicativeStmt  x x' b)+       , c (XBodyStmt         x x' b)+       , c (XLetStmt          x x' b)+       , c (XParStmt          x x' b)+       , c (XTransStmt        x x' b)+       , c (XRecStmt          x x' b)+       , c (XXStmtLR          x x' b)+       )++-- ---------------------------------------------------------------------++type family XCmdArrApp  x+type family XCmdArrForm x+type family XCmdApp     x+type family XCmdLam     x+type family XCmdPar     x+type family XCmdCase    x+type family XCmdIf      x+type family XCmdLet     x+type family XCmdDo      x+type family XCmdWrap    x+type family XXCmd       x++type ForallXCmd (c :: * -> Constraint) (x :: *) =+       ( c (XCmdArrApp  x)+       , c (XCmdArrForm x)+       , c (XCmdApp     x)+       , c (XCmdLam     x)+       , c (XCmdPar     x)+       , c (XCmdCase    x)+       , c (XCmdIf      x)+       , c (XCmdLet     x)+       , c (XCmdDo      x)+       , c (XCmdWrap    x)+       , c (XXCmd       x)+       )++-- ---------------------------------------------------------------------++type family XParStmtBlock  x x'+type family XXParStmtBlock x x'++type ForallXParStmtBlock (c :: * -> Constraint) (x :: *) (x' :: *) =+       ( c (XParStmtBlock  x x')+       , c (XXParStmtBlock x x')+       )++-- ---------------------------------------------------------------------++type family XApplicativeArgOne   x+type family XApplicativeArgMany  x+type family XXApplicativeArg     x++type ForallXApplicativeArg (c :: * -> Constraint) (x :: *) =+       ( c (XApplicativeArgOne   x)+       , c (XApplicativeArgMany  x)+       , c (XXApplicativeArg     x)+       )++-- =====================================================================+-- Type families for the HsImpExp extension points++-- TODO++-- =====================================================================+-- Type families for the HsLit extension points++-- We define a type family for each extension point. This is based on prepending+-- 'X' to the constructor name, for ease of reference.+type family XHsChar x+type family XHsCharPrim x+type family XHsString x+type family XHsStringPrim x+type family XHsInt x+type family XHsIntPrim x+type family XHsWordPrim x+type family XHsInt64Prim x+type family XHsWord64Prim x+type family XHsInteger x+type family XHsRat x+type family XHsFloatPrim x+type family XHsDoublePrim x+type family XXLit x++-- | Helper to apply a constraint to all extension points. It has one+-- entry per extension point type family.+type ForallXHsLit (c :: * -> Constraint) (x :: *) =+  ( c (XHsChar       x)+  , c (XHsCharPrim   x)+  , c (XHsDoublePrim x)+  , c (XHsFloatPrim  x)+  , c (XHsInt        x)+  , c (XHsInt64Prim  x)+  , c (XHsIntPrim    x)+  , c (XHsInteger    x)+  , c (XHsRat        x)+  , c (XHsString     x)+  , c (XHsStringPrim x)+  , c (XHsWord64Prim x)+  , c (XHsWordPrim   x)+  , c (XXLit         x)+  )++type family XOverLit  x+type family XXOverLit x++type ForallXOverLit (c :: * -> Constraint) (x :: *) =+       ( c (XOverLit  x)+       , c (XXOverLit x)+       )++-- =====================================================================+-- Type families for the HsPat extension points++type family XWildPat   x+type family XVarPat    x+type family XLazyPat   x+type family XAsPat     x+type family XParPat    x+type family XBangPat   x+type family XListPat   x+type family XTuplePat  x+type family XSumPat    x+type family XConPat    x+type family XViewPat   x+type family XSplicePat x+type family XLitPat    x+type family XNPat      x+type family XNPlusKPat x+type family XSigPat    x+type family XCoPat     x+type family XXPat      x+++type ForallXPat (c :: * -> Constraint) (x :: *) =+       ( c (XWildPat   x)+       , c (XVarPat    x)+       , c (XLazyPat   x)+       , c (XAsPat     x)+       , c (XParPat    x)+       , c (XBangPat   x)+       , c (XListPat   x)+       , c (XTuplePat  x)+       , c (XSumPat    x)+       , c (XViewPat   x)+       , c (XSplicePat x)+       , c (XLitPat    x)+       , c (XNPat      x)+       , c (XNPlusKPat x)+       , c (XSigPat    x)+       , c (XCoPat     x)+       , c (XXPat      x)+       )++-- =====================================================================+-- Type families for the HsTypes type families++type family XHsQTvs       x+type family XXLHsQTyVars  x++type ForallXLHsQTyVars (c :: * -> Constraint) (x :: *) =+       ( c (XHsQTvs       x)+       , c (XXLHsQTyVars  x)+       )++-- -------------------------------------++type family XHsIB              x b+type family XXHsImplicitBndrs  x b++type ForallXHsImplicitBndrs (c :: * -> Constraint) (x :: *) (b :: *) =+       ( c (XHsIB              x b)+       , c (XXHsImplicitBndrs  x b)+       )++-- -------------------------------------++type family XHsWC              x b+type family XXHsWildCardBndrs  x b++type ForallXHsWildCardBndrs(c :: * -> Constraint) (x :: *) (b :: *) =+       ( c (XHsWC              x b)+       , c (XXHsWildCardBndrs  x b)+       )++-- -------------------------------------++type family XForAllTy        x+type family XQualTy          x+type family XTyVar           x+type family XAppTy           x+type family XAppKindTy       x+type family XFunTy           x+type family XListTy          x+type family XTupleTy         x+type family XSumTy           x+type family XOpTy            x+type family XParTy           x+type family XIParamTy        x+type family XStarTy          x+type family XKindSig         x+type family XSpliceTy        x+type family XDocTy           x+type family XBangTy          x+type family XRecTy           x+type family XExplicitListTy  x+type family XExplicitTupleTy x+type family XTyLit           x+type family XWildCardTy      x+type family XXType           x++-- | Helper to apply a constraint to all extension points. It has one+-- entry per extension point type family.+type ForallXType (c :: * -> Constraint) (x :: *) =+       ( c (XForAllTy        x)+       , c (XQualTy          x)+       , c (XTyVar           x)+       , c (XAppTy           x)+       , c (XAppKindTy       x)+       , c (XFunTy           x)+       , c (XListTy          x)+       , c (XTupleTy         x)+       , c (XSumTy           x)+       , c (XOpTy            x)+       , c (XParTy           x)+       , c (XIParamTy        x)+       , c (XStarTy          x)+       , c (XKindSig         x)+       , c (XSpliceTy        x)+       , c (XDocTy           x)+       , c (XBangTy          x)+       , c (XRecTy           x)+       , c (XExplicitListTy  x)+       , c (XExplicitTupleTy x)+       , c (XTyLit           x)+       , c (XWildCardTy      x)+       , c (XXType           x)+       )++-- ---------------------------------------------------------------------++type family XUserTyVar   x+type family XKindedTyVar x+type family XXTyVarBndr  x++type ForallXTyVarBndr (c :: * -> Constraint) (x :: *) =+       ( c (XUserTyVar      x)+       , c (XKindedTyVar    x)+       , c (XXTyVarBndr     x)+       )++-- ---------------------------------------------------------------------++type family XConDeclField  x+type family XXConDeclField x++type ForallXConDeclField (c :: * -> Constraint) (x :: *) =+       ( c (XConDeclField  x)+       , c (XXConDeclField x)+       )++-- ---------------------------------------------------------------------++type family XCFieldOcc x+type family XXFieldOcc x++type ForallXFieldOcc (c :: * -> Constraint) (x :: *) =+       ( c (XCFieldOcc x)+       , c (XXFieldOcc x)+       )+++-- =====================================================================+-- Type families for the HsImpExp type families++type family XCImportDecl       x+type family XXImportDecl       x++type ForallXImportDecl (c :: * -> Constraint) (x :: *) =+       ( c (XCImportDecl x)+       , c (XXImportDecl x)+       )++-- -------------------------------------++type family XIEVar             x+type family XIEThingAbs        x+type family XIEThingAll        x+type family XIEThingWith       x+type family XIEModuleContents  x+type family XIEGroup           x+type family XIEDoc             x+type family XIEDocNamed        x+type family XXIE               x++type ForallXIE (c :: * -> Constraint) (x :: *) =+       ( c (XIEVar x)+       , c (XIEThingAbs        x)+       , c (XIEThingAll        x)+       , c (XIEThingWith       x)+       , c (XIEModuleContents  x)+       , c (XIEGroup           x)+       , c (XIEDoc             x)+       , c (XIEDocNamed        x)+       , c (XXIE               x)+       )++-- -------------------------------------+++-- =====================================================================+-- End of Type family definitions+-- =====================================================================++-- ----------------------------------------------------------------------+-- | Conversion of annotations from one type index to another. This is required+-- where the AST is converted from one pass to another, and the extension values+-- need to be brought along if possible. So for example a 'SourceText' is+-- converted via 'id', but needs a type signature to keep the type checker+-- happy.+class Convertable a b  | a -> b where+  convert :: a -> b++instance Convertable a a where+  convert = id++-- | A constraint capturing all the extension points that can be converted via+-- @instance Convertable a a@+type ConvertIdX a b =+  (XHsDoublePrim a ~ XHsDoublePrim b,+   XHsFloatPrim a ~ XHsFloatPrim b,+   XHsRat a ~ XHsRat b,+   XHsInteger a ~ XHsInteger b,+   XHsWord64Prim a ~ XHsWord64Prim b,+   XHsInt64Prim a ~ XHsInt64Prim b,+   XHsWordPrim a ~ XHsWordPrim b,+   XHsIntPrim a ~ XHsIntPrim b,+   XHsInt a ~ XHsInt b,+   XHsStringPrim a ~ XHsStringPrim b,+   XHsString a ~ XHsString b,+   XHsCharPrim a ~ XHsCharPrim b,+   XHsChar a ~ XHsChar b,+   XXLit a ~ XXLit b)++-- ----------------------------------------------------------------------++-- Note [OutputableX]+-- ~~~~~~~~~~~~~~~~~~+--+-- is required because the type family resolution+-- process cannot determine that all cases are handled for a `GhcPass p`+-- case where the cases are listed separately.+--+-- So+--+--   type instance XXHsIPBinds    (GhcPass p) = NoExt+--+-- will correctly deduce Outputable for (GhcPass p), but+--+--   type instance XIPBinds       GhcPs = NoExt+--   type instance XIPBinds       GhcRn = NoExt+--   type instance XIPBinds       GhcTc = TcEvBinds+--+-- will not.+++-- | Provide a summary constraint that gives all am Outputable constraint to+-- extension points needing one+type OutputableX p = -- See Note [OutputableX]+  ( Outputable (XIPBinds    p)+  , Outputable (XViaStrategy p)+  , Outputable (XViaStrategy GhcRn)+  )+-- TODO: Should OutputableX be included in OutputableBndrId?++-- ----------------------------------------------------------------------++-- |Constraint type to bundle up the requirement for 'OutputableBndr' on both+-- the @id@ and the 'NameOrRdrName' type for it+type OutputableBndrId id =+  ( OutputableBndr (NameOrRdrName (IdP id))+  , OutputableBndr (IdP id)+  , OutputableBndr (NameOrRdrName (IdP (NoGhcTc id)))+  , OutputableBndr (IdP (NoGhcTc id))+  , NoGhcTc id ~ NoGhcTc (NoGhcTc id)+  , OutputableX id+  , OutputableX (NoGhcTc id)+  )
+ compiler/hsSyn/HsImpExp.hs view
@@ -0,0 +1,339 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+++HsImpExp: Abstract syntax: imports, exports, interfaces+-}++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]+                                      -- in module PlaceHolder++module HsImpExp where++import GhcPrelude++import Module           ( ModuleName )+import HsDoc            ( HsDocString )+import OccName          ( HasOccName(..), isTcOcc, isSymOcc )+import BasicTypes       ( SourceText(..), StringLiteral(..), pprWithSourceText )+import FieldLabel       ( FieldLbl(..) )++import Outputable+import FastString+import SrcLoc+import HsExtension++import Data.Data++{-+************************************************************************+*                                                                      *+\subsection{Import and export declaration lists}+*                                                                      *+************************************************************************++One per \tr{import} declaration in a module.+-}++-- | Located Import Declaration+type LImportDecl pass = Located (ImportDecl pass)+        -- ^ When in a list this may have+        --+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'++        -- For details on above see note [Api annotations] in ApiAnnotation++-- | Import Declaration+--+-- A single Haskell @import@ declaration.+data ImportDecl pass+  = ImportDecl {+      ideclExt       :: XCImportDecl pass,+      ideclSourceSrc :: SourceText,+                                 -- Note [Pragma source text] in BasicTypes+      ideclName      :: Located ModuleName, -- ^ Module name.+      ideclPkgQual   :: Maybe StringLiteral,  -- ^ Package qualifier.+      ideclSource    :: Bool,          -- ^ True <=> {-\# SOURCE \#-} import+      ideclSafe      :: Bool,          -- ^ True => safe import+      ideclQualified :: Bool,          -- ^ True => qualified+      ideclImplicit  :: Bool,          -- ^ True => implicit import (of Prelude)+      ideclAs        :: Maybe (Located ModuleName),  -- ^ as Module+      ideclHiding    :: Maybe (Bool, Located [LIE pass])+                                       -- ^ (True => hiding, names)+    }+  | XImportDecl (XXImportDecl pass)+     -- ^+     --  'ApiAnnotation.AnnKeywordId's+     --+     --  - 'ApiAnnotation.AnnImport'+     --+     --  - 'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnClose' for ideclSource+     --+     --  - 'ApiAnnotation.AnnSafe','ApiAnnotation.AnnQualified',+     --    'ApiAnnotation.AnnPackageName','ApiAnnotation.AnnAs',+     --    'ApiAnnotation.AnnVal'+     --+     --  - 'ApiAnnotation.AnnHiding','ApiAnnotation.AnnOpen',+     --    'ApiAnnotation.AnnClose' attached+     --     to location in ideclHiding++     -- For details on above see note [Api annotations] in ApiAnnotation++type instance XCImportDecl  (GhcPass _) = NoExt+type instance XXImportDecl  (GhcPass _) = NoExt++simpleImportDecl :: ModuleName -> ImportDecl (GhcPass p)+simpleImportDecl mn = ImportDecl {+      ideclExt       = noExt,+      ideclSourceSrc = NoSourceText,+      ideclName      = noLoc mn,+      ideclPkgQual   = Nothing,+      ideclSource    = False,+      ideclSafe      = False,+      ideclImplicit  = False,+      ideclQualified = False,+      ideclAs        = Nothing,+      ideclHiding    = Nothing+    }++instance (p ~ GhcPass pass,OutputableBndrId p)+       => Outputable (ImportDecl p) where+    ppr (ImportDecl { ideclSourceSrc = mSrcText, ideclName = mod'+                    , ideclPkgQual = pkg+                    , ideclSource = from, ideclSafe = safe+                    , ideclQualified = qual, ideclImplicit = implicit+                    , ideclAs = as, ideclHiding = spec })+      = hang (hsep [text "import", ppr_imp from, pp_implicit implicit, pp_safe safe,+                    pp_qual qual, pp_pkg pkg, ppr mod', pp_as as])+             4 (pp_spec spec)+      where+        pp_implicit False = empty+        pp_implicit True = ptext (sLit ("(implicit)"))++        pp_pkg Nothing                    = empty+        pp_pkg (Just (StringLiteral st p))+          = pprWithSourceText st (doubleQuotes (ftext p))++        pp_qual False   = empty+        pp_qual True    = text "qualified"++        pp_safe False   = empty+        pp_safe True    = text "safe"++        pp_as Nothing   = empty+        pp_as (Just a)  = text "as" <+> ppr a++        ppr_imp True  = case mSrcText of+                          NoSourceText   -> text "{-# SOURCE #-}"+                          SourceText src -> text src <+> text "#-}"+        ppr_imp False = empty++        pp_spec Nothing             = empty+        pp_spec (Just (False, (L _ ies))) = ppr_ies ies+        pp_spec (Just (True, (L _ ies))) = text "hiding" <+> ppr_ies ies++        ppr_ies []  = text "()"+        ppr_ies ies = char '(' <+> interpp'SP ies <+> char ')'+    ppr (XImportDecl x) = ppr x++{-+************************************************************************+*                                                                      *+\subsection{Imported and exported entities}+*                                                                      *+************************************************************************+-}++-- | A name in an import or export specification which may have adornments. Used+-- primarily for accurate pretty printing of ParsedSource, and API Annotation+-- placement.+data IEWrappedName name+  = IEName    (Located name)  -- ^ no extra+  | IEPattern (Located name)  -- ^ pattern X+  | IEType    (Located name)  -- ^ type (:+:)+  deriving (Eq,Data)++-- | Located name with possible adornment+-- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnType',+--         'ApiAnnotation.AnnPattern'+type LIEWrappedName name = Located (IEWrappedName name)+-- For details on above see note [Api annotations] in ApiAnnotation+++-- | Located Import or Export+type LIE pass = Located (IE pass)+        -- ^ When in a list this may have+        --+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'++        -- For details on above see note [Api annotations] in ApiAnnotation++-- | Imported or exported entity.+data IE pass+  = IEVar       (XIEVar pass) (LIEWrappedName (IdP pass))+        -- ^ Imported or Exported Variable++  | IEThingAbs  (XIEThingAbs pass) (LIEWrappedName (IdP pass))+        -- ^ Imported or exported Thing with Absent list+        --+        -- The thing is a Class/Type (can't tell)+        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnPattern',+        --             'ApiAnnotation.AnnType','ApiAnnotation.AnnVal'++        -- For details on above see note [Api annotations] in ApiAnnotation+        -- See Note [Located RdrNames] in HsExpr+  | IEThingAll  (XIEThingAll pass) (LIEWrappedName (IdP pass))+        -- ^ Imported or exported Thing with All imported or exported+        --+        -- The thing is a Class/Type and the All refers to methods/constructors+        --+        -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',+        --       'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose',+        --                                 'ApiAnnotation.AnnType'++        -- For details on above see note [Api annotations] in ApiAnnotation+        -- See Note [Located RdrNames] in HsExpr++  | IEThingWith (XIEThingWith pass)+                (LIEWrappedName (IdP pass))+                IEWildcard+                [LIEWrappedName (IdP pass)]+                [Located (FieldLbl (IdP pass))]+        -- ^ Imported or exported Thing With given imported or exported+        --+        -- The thing is a Class/Type and the imported or exported things are+        -- methods/constructors and record fields; see Note [IEThingWith]+        -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',+        --                                   'ApiAnnotation.AnnClose',+        --                                   'ApiAnnotation.AnnComma',+        --                                   'ApiAnnotation.AnnType'++        -- For details on above see note [Api annotations] in ApiAnnotation+  | IEModuleContents  (XIEModuleContents pass) (Located ModuleName)+        -- ^ Imported or exported module contents+        --+        -- (Export Only)+        --+        -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnModule'++        -- For details on above see note [Api annotations] in ApiAnnotation+  | IEGroup             (XIEGroup pass) Int HsDocString -- ^ Doc section heading+  | IEDoc               (XIEDoc pass) HsDocString       -- ^ Some documentation+  | IEDocNamed          (XIEDocNamed pass) String    -- ^ Reference to named doc+  | XIE (XXIE pass)++type instance XIEVar             (GhcPass _) = NoExt+type instance XIEThingAbs        (GhcPass _) = NoExt+type instance XIEThingAll        (GhcPass _) = NoExt+type instance XIEThingWith       (GhcPass _) = NoExt+type instance XIEModuleContents  (GhcPass _) = NoExt+type instance XIEGroup           (GhcPass _) = NoExt+type instance XIEDoc             (GhcPass _) = NoExt+type instance XIEDocNamed        (GhcPass _) = NoExt+type instance XXIE               (GhcPass _) = NoExt++-- | Imported or Exported Wildcard+data IEWildcard = NoIEWildcard | IEWildcard Int deriving (Eq, Data)++{-+Note [IEThingWith]+~~~~~~~~~~~~~~~~~~++A definition like++    module M ( T(MkT, x) ) where+      data T = MkT { x :: Int }++gives rise to++    IEThingWith T [MkT] [FieldLabel "x" False x)]           (without DuplicateRecordFields)+    IEThingWith T [MkT] [FieldLabel "x" True $sel:x:MkT)]   (with    DuplicateRecordFields)++See Note [Representing fields in AvailInfo] in Avail for more details.+-}++ieName :: IE pass -> IdP pass+ieName (IEVar _ (L _ n))              = ieWrappedName n+ieName (IEThingAbs  _ (L _ n))        = ieWrappedName n+ieName (IEThingWith _ (L _ n) _ _ _)  = ieWrappedName n+ieName (IEThingAll  _ (L _ n))        = ieWrappedName n+ieName _ = panic "ieName failed pattern match!"++ieNames :: IE pass -> [IdP pass]+ieNames (IEVar       _ (L _ n)   )     = [ieWrappedName n]+ieNames (IEThingAbs  _ (L _ n)   )     = [ieWrappedName n]+ieNames (IEThingAll  _ (L _ n)   )     = [ieWrappedName n]+ieNames (IEThingWith _ (L _ n) _ ns _) = ieWrappedName n+                                       : map (ieWrappedName . unLoc) ns+ieNames (IEModuleContents {})     = []+ieNames (IEGroup          {})     = []+ieNames (IEDoc            {})     = []+ieNames (IEDocNamed       {})     = []+ieNames (XIE {}) = panic "ieNames"++ieWrappedName :: IEWrappedName name -> name+ieWrappedName (IEName    (L _ n)) = n+ieWrappedName (IEPattern (L _ n)) = n+ieWrappedName (IEType    (L _ n)) = n++lieWrappedName :: LIEWrappedName name -> name+lieWrappedName (L _ n) = ieWrappedName n++ieLWrappedName :: LIEWrappedName name -> Located name+ieLWrappedName (L l n) = L l (ieWrappedName n)++replaceWrappedName :: IEWrappedName name1 -> name2 -> IEWrappedName name2+replaceWrappedName (IEName    (L l _)) n = IEName    (L l n)+replaceWrappedName (IEPattern (L l _)) n = IEPattern (L l n)+replaceWrappedName (IEType    (L l _)) n = IEType    (L l n)++replaceLWrappedName :: LIEWrappedName name1 -> name2 -> LIEWrappedName name2+replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n')++instance (p ~ GhcPass pass,OutputableBndrId p) => Outputable (IE p) where+    ppr (IEVar       _     var) = ppr (unLoc var)+    ppr (IEThingAbs  _   thing) = ppr (unLoc thing)+    ppr (IEThingAll  _   thing) = hcat [ppr (unLoc thing), text "(..)"]+    ppr (IEThingWith _ thing wc withs flds)+        = ppr (unLoc thing) <> parens (fsep (punctuate comma+                                              (ppWiths +++                                              map (ppr . flLabel . unLoc) flds)))+      where+        ppWiths =+          case wc of+              NoIEWildcard ->+                map (ppr . unLoc) withs+              IEWildcard pos ->+                let (bs, as) = splitAt pos (map (ppr . unLoc) withs)+                in bs ++ [text ".."] ++ as+    ppr (IEModuleContents _ mod')+        = text "module" <+> ppr mod'+    ppr (IEGroup _ n _)           = text ("<IEGroup: " ++ show n ++ ">")+    ppr (IEDoc _ doc)             = ppr doc+    ppr (IEDocNamed _ string)     = text ("<IEDocNamed: " ++ string ++ ">")+    ppr (XIE x) = ppr x++instance (HasOccName name) => HasOccName (IEWrappedName name) where+  occName w = occName (ieWrappedName w)++instance (OutputableBndr name) => OutputableBndr (IEWrappedName name) where+  pprBndr bs   w = pprBndr bs   (ieWrappedName w)+  pprPrefixOcc w = pprPrefixOcc (ieWrappedName w)+  pprInfixOcc  w = pprInfixOcc  (ieWrappedName w)++instance (OutputableBndr name) => Outputable (IEWrappedName name) where+  ppr (IEName    n) = pprPrefixOcc (unLoc n)+  ppr (IEPattern n) = text "pattern" <+> pprPrefixOcc (unLoc n)+  ppr (IEType    n) = text "type"    <+> pprPrefixOcc (unLoc n)++pprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc+pprImpExp name = type_pref <+> pprPrefixOcc name+    where+    occ = occName name+    type_pref | isTcOcc occ && isSymOcc occ = text "type"+              | otherwise                   = empty
+ compiler/hsSyn/HsInstances.hs view
@@ -0,0 +1,420 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module HsInstances where++-- This module defines the Data instances for the hsSyn AST.++-- It happens here to avoid massive constraint types on the AST with concomitant+-- slow GHC bootstrap times.++-- UndecidableInstances ?++import Data.Data hiding ( Fixity )++import GhcPrelude+import HsExtension+import HsBinds+import HsDecls+import HsExpr+import HsLit+import HsTypes+import HsPat+import HsImpExp++-- ---------------------------------------------------------------------+-- Data derivations from HsSyn -----------------------------------------++-- ---------------------------------------------------------------------+-- Data derivations from HsBinds ---------------------------------------++-- deriving instance (DataIdLR pL pR) => Data (HsLocalBindsLR pL pR)+deriving instance Data (HsLocalBindsLR GhcPs GhcPs)+deriving instance Data (HsLocalBindsLR GhcPs GhcRn)+deriving instance Data (HsLocalBindsLR GhcRn GhcRn)+deriving instance Data (HsLocalBindsLR GhcTc GhcTc)++-- deriving instance (DataIdLR pL pR) => Data (HsValBindsLR pL pR)+deriving instance Data (HsValBindsLR GhcPs GhcPs)+deriving instance Data (HsValBindsLR GhcPs GhcRn)+deriving instance Data (HsValBindsLR GhcRn GhcRn)+deriving instance Data (HsValBindsLR GhcTc GhcTc)++-- deriving instance (DataIdLR pL pL) => Data (NHsValBindsLR pL)+deriving instance Data (NHsValBindsLR GhcPs)+deriving instance Data (NHsValBindsLR GhcRn)+deriving instance Data (NHsValBindsLR GhcTc)++-- deriving instance (DataIdLR pL pR) => Data (HsBindLR pL pR)+deriving instance Data (HsBindLR GhcPs GhcPs)+deriving instance Data (HsBindLR GhcPs GhcRn)+deriving instance Data (HsBindLR GhcRn GhcRn)+deriving instance Data (HsBindLR GhcTc GhcTc)++-- deriving instance (DataId p)       => Data (ABExport p)+deriving instance Data (ABExport GhcPs)+deriving instance Data (ABExport GhcRn)+deriving instance Data (ABExport GhcTc)++-- deriving instance (DataIdLR pL pR) => Data (PatSynBind pL pR)+deriving instance Data (PatSynBind GhcPs GhcPs)+deriving instance Data (PatSynBind GhcPs GhcRn)+deriving instance Data (PatSynBind GhcRn GhcRn)+deriving instance Data (PatSynBind GhcTc GhcTc)++-- deriving instance (DataIdLR p p)   => Data (HsIPBinds p)+deriving instance Data (HsIPBinds GhcPs)+deriving instance Data (HsIPBinds GhcRn)+deriving instance Data (HsIPBinds GhcTc)++-- deriving instance (DataIdLR p p)   => Data (IPBind p)+deriving instance Data (IPBind GhcPs)+deriving instance Data (IPBind GhcRn)+deriving instance Data (IPBind GhcTc)++-- deriving instance (DataIdLR p p)   => Data (Sig p)+deriving instance Data (Sig GhcPs)+deriving instance Data (Sig GhcRn)+deriving instance Data (Sig GhcTc)++-- deriving instance (DataId p)       => Data (FixitySig p)+deriving instance Data (FixitySig GhcPs)+deriving instance Data (FixitySig GhcRn)+deriving instance Data (FixitySig GhcTc)++-- deriving instance (DataIdLR p p)   => Data (HsPatSynDir p)+deriving instance Data (HsPatSynDir GhcPs)+deriving instance Data (HsPatSynDir GhcRn)+deriving instance Data (HsPatSynDir GhcTc)++-- ---------------------------------------------------------------------+-- Data derivations from HsDecls ---------------------------------------++-- deriving instance (DataIdLR p p) => Data (HsDecl p)+deriving instance Data (HsDecl GhcPs)+deriving instance Data (HsDecl GhcRn)+deriving instance Data (HsDecl GhcTc)++-- deriving instance (DataIdLR p p) => Data (HsGroup p)+deriving instance Data (HsGroup GhcPs)+deriving instance Data (HsGroup GhcRn)+deriving instance Data (HsGroup GhcTc)++-- deriving instance (DataIdLR p p) => Data (SpliceDecl p)+deriving instance Data (SpliceDecl GhcPs)+deriving instance Data (SpliceDecl GhcRn)+deriving instance Data (SpliceDecl GhcTc)++-- deriving instance (DataIdLR p p) => Data (TyClDecl p)+deriving instance Data (TyClDecl GhcPs)+deriving instance Data (TyClDecl GhcRn)+deriving instance Data (TyClDecl GhcTc)++-- deriving instance (DataIdLR p p) => Data (TyClGroup p)+deriving instance Data (TyClGroup GhcPs)+deriving instance Data (TyClGroup GhcRn)+deriving instance Data (TyClGroup GhcTc)++-- deriving instance (DataIdLR p p) => Data (FamilyResultSig p)+deriving instance Data (FamilyResultSig GhcPs)+deriving instance Data (FamilyResultSig GhcRn)+deriving instance Data (FamilyResultSig GhcTc)++-- deriving instance (DataIdLR p p) => Data (FamilyDecl p)+deriving instance Data (FamilyDecl GhcPs)+deriving instance Data (FamilyDecl GhcRn)+deriving instance Data (FamilyDecl GhcTc)++-- deriving instance (DataIdLR p p) => Data (InjectivityAnn p)+deriving instance Data (InjectivityAnn GhcPs)+deriving instance Data (InjectivityAnn GhcRn)+deriving instance Data (InjectivityAnn GhcTc)++-- deriving instance (DataIdLR p p) => Data (FamilyInfo p)+deriving instance Data (FamilyInfo GhcPs)+deriving instance Data (FamilyInfo GhcRn)+deriving instance Data (FamilyInfo GhcTc)++-- deriving instance (DataIdLR p p) => Data (HsDataDefn p)+deriving instance Data (HsDataDefn GhcPs)+deriving instance Data (HsDataDefn GhcRn)+deriving instance Data (HsDataDefn GhcTc)++-- deriving instance (DataIdLR p p) => Data (HsDerivingClause p)+deriving instance Data (HsDerivingClause GhcPs)+deriving instance Data (HsDerivingClause GhcRn)+deriving instance Data (HsDerivingClause GhcTc)++-- deriving instance (DataIdLR p p) => Data (ConDecl p)+deriving instance Data (ConDecl GhcPs)+deriving instance Data (ConDecl GhcRn)+deriving instance Data (ConDecl GhcTc)++-- deriving instance DataIdLR p p   => Data (TyFamInstDecl p)+deriving instance Data (TyFamInstDecl GhcPs)+deriving instance Data (TyFamInstDecl GhcRn)+deriving instance Data (TyFamInstDecl GhcTc)++-- deriving instance DataIdLR p p   => Data (DataFamInstDecl p)+deriving instance Data (DataFamInstDecl GhcPs)+deriving instance Data (DataFamInstDecl GhcRn)+deriving instance Data (DataFamInstDecl GhcTc)++-- deriving instance (DataIdLR p p,Data pats,Data rhs)=>Data (FamEqn p pats rhs)+deriving instance (Data pats,Data rhs) => Data (FamEqn GhcPs pats rhs)+deriving instance (Data pats,Data rhs) => Data (FamEqn GhcRn pats rhs)+deriving instance (Data pats,Data rhs) => Data (FamEqn GhcTc pats rhs)++-- deriving instance (DataIdLR p p) => Data (ClsInstDecl p)+deriving instance Data (ClsInstDecl GhcPs)+deriving instance Data (ClsInstDecl GhcRn)+deriving instance Data (ClsInstDecl GhcTc)++-- deriving instance (DataIdLR p p) => Data (InstDecl p)+deriving instance Data (InstDecl GhcPs)+deriving instance Data (InstDecl GhcRn)+deriving instance Data (InstDecl GhcTc)++-- deriving instance (DataIdLR p p) => Data (DerivDecl p)+deriving instance Data (DerivDecl GhcPs)+deriving instance Data (DerivDecl GhcRn)+deriving instance Data (DerivDecl GhcTc)++-- deriving instance (DataIdLR p p) => Data (DerivStrategy p)+deriving instance Data (DerivStrategy GhcPs)+deriving instance Data (DerivStrategy GhcRn)+deriving instance Data (DerivStrategy GhcTc)++-- deriving instance (DataIdLR p p) => Data (DefaultDecl p)+deriving instance Data (DefaultDecl GhcPs)+deriving instance Data (DefaultDecl GhcRn)+deriving instance Data (DefaultDecl GhcTc)++-- deriving instance (DataIdLR p p) => Data (ForeignDecl p)+deriving instance Data (ForeignDecl GhcPs)+deriving instance Data (ForeignDecl GhcRn)+deriving instance Data (ForeignDecl GhcTc)++-- deriving instance (DataIdLR p p) => Data (RuleDecls p)+deriving instance Data (RuleDecls GhcPs)+deriving instance Data (RuleDecls GhcRn)+deriving instance Data (RuleDecls GhcTc)++-- deriving instance (DataIdLR p p) => Data (RuleDecl p)+deriving instance Data (RuleDecl GhcPs)+deriving instance Data (RuleDecl GhcRn)+deriving instance Data (RuleDecl GhcTc)++-- deriving instance (DataIdLR p p) => Data (RuleBndr p)+deriving instance Data (RuleBndr GhcPs)+deriving instance Data (RuleBndr GhcRn)+deriving instance Data (RuleBndr GhcTc)++-- deriving instance (DataId p)     => Data (WarnDecls p)+deriving instance Data (WarnDecls GhcPs)+deriving instance Data (WarnDecls GhcRn)+deriving instance Data (WarnDecls GhcTc)++-- deriving instance (DataId p)     => Data (WarnDecl p)+deriving instance Data (WarnDecl GhcPs)+deriving instance Data (WarnDecl GhcRn)+deriving instance Data (WarnDecl GhcTc)++-- deriving instance (DataIdLR p p) => Data (AnnDecl p)+deriving instance Data (AnnDecl GhcPs)+deriving instance Data (AnnDecl GhcRn)+deriving instance Data (AnnDecl GhcTc)++-- deriving instance (DataId p)     => Data (RoleAnnotDecl p)+deriving instance Data (RoleAnnotDecl GhcPs)+deriving instance Data (RoleAnnotDecl GhcRn)+deriving instance Data (RoleAnnotDecl GhcTc)++-- ---------------------------------------------------------------------+-- Data derivations from HsExpr ----------------------------------------++-- deriving instance (DataIdLR p p) => Data (SyntaxExpr p)+deriving instance Data (SyntaxExpr GhcPs)+deriving instance Data (SyntaxExpr GhcRn)+deriving instance Data (SyntaxExpr GhcTc)++-- deriving instance (DataIdLR p p) => Data (HsExpr p)+deriving instance Data (HsExpr GhcPs)+deriving instance Data (HsExpr GhcRn)+deriving instance Data (HsExpr GhcTc)++-- deriving instance (DataIdLR p p) => Data (HsTupArg p)+deriving instance Data (HsTupArg GhcPs)+deriving instance Data (HsTupArg GhcRn)+deriving instance Data (HsTupArg GhcTc)++-- deriving instance (DataIdLR p p) => Data (HsCmd p)+deriving instance Data (HsCmd GhcPs)+deriving instance Data (HsCmd GhcRn)+deriving instance Data (HsCmd GhcTc)++-- deriving instance (DataIdLR p p) => Data (HsCmdTop p)+deriving instance Data (HsCmdTop GhcPs)+deriving instance Data (HsCmdTop GhcRn)+deriving instance Data (HsCmdTop GhcTc)++-- deriving instance (DataIdLR p p,Data body) => Data (MatchGroup p body)+deriving instance (Data body) => Data (MatchGroup GhcPs body)+deriving instance (Data body) => Data (MatchGroup GhcRn body)+deriving instance (Data body) => Data (MatchGroup GhcTc body)++-- deriving instance (DataIdLR p p,Data body) => Data (Match      p body)+deriving instance (Data body) => Data (Match      GhcPs body)+deriving instance (Data body) => Data (Match      GhcRn body)+deriving instance (Data body) => Data (Match      GhcTc body)++-- deriving instance (DataIdLR p p,Data body) => Data (GRHSs      p body)+deriving instance (Data body) => Data (GRHSs     GhcPs body)+deriving instance (Data body) => Data (GRHSs     GhcRn body)+deriving instance (Data body) => Data (GRHSs     GhcTc body)++-- deriving instance (DataIdLR p p,Data body) => Data (GRHS       p body)+deriving instance (Data body) => Data (GRHS     GhcPs body)+deriving instance (Data body) => Data (GRHS     GhcRn body)+deriving instance (Data body) => Data (GRHS     GhcTc body)++-- deriving instance (DataIdLR p p,Data body) => Data (StmtLR   p p body)+deriving instance (Data body) => Data (StmtLR   GhcPs GhcPs body)+deriving instance (Data body) => Data (StmtLR   GhcPs GhcRn body)+deriving instance (Data body) => Data (StmtLR   GhcRn GhcRn body)+deriving instance (Data body) => Data (StmtLR   GhcTc GhcTc body)++deriving instance Data RecStmtTc++-- deriving instance (DataIdLR p p) => Data (ParStmtBlock p p)+deriving instance Data (ParStmtBlock GhcPs GhcPs)+deriving instance Data (ParStmtBlock GhcPs GhcRn)+deriving instance Data (ParStmtBlock GhcRn GhcRn)+deriving instance Data (ParStmtBlock GhcTc GhcTc)++-- deriving instance (DataIdLR p p) => Data (ApplicativeArg p)+deriving instance Data (ApplicativeArg GhcPs)+deriving instance Data (ApplicativeArg GhcRn)+deriving instance Data (ApplicativeArg GhcTc)++-- deriving instance (DataIdLR p p) => Data (HsSplice p)+deriving instance Data (HsSplice GhcPs)+deriving instance Data (HsSplice GhcRn)+deriving instance Data (HsSplice GhcTc)++-- deriving instance (DataIdLR p p) => Data (HsSplicedThing p)+deriving instance Data (HsSplicedThing GhcPs)+deriving instance Data (HsSplicedThing GhcRn)+deriving instance Data (HsSplicedThing GhcTc)++-- deriving instance (DataIdLR p p) => Data (HsBracket p)+deriving instance Data (HsBracket GhcPs)+deriving instance Data (HsBracket GhcRn)+deriving instance Data (HsBracket GhcTc)++-- deriving instance (DataIdLR p p) => Data (ArithSeqInfo p)+deriving instance Data (ArithSeqInfo GhcPs)+deriving instance Data (ArithSeqInfo GhcRn)+deriving instance Data (ArithSeqInfo GhcTc)++deriving instance                   Data RecordConTc+deriving instance                   Data CmdTopTc+deriving instance                   Data PendingRnSplice+deriving instance                   Data PendingTcSplice++-- ---------------------------------------------------------------------+-- Data derivations from HsLit ----------------------------------------++-- deriving instance (DataId p) => Data (HsLit p)+deriving instance Data (HsLit GhcPs)+deriving instance Data (HsLit GhcRn)+deriving instance Data (HsLit GhcTc)++-- deriving instance (DataIdLR p p) => Data (HsOverLit p)+deriving instance Data (HsOverLit GhcPs)+deriving instance Data (HsOverLit GhcRn)+deriving instance Data (HsOverLit GhcTc)++-- ---------------------------------------------------------------------+-- Data derivations from HsPat -----------------------------------------++-- deriving instance (DataIdLR p p) => Data (Pat p)+deriving instance Data (Pat GhcPs)+deriving instance Data (Pat GhcRn)+deriving instance Data (Pat GhcTc)++deriving instance Data ListPatTc++-- deriving instance (DataIdLR p p, Data body) => Data (HsRecFields p body)+deriving instance (Data body) => Data (HsRecFields GhcPs body)+deriving instance (Data body) => Data (HsRecFields GhcRn body)+deriving instance (Data body) => Data (HsRecFields GhcTc body)++-- ---------------------------------------------------------------------+-- Data derivations from HsTypes ---------------------------------------++-- deriving instance (DataIdLR p p) => Data (LHsQTyVars p)+deriving instance Data (LHsQTyVars GhcPs)+deriving instance Data (LHsQTyVars GhcRn)+deriving instance Data (LHsQTyVars GhcTc)++-- deriving instance (DataIdLR p p, Data thing) =>Data (HsImplicitBndrs p thing)+deriving instance (Data thing) => Data (HsImplicitBndrs GhcPs thing)+deriving instance (Data thing) => Data (HsImplicitBndrs GhcRn thing)+deriving instance (Data thing) => Data (HsImplicitBndrs GhcTc thing)++-- deriving instance (DataIdLR p p, Data thing) =>Data (HsWildCardBndrs p thing)+deriving instance (Data thing) => Data (HsWildCardBndrs GhcPs thing)+deriving instance (Data thing) => Data (HsWildCardBndrs GhcRn thing)+deriving instance (Data thing) => Data (HsWildCardBndrs GhcTc thing)++-- deriving instance (DataIdLR p p) => Data (HsTyVarBndr p)+deriving instance Data (HsTyVarBndr GhcPs)+deriving instance Data (HsTyVarBndr GhcRn)+deriving instance Data (HsTyVarBndr GhcTc)++-- deriving instance (DataIdLR p p) => Data (HsType p)+deriving instance Data (HsType GhcPs)+deriving instance Data (HsType GhcRn)+deriving instance Data (HsType GhcTc)++deriving instance Data (LHsTypeArg GhcPs)+deriving instance Data (LHsTypeArg GhcRn)+deriving instance Data (LHsTypeArg GhcTc)++-- deriving instance (DataIdLR p p) => Data (ConDeclField p)+deriving instance Data (ConDeclField GhcPs)+deriving instance Data (ConDeclField GhcRn)+deriving instance Data (ConDeclField GhcTc)++-- deriving instance (DataId p)     => Data (FieldOcc p)+deriving instance Data (FieldOcc GhcPs)+deriving instance Data (FieldOcc GhcRn)+deriving instance Data (FieldOcc GhcTc)++-- deriving instance DataId p       => Data (AmbiguousFieldOcc p)+deriving instance Data (AmbiguousFieldOcc GhcPs)+deriving instance Data (AmbiguousFieldOcc GhcRn)+deriving instance Data (AmbiguousFieldOcc GhcTc)+++-- deriving instance (DataId name) => Data (ImportDecl name)+deriving instance Data (ImportDecl GhcPs)+deriving instance Data (ImportDecl GhcRn)+deriving instance Data (ImportDecl GhcTc)++-- deriving instance (DataId name)             => Data (IE name)+deriving instance Data (IE GhcPs)+deriving instance Data (IE GhcRn)+deriving instance Data (IE GhcTc)++-- deriving instance (Eq name, Eq (IdP name)) => Eq (IE name)+deriving instance Eq (IE GhcPs)+deriving instance Eq (IE GhcRn)+deriving instance Eq (IE GhcTc)++-- ---------------------------------------------------------------------
+ compiler/hsSyn/HsLit.hs view
@@ -0,0 +1,314 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[HsLit]{Abstract syntax: source-language literals}+-}++{-# LANGUAGE CPP, DeriveDataTypeable #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]+                                      -- in module PlaceHolder+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeFamilies #-}++module HsLit where++#include "HsVersions.h"++import GhcPrelude++import {-# SOURCE #-} HsExpr( HsExpr, pprExpr )+import BasicTypes ( IntegralLit(..),FractionalLit(..),negateIntegralLit,+                    negateFractionalLit,SourceText(..),pprWithSourceText )+import Type+import Outputable+import FastString+import HsExtension++import Data.ByteString (ByteString)+import Data.Data hiding ( Fixity )++{-+************************************************************************+*                                                                      *+\subsection[HsLit]{Literals}+*                                                                      *+************************************************************************+-}++-- Note [Literal source text] in BasicTypes for SourceText fields in+-- the following+-- Note [Trees that grow] in HsExtension for the Xxxxx fields in the following+-- | Haskell Literal+data HsLit x+  = HsChar (XHsChar x) {- SourceText -} Char+      -- ^ Character+  | HsCharPrim (XHsCharPrim x) {- SourceText -} Char+      -- ^ Unboxed character+  | HsString (XHsString x) {- SourceText -} FastString+      -- ^ String+  | HsStringPrim (XHsStringPrim x) {- SourceText -} ByteString+      -- ^ Packed bytes+  | HsInt (XHsInt x)  IntegralLit+      -- ^ Genuinely an Int; arises from+      -- @TcGenDeriv@, and from TRANSLATION+  | HsIntPrim (XHsIntPrim x) {- SourceText -} Integer+      -- ^ literal @Int#@+  | HsWordPrim (XHsWordPrim x) {- SourceText -} Integer+      -- ^ literal @Word#@+  | HsInt64Prim (XHsInt64Prim x) {- SourceText -} Integer+      -- ^ literal @Int64#@+  | HsWord64Prim (XHsWord64Prim x) {- SourceText -} Integer+      -- ^ literal @Word64#@+  | HsInteger (XHsInteger x) {- SourceText -} Integer Type+      -- ^ Genuinely an integer; arises only+      -- from TRANSLATION (overloaded+      -- literals are done with HsOverLit)+  | HsRat (XHsRat x)  FractionalLit Type+      -- ^ Genuinely a rational; arises only from+      -- TRANSLATION (overloaded literals are+      -- done with HsOverLit)+  | HsFloatPrim (XHsFloatPrim x)   FractionalLit+      -- ^ Unboxed Float+  | HsDoublePrim (XHsDoublePrim x) FractionalLit+      -- ^ Unboxed Double++  | XLit (XXLit x)++type instance XHsChar       (GhcPass _) = SourceText+type instance XHsCharPrim   (GhcPass _) = SourceText+type instance XHsString     (GhcPass _) = SourceText+type instance XHsStringPrim (GhcPass _) = SourceText+type instance XHsInt        (GhcPass _) = NoExt+type instance XHsIntPrim    (GhcPass _) = SourceText+type instance XHsWordPrim   (GhcPass _) = SourceText+type instance XHsInt64Prim  (GhcPass _) = SourceText+type instance XHsWord64Prim (GhcPass _) = SourceText+type instance XHsInteger    (GhcPass _) = SourceText+type instance XHsRat        (GhcPass _) = NoExt+type instance XHsFloatPrim  (GhcPass _) = NoExt+type instance XHsDoublePrim (GhcPass _) = NoExt+type instance XXLit         (GhcPass _) = NoExt++instance Eq (HsLit x) where+  (HsChar _ x1)       == (HsChar _ x2)       = x1==x2+  (HsCharPrim _ x1)   == (HsCharPrim _ x2)   = x1==x2+  (HsString _ x1)     == (HsString _ x2)     = x1==x2+  (HsStringPrim _ x1) == (HsStringPrim _ x2) = x1==x2+  (HsInt _ x1)        == (HsInt _ x2)        = x1==x2+  (HsIntPrim _ x1)    == (HsIntPrim _ x2)    = x1==x2+  (HsWordPrim _ x1)   == (HsWordPrim _ x2)   = x1==x2+  (HsInt64Prim _ x1)  == (HsInt64Prim _ x2)  = x1==x2+  (HsWord64Prim _ x1) == (HsWord64Prim _ x2) = x1==x2+  (HsInteger _ x1 _)  == (HsInteger _ x2 _)  = x1==x2+  (HsRat _ x1 _)      == (HsRat _ x2 _)      = x1==x2+  (HsFloatPrim _ x1)  == (HsFloatPrim _ x2)  = x1==x2+  (HsDoublePrim _ x1) == (HsDoublePrim _ x2) = x1==x2+  _                   == _                   = False++-- | Haskell Overloaded Literal+data HsOverLit p+  = OverLit {+      ol_ext :: (XOverLit p),+      ol_val :: OverLitVal,+      ol_witness :: HsExpr p}         -- Note [Overloaded literal witnesses]++  | XOverLit+      (XXOverLit p)++data OverLitTc+  = OverLitTc {+        ol_rebindable :: Bool, -- Note [ol_rebindable]+        ol_type :: Type }+  deriving Data++type instance XOverLit GhcPs = NoExt+type instance XOverLit GhcRn = Bool            -- Note [ol_rebindable]+type instance XOverLit GhcTc = OverLitTc++type instance XXOverLit (GhcPass _) = NoExt++-- Note [Literal source text] in BasicTypes for SourceText fields in+-- the following+-- | Overloaded Literal Value+data OverLitVal+  = HsIntegral   !IntegralLit            -- ^ Integer-looking literals;+  | HsFractional !FractionalLit          -- ^ Frac-looking literals+  | HsIsString   !SourceText !FastString -- ^ String-looking literals+  deriving Data++negateOverLitVal :: OverLitVal -> OverLitVal+negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)+negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)+negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"++overLitType :: HsOverLit GhcTc -> Type+overLitType (OverLit (OverLitTc _ ty) _ _) = ty+overLitType XOverLit{} = panic "overLitType"++-- | Convert a literal from one index type to another, updating the annotations+-- according to the relevant 'Convertable' instance+convertLit :: (ConvertIdX a b) => HsLit a -> HsLit b+convertLit (HsChar a x)       = (HsChar (convert a) x)+convertLit (HsCharPrim a x)   = (HsCharPrim (convert a) x)+convertLit (HsString a x)     = (HsString (convert a) x)+convertLit (HsStringPrim a x) = (HsStringPrim (convert a) x)+convertLit (HsInt a x)        = (HsInt (convert a) x)+convertLit (HsIntPrim a x)    = (HsIntPrim (convert a) x)+convertLit (HsWordPrim a x)   = (HsWordPrim (convert a) x)+convertLit (HsInt64Prim a x)  = (HsInt64Prim (convert a) x)+convertLit (HsWord64Prim a x) = (HsWord64Prim (convert a) x)+convertLit (HsInteger a x b)  = (HsInteger (convert a) x b)+convertLit (HsRat a x b)      = (HsRat (convert a) x b)+convertLit (HsFloatPrim a x)  = (HsFloatPrim (convert a) x)+convertLit (HsDoublePrim a x) = (HsDoublePrim (convert a) x)+convertLit (XLit a)           = (XLit (convert a))++{-+Note [ol_rebindable]+~~~~~~~~~~~~~~~~~~~~+The ol_rebindable field is True if this literal is actually+using rebindable syntax.  Specifically:++  False iff ol_witness is the standard one+  True  iff ol_witness is non-standard++Equivalently it's True if+  a) RebindableSyntax is on+  b) the witness for fromInteger/fromRational/fromString+     that happens to be in scope isn't the standard one++Note [Overloaded literal witnesses]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+*Before* type checking, the HsExpr in an HsOverLit is the+name of the coercion function, 'fromInteger' or 'fromRational'.+*After* type checking, it is a witness for the literal, such as+        (fromInteger 3) or lit_78+This witness should replace the literal.++This dual role is unusual, because we're replacing 'fromInteger' with+a call to fromInteger.  Reason: it allows commoning up of the fromInteger+calls, which wouldn't be possible if the desugarer made the application.++The PostTcType in each branch records the type the overload literal is+found to have.+-}++-- Comparison operations are needed when grouping literals+-- for compiling pattern-matching (module MatchLit)+instance (Eq (XXOverLit p)) => Eq (HsOverLit p) where+  (OverLit _ val1 _) == (OverLit _ val2 _) = val1 == val2+  (XOverLit  val1)   == (XOverLit  val2)   = val1 == val2+  _ == _ = panic "Eq HsOverLit"++instance Eq OverLitVal where+  (HsIntegral   i1)   == (HsIntegral   i2)   = i1 == i2+  (HsFractional f1)   == (HsFractional f2)   = f1 == f2+  (HsIsString _ s1)   == (HsIsString _ s2)   = s1 == s2+  _                   == _                   = False++instance (Ord (XXOverLit p)) => Ord (HsOverLit p) where+  compare (OverLit _ val1 _) (OverLit _ val2 _) = val1 `compare` val2+  compare (XOverLit  val1)   (XOverLit  val2)   = val1 `compare` val2+  compare _ _ = panic "Ord HsOverLit"++instance Ord OverLitVal where+  compare (HsIntegral i1)     (HsIntegral i2)     = i1 `compare` i2+  compare (HsIntegral _)      (HsFractional _)    = LT+  compare (HsIntegral _)      (HsIsString _ _)    = LT+  compare (HsFractional f1)   (HsFractional f2)   = f1 `compare` f2+  compare (HsFractional _)    (HsIntegral   _)    = GT+  compare (HsFractional _)    (HsIsString _ _)    = LT+  compare (HsIsString _ s1)   (HsIsString _ s2)   = s1 `compare` s2+  compare (HsIsString _ _)    (HsIntegral   _)    = GT+  compare (HsIsString _ _)    (HsFractional _)    = GT++-- Instance specific to GhcPs, need the SourceText+instance p ~ GhcPass pass => Outputable (HsLit p) where+    ppr (HsChar st c)       = pprWithSourceText st (pprHsChar c)+    ppr (HsCharPrim st c)   = pp_st_suffix st primCharSuffix (pprPrimChar c)+    ppr (HsString st s)     = pprWithSourceText st (pprHsString s)+    ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)+    ppr (HsInt _ i)+      = pprWithSourceText (il_text i) (integer (il_value i))+    ppr (HsInteger st i _)  = pprWithSourceText st (integer i)+    ppr (HsRat _ f _)       = ppr f+    ppr (HsFloatPrim _ f)   = ppr f <> primFloatSuffix+    ppr (HsDoublePrim _ d)  = ppr d <> primDoubleSuffix+    ppr (HsIntPrim st i)    = pprWithSourceText st (pprPrimInt i)+    ppr (HsWordPrim st w)   = pprWithSourceText st (pprPrimWord w)+    ppr (HsInt64Prim st i)  = pp_st_suffix st primInt64Suffix  (pprPrimInt64 i)+    ppr (HsWord64Prim st w) = pp_st_suffix st primWord64Suffix (pprPrimWord64 w)+    ppr (XLit x) = ppr x++pp_st_suffix :: SourceText -> SDoc -> SDoc -> SDoc+pp_st_suffix NoSourceText         _ doc = doc+pp_st_suffix (SourceText st) suffix _   = text st <> suffix++-- in debug mode, print the expression that it's resolved to, too+instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (HsOverLit p) where+  ppr (OverLit {ol_val=val, ol_witness=witness})+        = ppr val <+> (whenPprDebug (parens (pprExpr witness)))+  ppr (XOverLit x) = ppr x++instance Outputable OverLitVal where+  ppr (HsIntegral i)     = pprWithSourceText (il_text i) (integer (il_value i))+  ppr (HsFractional f)   = ppr f+  ppr (HsIsString st s)  = pprWithSourceText st (pprHsString s)++-- | pmPprHsLit pretty prints literals and is used when pretty printing pattern+-- match warnings. All are printed the same (i.e., without hashes if they are+-- primitive and not wrapped in constructors if they are boxed). This happens+-- mainly for too reasons:+--  * We do not want to expose their internal representation+--  * The warnings become too messy+pmPprHsLit :: HsLit (GhcPass x) -> SDoc+pmPprHsLit (HsChar _ c)       = pprHsChar c+pmPprHsLit (HsCharPrim _ c)   = pprHsChar c+pmPprHsLit (HsString st s)    = pprWithSourceText st (pprHsString s)+pmPprHsLit (HsStringPrim _ s) = pprHsBytes s+pmPprHsLit (HsInt _ i)        = integer (il_value i)+pmPprHsLit (HsIntPrim _ i)    = integer i+pmPprHsLit (HsWordPrim _ w)   = integer w+pmPprHsLit (HsInt64Prim _ i)  = integer i+pmPprHsLit (HsWord64Prim _ w) = integer w+pmPprHsLit (HsInteger _ i _)  = integer i+pmPprHsLit (HsRat _ f _)      = ppr f+pmPprHsLit (HsFloatPrim _ f)  = ppr f+pmPprHsLit (HsDoublePrim _ d) = ppr d+pmPprHsLit (XLit x)           = ppr x++-- | @'hsLitNeedsParens' p l@ returns 'True' if a literal @l@ needs+-- to be parenthesized under precedence @p@.+hsLitNeedsParens :: PprPrec -> HsLit x -> Bool+hsLitNeedsParens p = go+  where+    go (HsChar {})        = False+    go (HsCharPrim {})    = False+    go (HsString {})      = False+    go (HsStringPrim {})  = False+    go (HsInt _ x)        = p > topPrec && il_neg x+    go (HsIntPrim _ x)    = p > topPrec && x < 0+    go (HsWordPrim {})    = False+    go (HsInt64Prim _ x)  = p > topPrec && x < 0+    go (HsWord64Prim {})  = False+    go (HsInteger _ x _)  = p > topPrec && x < 0+    go (HsRat _ x _)      = p > topPrec && fl_neg x+    go (HsFloatPrim _ x)  = p > topPrec && fl_neg x+    go (HsDoublePrim _ x) = p > topPrec && fl_neg x+    go (XLit _)           = False++-- | @'hsOverLitNeedsParens' p ol@ returns 'True' if an overloaded literal+-- @ol@ needs to be parenthesized under precedence @p@.+hsOverLitNeedsParens :: PprPrec -> HsOverLit x -> Bool+hsOverLitNeedsParens p (OverLit { ol_val = olv }) = go olv+  where+    go :: OverLitVal -> Bool+    go (HsIntegral x)   = p > topPrec && il_neg x+    go (HsFractional x) = p > topPrec && fl_neg x+    go (HsIsString {})  = False+hsOverLitNeedsParens _ (XOverLit { }) = False
+ compiler/hsSyn/HsPat.hs view
@@ -0,0 +1,846 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[PatSyntax]{Abstract Haskell syntax---patterns}+-}++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]+                                      -- in module PlaceHolder+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns      #-}+{-# LANGUAGE FlexibleInstances #-}++module HsPat (+        Pat(..), InPat, OutPat, LPat,+        ListPatTc(..),++        HsConPatDetails, hsConPatArgs,+        HsRecFields(..), HsRecField'(..), LHsRecField',+        HsRecField, LHsRecField,+        HsRecUpdField, LHsRecUpdField,+        hsRecFields, hsRecFieldSel, hsRecFieldId, hsRecFieldsArgs,+        hsRecUpdFieldId, hsRecUpdFieldOcc, hsRecUpdFieldRdr,++        mkPrefixConPat, mkCharLitPat, mkNilPat,++        looksLazyPatBind,+        isBangedLPat,+        patNeedsParens, parenthesizePat,+        isIrrefutableHsPat,++        collectEvVarsPat, collectEvVarsPats,++        pprParendLPat, pprConArgs+    ) where++import GhcPrelude++import {-# SOURCE #-} HsExpr            (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprSplice)++-- friends:+import HsBinds+import HsLit+import HsExtension+import HsTypes+import TcEvidence+import BasicTypes+-- others:+import PprCore          ( {- instance OutputableBndr TyVar -} )+import TysWiredIn+import Var+import RdrName ( RdrName )+import ConLike+import DataCon+import TyCon+import Outputable+import Type+import SrcLoc+import Bag -- collect ev vars from pats+import DynFlags( gopt, GeneralFlag(..) )+import Maybes+-- libraries:+import Data.Data hiding (TyCon,Fixity)++type InPat p  = LPat p        -- No 'Out' constructors+type OutPat p = LPat p        -- No 'In' constructors++type LPat p = Pat p++-- | Pattern+--+-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'++-- For details on above see note [Api annotations] in ApiAnnotation+data Pat p+  =     ------------ Simple patterns ---------------+    WildPat     (XWildPat p)        -- ^ Wildcard Pattern+        -- The sole reason for a type on a WildPat is to+        -- support hsPatType :: Pat Id -> Type++       -- AZ:TODO above comment needs to be updated+  | VarPat      (XVarPat p)+                (Located (IdP p))  -- ^ Variable Pattern++                             -- See Note [Located RdrNames] in HsExpr+  | LazyPat     (XLazyPat p)+                (LPat p)                -- ^ Lazy Pattern+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'++    -- For details on above see note [Api annotations] in ApiAnnotation++  | AsPat       (XAsPat p)+                (Located (IdP p)) (LPat p)    -- ^ As pattern+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'++    -- For details on above see note [Api annotations] in ApiAnnotation++  | ParPat      (XParPat p)+                (LPat p)                -- ^ Parenthesised pattern+                                        -- See Note [Parens in HsSyn] in HsExpr+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,+    --                                    'ApiAnnotation.AnnClose' @')'@++    -- For details on above see note [Api annotations] in ApiAnnotation+  | BangPat     (XBangPat p)+                (LPat p)                -- ^ Bang pattern+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'++    -- For details on above see note [Api annotations] in ApiAnnotation++        ------------ Lists, tuples, arrays ---------------+  | ListPat     (XListPat p)+                [LPat p]+                   -- For OverloadedLists a Just (ty,fn) gives+                   -- overall type of the pattern, and the toList+-- function to convert the scrutinee to a list value++    -- ^ Syntactic List+    --+    -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,+    --                                    'ApiAnnotation.AnnClose' @']'@++    -- For details on above see note [Api annotations] in ApiAnnotation++  | TuplePat    (XTuplePat p)+                  -- after typechecking, holds the types of the tuple components+                [LPat p]         -- Tuple sub-patterns+                Boxity           -- UnitPat is TuplePat []+        -- You might think that the post typechecking Type was redundant,+        -- because we can get the pattern type by getting the types of the+        -- sub-patterns.+        -- But it's essential+        --      data T a where+        --        T1 :: Int -> T Int+        --      f :: (T a, a) -> Int+        --      f (T1 x, z) = z+        -- When desugaring, we must generate+        --      f = /\a. \v::a.  case v of (t::T a, w::a) ->+        --                       case t of (T1 (x::Int)) ->+        -- Note the (w::a), NOT (w::Int), because we have not yet+        -- refined 'a' to Int.  So we must know that the second component+        -- of the tuple is of type 'a' not Int.  See selectMatchVar+        -- (June 14: I'm not sure this comment is right; the sub-patterns+        --           will be wrapped in CoPats, no?)+    -- ^ Tuple sub-patterns+    --+    -- - 'ApiAnnotation.AnnKeywordId' :+    --            'ApiAnnotation.AnnOpen' @'('@ or @'(#'@,+    --            'ApiAnnotation.AnnClose' @')'@ or  @'#)'@++  | SumPat      (XSumPat p)        -- PlaceHolder before typechecker, filled in+                                   -- afterwards with the types of the+                                   -- alternative+                (LPat p)           -- Sum sub-pattern+                ConTag             -- Alternative (one-based)+                Arity              -- Arity (INVARIANT: ≥ 2)+    -- ^ Anonymous sum pattern+    --+    -- - 'ApiAnnotation.AnnKeywordId' :+    --            'ApiAnnotation.AnnOpen' @'(#'@,+    --            'ApiAnnotation.AnnClose' @'#)'@++    -- For details on above see note [Api annotations] in ApiAnnotation++        ------------ Constructor patterns ---------------+  | ConPatIn    (Located (IdP p))+                (HsConPatDetails p)+    -- ^ Constructor Pattern In++  | ConPatOut {+        pat_con     :: Located ConLike,+        pat_arg_tys :: [Type],          -- The universal arg types, 1-1 with the universal+                                        -- tyvars of the constructor/pattern synonym+                                        --   Use (conLikeResTy pat_con pat_arg_tys) to get+                                        --   the type of the pattern++        pat_tvs   :: [TyVar],           -- Existentially bound type variables+                                        -- in correctly-scoped order e.g. [k:*, x:k]+        pat_dicts :: [EvVar],           -- Ditto *coercion variables* and *dictionaries*+                                        -- One reason for putting coercion variable here, I think,+                                        --      is to ensure their kinds are zonked++        pat_binds :: TcEvBinds,         -- Bindings involving those dictionaries+        pat_args  :: HsConPatDetails p,+        pat_wrap  :: HsWrapper          -- Extra wrapper to pass to the matcher+                                        -- Only relevant for pattern-synonyms;+                                        --   ignored for data cons+    }+    -- ^ Constructor Pattern Out++        ------------ View patterns ---------------+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | ViewPat       (XViewPat p)     -- The overall type of the pattern+                                   -- (= the argument type of the view function)+                                   -- for hsPatType.+                  (LHsExpr p)+                  (LPat p)+    -- ^ View Pattern++        ------------ Pattern splices ---------------+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@+  --        'ApiAnnotation.AnnClose' @')'@++  -- For details on above see note [Api annotations] in ApiAnnotation+  | SplicePat       (XSplicePat p)+                    (HsSplice p)    -- ^ Splice Pattern (Includes quasi-quotes)++        ------------ Literal and n+k patterns ---------------+  | LitPat          (XLitPat p)+                    (HsLit p)           -- ^ Literal Pattern+                                        -- Used for *non-overloaded* literal patterns:+                                        -- Int#, Char#, Int, Char, String, etc.++  | NPat                -- Natural Pattern+                        -- Used for all overloaded literals,+                        -- including overloaded strings with -XOverloadedStrings+                    (XNPat p)            -- Overall type of pattern. Might be+                                         -- different than the literal's type+                                         -- if (==) or negate changes the type+                    (Located (HsOverLit p))     -- ALWAYS positive+                    (Maybe (SyntaxExpr p)) -- Just (Name of 'negate') for+                                           -- negative patterns, Nothing+                                           -- otherwise+                    (SyntaxExpr p)       -- Equality checker, of type t->t->Bool++  -- ^ Natural Pattern+  --+  -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVal' @'+'@++  -- For details on above see note [Api annotations] in ApiAnnotation+  | NPlusKPat       (XNPlusKPat p)           -- Type of overall pattern+                    (Located (IdP p))        -- n+k pattern+                    (Located (HsOverLit p))  -- It'll always be an HsIntegral+                    (HsOverLit p)       -- See Note [NPlusK patterns] in TcPat+                     -- NB: This could be (PostTc ...), but that induced a+                     -- a new hs-boot file. Not worth it.++                    (SyntaxExpr p)   -- (>=) function, of type t1->t2->Bool+                    (SyntaxExpr p)   -- Name of '-' (see RnEnv.lookupSyntaxName)+  -- ^ n+k pattern++        ------------ Pattern type signatures ---------------+  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'++  -- For details on above see note [Api annotations] in ApiAnnotation+  | SigPat          (XSigPat p)             -- After typechecker: Type+                    (LPat p)                -- Pattern with a type signature+                    (LHsSigWcType (NoGhcTc p)) --  Signature can bind both+                                               --  kind and type vars++    -- ^ Pattern with a type signature++        ------------ Pattern coercions (translation only) ---------------+  | CoPat       (XCoPat p)+                HsWrapper           -- Coercion Pattern+                                    -- If co :: t1 ~ t2, p :: t2,+                                    -- then (CoPat co p) :: t1+                (Pat p)             -- Why not LPat?  Ans: existing locn will do+                Type                -- Type of whole pattern, t1+        -- During desugaring a (CoPat co pat) turns into a cast with 'co' on+        -- the scrutinee, followed by a match on 'pat'+    -- ^ Coercion Pattern++  -- | Trees that Grow extension point for new constructors+  | XPat+      (XXPat p)++-- ---------------------------------------------------------------------++data ListPatTc+  = ListPatTc+      Type                             -- The type of the elements+      (Maybe (Type, SyntaxExpr GhcTc)) -- For rebindable syntax++type instance XWildPat GhcPs = NoExt+type instance XWildPat GhcRn = NoExt+type instance XWildPat GhcTc = Type++type instance XVarPat  (GhcPass _) = NoExt+type instance XLazyPat (GhcPass _) = NoExt+type instance XAsPat   (GhcPass _) = NoExt+type instance XParPat  (GhcPass _) = NoExt+type instance XBangPat (GhcPass _) = NoExt++-- Note: XListPat cannot be extended when using GHC 8.0.2 as the bootstrap+-- compiler, as it triggers https://gitlab.haskell.org/ghc/ghc/issues/14396 for+-- `SyntaxExpr`+type instance XListPat GhcPs = NoExt+type instance XListPat GhcRn = Maybe (SyntaxExpr GhcRn)+type instance XListPat GhcTc = ListPatTc++type instance XTuplePat GhcPs = NoExt+type instance XTuplePat GhcRn = NoExt+type instance XTuplePat GhcTc = [Type]++type instance XSumPat GhcPs = NoExt+type instance XSumPat GhcRn = NoExt+type instance XSumPat GhcTc = [Type]++type instance XViewPat GhcPs = NoExt+type instance XViewPat GhcRn = NoExt+type instance XViewPat GhcTc = Type++type instance XSplicePat (GhcPass _) = NoExt+type instance XLitPat    (GhcPass _) = NoExt++type instance XNPat GhcPs = NoExt+type instance XNPat GhcRn = NoExt+type instance XNPat GhcTc = Type++type instance XNPlusKPat GhcPs = NoExt+type instance XNPlusKPat GhcRn = NoExt+type instance XNPlusKPat GhcTc = Type++type instance XSigPat GhcPs = NoExt+type instance XSigPat GhcRn = NoExt+type instance XSigPat GhcTc = Type++type instance XCoPat  (GhcPass _) = NoExt+type instance XXPat   (GhcPass p) = Located (Pat (GhcPass p))+++{-+************************************************************************+*                                                                      *+*              HasSrcSpan Instance+*                                                                      *+************************************************************************+-}++type instance SrcSpanLess (LPat (GhcPass p)) = Pat (GhcPass p)+instance HasSrcSpan (LPat (GhcPass p)) where+  -- NB: The following chooses the behaviour of the outer location+  --     wrapper replacing the inner ones.+  composeSrcSpan (L sp p) =  if sp == noSrcSpan+                             then p+                             else XPat (L sp (stripSrcSpanPat p))++  -- NB: The following only returns the top-level location, if any.+  decomposeSrcSpan (XPat (L sp p)) = L sp (stripSrcSpanPat p)+  decomposeSrcSpan p               = L noSrcSpan p++stripSrcSpanPat :: LPat (GhcPass p) -> Pat (GhcPass p)+stripSrcSpanPat (XPat (L _  p)) = stripSrcSpanPat p+stripSrcSpanPat p               = p++++-- ---------------------------------------------------------------------+++-- | Haskell Constructor Pattern Details+type HsConPatDetails p = HsConDetails (LPat p) (HsRecFields p (LPat p))++hsConPatArgs :: HsConPatDetails p -> [LPat p]+hsConPatArgs (PrefixCon ps)   = ps+hsConPatArgs (RecCon fs)      = map (hsRecFieldArg . unLoc) (rec_flds fs)+hsConPatArgs (InfixCon p1 p2) = [p1,p2]++-- | Haskell Record Fields+--+-- HsRecFields is used only for patterns and expressions (not data type+-- declarations)+data HsRecFields p arg         -- A bunch of record fields+                                --      { x = 3, y = True }+        -- Used for both expressions and patterns+  = HsRecFields { rec_flds   :: [LHsRecField p arg],+                  rec_dotdot :: Maybe (Located Int) }  -- Note [DotDot fields]+  deriving (Functor, Foldable, Traversable)+++-- Note [DotDot fields]+-- ~~~~~~~~~~~~~~~~~~~~+-- The rec_dotdot field means this:+--   Nothing => the normal case+--   Just n  => the group uses ".." notation,+--+-- In the latter case:+--+--   *before* renamer: rec_flds are exactly the n user-written fields+--+--   *after* renamer:  rec_flds includes *all* fields, with+--                     the first 'n' being the user-written ones+--                     and the remainder being 'filled in' implicitly++-- | Located Haskell Record Field+type LHsRecField' p arg = Located (HsRecField' p arg)++-- | Located Haskell Record Field+type LHsRecField  p arg = Located (HsRecField  p arg)++-- | Located Haskell Record Update Field+type LHsRecUpdField p   = Located (HsRecUpdField p)++-- | Haskell Record Field+type HsRecField    p arg = HsRecField' (FieldOcc p) arg++-- | Haskell Record Update Field+type HsRecUpdField p     = HsRecField' (AmbiguousFieldOcc p) (LHsExpr p)++-- | Haskell Record Field+--+-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual',+--+-- For details on above see note [Api annotations] in ApiAnnotation+data HsRecField' id arg = HsRecField {+        hsRecFieldLbl :: Located id,+        hsRecFieldArg :: arg,           -- ^ Filled in by renamer when punning+        hsRecPun      :: Bool           -- ^ Note [Punning]+  } deriving (Data, Functor, Foldable, Traversable)+++-- Note [Punning]+-- ~~~~~~~~~~~~~~+-- If you write T { x, y = v+1 }, the HsRecFields will be+--      HsRecField x x True ...+--      HsRecField y (v+1) False ...+-- That is, for "punned" field x is expanded (in the renamer)+-- to x=x; but with a punning flag so we can detect it later+-- (e.g. when pretty printing)+--+-- If the original field was qualified, we un-qualify it, thus+--    T { A.x } means T { A.x = x }+++-- Note [HsRecField and HsRecUpdField]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++-- A HsRecField (used for record construction and pattern matching)+-- contains an unambiguous occurrence of a field (i.e. a FieldOcc).+-- We can't just store the Name, because thanks to+-- DuplicateRecordFields this may not correspond to the label the user+-- wrote.+--+-- A HsRecUpdField (used for record update) contains a potentially+-- ambiguous occurrence of a field (an AmbiguousFieldOcc).  The+-- renamer will fill in the selector function if it can, but if the+-- selector is ambiguous the renamer will defer to the typechecker.+-- After the typechecker, a unique selector will have been determined.+--+-- The renamer produces an Unambiguous result if it can, rather than+-- just doing the lookup in the typechecker, so that completely+-- unambiguous updates can be represented by 'DsMeta.repUpdFields'.+--+-- For example, suppose we have:+--+--     data S = MkS { x :: Int }+--     data T = MkT { x :: Int }+--+--     f z = (z { x = 3 }) :: S+--+-- The parsed HsRecUpdField corresponding to the record update will have:+--+--     hsRecFieldLbl = Unambiguous "x" NoExt :: AmbiguousFieldOcc RdrName+--+-- After the renamer, this will become:+--+--     hsRecFieldLbl = Ambiguous   "x" NoExt :: AmbiguousFieldOcc Name+--+-- (note that the Unambiguous constructor is not type-correct here).+-- The typechecker will determine the particular selector:+--+--     hsRecFieldLbl = Unambiguous "x" $sel:x:MkS  :: AmbiguousFieldOcc Id+--+-- See also Note [Disambiguating record fields] in TcExpr.++hsRecFields :: HsRecFields p arg -> [XCFieldOcc p]+hsRecFields rbinds = map (unLoc . hsRecFieldSel . unLoc) (rec_flds rbinds)++-- Probably won't typecheck at once, things have changed :/+hsRecFieldsArgs :: HsRecFields p arg -> [arg]+hsRecFieldsArgs rbinds = map (hsRecFieldArg . unLoc) (rec_flds rbinds)++hsRecFieldSel :: HsRecField pass arg -> Located (XCFieldOcc pass)+hsRecFieldSel = fmap extFieldOcc . hsRecFieldLbl++hsRecFieldId :: HsRecField GhcTc arg -> Located Id+hsRecFieldId = hsRecFieldSel++hsRecUpdFieldRdr :: HsRecUpdField (GhcPass p) -> Located RdrName+hsRecUpdFieldRdr = fmap rdrNameAmbiguousFieldOcc . hsRecFieldLbl++hsRecUpdFieldId :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located Id+hsRecUpdFieldId = fmap extFieldOcc . hsRecUpdFieldOcc++hsRecUpdFieldOcc :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc+hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl+++{-+************************************************************************+*                                                                      *+*              Printing patterns+*                                                                      *+************************************************************************+-}++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (Pat p) where+    ppr = pprPat++pprPatBndr :: OutputableBndr name => name -> SDoc+pprPatBndr var                  -- Print with type info if -dppr-debug is on+  = getPprStyle $ \ sty ->+    if debugStyle sty then+        parens (pprBndr LambdaBind var)         -- Could pass the site to pprPat+                                                -- but is it worth it?+    else+        pprPrefixOcc var++pprParendLPat :: (OutputableBndrId (GhcPass p))+              => PprPrec -> LPat (GhcPass p) -> SDoc+pprParendLPat p = pprParendPat p . unLoc++pprParendPat :: (OutputableBndrId (GhcPass p))+             => PprPrec -> Pat (GhcPass p) -> SDoc+pprParendPat p pat = sdocWithDynFlags $ \ dflags ->+                     if need_parens dflags pat+                     then parens (pprPat pat)+                     else  pprPat pat+  where+    need_parens dflags pat+      | CoPat {} <- pat = gopt Opt_PrintTypecheckerElaboration dflags+      | otherwise       = patNeedsParens p pat+      -- For a CoPat we need parens if we are going to show it, which+      -- we do if -fprint-typechecker-elaboration is on (c.f. pprHsWrapper)+      -- But otherwise the CoPat is discarded, so it+      -- is the pattern inside that matters.  Sigh.++pprPat :: (OutputableBndrId (GhcPass p)) => Pat (GhcPass p) -> SDoc+pprPat (VarPat _ lvar)          = pprPatBndr (unLoc lvar)+pprPat (WildPat _)              = char '_'+pprPat (LazyPat _ pat)          = char '~' <> pprParendLPat appPrec pat+pprPat (BangPat _ pat)          = char '!' <> pprParendLPat appPrec pat+pprPat (AsPat _ name pat)       = hcat [pprPrefixOcc (unLoc name), char '@',+                                        pprParendLPat appPrec pat]+pprPat (ViewPat _ expr pat)     = hcat [pprLExpr expr, text " -> ", ppr pat]+pprPat (ParPat _ pat)           = parens (ppr pat)+pprPat (LitPat _ s)             = ppr s+pprPat (NPat _ l Nothing  _)    = ppr l+pprPat (NPat _ l (Just _) _)    = char '-' <> ppr l+pprPat (NPlusKPat _ n k _ _ _)  = hcat [ppr n, char '+', ppr k]+pprPat (SplicePat _ splice)     = pprSplice splice+pprPat (CoPat _ co pat _)       = pprHsWrapper co $ \parens+                                            -> if parens+                                                 then pprParendPat appPrec pat+                                                 else pprPat pat+pprPat (SigPat _ pat ty)        = ppr pat <+> dcolon <+> ppr ty+pprPat (ListPat _ pats)         = brackets (interpp'SP pats)+pprPat (TuplePat _ pats bx)     = tupleParens (boxityTupleSort bx)+                                              (pprWithCommas ppr pats)+pprPat (SumPat _ pat alt arity) = sumParens (pprAlternative ppr pat alt arity)+pprPat (ConPatIn con details)   = pprUserCon (unLoc con) details+pprPat (ConPatOut { pat_con = con+                  , pat_tvs = tvs+                  , pat_dicts = dicts+                  , pat_binds = binds+                  , pat_args = details })+  = sdocWithDynFlags $ \dflags ->+       -- Tiresome; in TcBinds.tcRhs we print out a+       -- typechecked Pat in an error message,+       -- and we want to make sure it prints nicely+    if gopt Opt_PrintTypecheckerElaboration dflags then+        ppr con+          <> braces (sep [ hsep (map pprPatBndr (tvs ++ dicts))+                         , ppr binds])+          <+> pprConArgs details+    else pprUserCon (unLoc con) details+pprPat (XPat x)               = ppr x+++pprUserCon :: (OutputableBndr con, OutputableBndrId (GhcPass p))+           => con -> HsConPatDetails (GhcPass p) -> SDoc+pprUserCon c (InfixCon p1 p2) = ppr p1 <+> pprInfixOcc c <+> ppr p2+pprUserCon c details          = pprPrefixOcc c <+> pprConArgs details++pprConArgs :: (OutputableBndrId (GhcPass p))+           => HsConPatDetails (GhcPass p) -> SDoc+pprConArgs (PrefixCon pats) = sep (map (pprParendLPat appPrec) pats)+pprConArgs (InfixCon p1 p2) = sep [ pprParendLPat appPrec p1+                                  , pprParendLPat appPrec p2 ]+pprConArgs (RecCon rpats)   = ppr rpats++instance (Outputable arg)+      => Outputable (HsRecFields p arg) where+  ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })+        = braces (fsep (punctuate comma (map ppr flds)))+  ppr (HsRecFields { rec_flds = flds, rec_dotdot = Just (unLoc -> n) })+        = braces (fsep (punctuate comma (map ppr (take n flds) ++ [dotdot])))+        where+          dotdot = text ".." <+> whenPprDebug (ppr (drop n flds))++instance (Outputable p, Outputable arg)+      => Outputable (HsRecField' p arg) where+  ppr (HsRecField { hsRecFieldLbl = f, hsRecFieldArg = arg,+                    hsRecPun = pun })+    = ppr f <+> (ppUnless pun $ equals <+> ppr arg)+++{-+************************************************************************+*                                                                      *+*              Building patterns+*                                                                      *+************************************************************************+-}++mkPrefixConPat :: DataCon ->+                  [OutPat (GhcPass p)] -> [Type] -> OutPat (GhcPass p)+-- Make a vanilla Prefix constructor pattern+mkPrefixConPat dc pats tys+  = noLoc $ ConPatOut { pat_con = noLoc (RealDataCon dc)+                      , pat_tvs = []+                      , pat_dicts = []+                      , pat_binds = emptyTcEvBinds+                      , pat_args = PrefixCon pats+                      , pat_arg_tys = tys+                      , pat_wrap = idHsWrapper }++mkNilPat :: Type -> OutPat (GhcPass p)+mkNilPat ty = mkPrefixConPat nilDataCon [] [ty]++mkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p)+mkCharLitPat src c = mkPrefixConPat charDataCon+                          [noLoc $ LitPat NoExt (HsCharPrim src c)] []++{-+************************************************************************+*                                                                      *+* Predicates for checking things about pattern-lists in EquationInfo   *+*                                                                      *+************************************************************************++\subsection[Pat-list-predicates]{Look for interesting things in patterns}++Unlike in the Wadler chapter, where patterns are either ``variables''+or ``constructors,'' here we distinguish between:+\begin{description}+\item[unfailable:]+Patterns that cannot fail to match: variables, wildcards, and lazy+patterns.++These are the irrefutable patterns; the two other categories+are refutable patterns.++\item[constructor:]+A non-literal constructor pattern (see next category).++\item[literal patterns:]+At least the numeric ones may be overloaded.+\end{description}++A pattern is in {\em exactly one} of the above three categories; `as'+patterns are treated specially, of course.++The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.+-}++isBangedLPat :: LPat (GhcPass p) -> Bool+isBangedLPat = isBangedPat . unLoc++isBangedPat :: Pat (GhcPass p) -> Bool+isBangedPat (ParPat _ p) = isBangedLPat p+isBangedPat (BangPat {}) = True+isBangedPat _            = False++looksLazyPatBind :: HsBind (GhcPass p) -> Bool+-- Returns True of anything *except*+--     a StrictHsBind (as above) or+--     a VarPat+-- In particular, returns True of a pattern binding with a compound pattern, like (I# x)+-- Looks through AbsBinds+looksLazyPatBind (PatBind { pat_lhs = p })+  = looksLazyLPat p+looksLazyPatBind (AbsBinds { abs_binds = binds })+  = anyBag (looksLazyPatBind . unLoc) binds+looksLazyPatBind _+  = False++looksLazyLPat :: LPat (GhcPass p) -> Bool+looksLazyLPat = looksLazyPat . unLoc++looksLazyPat :: Pat (GhcPass p) -> Bool+looksLazyPat (ParPat _ p)  = looksLazyLPat p+looksLazyPat (AsPat _ _ p) = looksLazyLPat p+looksLazyPat (BangPat {})  = False+looksLazyPat (VarPat {})   = False+looksLazyPat (WildPat {})  = False+looksLazyPat _             = True++isIrrefutableHsPat :: (OutputableBndrId (GhcPass p)) => LPat (GhcPass p) -> Bool+-- (isIrrefutableHsPat p) is true if matching against p cannot fail,+-- in the sense of falling through to the next pattern.+--      (NB: this is not quite the same as the (silly) defn+--      in 3.17.2 of the Haskell 98 report.)+--+-- WARNING: isIrrefutableHsPat returns False if it's in doubt.+-- Specifically on a ConPatIn, which is what it sees for a+-- (LPat Name) in the renamer, it doesn't know the size of the+-- constructor family, so it returns False.  Result: only+-- tuple patterns are considered irrefuable at the renamer stage.+--+-- But if it returns True, the pattern is definitely irrefutable+isIrrefutableHsPat+  = goL+  where+    goL = go . unLoc++    go (WildPat {})        = True+    go (VarPat {})         = True+    go (LazyPat {})        = True+    go (BangPat _ pat)     = goL pat+    go (CoPat _ _ pat _)   = go  pat+    go (ParPat _ pat)      = goL pat+    go (AsPat _ _ pat)     = goL pat+    go (ViewPat _ _ pat)   = goL pat+    go (SigPat _ pat _)    = goL pat+    go (TuplePat _ pats _) = all goL pats+    go (SumPat {})         = False+                    -- See Note [Unboxed sum patterns aren't irrefutable]+    go (ListPat {})        = False++    go (ConPatIn {})       = False     -- Conservative+    go (ConPatOut+        { pat_con  = (dL->L _ (RealDataCon con))+        , pat_args = details })+                           =+      isJust (tyConSingleDataCon_maybe (dataConTyCon con))+      -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because+      -- the latter is false of existentials. See #4439+      && all goL (hsConPatArgs details)+    go (ConPatOut+        { pat_con = (dL->L _ (PatSynCon _pat)) })+                           = False -- Conservative+    go (ConPatOut{})       = panic "ConPatOut:Impossible Match" -- due to #15884+    go (LitPat {})         = False+    go (NPat {})           = False+    go (NPlusKPat {})      = False++    -- We conservatively assume that no TH splices are irrefutable+    -- since we cannot know until the splice is evaluated.+    go (SplicePat {})      = False++    go (XPat {})           = False++{- Note [Unboxed sum patterns aren't irrefutable]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Unlike unboxed tuples, unboxed sums are *not* irrefutable when used as+patterns. A simple example that demonstrates this is from #14228:++  pattern Just' x = (# x | #)+  pattern Nothing' = (# | () #)++  foo x = case x of+    Nothing' -> putStrLn "nothing"+    Just'    -> putStrLn "just"++In foo, the pattern Nothing' (that is, (# x | #)) is certainly not irrefutable,+as does not match an unboxed sum value of the same arity—namely, (# | y #)+(covered by Just'). In fact, no unboxed sum pattern is irrefutable, since the+minimum unboxed sum arity is 2.++Failing to mark unboxed sum patterns as non-irrefutable would cause the Just'+case in foo to be unreachable, as GHC would mistakenly believe that Nothing'+is the only thing that could possibly be matched!+-}++-- | @'patNeedsParens' p pat@ returns 'True' if the pattern @pat@ needs+-- parentheses under precedence @p@.+patNeedsParens :: PprPrec -> Pat p -> Bool+patNeedsParens p = go+  where+    go (NPlusKPat {})    = p > opPrec+    go (SplicePat {})    = False+    go (ConPatIn _ ds)   = conPatNeedsParens p ds+    go cp@(ConPatOut {}) = conPatNeedsParens p (pat_args cp)+    go (SigPat {})       = p >= sigPrec+    go (ViewPat {})      = True+    go (CoPat _ _ p _)   = go p+    go (WildPat {})      = False+    go (VarPat {})       = False+    go (LazyPat {})      = False+    go (BangPat {})      = False+    go (ParPat {})       = False+    go (AsPat {})        = False+    go (TuplePat {})     = False+    go (SumPat {})       = False+    go (ListPat {})      = False+    go (LitPat _ l)      = hsLitNeedsParens p l+    go (NPat _ lol _ _)  = hsOverLitNeedsParens p (unLoc lol)+    go (XPat {})         = True -- conservative default++-- | @'conPatNeedsParens' p cp@ returns 'True' if the constructor patterns @cp@+-- needs parentheses under precedence @p@.+conPatNeedsParens :: PprPrec -> HsConDetails a b -> Bool+conPatNeedsParens p = go+  where+    go (PrefixCon args) = p >= appPrec && not (null args)+    go (InfixCon {})    = p >= opPrec+    go (RecCon {})      = False++-- | @'parenthesizePat' p pat@ checks if @'patNeedsParens' p pat@ is true, and+-- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat@.+parenthesizePat :: PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)+parenthesizePat p lpat@(dL->L loc pat)+  | patNeedsParens p pat = cL loc (ParPat NoExt lpat)+  | otherwise            = lpat++{-+% Collect all EvVars from all constructor patterns+-}++-- May need to add more cases+collectEvVarsPats :: [Pat GhcTc] -> Bag EvVar+collectEvVarsPats = unionManyBags . map collectEvVarsPat++collectEvVarsLPat :: LPat GhcTc -> Bag EvVar+collectEvVarsLPat = collectEvVarsPat . unLoc++collectEvVarsPat :: Pat GhcTc -> Bag EvVar+collectEvVarsPat pat =+  case pat of+    LazyPat _ p      -> collectEvVarsLPat p+    AsPat _ _ p      -> collectEvVarsLPat p+    ParPat  _ p      -> collectEvVarsLPat p+    BangPat _ p      -> collectEvVarsLPat p+    ListPat _ ps     -> unionManyBags $ map collectEvVarsLPat ps+    TuplePat _ ps _  -> unionManyBags $ map collectEvVarsLPat ps+    SumPat _ p _ _   -> collectEvVarsLPat p+    ConPatOut {pat_dicts = dicts, pat_args  = args}+                     -> unionBags (listToBag dicts)+                                   $ unionManyBags+                                   $ map collectEvVarsLPat+                                   $ hsConPatArgs args+    SigPat  _ p _    -> collectEvVarsLPat p+    CoPat _ _ p _    -> collectEvVarsPat  p+    ConPatIn _  _    -> panic "foldMapPatBag: ConPatIn"+    _other_pat       -> emptyBag
+ compiler/hsSyn/HsPat.hs-boot view
@@ -0,0 +1,18 @@+{-# LANGUAGE CPP, KindSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]+                                      -- in module PlaceHolder+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE TypeFamilies #-}++module HsPat where++import Outputable+import HsExtension      ( OutputableBndrId, GhcPass )++type role Pat nominal+data Pat (i :: *)+type LPat i = Pat i++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (Pat p)
+ compiler/hsSyn/HsSyn.hs view
@@ -0,0 +1,153 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section{Haskell abstract syntax definition}++This module glues together the pieces of the Haskell abstract syntax,+which is declared in the various \tr{Hs*} modules.  This module,+therefore, is almost nothing but re-exporting.+-}++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]+                                      -- in module PlaceHolder+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-} -- For deriving instance Data++module HsSyn (+        module HsBinds,+        module HsDecls,+        module HsExpr,+        module HsImpExp,+        module HsLit,+        module HsPat,+        module HsTypes,+        module HsUtils,+        module HsDoc,+        module PlaceHolder,+        module HsExtension,+        Fixity,++        HsModule(..),+) where++-- friends:+import GhcPrelude++import HsDecls+import HsBinds+import HsExpr+import HsImpExp+import HsLit+import PlaceHolder+import HsExtension+import HsPat+import HsTypes+import BasicTypes       ( Fixity, WarningTxt )+import HsUtils+import HsDoc+import HsInstances ()++-- others:+import Outputable+import SrcLoc+import Module           ( ModuleName )++-- libraries:+import Data.Data hiding ( Fixity )++-- | Haskell Module+--+-- All we actually declare here is the top-level structure for a module.+data HsModule pass+  = HsModule {+      hsmodName :: Maybe (Located ModuleName),+        -- ^ @Nothing@: \"module X where\" is omitted (in which case the next+        --     field is Nothing too)+      hsmodExports :: Maybe (Located [LIE pass]),+        -- ^ Export list+        --+        --  - @Nothing@: export list omitted, so export everything+        --+        --  - @Just []@: export /nothing/+        --+        --  - @Just [...]@: as you would expect...+        --+        --+        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen'+        --                                   ,'ApiAnnotation.AnnClose'++        -- For details on above see note [Api annotations] in ApiAnnotation+      hsmodImports :: [LImportDecl pass],+        -- ^ We snaffle interesting stuff out of the imported interfaces early+        -- on, adding that info to TyDecls/etc; so this list is often empty,+        -- downstream.+      hsmodDecls :: [LHsDecl pass],+        -- ^ Type, class, value, and interface signature decls+      hsmodDeprecMessage :: Maybe (Located WarningTxt),+        -- ^ reason\/explanation for warning/deprecation of this module+        --+        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen'+        --                                   ,'ApiAnnotation.AnnClose'+        --++        -- For details on above see note [Api annotations] in ApiAnnotation+      hsmodHaddockModHeader :: Maybe LHsDocString+        -- ^ Haddock module info and description, unparsed+        --+        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen'+        --                                   ,'ApiAnnotation.AnnClose'++        -- For details on above see note [Api annotations] in ApiAnnotation+   }+     -- ^ 'ApiAnnotation.AnnKeywordId's+     --+     --  - 'ApiAnnotation.AnnModule','ApiAnnotation.AnnWhere'+     --+     --  - 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnSemi',+     --    'ApiAnnotation.AnnClose' for explicit braces and semi around+     --    hsmodImports,hsmodDecls if this style is used.++     -- For details on above see note [Api annotations] in ApiAnnotation+-- deriving instance (DataIdLR name name) => Data (HsModule name)+deriving instance Data (HsModule GhcPs)+deriving instance Data (HsModule GhcRn)+deriving instance Data (HsModule GhcTc)++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsModule p) where++    ppr (HsModule Nothing _ imports decls _ mbDoc)+      = pp_mb mbDoc $$ pp_nonnull imports+                    $$ pp_nonnull decls++    ppr (HsModule (Just name) exports imports decls deprec mbDoc)+      = vcat [+            pp_mb mbDoc,+            case exports of+              Nothing -> pp_header (text "where")+              Just es -> vcat [+                           pp_header lparen,+                           nest 8 (fsep (punctuate comma (map ppr (unLoc es)))),+                           nest 4 (text ") where")+                          ],+            pp_nonnull imports,+            pp_nonnull decls+          ]+      where+        pp_header rest = case deprec of+           Nothing -> pp_modname <+> rest+           Just d -> vcat [ pp_modname, ppr d, rest ]++        pp_modname = text "module" <+> ppr name++pp_mb :: Outputable t => Maybe t -> SDoc+pp_mb (Just x) = ppr x+pp_mb Nothing  = empty++pp_nonnull :: Outputable t => [t] -> SDoc+pp_nonnull [] = empty+pp_nonnull xs = vcat (map ppr xs)
+ compiler/hsSyn/HsTypes.hs view
@@ -0,0 +1,1663 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+++HsTypes: Abstract syntax: user-defined types+-}++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]+                                      -- in module PlaceHolder+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}++module HsTypes (+        HsType(..), NewHsTypeX(..), LHsType, HsKind, LHsKind,+        HsTyVarBndr(..), LHsTyVarBndr, ForallVisFlag(..),+        LHsQTyVars(..),+        HsImplicitBndrs(..),+        HsWildCardBndrs(..),+        LHsSigType, LHsSigWcType, LHsWcType,+        HsTupleSort(..),+        HsContext, LHsContext, noLHsContext,+        HsTyLit(..),+        HsIPName(..), hsIPNameFS,+        HsArg(..), numVisibleArgs,+        LHsTypeArg,++        LBangType, BangType,+        HsSrcBang(..), HsImplBang(..),+        SrcStrictness(..), SrcUnpackedness(..),+        getBangType, getBangStrictness,++        ConDeclField(..), LConDeclField, pprConDeclFields,++        HsConDetails(..),++        FieldOcc(..), LFieldOcc, mkFieldOcc,+        AmbiguousFieldOcc(..), mkAmbiguousFieldOcc,+        rdrNameAmbiguousFieldOcc, selectorAmbiguousFieldOcc,+        unambiguousFieldOcc, ambiguousFieldOcc,++        mkAnonWildCardTy, pprAnonWildCard,++        mkHsImplicitBndrs, mkHsWildCardBndrs, hsImplicitBody,+        mkEmptyImplicitBndrs, mkEmptyWildCardBndrs,+        mkHsQTvs, hsQTvExplicit, emptyLHsQTvs, isEmptyLHsQTvs,+        isHsKindedTyVar, hsTvbAllKinded, isLHsForAllTy,+        hsScopedTvs, hsWcScopedTvs, dropWildCards,+        hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames,+        hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsExplicitLTyVarNames,+        splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe,+        splitLHsPatSynTy,+        splitLHsForAllTy, splitLHsForAllTyInvis,+        splitLHsQualTy, splitLHsSigmaTy, splitLHsSigmaTyInvis,+        splitHsFunType, hsTyGetAppHead_maybe,+        mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy,+        ignoreParens, hsSigType, hsSigWcType,+        hsLTyVarBndrToType, hsLTyVarBndrsToTypes,++        -- Printing+        pprHsType, pprHsForAll, pprHsForAllExtra, pprHsExplicitForAll,+        pprLHsContext,+        hsTypeNeedsParens, parenthesizeHsType, parenthesizeHsContext+    ) where++import GhcPrelude++import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )++import HsExtension+import HsLit () -- for instances++import Id ( Id )+import Name( Name )+import RdrName ( RdrName )+import DataCon( HsSrcBang(..), HsImplBang(..),+                SrcStrictness(..), SrcUnpackedness(..) )+import TysPrim( funTyConName )+import Type+import HsDoc+import BasicTypes+import SrcLoc+import Outputable+import FastString+import Maybes( isJust )+import Util ( count )++import Data.Data hiding ( Fixity, Prefix, Infix )++{-+************************************************************************+*                                                                      *+\subsection{Bang annotations}+*                                                                      *+************************************************************************+-}++-- | Located Bang Type+type LBangType pass = Located (BangType pass)++-- | Bang Type+type BangType pass  = HsType pass       -- Bangs are in the HsType data type++getBangType :: LHsType a -> LHsType a+getBangType (L _ (HsBangTy _ _ ty)) = ty+getBangType ty                      = ty++getBangStrictness :: LHsType a -> HsSrcBang+getBangStrictness (L _ (HsBangTy _ s _)) = s+getBangStrictness _ = (HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict)++{-+************************************************************************+*                                                                      *+\subsection{Data types}+*                                                                      *+************************************************************************++This is the syntax for types as seen in type signatures.++Note [HsBSig binder lists]+~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider a binder (or pattern) decorated with a type or kind,+   \ (x :: a -> a). blah+   forall (a :: k -> *) (b :: k). blah+Then we use a LHsBndrSig on the binder, so that the+renamer can decorate it with the variables bound+by the pattern ('a' in the first example, 'k' in the second),+assuming that neither of them is in scope already+See also Note [Kind and type-variable binders] in RnTypes++Note [HsType binders]+~~~~~~~~~~~~~~~~~~~~~+The system for recording type and kind-variable binders in HsTypes+is a bit complicated.  Here's how it works.++* In a HsType,+     HsForAllTy   represents an /explicit, user-written/ 'forall'+                   e.g.   forall a b.   {...} or+                          forall a b -> {...}+     HsQualTy     represents an /explicit, user-written/ context+                   e.g.   (Eq a, Show a) => ...+                  The context can be empty if that's what the user wrote+  These constructors represent what the user wrote, no more+  and no less.++* The ForallVisFlag field of HsForAllTy represents whether a forall is+  invisible (e.g., forall a b. {...}, with a dot) or visible+  (e.g., forall a b -> {...}, with an arrow).++* HsTyVarBndr describes a quantified type variable written by the+  user.  For example+     f :: forall a (b :: *).  blah+  here 'a' and '(b::*)' are each a HsTyVarBndr.  A HsForAllTy has+  a list of LHsTyVarBndrs.++* HsImplicitBndrs is a wrapper that gives the implicitly-quantified+  kind and type variables of the wrapped thing.  It is filled in by+  the renamer. For example, if the user writes+     f :: a -> a+  the HsImplicitBinders binds the 'a' (not a HsForAllTy!).+  NB: this implicit quantification is purely lexical: we bind any+      type or kind variables that are not in scope. The type checker+      may subsequently quantify over further kind variables.++* HsWildCardBndrs is a wrapper that binds the wildcard variables+  of the wrapped thing.  It is filled in by the renamer+     f :: _a -> _+  The enclosing HsWildCardBndrs binds the wildcards _a and _.++* The explicit presence of these wrappers specifies, in the HsSyn,+  exactly where implicit quantification is allowed, and where+  wildcards are allowed.++* LHsQTyVars is used in data/class declarations, where the user gives+  explicit *type* variable bindings, but we need to implicitly bind+  *kind* variables.  For example+      class C (a :: k -> *) where ...+  The 'k' is implicitly bound in the hsq_tvs field of LHsQTyVars++Note [The wildcard story for types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Types can have wildcards in them, to support partial type signatures,+like       f :: Int -> (_ , _a) -> _a++A wildcard in a type can be++  * An anonymous wildcard,+        written '_'+    In HsType this is represented by HsWildCardTy.+    The renamer leaves it untouched, and it is later given fresh meta tyvars in+    the typechecker.++  * A named wildcard,+        written '_a', '_foo', etc+    In HsType this is represented by (HsTyVar "_a")+    i.e. a perfectly ordinary type variable that happens+         to start with an underscore++Note carefully:++* When NamedWildCards is off, type variables that start with an+  underscore really /are/ ordinary type variables.  And indeed, even+  when NamedWildCards is on you can bind _a explicitly as an ordinary+  type variable:+        data T _a _b = MkT _b _a+  Or even:+        f :: forall _a. _a -> _b+  Here _a is an ordinary forall'd binder, but (With NamedWildCards)+  _b is a named wildcard.  (See the comments in #10982)++* Named wildcards are bound by the HsWildCardBndrs construct, which wraps+  types that are allowed to have wildcards. Unnamed wildcards however are left+  unchanged until typechecking, where we give them fresh wild tyavrs and+  determine whether or not to emit hole constraints on each wildcard+  (we don't if it's a visible type/kind argument or a type family pattern).+  See related notes Note [Wildcards in visible kind application]+  and Note [Wildcards in visible type application] in TcHsType.hs++* After type checking is done, we report what types the wildcards+  got unified with.++Note [Ordering of implicit variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Since the advent of -XTypeApplications, GHC makes promises about the ordering+of implicit variable quantification. Specifically, we offer that implicitly+quantified variables (such as those in const :: a -> b -> a, without a `forall`)+will occur in left-to-right order of first occurrence. Here are a few examples:++  const :: a -> b -> a       -- forall a b. ...+  f :: Eq a => b -> a -> a   -- forall a b. ...  contexts are included++  type a <-< b = b -> a+  g :: a <-< b               -- forall a b. ...  type synonyms matter++  class Functor f where+    fmap :: (a -> b) -> f a -> f b   -- forall f a b. ...+    -- The f is quantified by the class, so only a and b are considered in fmap++This simple story is complicated by the possibility of dependency: all variables+must come after any variables mentioned in their kinds.++  typeRep :: Typeable a => TypeRep (a :: k)   -- forall k a. ...++The k comes first because a depends on k, even though the k appears later than+the a in the code. Thus, GHC does a *stable topological sort* on the variables.+By "stable", we mean that any two variables who do not depend on each other+preserve their existing left-to-right ordering.++Implicitly bound variables are collected by the extract- family of functions+(extractHsTysRdrTyVars, extractHsTyVarBndrsKVs, etc.) in RnTypes.+These functions thus promise to keep left-to-right ordering.+Look for pointers to this note to see the places where the action happens.++Note that we also maintain this ordering in kind signatures. Even though+there's no visible kind application (yet), having implicit variables be+quantified in left-to-right order in kind signatures is nice since:++* It's consistent with the treatment for type signatures.+* It can affect how types are displayed with -fprint-explicit-kinds (see+  #15568 for an example), which is a situation where knowing the order in+  which implicit variables are quantified can be useful.+* In the event that visible kind application is implemented, the order in+  which we would expect implicit variables to be ordered in kinds will have+  already been established.+-}++-- | Located Haskell Context+type LHsContext pass = Located (HsContext pass)+      -- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnUnit'+      -- For details on above see note [Api annotations] in ApiAnnotation++noLHsContext :: LHsContext pass+-- Use this when there is no context in the original program+-- It would really be more kosher to use a Maybe, to distinguish+--     class () => C a where ...+-- from+--     class C a where ...+noLHsContext = noLoc []++-- | Haskell Context+type HsContext pass = [LHsType pass]++-- | Located Haskell Type+type LHsType pass = Located (HsType pass)+      -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when+      --   in a list++      -- For details on above see note [Api annotations] in ApiAnnotation++-- | Haskell Kind+type HsKind pass = HsType pass++-- | Located Haskell Kind+type LHsKind pass = Located (HsKind pass)+      -- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'++      -- For details on above see note [Api annotations] in ApiAnnotation++--------------------------------------------------+--             LHsQTyVars+--  The explicitly-quantified binders in a data/type declaration++-- | Located Haskell Type Variable Binder+type LHsTyVarBndr pass = Located (HsTyVarBndr pass)+                         -- See Note [HsType binders]++-- | Located Haskell Quantified Type Variables+data LHsQTyVars pass   -- See Note [HsType binders]+  = HsQTvs { hsq_ext :: XHsQTvs pass++           , hsq_explicit :: [LHsTyVarBndr pass]+                -- Explicit variables, written by the user+                -- See Note [HsForAllTy tyvar binders]+    }+  | XLHsQTyVars (XXLHsQTyVars pass)++type HsQTvsRn = [Name]  -- Implicit variables+  -- For example, in   data T (a :: k1 -> k2) = ...+  -- the 'a' is explicit while 'k1', 'k2' are implicit++type instance XHsQTvs GhcPs = NoExt+type instance XHsQTvs GhcRn = HsQTvsRn+type instance XHsQTvs GhcTc = HsQTvsRn++type instance XXLHsQTyVars  (GhcPass _) = NoExt++mkHsQTvs :: [LHsTyVarBndr GhcPs] -> LHsQTyVars GhcPs+mkHsQTvs tvs = HsQTvs { hsq_ext = noExt, hsq_explicit = tvs }++hsQTvExplicit :: LHsQTyVars pass -> [LHsTyVarBndr pass]+hsQTvExplicit = hsq_explicit++emptyLHsQTvs :: LHsQTyVars GhcRn+emptyLHsQTvs = HsQTvs { hsq_ext = [], hsq_explicit = [] }++isEmptyLHsQTvs :: LHsQTyVars GhcRn -> Bool+isEmptyLHsQTvs (HsQTvs { hsq_ext = imp, hsq_explicit = exp })+  = null imp && null exp+isEmptyLHsQTvs _ = False++------------------------------------------------+--            HsImplicitBndrs+-- Used to quantify the implicit binders of a type+--    * Implicit binders of a type signature (LHsSigType/LHsSigWcType)+--    * Patterns in a type/data family instance (HsTyPats)++-- | Haskell Implicit Binders+data HsImplicitBndrs pass thing   -- See Note [HsType binders]+  = HsIB { hsib_ext  :: XHsIB pass thing -- after renamer: [Name]+                                         -- Implicitly-bound kind & type vars+                                         -- Order is important; see+                                         -- Note [Ordering of implicit variables]+                                         -- in RnTypes++         , hsib_body :: thing            -- Main payload (type or list of types)+    }+  | XHsImplicitBndrs (XXHsImplicitBndrs pass thing)++type instance XHsIB              GhcPs _ = NoExt+type instance XHsIB              GhcRn _ = [Name]+type instance XHsIB              GhcTc _ = [Name]++type instance XXHsImplicitBndrs  (GhcPass _) _ = NoExt++-- | Haskell Wildcard Binders+data HsWildCardBndrs pass thing+    -- See Note [HsType binders]+    -- See Note [The wildcard story for types]+  = HsWC { hswc_ext :: XHsWC pass thing+                -- after the renamer+                -- Wild cards, only named+                -- See Note [Wildcards in visible kind application]++         , hswc_body :: thing+                -- Main payload (type or list of types)+                -- If there is an extra-constraints wildcard,+                -- it's still there in the hsc_body.+    }+  | XHsWildCardBndrs (XXHsWildCardBndrs pass thing)++type instance XHsWC              GhcPs b = NoExt+type instance XHsWC              GhcRn b = [Name]+type instance XHsWC              GhcTc b = [Name]++type instance XXHsWildCardBndrs  (GhcPass _) b = NoExt++-- | Located Haskell Signature Type+type LHsSigType   pass = HsImplicitBndrs pass (LHsType pass)    -- Implicit only++-- | Located Haskell Wildcard Type+type LHsWcType    pass = HsWildCardBndrs pass (LHsType pass)    -- Wildcard only++-- | Located Haskell Signature Wildcard Type+type LHsSigWcType pass = HsWildCardBndrs pass (LHsSigType pass) -- Both++-- See Note [Representing type signatures]++hsImplicitBody :: HsImplicitBndrs pass thing -> thing+hsImplicitBody (HsIB { hsib_body = body }) = body+hsImplicitBody (XHsImplicitBndrs _) = panic "hsImplicitBody"++hsSigType :: LHsSigType pass -> LHsType pass+hsSigType = hsImplicitBody++hsSigWcType :: LHsSigWcType pass -> LHsType pass+hsSigWcType sig_ty = hsib_body (hswc_body sig_ty)++dropWildCards :: LHsSigWcType pass -> LHsSigType pass+-- Drop the wildcard part of a LHsSigWcType+dropWildCards sig_ty = hswc_body sig_ty++{- Note [Representing type signatures]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+HsSigType is used to represent an explicit user type signature+such as   f :: a -> a+     or   g (x :: a -> a) = x++A HsSigType is just a HsImplicitBndrs wrapping a LHsType.+ * The HsImplicitBndrs binds the /implicitly/ quantified tyvars+ * The LHsType binds the /explicitly/ quantified tyvars++E.g. For a signature like+   f :: forall (a::k). blah+we get+   HsIB { hsib_vars = [k]+        , hsib_body = HsForAllTy { hst_bndrs = [(a::*)]+                                 , hst_body = blah }+The implicit kind variable 'k' is bound by the HsIB;+the explicitly forall'd tyvar 'a' is bound by the HsForAllTy+-}++mkHsImplicitBndrs :: thing -> HsImplicitBndrs GhcPs thing+mkHsImplicitBndrs x = HsIB { hsib_ext  = noExt+                           , hsib_body = x }++mkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing+mkHsWildCardBndrs x = HsWC { hswc_body = x+                           , hswc_ext  = noExt }++-- Add empty binders.  This is a bit suspicious; what if+-- the wrapped thing had free type variables?+mkEmptyImplicitBndrs :: thing -> HsImplicitBndrs GhcRn thing+mkEmptyImplicitBndrs x = HsIB { hsib_ext = []+                              , hsib_body = x }++mkEmptyWildCardBndrs :: thing -> HsWildCardBndrs GhcRn thing+mkEmptyWildCardBndrs x = HsWC { hswc_body = x+                              , hswc_ext  = [] }+++--------------------------------------------------+-- | These names are used early on to store the names of implicit+-- parameters.  They completely disappear after type-checking.+newtype HsIPName = HsIPName FastString+  deriving( Eq, Data )++hsIPNameFS :: HsIPName -> FastString+hsIPNameFS (HsIPName n) = n++instance Outputable HsIPName where+    ppr (HsIPName n) = char '?' <> ftext n -- Ordinary implicit parameters++instance OutputableBndr HsIPName where+    pprBndr _ n   = ppr n         -- Simple for now+    pprInfixOcc  n = ppr n+    pprPrefixOcc n = ppr n++--------------------------------------------------++-- | Haskell Type Variable Binder+data HsTyVarBndr pass+  = UserTyVar        -- no explicit kinding+         (XUserTyVar pass)+         (Located (IdP pass))+        -- See Note [Located RdrNames] in HsExpr+  | KindedTyVar+         (XKindedTyVar pass)+         (Located (IdP pass))+         (LHsKind pass)  -- The user-supplied kind signature+        -- ^+        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',+        --          'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnClose'++        -- For details on above see note [Api annotations] in ApiAnnotation++  | XTyVarBndr+      (XXTyVarBndr pass)++type instance XUserTyVar    (GhcPass _) = NoExt+type instance XKindedTyVar  (GhcPass _) = NoExt+type instance XXTyVarBndr   (GhcPass _) = NoExt++-- | Does this 'HsTyVarBndr' come with an explicit kind annotation?+isHsKindedTyVar :: HsTyVarBndr pass -> Bool+isHsKindedTyVar (UserTyVar {})   = False+isHsKindedTyVar (KindedTyVar {}) = True+isHsKindedTyVar (XTyVarBndr{})   = panic "isHsKindedTyVar"++-- | Do all type variables in this 'LHsQTyVars' come with kind annotations?+hsTvbAllKinded :: LHsQTyVars pass -> Bool+hsTvbAllKinded = all (isHsKindedTyVar . unLoc) . hsQTvExplicit++-- | Haskell Type+data HsType pass+  = HsForAllTy   -- See Note [HsType binders]+      { hst_xforall :: XForAllTy pass+      , hst_fvf     :: ForallVisFlag -- Is this `forall a -> {...}` or+                                     --         `forall a. {...}`?+      , hst_bndrs   :: [LHsTyVarBndr pass]+                                       -- Explicit, user-supplied 'forall a b c'+      , hst_body    :: LHsType pass      -- body type+      }+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForall',+      --         'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'+      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsQualTy   -- See Note [HsType binders]+      { hst_xqual :: XQualTy pass+      , hst_ctxt  :: LHsContext pass       -- Context C => blah+      , hst_body  :: LHsType pass }++  | HsTyVar  (XTyVar pass)+              PromotionFlag    -- Whether explicitly promoted,+                               -- for the pretty printer+             (Located (IdP pass))+                  -- Type variable, type constructor, or data constructor+                  -- see Note [Promotions (HsTyVar)]+                  -- See Note [Located RdrNames] in HsExpr+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsAppTy             (XAppTy pass)+                        (LHsType pass)+                        (LHsType pass)+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsAppKindTy         (XAppKindTy pass) -- type level type app+                        (LHsType pass)+                        (LHsKind pass)++  | HsFunTy             (XFunTy pass)+                        (LHsType pass)   -- function type+                        (LHsType pass)+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow',++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsListTy            (XListTy pass)+                        (LHsType pass)  -- Element type+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,+      --         'ApiAnnotation.AnnClose' @']'@++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsTupleTy           (XTupleTy pass)+                        HsTupleSort+                        [LHsType pass]  -- Element types (length gives arity)+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(' or '(#'@,+    --         'ApiAnnotation.AnnClose' @')' or '#)'@++    -- For details on above see note [Api annotations] in ApiAnnotation++  | HsSumTy             (XSumTy pass)+                        [LHsType pass]  -- Element types (length gives arity)+    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(#'@,+    --         'ApiAnnotation.AnnClose' '#)'@++    -- For details on above see note [Api annotations] in ApiAnnotation++  | HsOpTy              (XOpTy pass)+                        (LHsType pass) (Located (IdP pass)) (LHsType pass)+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsParTy             (XParTy pass)+                        (LHsType pass)   -- See Note [Parens in HsSyn] in HsExpr+        -- Parenthesis preserved for the precedence re-arrangement in RnTypes+        -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,+      --         'ApiAnnotation.AnnClose' @')'@++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsIParamTy          (XIParamTy pass)+                        (Located HsIPName) -- (?x :: ty)+                        (LHsType pass)   -- Implicit parameters as they occur in+                                         -- contexts+      -- ^+      -- > (?x :: ty)+      --+      -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsStarTy            (XStarTy pass)+                        Bool             -- Is this the Unicode variant?+                                         -- Note [HsStarTy]+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None++  | HsKindSig           (XKindSig pass)+                        (LHsType pass)  -- (ty :: kind)+                        (LHsKind pass)  -- A type with a kind signature+      -- ^+      -- > (ty :: kind)+      --+      -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,+      --         'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose' @')'@++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsSpliceTy          (XSpliceTy pass)+                        (HsSplice pass)   -- Includes quasi-quotes+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@,+      --         'ApiAnnotation.AnnClose' @')'@++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsDocTy             (XDocTy pass)+                        (LHsType pass) LHsDocString -- A documented type+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsBangTy    (XBangTy pass)+                HsSrcBang (LHsType pass)   -- Bang-style type annotations+      -- ^ - 'ApiAnnotation.AnnKeywordId' :+      --         'ApiAnnotation.AnnOpen' @'{-\# UNPACK' or '{-\# NOUNPACK'@,+      --         'ApiAnnotation.AnnClose' @'#-}'@+      --         'ApiAnnotation.AnnBang' @\'!\'@++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsRecTy     (XRecTy pass)+                [LConDeclField pass]    -- Only in data type declarations+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,+      --         'ApiAnnotation.AnnClose' @'}'@++      -- For details on above see note [Api annotations] in ApiAnnotation++  -- | HsCoreTy (XCoreTy pass) Type -- An escape hatch for tunnelling a *closed*+  --                                -- Core Type through HsSyn.+  --     -- ^ - 'ApiAnnotation.AnnKeywordId' : None++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsExplicitListTy       -- A promoted explicit list+        (XExplicitListTy pass)+        PromotionFlag      -- whether explcitly promoted, for pretty printer+        [LHsType pass]+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'["@,+      --         'ApiAnnotation.AnnClose' @']'@++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsExplicitTupleTy      -- A promoted explicit tuple+        (XExplicitTupleTy pass)+        [LHsType pass]+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'("@,+      --         'ApiAnnotation.AnnClose' @')'@++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsTyLit (XTyLit pass) HsTyLit      -- A promoted numeric literal.+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None++      -- For details on above see note [Api annotations] in ApiAnnotation++  | HsWildCardTy (XWildCardTy pass)  -- A type wildcard+      -- See Note [The wildcard story for types]+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None++      -- For details on above see note [Api annotations] in ApiAnnotation++  -- For adding new constructors via Trees that Grow+  | XHsType+      (XXType pass)++data NewHsTypeX+  = NHsCoreTy Type -- An escape hatch for tunnelling a *closed*+                   -- Core Type through HsSyn.+    deriving Data+      -- ^ - 'ApiAnnotation.AnnKeywordId' : None++instance Outputable NewHsTypeX where+  ppr (NHsCoreTy ty) = ppr ty++type instance XForAllTy        (GhcPass _) = NoExt+type instance XQualTy          (GhcPass _) = NoExt+type instance XTyVar           (GhcPass _) = NoExt+type instance XAppTy           (GhcPass _) = NoExt+type instance XFunTy           (GhcPass _) = NoExt+type instance XListTy          (GhcPass _) = NoExt+type instance XTupleTy         (GhcPass _) = NoExt+type instance XSumTy           (GhcPass _) = NoExt+type instance XOpTy            (GhcPass _) = NoExt+type instance XParTy           (GhcPass _) = NoExt+type instance XIParamTy        (GhcPass _) = NoExt+type instance XStarTy          (GhcPass _) = NoExt+type instance XKindSig         (GhcPass _) = NoExt++type instance XAppKindTy       (GhcPass _) = SrcSpan -- Where the `@` lives++type instance XSpliceTy        GhcPs = NoExt+type instance XSpliceTy        GhcRn = NoExt+type instance XSpliceTy        GhcTc = Kind++type instance XDocTy           (GhcPass _) = NoExt+type instance XBangTy          (GhcPass _) = NoExt+type instance XRecTy           (GhcPass _) = NoExt++type instance XExplicitListTy  GhcPs = NoExt+type instance XExplicitListTy  GhcRn = NoExt+type instance XExplicitListTy  GhcTc = Kind++type instance XExplicitTupleTy GhcPs = NoExt+type instance XExplicitTupleTy GhcRn = NoExt+type instance XExplicitTupleTy GhcTc = [Kind]++type instance XTyLit           (GhcPass _) = NoExt++type instance XWildCardTy      (GhcPass _) = NoExt++type instance XXType         (GhcPass _) = NewHsTypeX+++-- Note [Literal source text] in BasicTypes for SourceText fields in+-- the following+-- | Haskell Type Literal+data HsTyLit+  = HsNumTy SourceText Integer+  | HsStrTy SourceText FastString+    deriving Data+++{-+Note [HsForAllTy tyvar binders]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+After parsing:+  * Implicit => empty+    Explicit => the variables the user wrote++After renaming+  * Implicit => the *type* variables free in the type+    Explicit => the variables the user wrote (renamed)++Qualified currently behaves exactly as Implicit,+but it is deprecated to use it for implicit quantification.+In this case, GHC 7.10 gives a warning; see+Note [Context quantification] in RnTypes, and #4426.+In GHC 8.0, Qualified will no longer bind variables+and this will become an error.++The kind variables bound in the hsq_implicit field come both+  a) from the kind signatures on the kind vars (eg k1)+  b) from the scope of the forall (eg k2)+Example:   f :: forall (a::k1) b. T a (b::k2)+++Note [Unit tuples]+~~~~~~~~~~~~~~~~~~+Consider the type+    type instance F Int = ()+We want to parse that "()"+    as HsTupleTy HsBoxedOrConstraintTuple [],+NOT as HsTyVar unitTyCon++Why? Because F might have kind (* -> Constraint), so we when parsing we+don't know if that tuple is going to be a constraint tuple or an ordinary+unit tuple.  The HsTupleSort flag is specifically designed to deal with+that, but it has to work for unit tuples too.++Note [Promotions (HsTyVar)]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+HsTyVar: A name in a type or kind.+  Here are the allowed namespaces for the name.+    In a type:+      Var: not allowed+      Data: promoted data constructor+      Tv: type variable+      TcCls before renamer: type constructor, class constructor, or promoted data constructor+      TcCls after renamer: type constructor or class constructor+    In a kind:+      Var, Data: not allowed+      Tv: kind variable+      TcCls: kind constructor or promoted type constructor++  The 'Promoted' field in an HsTyVar captures whether the type was promoted in+  the source code by prefixing an apostrophe.++Note [HsStarTy]+~~~~~~~~~~~~~~~+When the StarIsType extension is enabled, we want to treat '*' and its Unicode+variant identically to 'Data.Kind.Type'. Unfortunately, doing so in the parser+would mean that when we pretty-print it back, we don't know whether the user+wrote '*' or 'Type', and lose the parse/ppr roundtrip property.++As a workaround, we parse '*' as HsStarTy (if it stands for 'Data.Kind.Type')+and then desugar it to 'Data.Kind.Type' in the typechecker (see tc_hs_type).+When '*' is a regular type operator (StarIsType is disabled), HsStarTy is not+involved.+++Note [Promoted lists and tuples]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Notice the difference between+   HsListTy    HsExplicitListTy+   HsTupleTy   HsExplicitListTupleTy++E.g.    f :: [Int]                      HsListTy++        g3  :: T '[]                   All these use+        g2  :: T '[True]                  HsExplicitListTy+        g1  :: T '[True,False]+        g1a :: T [True,False]             (can omit ' where unambiguous)++  kind of T :: [Bool] -> *        This kind uses HsListTy!++E.g.    h :: (Int,Bool)                 HsTupleTy; f is a pair+        k :: S '(True,False)            HsExplicitTypleTy; S is indexed by+                                           a type-level pair of booleans+        kind of S :: (Bool,Bool) -> *   This kind uses HsExplicitTupleTy++Note [Distinguishing tuple kinds]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Apart from promotion, tuples can have one of three different kinds:++        x :: (Int, Bool)                -- Regular boxed tuples+        f :: Int# -> (# Int#, Int# #)   -- Unboxed tuples+        g :: (Eq a, Ord a) => a         -- Constraint tuples++For convenience, internally we use a single constructor for all of these,+namely HsTupleTy, but keep track of the tuple kind (in the first argument to+HsTupleTy, a HsTupleSort). We can tell if a tuple is unboxed while parsing,+because of the #. However, with -XConstraintKinds we can only distinguish+between constraint and boxed tuples during type checking, in general. Hence the+four constructors of HsTupleSort:++        HsUnboxedTuple                  -> Produced by the parser+        HsBoxedTuple                    -> Certainly a boxed tuple+        HsConstraintTuple               -> Certainly a constraint tuple+        HsBoxedOrConstraintTuple        -> Could be a boxed or a constraint+                                        tuple. Produced by the parser only,+                                        disappears after type checking+-}++-- | Haskell Tuple Sort+data HsTupleSort = HsUnboxedTuple+                 | HsBoxedTuple+                 | HsConstraintTuple+                 | HsBoxedOrConstraintTuple+                 deriving Data++-- | Located Constructor Declaration Field+type LConDeclField pass = Located (ConDeclField pass)+      -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when+      --   in a list++      -- For details on above see note [Api annotations] in ApiAnnotation++-- | Constructor Declaration Field+data ConDeclField pass  -- Record fields have Haddoc docs on them+  = ConDeclField { cd_fld_ext  :: XConDeclField pass,+                   cd_fld_names :: [LFieldOcc pass],+                                   -- ^ See Note [ConDeclField passs]+                   cd_fld_type :: LBangType pass,+                   cd_fld_doc  :: Maybe LHsDocString }+      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'++      -- For details on above see note [Api annotations] in ApiAnnotation+  | XConDeclField (XXConDeclField pass)++type instance XConDeclField  (GhcPass _) = NoExt+type instance XXConDeclField (GhcPass _) = NoExt++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (ConDeclField p) where+  ppr (ConDeclField _ fld_n fld_ty _) = ppr fld_n <+> dcolon <+> ppr fld_ty+  ppr (XConDeclField x) = ppr x++-- HsConDetails is used for patterns/expressions *and* for data type+-- declarations+-- | Haskell Constructor Details+data HsConDetails arg rec+  = PrefixCon [arg]             -- C p1 p2 p3+  | RecCon    rec               -- C { x = p1, y = p2 }+  | InfixCon  arg arg           -- p1 `C` p2+  deriving Data++instance (Outputable arg, Outputable rec)+         => Outputable (HsConDetails arg rec) where+  ppr (PrefixCon args) = text "PrefixCon" <+> ppr args+  ppr (RecCon rec)     = text "RecCon:" <+> ppr rec+  ppr (InfixCon l r)   = text "InfixCon:" <+> ppr [l, r]++{-+Note [ConDeclField passs]+~~~~~~~~~~~~~~~~~~~~~~~~~++A ConDeclField contains a list of field occurrences: these always+include the field label as the user wrote it.  After the renamer, it+will additionally contain the identity of the selector function in the+second component.++Due to DuplicateRecordFields, the OccName of the selector function+may have been mangled, which is why we keep the original field label+separately.  For example, when DuplicateRecordFields is enabled++    data T = MkT { x :: Int }++gives++    ConDeclField { cd_fld_names = [L _ (FieldOcc "x" $sel:x:MkT)], ... }.+-}++-----------------------+-- A valid type must have a for-all at the top of the type, or of the fn arg+-- types++---------------------+hsWcScopedTvs :: LHsSigWcType GhcRn -> [Name]+-- Get the lexically-scoped type variables of a HsSigType+--  - the explicitly-given forall'd type variables+--  - the implicitly-bound kind variables+--  - the named wildcars; see Note [Scoping of named wildcards]+-- because they scope in the same way+hsWcScopedTvs sig_ty+  | HsWC { hswc_ext = nwcs, hswc_body = sig_ty1 }  <- sig_ty+  , HsIB { hsib_ext = vars+         , hsib_body = sig_ty2 } <- sig_ty1+  = case sig_ty2 of+      L _ (HsForAllTy { hst_bndrs = tvs }) -> vars ++ nwcs +++                                              hsLTyVarNames tvs+               -- include kind variables only if the type is headed by forall+               -- (this is consistent with GHC 7 behaviour)+      _                                    -> nwcs+hsWcScopedTvs (HsWC _ (XHsImplicitBndrs _)) = panic "hsWcScopedTvs"+hsWcScopedTvs (XHsWildCardBndrs _) = panic "hsWcScopedTvs"++hsScopedTvs :: LHsSigType GhcRn -> [Name]+-- Same as hsWcScopedTvs, but for a LHsSigType+hsScopedTvs sig_ty+  | HsIB { hsib_ext = vars+         , hsib_body = sig_ty2 } <- sig_ty+  , L _ (HsForAllTy { hst_bndrs = tvs }) <- sig_ty2+  = vars ++ hsLTyVarNames tvs+  | otherwise+  = []++{- Note [Scoping of named wildcards]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+  f :: _a -> _a+  f x = let g :: _a -> _a+            g = ...+        in ...++Currently, for better or worse, the "_a" variables are all the same. So+although there is no explicit forall, the "_a" scopes over the definition.+I don't know if this is a good idea, but there it is.+-}++---------------------+hsTyVarName :: HsTyVarBndr pass -> IdP pass+hsTyVarName (UserTyVar _ (L _ n))     = n+hsTyVarName (KindedTyVar _ (L _ n) _) = n+hsTyVarName (XTyVarBndr{}) = panic "hsTyVarName"++hsLTyVarName :: LHsTyVarBndr pass -> IdP pass+hsLTyVarName = hsTyVarName . unLoc++hsLTyVarNames :: [LHsTyVarBndr pass] -> [IdP pass]+hsLTyVarNames = map hsLTyVarName++hsExplicitLTyVarNames :: LHsQTyVars pass -> [IdP pass]+-- Explicit variables only+hsExplicitLTyVarNames qtvs = map hsLTyVarName (hsQTvExplicit qtvs)++hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name]+-- All variables+hsAllLTyVarNames (HsQTvs { hsq_ext = kvs+                         , hsq_explicit = tvs })+  = kvs ++ hsLTyVarNames tvs+hsAllLTyVarNames (XLHsQTyVars _) = panic "hsAllLTyVarNames"++hsLTyVarLocName :: LHsTyVarBndr pass -> Located (IdP pass)+hsLTyVarLocName = onHasSrcSpan hsTyVarName++hsLTyVarLocNames :: LHsQTyVars pass -> [Located (IdP pass)]+hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvExplicit qtvs)++-- | Convert a LHsTyVarBndr to an equivalent LHsType.+hsLTyVarBndrToType :: LHsTyVarBndr (GhcPass p) -> LHsType (GhcPass p)+hsLTyVarBndrToType = onHasSrcSpan cvt+  where cvt (UserTyVar _ n) = HsTyVar noExt NotPromoted n+        cvt (KindedTyVar _ (L name_loc n) kind)+          = HsKindSig noExt+                   (L name_loc (HsTyVar noExt NotPromoted (L name_loc n))) kind+        cvt (XTyVarBndr{}) = panic "hsLTyVarBndrToType"++-- | Convert a LHsTyVarBndrs to a list of types.+-- Works on *type* variable only, no kind vars.+hsLTyVarBndrsToTypes :: LHsQTyVars (GhcPass p) -> [LHsType (GhcPass p)]+hsLTyVarBndrsToTypes (HsQTvs { hsq_explicit = tvbs }) = map hsLTyVarBndrToType tvbs+hsLTyVarBndrsToTypes (XLHsQTyVars _) = panic "hsLTyVarBndrsToTypes"++---------------------+ignoreParens :: LHsType pass -> LHsType pass+ignoreParens (L _ (HsParTy _ ty)) = ignoreParens ty+ignoreParens ty                   = ty++isLHsForAllTy :: LHsType p -> Bool+isLHsForAllTy (L _ (HsForAllTy {})) = True+isLHsForAllTy _                     = False++{-+************************************************************************+*                                                                      *+                Building types+*                                                                      *+************************************************************************+-}++mkAnonWildCardTy :: HsType GhcPs+mkAnonWildCardTy = HsWildCardTy noExt++mkHsOpTy :: LHsType (GhcPass p) -> Located (IdP (GhcPass p))+         -> LHsType (GhcPass p) -> HsType (GhcPass p)+mkHsOpTy ty1 op ty2 = HsOpTy noExt ty1 op ty2++mkHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)+mkHsAppTy t1 t2+  = addCLoc t1 t2 (HsAppTy noExt t1 (parenthesizeHsType appPrec t2))++mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]+           -> LHsType (GhcPass p)+mkHsAppTys = foldl' mkHsAppTy++mkHsAppKindTy :: XAppKindTy (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)+              -> LHsType (GhcPass p)+mkHsAppKindTy ext ty k+  = addCLoc ty k (HsAppKindTy ext ty k)++{-+************************************************************************+*                                                                      *+                Decomposing HsTypes+*                                                                      *+************************************************************************+-}++---------------------------------+-- splitHsFunType decomposes a type (t1 -> t2 ... -> tn)+-- Breaks up any parens in the result type:+--      splitHsFunType (a -> (b -> c)) = ([a,b], c)+-- Also deals with (->) t1 t2; that is why it only works on LHsType Name+--   (see #9096)+splitHsFunType :: LHsType GhcRn -> ([LHsType GhcRn], LHsType GhcRn)+splitHsFunType (L _ (HsParTy _ ty))+  = splitHsFunType ty++splitHsFunType (L _ (HsFunTy _ x y))+  | (args, res) <- splitHsFunType y+  = (x:args, res)+{- This is not so correct, because it won't work with visible kind app, in case+  someone wants to write '(->) @k1 @k2 t1 t2'. Fixing this would require changing+  ConDeclGADT abstract syntax -}+splitHsFunType orig_ty@(L _ (HsAppTy _ t1 t2))+  = go t1 [t2]+  where  -- Look for (->) t1 t2, possibly with parenthesisation+    go (L _ (HsTyVar _ _ (L _ fn))) tys | fn == funTyConName+                                 , [t1,t2] <- tys+                                 , (args, res) <- splitHsFunType t2+                                 = (t1:args, res)+    go (L _ (HsAppTy _ t1 t2)) tys = go t1 (t2:tys)+    go (L _ (HsParTy _ ty))    tys = go ty tys+    go _                       _   = ([], orig_ty)  -- Failure to match++splitHsFunType other = ([], other)++-- retrieve the name of the "head" of a nested type application+-- somewhat like splitHsAppTys, but a little more thorough+-- used to examine the result of a GADT-like datacon, so it doesn't handle+-- *all* cases (like lists, tuples, (~), etc.)+hsTyGetAppHead_maybe :: LHsType (GhcPass p)+                     -> Maybe (Located (IdP (GhcPass p)))+hsTyGetAppHead_maybe = go+  where+    go (L _ (HsTyVar _ _ ln))          = Just ln+    go (L _ (HsAppTy _ l _))           = go l+    go (L _ (HsAppKindTy _ t _))       = go t+    go (L _ (HsOpTy _ _ (L loc n) _))  = Just (L loc n)+    go (L _ (HsParTy _ t))             = go t+    go (L _ (HsKindSig _ t _))         = go t+    go _                               = Nothing++------------------------------------------------------------+-- Arguments in an expression/type after splitting+data HsArg tm ty+  = HsValArg tm   -- Argument is an ordinary expression     (f arg)+  | HsTypeArg SrcSpan ty -- Argument is a visible type application (f @ty)+                         -- SrcSpan is location of the `@`+  | HsArgPar SrcSpan -- See Note [HsArgPar]++numVisibleArgs :: [HsArg tm ty] -> Arity+numVisibleArgs = count is_vis+  where is_vis (HsValArg _) = True+        is_vis _            = False++-- type level equivalent+type LHsTypeArg p = HsArg (LHsType p) (LHsKind p)++instance (Outputable tm, Outputable ty) => Outputable (HsArg tm ty) where+  ppr (HsValArg tm)    = ppr tm+  ppr (HsTypeArg _ ty) = char '@' <> ppr ty+  ppr (HsArgPar sp)    = text "HsArgPar"  <+> ppr sp+{-+Note [HsArgPar]+A HsArgPar indicates that everything to the left of this in the argument list is+enclosed in parentheses together with the function itself. It is necessary so+that we can recreate the parenthesis structure in the original source after+typechecking the arguments.++The SrcSpan is the span of the original HsPar++((f arg1) arg2 arg3) results in an input argument list of+[HsValArg arg1, HsArgPar span1, HsValArg arg2, HsValArg arg3, HsArgPar span2]++-}++--------------------------------++-- | Decompose a pattern synonym type signature into its constituent parts.+--+-- Note that this function looks through parentheses, so it will work on types+-- such as @(forall a. <...>)@. The downside to this is that it is not+-- generally possible to take the returned types and reconstruct the original+-- type (parentheses and all) from them.+splitLHsPatSynTy :: LHsType pass+                 -> ( [LHsTyVarBndr pass]    -- universals+                    , LHsContext pass        -- required constraints+                    , [LHsTyVarBndr pass]    -- existentials+                    , LHsContext pass        -- provided constraints+                    , LHsType pass)          -- body type+splitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4)+  where+    (univs, ty1) = splitLHsForAllTyInvis ty+    (reqs,  ty2) = splitLHsQualTy ty1+    (exis,  ty3) = splitLHsForAllTyInvis ty2+    (provs, ty4) = splitLHsQualTy ty3++-- | Decompose a sigma type (of the form @forall <tvs>. context => body@)+-- into its constituent parts.+--+-- Note that this function looks through parentheses, so it will work on types+-- such as @(forall a. <...>)@. The downside to this is that it is not+-- generally possible to take the returned types and reconstruct the original+-- type (parentheses and all) from them.+splitLHsSigmaTy :: LHsType pass+                -> ([LHsTyVarBndr pass], LHsContext pass, LHsType pass)+splitLHsSigmaTy ty+  | (tvs, ty1)  <- splitLHsForAllTy ty+  , (ctxt, ty2) <- splitLHsQualTy ty1+  = (tvs, ctxt, ty2)++-- | Like 'splitLHsSigmaTy', but only splits type variable binders that were+-- quantified invisibly (e.g., @forall a.@, with a dot).+--+-- This function is used to split apart certain types, such as instance+-- declaration types, which disallow visible @forall@s. For instance, if GHC+-- split apart the @forall@ in @instance forall a -> Show (Blah a)@, then that+-- declaration would mistakenly be accepted!+--+-- Note that this function looks through parentheses, so it will work on types+-- such as @(forall a. <...>)@. The downside to this is that it is not+-- generally possible to take the returned types and reconstruct the original+-- type (parentheses and all) from them.+splitLHsSigmaTyInvis :: LHsType pass+                     -> ([LHsTyVarBndr pass], LHsContext pass, LHsType pass)+splitLHsSigmaTyInvis ty+  | (tvs,  ty1) <- splitLHsForAllTyInvis ty+  , (ctxt, ty2) <- splitLHsQualTy ty1+  = (tvs, ctxt, ty2)++-- | Decompose a type of the form @forall <tvs>. body@) into its constituent+-- parts.+--+-- Note that this function looks through parentheses, so it will work on types+-- such as @(forall a. <...>)@. The downside to this is that it is not+-- generally possible to take the returned types and reconstruct the original+-- type (parentheses and all) from them.+splitLHsForAllTy :: LHsType pass -> ([LHsTyVarBndr pass], LHsType pass)+splitLHsForAllTy (L _ (HsParTy _ ty)) = splitLHsForAllTy ty+splitLHsForAllTy (L _ (HsForAllTy { hst_bndrs = tvs, hst_body = body })) = (tvs, body)+splitLHsForAllTy body              = ([], body)++-- | Like 'splitLHsForAllTy', but only splits type variable binders that+-- were quantified invisibly (e.g., @forall a.@, with a dot).+--+-- This function is used to split apart certain types, such as instance+-- declaration types, which disallow visible @forall@s. For instance, if GHC+-- split apart the @forall@ in @instance forall a -> Show (Blah a)@, then that+-- declaration would mistakenly be accepted!+--+-- Note that this function looks through parentheses, so it will work on types+-- such as @(forall a. <...>)@. The downside to this is that it is not+-- generally possible to take the returned types and reconstruct the original+-- type (parentheses and all) from them.+splitLHsForAllTyInvis :: LHsType pass -> ([LHsTyVarBndr pass], LHsType pass)+splitLHsForAllTyInvis lty@(L _ ty) =+  case ty of+    HsParTy _ ty' -> splitLHsForAllTyInvis ty'+    HsForAllTy { hst_fvf = fvf', hst_bndrs = tvs', hst_body = body' }+      |  fvf' == ForallInvis+      -> (tvs', body')+    _ -> ([], lty)++-- | Decompose a type of the form @context => body@ into its constituent parts.+--+-- Note that this function looks through parentheses, so it will work on types+-- such as @(context => <...>)@. The downside to this is that it is not+-- generally possible to take the returned types and reconstruct the original+-- type (parentheses and all) from them.+splitLHsQualTy :: LHsType pass -> (LHsContext pass, LHsType pass)+splitLHsQualTy (L _ (HsParTy _ ty)) = splitLHsQualTy ty+splitLHsQualTy (L _ (HsQualTy { hst_ctxt = ctxt, hst_body = body })) = (ctxt,     body)+splitLHsQualTy body              = (noLHsContext, body)++-- | Decompose a type class instance type (of the form+-- @forall <tvs>. context => instance_head@) into its constituent parts.+--+-- Note that this function looks through parentheses, so it will work on types+-- such as @(forall <tvs>. <...>)@. The downside to this is that it is not+-- generally possible to take the returned types and reconstruct the original+-- type (parentheses and all) from them.+splitLHsInstDeclTy :: LHsSigType GhcRn+                   -> ([Name], LHsContext GhcRn, LHsType GhcRn)+-- Split up an instance decl type, returning the pieces+splitLHsInstDeclTy (HsIB { hsib_ext = itkvs+                         , hsib_body = inst_ty })+  | (tvs, cxt, body_ty) <- splitLHsSigmaTyInvis inst_ty+  = (itkvs ++ hsLTyVarNames tvs, cxt, body_ty)+         -- Return implicitly bound type and kind vars+         -- For an instance decl, all of them are in scope+splitLHsInstDeclTy (XHsImplicitBndrs _) = panic "splitLHsInstDeclTy"++getLHsInstDeclHead :: LHsSigType pass -> LHsType pass+getLHsInstDeclHead inst_ty+  | (_tvs, _cxt, body_ty) <- splitLHsSigmaTyInvis (hsSigType inst_ty)+  = body_ty++getLHsInstDeclClass_maybe :: LHsSigType (GhcPass p)+                          -> Maybe (Located (IdP (GhcPass p)))+-- Works on (HsSigType RdrName)+getLHsInstDeclClass_maybe inst_ty+  = do { let head_ty = getLHsInstDeclHead inst_ty+       ; cls <- hsTyGetAppHead_maybe head_ty+       ; return cls }++{-+************************************************************************+*                                                                      *+                FieldOcc+*                                                                      *+************************************************************************+-}++-- | Located Field Occurrence+type LFieldOcc pass = Located (FieldOcc pass)++-- | Field Occurrence+--+-- Represents an *occurrence* of an unambiguous field.  We store+-- both the 'RdrName' the user originally wrote, and after the+-- renamer, the selector function.+data FieldOcc pass = FieldOcc { extFieldOcc     :: XCFieldOcc pass+                              , rdrNameFieldOcc :: Located RdrName+                                 -- ^ See Note [Located RdrNames] in HsExpr+                              }++  | XFieldOcc+      (XXFieldOcc pass)+deriving instance (p ~ GhcPass pass, Eq (XCFieldOcc p)) => Eq  (FieldOcc p)+deriving instance (p ~ GhcPass pass, Ord (XCFieldOcc p)) => Ord (FieldOcc p)++type instance XCFieldOcc GhcPs = NoExt+type instance XCFieldOcc GhcRn = Name+type instance XCFieldOcc GhcTc = Id++type instance XXFieldOcc (GhcPass _) = NoExt++instance Outputable (FieldOcc pass) where+  ppr = ppr . rdrNameFieldOcc++mkFieldOcc :: Located RdrName -> FieldOcc GhcPs+mkFieldOcc rdr = FieldOcc noExt rdr+++-- | Ambiguous Field Occurrence+--+-- Represents an *occurrence* of a field that is potentially+-- ambiguous after the renamer, with the ambiguity resolved by the+-- typechecker.  We always store the 'RdrName' that the user+-- originally wrote, and store the selector function after the renamer+-- (for unambiguous occurrences) or the typechecker (for ambiguous+-- occurrences).+--+-- See Note [HsRecField and HsRecUpdField] in HsPat and+-- Note [Disambiguating record fields] in TcExpr.+-- See Note [Located RdrNames] in HsExpr+data AmbiguousFieldOcc pass+  = Unambiguous (XUnambiguous pass) (Located RdrName)+  | Ambiguous   (XAmbiguous pass)   (Located RdrName)+  | XAmbiguousFieldOcc (XXAmbiguousFieldOcc pass)++type instance XUnambiguous GhcPs = NoExt+type instance XUnambiguous GhcRn = Name+type instance XUnambiguous GhcTc = Id++type instance XAmbiguous GhcPs = NoExt+type instance XAmbiguous GhcRn = NoExt+type instance XAmbiguous GhcTc = Id++type instance XXAmbiguousFieldOcc (GhcPass _) = NoExt++instance p ~ GhcPass pass => Outputable (AmbiguousFieldOcc p) where+  ppr = ppr . rdrNameAmbiguousFieldOcc++instance p ~ GhcPass pass => OutputableBndr (AmbiguousFieldOcc p) where+  pprInfixOcc  = pprInfixOcc . rdrNameAmbiguousFieldOcc+  pprPrefixOcc = pprPrefixOcc . rdrNameAmbiguousFieldOcc++mkAmbiguousFieldOcc :: Located RdrName -> AmbiguousFieldOcc GhcPs+mkAmbiguousFieldOcc rdr = Unambiguous noExt rdr++rdrNameAmbiguousFieldOcc :: AmbiguousFieldOcc (GhcPass p) -> RdrName+rdrNameAmbiguousFieldOcc (Unambiguous _ (L _ rdr)) = rdr+rdrNameAmbiguousFieldOcc (Ambiguous   _ (L _ rdr)) = rdr+rdrNameAmbiguousFieldOcc (XAmbiguousFieldOcc _)+  = panic "rdrNameAmbiguousFieldOcc"++selectorAmbiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> Id+selectorAmbiguousFieldOcc (Unambiguous sel _) = sel+selectorAmbiguousFieldOcc (Ambiguous   sel _) = sel+selectorAmbiguousFieldOcc (XAmbiguousFieldOcc _)+  = panic "selectorAmbiguousFieldOcc"++unambiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc+unambiguousFieldOcc (Unambiguous rdr sel) = FieldOcc rdr sel+unambiguousFieldOcc (Ambiguous   rdr sel) = FieldOcc rdr sel+unambiguousFieldOcc (XAmbiguousFieldOcc _) = panic "unambiguousFieldOcc"++ambiguousFieldOcc :: FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc+ambiguousFieldOcc (FieldOcc sel rdr) = Unambiguous sel rdr+ambiguousFieldOcc (XFieldOcc _) = panic "ambiguousFieldOcc"++{-+************************************************************************+*                                                                      *+\subsection{Pretty printing}+*                                                                      *+************************************************************************+-}++instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsType p) where+    ppr ty = pprHsType ty++instance Outputable HsTyLit where+    ppr = ppr_tylit++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (LHsQTyVars p) where+    ppr (HsQTvs { hsq_explicit = tvs }) = interppSP tvs+    ppr (XLHsQTyVars x) = ppr x++instance (p ~ GhcPass pass, OutputableBndrId p)+       => Outputable (HsTyVarBndr p) where+    ppr (UserTyVar _ n)     = ppr n+    ppr (KindedTyVar _ n k) = parens $ hsep [ppr n, dcolon, ppr k]+    ppr (XTyVarBndr n)      = ppr n++instance (p ~ GhcPass pass,Outputable thing)+       => Outputable (HsImplicitBndrs p thing) where+    ppr (HsIB { hsib_body = ty }) = ppr ty+    ppr (XHsImplicitBndrs x) = ppr x++instance (p ~ GhcPass pass,Outputable thing)+       => Outputable (HsWildCardBndrs p thing) where+    ppr (HsWC { hswc_body = ty }) = ppr ty+    ppr (XHsWildCardBndrs x) = ppr x++pprAnonWildCard :: SDoc+pprAnonWildCard = char '_'++-- | Prints a forall; When passed an empty list, prints @forall .@/@forall ->@+-- only when @-dppr-debug@ is enabled.+pprHsForAll :: (OutputableBndrId (GhcPass p))+            => ForallVisFlag -> [LHsTyVarBndr (GhcPass p)]+            -> LHsContext (GhcPass p) -> SDoc+pprHsForAll = pprHsForAllExtra Nothing++-- | Version of 'pprHsForAll' that can also print an extra-constraints+-- wildcard, e.g. @_ => a -> Bool@ or @(Show a, _) => a -> String@. This+-- underscore will be printed when the 'Maybe SrcSpan' argument is a 'Just'+-- containing the location of the extra-constraints wildcard. A special+-- function for this is needed, as the extra-constraints wildcard is removed+-- from the actual context and type, and stored in a separate field, thus just+-- printing the type will not print the extra-constraints wildcard.+pprHsForAllExtra :: (OutputableBndrId (GhcPass p))+                 => Maybe SrcSpan -> ForallVisFlag+                 -> [LHsTyVarBndr (GhcPass p)]+                 -> LHsContext (GhcPass p) -> SDoc+pprHsForAllExtra extra fvf qtvs cxt+  = pp_forall <+> pprLHsContextExtra (isJust extra) cxt+  where+    pp_forall | null qtvs = whenPprDebug (forAllLit <> separator)+              | otherwise = forAllLit <+> interppSP qtvs <> separator++    separator = ppr_forall_separator fvf++-- | Version of 'pprHsForAll' or 'pprHsForAllExtra' that will always print+-- @forall.@ when passed @Just []@. Prints nothing if passed 'Nothing'+pprHsExplicitForAll :: (OutputableBndrId (GhcPass p))+                    => ForallVisFlag+                    -> Maybe [LHsTyVarBndr (GhcPass p)] -> SDoc+pprHsExplicitForAll fvf (Just qtvs) = forAllLit <+> interppSP qtvs+                                                 <> ppr_forall_separator fvf+pprHsExplicitForAll _   Nothing     = empty++-- | Prints an arrow for visible @forall@s (e.g., @forall a ->@) and a dot for+-- invisible @forall@s (e.g., @forall a.@).+ppr_forall_separator :: ForallVisFlag -> SDoc+ppr_forall_separator ForallVis   = space <> arrow+ppr_forall_separator ForallInvis = dot++pprLHsContext :: (OutputableBndrId (GhcPass p))+              => LHsContext (GhcPass p) -> SDoc+pprLHsContext lctxt+  | null (unLoc lctxt) = empty+  | otherwise          = pprLHsContextAlways lctxt++-- For use in a HsQualTy, which always gets printed if it exists.+pprLHsContextAlways :: (OutputableBndrId (GhcPass p))+                    => LHsContext (GhcPass p) -> SDoc+pprLHsContextAlways (L _ ctxt)+  = case ctxt of+      []       -> parens empty             <+> darrow+      [L _ ty] -> ppr_mono_ty ty           <+> darrow+      _        -> parens (interpp'SP ctxt) <+> darrow++-- True <=> print an extra-constraints wildcard, e.g. @(Show a, _) =>@+pprLHsContextExtra :: (OutputableBndrId (GhcPass p))+                   => Bool -> LHsContext (GhcPass p) -> SDoc+pprLHsContextExtra show_extra lctxt@(L _ ctxt)+  | not show_extra = pprLHsContext lctxt+  | null ctxt      = char '_' <+> darrow+  | otherwise      = parens (sep (punctuate comma ctxt')) <+> darrow+  where+    ctxt' = map ppr ctxt ++ [char '_']++pprConDeclFields :: (OutputableBndrId (GhcPass p))+                 => [LConDeclField (GhcPass p)] -> SDoc+pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))+  where+    ppr_fld (L _ (ConDeclField { cd_fld_names = ns, cd_fld_type = ty,+                                 cd_fld_doc = doc }))+        = ppr_names ns <+> dcolon <+> ppr ty <+> ppr_mbDoc doc+    ppr_fld (L _ (XConDeclField x)) = ppr x+    ppr_names [n] = ppr n+    ppr_names ns = sep (punctuate comma (map ppr ns))++{-+Note [Printing KindedTyVars]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+#3830 reminded me that we should really only print the kind+signature on a KindedTyVar if the kind signature was put there by the+programmer.  During kind inference GHC now adds a PostTcKind to UserTyVars,+rather than converting to KindedTyVars as before.++(As it happens, the message in #3830 comes out a different way now,+and the problem doesn't show up; but having the flag on a KindedTyVar+seems like the Right Thing anyway.)+-}++-- Printing works more-or-less as for Types++pprHsType :: (OutputableBndrId (GhcPass p)) => HsType (GhcPass p) -> SDoc+pprHsType ty = ppr_mono_ty ty++ppr_mono_lty :: (OutputableBndrId (GhcPass p)) => LHsType (GhcPass p) -> SDoc+ppr_mono_lty ty = ppr_mono_ty (unLoc ty)++ppr_mono_ty :: (OutputableBndrId (GhcPass p)) => HsType (GhcPass p) -> SDoc+ppr_mono_ty (HsForAllTy { hst_fvf = fvf, hst_bndrs = tvs, hst_body = ty })+  = sep [pprHsForAll fvf tvs noLHsContext, ppr_mono_lty ty]++ppr_mono_ty (HsQualTy { hst_ctxt = ctxt, hst_body = ty })+  = sep [pprLHsContextAlways ctxt, ppr_mono_lty ty]++ppr_mono_ty (HsBangTy _ b ty)   = ppr b <> ppr_mono_lty ty+ppr_mono_ty (HsRecTy _ flds)      = pprConDeclFields flds+ppr_mono_ty (HsTyVar _ prom (L _ name))+  | isPromoted prom = quote (pprPrefixOcc name)+  | otherwise       = pprPrefixOcc name+ppr_mono_ty (HsFunTy _ ty1 ty2)   = ppr_fun_ty ty1 ty2+ppr_mono_ty (HsTupleTy _ con tys) = tupleParens std_con (pprWithCommas ppr tys)+  where std_con = case con of+                    HsUnboxedTuple -> UnboxedTuple+                    _              -> BoxedTuple+ppr_mono_ty (HsSumTy _ tys)+  = tupleParens UnboxedTuple (pprWithBars ppr tys)+ppr_mono_ty (HsKindSig _ ty kind)+  = ppr_mono_lty ty <+> dcolon <+> ppr kind+ppr_mono_ty (HsListTy _ ty)       = brackets (ppr_mono_lty ty)+ppr_mono_ty (HsIParamTy _ n ty)   = (ppr n <+> dcolon <+> ppr_mono_lty ty)+ppr_mono_ty (HsSpliceTy _ s)      = pprSplice s+ppr_mono_ty (HsExplicitListTy _ prom tys)+  | isPromoted prom = quote $ brackets (maybeAddSpace tys $ interpp'SP tys)+  | otherwise       = brackets (interpp'SP tys)+ppr_mono_ty (HsExplicitTupleTy _ tys)+  = quote $ parens (maybeAddSpace tys $ interpp'SP tys)+ppr_mono_ty (HsTyLit _ t)       = ppr_tylit t+ppr_mono_ty (HsWildCardTy {})   = char '_'++ppr_mono_ty (HsStarTy _ isUni)  = char (if isUni then '★' else '*')++ppr_mono_ty (HsAppTy _ fun_ty arg_ty)+  = hsep [ppr_mono_lty fun_ty, ppr_mono_lty arg_ty]+ppr_mono_ty (HsAppKindTy _ ty k)+  = ppr_mono_lty ty <+> char '@' <> ppr_mono_lty k+ppr_mono_ty (HsOpTy _ ty1 (L _ op) ty2)+  = sep [ ppr_mono_lty ty1+        , sep [pprInfixOcc op, ppr_mono_lty ty2 ] ]++ppr_mono_ty (HsParTy _ ty)+  = parens (ppr_mono_lty ty)+  -- Put the parens in where the user did+  -- But we still use the precedence stuff to add parens because+  --    toHsType doesn't put in any HsParTys, so we may still need them++ppr_mono_ty (HsDocTy _ ty doc)+  -- AZ: Should we add parens?  Should we introduce "-- ^"?+  = ppr_mono_lty ty <+> ppr (unLoc doc)+  -- we pretty print Haddock comments on types as if they were+  -- postfix operators++ppr_mono_ty (XHsType t) = ppr t++--------------------------+ppr_fun_ty :: (OutputableBndrId (GhcPass p))+           => LHsType (GhcPass p) -> LHsType (GhcPass p) -> SDoc+ppr_fun_ty ty1 ty2+  = let p1 = ppr_mono_lty ty1+        p2 = ppr_mono_lty ty2+    in+    sep [p1, arrow <+> p2]++--------------------------+ppr_tylit :: HsTyLit -> SDoc+ppr_tylit (HsNumTy _ i) = integer i+ppr_tylit (HsStrTy _ s) = text (show s)+++-- | @'hsTypeNeedsParens' p t@ returns 'True' if the type @t@ needs parentheses+-- under precedence @p@.+hsTypeNeedsParens :: PprPrec -> HsType pass -> Bool+hsTypeNeedsParens p = go+  where+    go (HsForAllTy{})        = p >= funPrec+    go (HsQualTy{})          = p >= funPrec+    go (HsBangTy{})          = p > topPrec+    go (HsRecTy{})           = False+    go (HsTyVar{})           = False+    go (HsFunTy{})           = p >= funPrec+    go (HsTupleTy{})         = False+    go (HsSumTy{})           = False+    go (HsKindSig{})         = p >= sigPrec+    go (HsListTy{})          = False+    go (HsIParamTy{})        = p > topPrec+    go (HsSpliceTy{})        = False+    go (HsExplicitListTy{})  = False+    go (HsExplicitTupleTy{}) = False+    go (HsTyLit{})           = False+    go (HsWildCardTy{})      = False+    go (HsStarTy{})          = False+    go (HsAppTy{})           = p >= appPrec+    go (HsAppKindTy{})       = p >= appPrec+    go (HsOpTy{})            = p >= opPrec+    go (HsParTy{})           = False+    go (HsDocTy _ (L _ t) _) = go t+    go (XHsType{})           = False++maybeAddSpace :: [LHsType pass] -> SDoc -> SDoc+-- See Note [Printing promoted type constructors]+-- in IfaceType.  This code implements the same+-- logic for printing HsType+maybeAddSpace tys doc+  | (ty : _) <- tys+  , lhsTypeHasLeadingPromotionQuote ty = space <> doc+  | otherwise                          = doc++lhsTypeHasLeadingPromotionQuote :: LHsType pass -> Bool+lhsTypeHasLeadingPromotionQuote ty+  = goL ty+  where+    goL (L _ ty) = go ty++    go (HsForAllTy{})        = False+    go (HsQualTy{ hst_ctxt = ctxt, hst_body = body})+      | L _ (c:_) <- ctxt    = goL c+      | otherwise            = goL body+    go (HsBangTy{})          = False+    go (HsRecTy{})           = False+    go (HsTyVar _ p _)       = isPromoted p+    go (HsFunTy _ arg _)     = goL arg+    go (HsListTy{})          = False+    go (HsTupleTy{})         = False+    go (HsSumTy{})           = False+    go (HsOpTy _ t1 _ _)     = goL t1+    go (HsKindSig _ t _)     = goL t+    go (HsIParamTy{})        = False+    go (HsSpliceTy{})        = False+    go (HsExplicitListTy _ p _) = isPromoted p+    go (HsExplicitTupleTy{}) = True+    go (HsTyLit{})           = False+    go (HsWildCardTy{})      = False+    go (HsStarTy{})          = False+    go (HsAppTy _ t _)       = goL t+    go (HsAppKindTy _ t _)   = goL t+    go (HsParTy{})           = False+    go (HsDocTy _ t _)       = goL t+    go (XHsType{})           = False++-- | @'parenthesizeHsType' p ty@ checks if @'hsTypeNeedsParens' p ty@ is+-- true, and if so, surrounds @ty@ with an 'HsParTy'. Otherwise, it simply+-- returns @ty@.+parenthesizeHsType :: PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)+parenthesizeHsType p lty@(L loc ty)+  | hsTypeNeedsParens p ty = L loc (HsParTy NoExt lty)+  | otherwise              = lty++-- | @'parenthesizeHsContext' p ctxt@ checks if @ctxt@ is a single constraint+-- @c@ such that @'hsTypeNeedsParens' p c@ is true, and if so, surrounds @c@+-- with an 'HsParTy' to form a parenthesized @ctxt@. Otherwise, it simply+-- returns @ctxt@ unchanged.+parenthesizeHsContext :: PprPrec+                      -> LHsContext (GhcPass p) -> LHsContext (GhcPass p)+parenthesizeHsContext p lctxt@(L loc ctxt) =+  case ctxt of+    [c] -> L loc [parenthesizeHsType p c]+    _   -> lctxt -- Other contexts are already "parenthesized" by virtue of+                 -- being tuples.
+ compiler/hsSyn/HsUtils.hs view
@@ -0,0 +1,1418 @@+{-+(c) The University of Glasgow, 1992-2006+++Here we collect a variety of helper functions that construct or+analyse HsSyn.  All these functions deal with generic HsSyn; functions+which deal with the instantiated versions are located elsewhere:++   Parameterised by          Module+   ----------------          -------------+   GhcPs/RdrName             parser/RdrHsSyn+   GhcRn/Name                rename/RnHsSyn+   GhcTc/Id                  typecheck/TcHsSyn+-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}++module HsUtils(+  -- Terms+  mkHsPar, mkHsApp, mkHsAppType, mkHsAppTypes, mkHsCaseAlt,+  mkSimpleMatch, unguardedGRHSs, unguardedRHS,+  mkMatchGroup, mkMatch, mkPrefixFunRhs, mkHsLam, mkHsIf,+  mkHsWrap, mkLHsWrap, mkHsWrapCo, mkHsWrapCoR, mkLHsWrapCo,+  mkHsDictLet, mkHsLams,+  mkHsOpApp, mkHsDo, mkHsComp, mkHsWrapPat, mkHsWrapPatCo,+  mkLHsPar, mkHsCmdWrap, mkLHsCmdWrap,+  mkHsCmdIf,++  nlHsTyApp, nlHsTyApps, nlHsVar, nlHsDataCon,+  nlHsLit, nlHsApp, nlHsApps, nlHsSyntaxApps,+  nlHsIntLit, nlHsVarApps,+  nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList,+  mkLHsTupleExpr, mkLHsVarTuple, missingTupArg,+  typeToLHsType,++  -- * Constructing general big tuples+  -- $big_tuples+  mkChunkified, chunkify,++  -- Bindings+  mkFunBind, mkVarBind, mkHsVarBind, mk_easy_FunBind, mkTopFunBind,+  mkPatSynBind,+  isInfixFunBind,++  -- Literals+  mkHsIntegral, mkHsFractional, mkHsIsString, mkHsString, mkHsStringPrimLit,++  -- Patterns+  mkNPat, mkNPlusKPat, nlVarPat, nlLitPat, nlConVarPat, nlConVarPatName, nlConPat,+  nlConPatName, nlInfixConPat, nlNullaryConPat, nlWildConPat, nlWildPat,+  nlWildPatName, nlTuplePat, mkParPat, nlParPat,+  mkBigLHsVarTup, mkBigLHsTup, mkBigLHsVarPatTup, mkBigLHsPatTup,++  -- Types+  mkHsAppTy, mkHsAppKindTy, userHsTyVarBndrs, userHsLTyVarBndrs,+  mkLHsSigType, mkLHsSigWcType, mkClassOpSigs, mkHsSigEnv,+  nlHsAppTy, nlHsAppKindTy, nlHsTyVar, nlHsFunTy, nlHsParTy, nlHsTyConApp,++  -- Stmts+  mkTransformStmt, mkTransformByStmt, mkBodyStmt, mkBindStmt, mkTcBindStmt,+  mkLastStmt,+  emptyTransStmt, mkGroupUsingStmt, mkGroupByUsingStmt,+  emptyRecStmt, emptyRecStmtName, emptyRecStmtId, mkRecStmt,+  unitRecStmtTc,++  -- Template Haskell+  mkUntypedSplice, mkTypedSplice,+  mkHsQuasiQuote, unqualQuasiQuote,++  -- Collecting binders+  isUnliftedHsBind, isBangedHsBind,++  collectLocalBinders, collectHsValBinders, collectHsBindListBinders,+  collectHsIdBinders,+  collectHsBindsBinders, collectHsBindBinders, collectMethodBinders,+  collectPatBinders, collectPatsBinders,+  collectLStmtsBinders, collectStmtsBinders,+  collectLStmtBinders, collectStmtBinders,++  hsLTyClDeclBinders, hsTyClForeignBinders,+  hsPatSynSelectors, getPatSynBinds,+  hsForeignDeclsBinders, hsGroupBinders, hsDataFamInstBinders,++  -- Collecting implicit binders+  lStmtsImplicits, hsValBindsImplicits, lPatImplicits+  ) where++#include "HsVersions.h"++import GhcPrelude++import HsDecls+import HsBinds+import HsExpr+import HsPat+import HsTypes+import HsLit+import PlaceHolder+import HsExtension++import TcEvidence+import RdrName+import Var+import TyCoRep+import Type   ( tyConArgFlags )+import TysWiredIn ( unitTy )+import TcType+import DataCon+import ConLike+import Id+import Name+import NameSet hiding ( unitFV )+import NameEnv+import BasicTypes+import SrcLoc+import FastString+import Util+import Bag+import Outputable+import Constants++import Data.Either+import Data.Function+import Data.List++{-+************************************************************************+*                                                                      *+        Some useful helpers for constructing syntax+*                                                                      *+************************************************************************++These functions attempt to construct a not-completely-useless SrcSpan+from their components, compared with the nl* functions below which+just attach noSrcSpan to everything.+-}++mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)+mkHsPar e = cL (getLoc e) (HsPar noExt e)++mkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))+              -> [LPat (GhcPass p)] -> Located (body (GhcPass p))+              -> LMatch (GhcPass p) (Located (body (GhcPass p)))+mkSimpleMatch ctxt pats rhs+  = cL loc $+    Match { m_ext = noExt, m_ctxt = ctxt, m_pats = pats+          , m_grhss = unguardedGRHSs rhs }+  where+    loc = case pats of+                []      -> getLoc rhs+                (pat:_) -> combineSrcSpans (getLoc pat) (getLoc rhs)++unguardedGRHSs :: Located (body (GhcPass p))+               -> GRHSs (GhcPass p) (Located (body (GhcPass p)))+unguardedGRHSs rhs@(dL->L loc _)+  = GRHSs noExt (unguardedRHS loc rhs) (noLoc emptyLocalBinds)++unguardedRHS :: SrcSpan -> Located (body (GhcPass p))+             -> [LGRHS (GhcPass p) (Located (body (GhcPass p)))]+unguardedRHS loc rhs = [cL loc (GRHS noExt [] rhs)]++mkMatchGroup :: (XMG name (Located (body name)) ~ NoExt)+             => Origin -> [LMatch name (Located (body name))]+             -> MatchGroup name (Located (body name))+mkMatchGroup origin matches = MG { mg_ext = noExt+                                 , mg_alts = mkLocatedList matches+                                 , mg_origin = origin }++mkLocatedList ::  [Located a] -> Located [Located a]+mkLocatedList [] = noLoc []+mkLocatedList ms = cL (combineLocs (head ms) (last ms)) ms++mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)+mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExt e1 e2)++mkHsAppType :: (NoGhcTc (GhcPass id) ~ GhcRn)+            => LHsExpr (GhcPass id) -> LHsWcType GhcRn -> LHsExpr (GhcPass id)+mkHsAppType e t = addCLoc e t_body (HsAppType noExt e paren_wct)+  where+    t_body    = hswc_body t+    paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body }++mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn+mkHsAppTypes = foldl' mkHsAppType++mkHsLam :: (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExt) =>+  [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)+mkHsLam pats body = mkHsPar (cL (getLoc body) (HsLam noExt matches))+  where+    matches = mkMatchGroup Generated+                           [mkSimpleMatch LambdaExpr pats' body]+    pats' = map (parenthesizePat appPrec) pats++mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc+mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars+                                       <.> mkWpLams dicts) expr++-- |A simple case alternative with a single pattern, no binds, no guards;+-- pre-typechecking+mkHsCaseAlt :: LPat (GhcPass p) -> (Located (body (GhcPass p)))+            -> LMatch (GhcPass p) (Located (body (GhcPass p)))+mkHsCaseAlt pat expr+  = mkSimpleMatch CaseAlt [pat] expr++nlHsTyApp :: IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id)+nlHsTyApp fun_id tys+  = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExt (noLoc fun_id)))++nlHsTyApps :: IdP (GhcPass id) -> [Type] -> [LHsExpr (GhcPass id)]+           -> LHsExpr (GhcPass id)+nlHsTyApps fun_id tys xs = foldl' nlHsApp (nlHsTyApp fun_id tys) xs++--------- Adding parens ---------+mkLHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)+-- Wrap in parens if (hsExprNeedsParens appPrec) says it needs them+-- So   'f x'  becomes '(f x)', but '3' stays as '3'+mkLHsPar le@(dL->L loc e)+  | hsExprNeedsParens appPrec e = cL loc (HsPar noExt le)+  | otherwise                   = le++mkParPat :: LPat (GhcPass name) -> LPat (GhcPass name)+mkParPat lp@(dL->L loc p)+  | patNeedsParens appPrec p = cL loc (ParPat noExt lp)+  | otherwise                = lp++nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)+nlParPat p = noLoc (ParPat noExt p)++-------------------------------+-- These are the bits of syntax that contain rebindable names+-- See RnEnv.lookupSyntaxName++mkHsIntegral   :: IntegralLit -> HsOverLit GhcPs+mkHsFractional :: FractionalLit -> HsOverLit GhcPs+mkHsIsString   :: SourceText -> FastString -> HsOverLit GhcPs+mkHsDo         :: HsStmtContext Name -> [ExprLStmt GhcPs] -> HsExpr GhcPs+mkHsComp       :: HsStmtContext Name -> [ExprLStmt GhcPs] -> LHsExpr GhcPs+               -> HsExpr GhcPs++mkNPat      :: Located (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs)+            -> Pat GhcPs+mkNPlusKPat :: Located RdrName -> Located (HsOverLit GhcPs) -> Pat GhcPs++mkLastStmt :: Located (bodyR (GhcPass idR))+           -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))+mkBodyStmt :: Located (bodyR GhcPs)+           -> StmtLR (GhcPass idL) GhcPs (Located (bodyR GhcPs))+mkBindStmt :: (XBindStmt (GhcPass idL) (GhcPass idR)+                         (Located (bodyR (GhcPass idR))) ~ NoExt)+           => LPat (GhcPass idL) -> Located (bodyR (GhcPass idR))+           -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))+mkTcBindStmt :: LPat GhcTc -> Located (bodyR GhcTc)+             -> StmtLR GhcTc GhcTc (Located (bodyR GhcTc))++emptyRecStmt     :: StmtLR (GhcPass idL) GhcPs bodyR+emptyRecStmtName :: StmtLR GhcRn GhcRn bodyR+emptyRecStmtId   :: StmtLR GhcTc GhcTc bodyR+mkRecStmt        :: [LStmtLR (GhcPass idL) GhcPs bodyR]+                 -> StmtLR (GhcPass idL) GhcPs bodyR+++mkHsIntegral     i  = OverLit noExt (HsIntegral       i) noExpr+mkHsFractional   f  = OverLit noExt (HsFractional     f) noExpr+mkHsIsString src s  = OverLit noExt (HsIsString   src s) noExpr++mkHsDo ctxt stmts = HsDo noExt ctxt (mkLocatedList stmts)+mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])+  where+    last_stmt = cL (getLoc expr) $ mkLastStmt expr++mkHsIf :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)+       -> HsExpr (GhcPass p)+mkHsIf c a b = HsIf noExt (Just noSyntaxExpr) c a b++mkHsCmdIf :: LHsExpr (GhcPass p) -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)+       -> HsCmd (GhcPass p)+mkHsCmdIf c a b = HsCmdIf noExt (Just noSyntaxExpr) c a b++mkNPat lit neg     = NPat noExt lit neg noSyntaxExpr+mkNPlusKPat id lit+  = NPlusKPat noExt id lit (unLoc lit) noSyntaxExpr noSyntaxExpr++mkTransformStmt    :: [ExprLStmt GhcPs] -> LHsExpr GhcPs+                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)+mkTransformByStmt  :: [ExprLStmt GhcPs] -> LHsExpr GhcPs+                   -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)+mkGroupUsingStmt   :: [ExprLStmt GhcPs] -> LHsExpr GhcPs+                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)+mkGroupByUsingStmt :: [ExprLStmt GhcPs] -> LHsExpr GhcPs+                   -> LHsExpr GhcPs+                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)++emptyTransStmt :: StmtLR GhcPs GhcPs (LHsExpr GhcPs)+emptyTransStmt = TransStmt { trS_ext = noExt+                           , trS_form = panic "emptyTransStmt: form"+                           , trS_stmts = [], trS_bndrs = []+                           , trS_by = Nothing, trS_using = noLoc noExpr+                           , trS_ret = noSyntaxExpr, trS_bind = noSyntaxExpr+                           , trS_fmap = noExpr }+mkTransformStmt    ss u   = emptyTransStmt { trS_form = ThenForm,  trS_stmts = ss, trS_using = u }+mkTransformByStmt  ss u b = emptyTransStmt { trS_form = ThenForm,  trS_stmts = ss, trS_using = u, trS_by = Just b }+mkGroupUsingStmt   ss u   = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u }+mkGroupByUsingStmt ss b u = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u, trS_by = Just b }++mkLastStmt body = LastStmt noExt body False noSyntaxExpr+mkBodyStmt body+  = BodyStmt noExt body noSyntaxExpr noSyntaxExpr+mkBindStmt pat body+  = BindStmt noExt pat body noSyntaxExpr noSyntaxExpr+mkTcBindStmt pat body = BindStmt unitTy pat body noSyntaxExpr noSyntaxExpr+  -- don't use placeHolderTypeTc above, because that panics during zonking++emptyRecStmt' :: forall idL idR body.+                 XRecStmt (GhcPass idL) (GhcPass idR) body+              -> StmtLR (GhcPass idL) (GhcPass idR) body+emptyRecStmt' tyVal =+   RecStmt+     { recS_stmts = [], recS_later_ids = []+     , recS_rec_ids = []+     , recS_ret_fn = noSyntaxExpr+     , recS_mfix_fn = noSyntaxExpr+     , recS_bind_fn = noSyntaxExpr+     , recS_ext = tyVal }++unitRecStmtTc :: RecStmtTc+unitRecStmtTc = RecStmtTc { recS_bind_ty = unitTy+                          , recS_later_rets = []+                          , recS_rec_rets = []+                          , recS_ret_ty = unitTy }++emptyRecStmt     = emptyRecStmt' noExt+emptyRecStmtName = emptyRecStmt' noExt+emptyRecStmtId   = emptyRecStmt' unitRecStmtTc+                                        -- a panic might trigger during zonking+mkRecStmt stmts  = emptyRecStmt { recS_stmts = stmts }++-------------------------------+--- A useful function for building @OpApps@.  The operator is always a+-- variable, and we don't know the fixity yet.+mkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs+mkHsOpApp e1 op e2 = OpApp noExt e1 (noLoc (HsVar noExt (noLoc op))) e2++unqualSplice :: RdrName+unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))++mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs+mkUntypedSplice hasParen e = HsUntypedSplice noExt hasParen unqualSplice e++mkTypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs+mkTypedSplice hasParen e = HsTypedSplice noExt hasParen unqualSplice e++mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs+mkHsQuasiQuote quoter span quote+  = HsQuasiQuote noExt unqualSplice quoter span quote++unqualQuasiQuote :: RdrName+unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))+                -- A name (uniquified later) to+                -- identify the quasi-quote++mkHsString :: String -> HsLit (GhcPass p)+mkHsString s = HsString NoSourceText (mkFastString s)++mkHsStringPrimLit :: FastString -> HsLit (GhcPass p)+mkHsStringPrimLit fs = HsStringPrim NoSourceText (bytesFS fs)++-------------+userHsLTyVarBndrs :: SrcSpan -> [Located (IdP (GhcPass p))]+                  -> [LHsTyVarBndr (GhcPass p)]+-- Caller sets location+userHsLTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt v) | v <- bndrs ]++userHsTyVarBndrs :: SrcSpan -> [IdP (GhcPass p)] -> [LHsTyVarBndr (GhcPass p)]+-- Caller sets location+userHsTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt (cL loc v))+                             | v <- bndrs ]+++{-+************************************************************************+*                                                                      *+        Constructing syntax with no location info+*                                                                      *+************************************************************************+-}++nlHsVar :: IdP (GhcPass id) -> LHsExpr (GhcPass id)+nlHsVar n = noLoc (HsVar noExt (noLoc n))++-- NB: Only for LHsExpr **Id**+nlHsDataCon :: DataCon -> LHsExpr GhcTc+nlHsDataCon con = noLoc (HsConLikeOut noExt (RealDataCon con))++nlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p)+nlHsLit n = noLoc (HsLit noExt n)++nlHsIntLit :: Integer -> LHsExpr (GhcPass p)+nlHsIntLit n = noLoc (HsLit noExt (HsInt noExt (mkIntegralLit n)))++nlVarPat :: IdP (GhcPass id) -> LPat (GhcPass id)+nlVarPat n = noLoc (VarPat noExt (noLoc n))++nlLitPat :: HsLit GhcPs -> LPat GhcPs+nlLitPat l = noLoc (LitPat noExt l)++nlHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)+nlHsApp f x = noLoc (HsApp noExt f (mkLHsPar x))++nlHsSyntaxApps :: SyntaxExpr (GhcPass id) -> [LHsExpr (GhcPass id)]+               -> LHsExpr (GhcPass id)+nlHsSyntaxApps (SyntaxExpr { syn_expr      = fun+                           , syn_arg_wraps = arg_wraps+                           , syn_res_wrap  = res_wrap }) args+  | [] <- arg_wraps   -- in the noSyntaxExpr case+  = ASSERT( isIdHsWrapper res_wrap )+    foldl' nlHsApp (noLoc fun) args++  | otherwise+  = mkLHsWrap res_wrap (foldl' nlHsApp (noLoc fun) (zipWithEqual "nlHsSyntaxApps"+                                                     mkLHsWrap arg_wraps args))++nlHsApps :: IdP (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)+nlHsApps f xs = foldl' nlHsApp (nlHsVar f) xs++nlHsVarApps :: IdP (GhcPass id) -> [IdP (GhcPass id)] -> LHsExpr (GhcPass id)+nlHsVarApps f xs = noLoc (foldl' mk (HsVar noExt (noLoc f))+                                               (map ((HsVar noExt) . noLoc) xs))+                 where+                   mk f a = HsApp noExt (noLoc f) (noLoc a)++nlConVarPat :: RdrName -> [RdrName] -> LPat GhcPs+nlConVarPat con vars = nlConPat con (map nlVarPat vars)++nlConVarPatName :: Name -> [Name] -> LPat GhcRn+nlConVarPatName con vars = nlConPatName con (map nlVarPat vars)++nlInfixConPat :: RdrName -> LPat GhcPs -> LPat GhcPs -> LPat GhcPs+nlInfixConPat con l r = noLoc (ConPatIn (noLoc con)+                              (InfixCon (parenthesizePat opPrec l)+                                        (parenthesizePat opPrec r)))++nlConPat :: RdrName -> [LPat GhcPs] -> LPat GhcPs+nlConPat con pats =+  noLoc (ConPatIn (noLoc con) (PrefixCon (map (parenthesizePat appPrec) pats)))++nlConPatName :: Name -> [LPat GhcRn] -> LPat GhcRn+nlConPatName con pats =+  noLoc (ConPatIn (noLoc con) (PrefixCon (map (parenthesizePat appPrec) pats)))++nlNullaryConPat :: IdP (GhcPass p) -> LPat (GhcPass p)+nlNullaryConPat con = noLoc (ConPatIn (noLoc con) (PrefixCon []))++nlWildConPat :: DataCon -> LPat GhcPs+nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con))+                         (PrefixCon (replicate (dataConSourceArity con)+                                             nlWildPat)))++nlWildPat :: LPat GhcPs+nlWildPat  = noLoc (WildPat noExt )  -- Pre-typechecking++nlWildPatName :: LPat GhcRn+nlWildPatName  = noLoc (WildPat noExt )  -- Pre-typechecking++nlHsDo :: HsStmtContext Name -> [LStmt GhcPs (LHsExpr GhcPs)]+       -> LHsExpr GhcPs+nlHsDo ctxt stmts = noLoc (mkHsDo ctxt stmts)++nlHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs+nlHsOpApp e1 op e2 = noLoc (mkHsOpApp e1 op e2)++nlHsLam  :: LMatch GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs+nlHsPar  :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)+nlHsIf   :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)+         -> LHsExpr (GhcPass id)+nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]+         -> LHsExpr GhcPs+nlList   :: [LHsExpr GhcPs] -> LHsExpr GhcPs++nlHsLam match          = noLoc (HsLam noExt (mkMatchGroup Generated [match]))+nlHsPar e              = noLoc (HsPar noExt e)++-- Note [Rebindable nlHsIf]+-- nlHsIf should generate if-expressions which are NOT subject to+-- RebindableSyntax, so the first field of HsIf is Nothing. (#12080)+nlHsIf cond true false = noLoc (HsIf noExt Nothing cond true false)++nlHsCase expr matches+  = noLoc (HsCase noExt expr (mkMatchGroup Generated matches))+nlList exprs          = noLoc (ExplicitList noExt Nothing exprs)++nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)+nlHsTyVar :: IdP (GhcPass p)                            -> LHsType (GhcPass p)+nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)+nlHsParTy :: LHsType (GhcPass p)                        -> LHsType (GhcPass p)++nlHsAppTy f t = noLoc (HsAppTy noExt f (parenthesizeHsType appPrec t))+nlHsTyVar x   = noLoc (HsTyVar noExt NotPromoted (noLoc x))+nlHsFunTy a b = noLoc (HsFunTy noExt (parenthesizeHsType funPrec a) b)+nlHsParTy t   = noLoc (HsParTy noExt t)++nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p)+nlHsTyConApp tycon tys  = foldl' nlHsAppTy (nlHsTyVar tycon) tys++nlHsAppKindTy ::+  LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p)+nlHsAppKindTy f k+  = noLoc (HsAppKindTy noSrcSpan f (parenthesizeHsType appPrec k))++{-+Tuples.  All these functions are *pre-typechecker* because they lack+types on the tuple.+-}++mkLHsTupleExpr :: [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a)+-- Makes a pre-typechecker boxed tuple, deals with 1 case+mkLHsTupleExpr [e] = e+mkLHsTupleExpr es+  = noLoc $ ExplicitTuple noExt (map (noLoc . (Present noExt)) es) Boxed++mkLHsVarTuple :: [IdP (GhcPass a)] -> LHsExpr (GhcPass a)+mkLHsVarTuple ids  = mkLHsTupleExpr (map nlHsVar ids)++nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs+nlTuplePat pats box = noLoc (TuplePat noExt pats box)++missingTupArg :: HsTupArg GhcPs+missingTupArg = Missing noExt++mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn+mkLHsPatTup []     = noLoc $ TuplePat noExt [] Boxed+mkLHsPatTup [lpat] = lpat+mkLHsPatTup lpats  = cL (getLoc (head lpats)) $ TuplePat noExt lpats Boxed++-- The Big equivalents for the source tuple expressions+mkBigLHsVarTup :: [IdP (GhcPass id)] -> LHsExpr (GhcPass id)+mkBigLHsVarTup ids = mkBigLHsTup (map nlHsVar ids)++mkBigLHsTup :: [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)+mkBigLHsTup = mkChunkified mkLHsTupleExpr++-- The Big equivalents for the source tuple patterns+mkBigLHsVarPatTup :: [IdP GhcRn] -> LPat GhcRn+mkBigLHsVarPatTup bs = mkBigLHsPatTup (map nlVarPat bs)++mkBigLHsPatTup :: [LPat GhcRn] -> LPat GhcRn+mkBigLHsPatTup = mkChunkified mkLHsPatTup++-- $big_tuples+-- #big_tuples#+--+-- GHCs built in tuples can only go up to 'mAX_TUPLE_SIZE' in arity, but+-- we might concievably want to build such a massive tuple as part of the+-- output of a desugaring stage (notably that for list comprehensions).+--+-- We call tuples above this size \"big tuples\", and emulate them by+-- creating and pattern matching on >nested< tuples that are expressible+-- by GHC.+--+-- Nesting policy: it's better to have a 2-tuple of 10-tuples (3 objects)+-- than a 10-tuple of 2-tuples (11 objects), so we want the leaves of any+-- construction to be big.+--+-- If you just use the 'mkBigCoreTup', 'mkBigCoreVarTupTy', 'mkTupleSelector'+-- and 'mkTupleCase' functions to do all your work with tuples you should be+-- fine, and not have to worry about the arity limitation at all.++-- | Lifts a \"small\" constructor into a \"big\" constructor by recursive decompositon+mkChunkified :: ([a] -> a)      -- ^ \"Small\" constructor function, of maximum input arity 'mAX_TUPLE_SIZE'+             -> [a]             -- ^ Possible \"big\" list of things to construct from+             -> a               -- ^ Constructed thing made possible by recursive decomposition+mkChunkified small_tuple as = mk_big_tuple (chunkify as)+  where+        -- Each sub-list is short enough to fit in a tuple+    mk_big_tuple [as] = small_tuple as+    mk_big_tuple as_s = mk_big_tuple (chunkify (map small_tuple as_s))++chunkify :: [a] -> [[a]]+-- ^ Split a list into lists that are small enough to have a corresponding+-- tuple arity. The sub-lists of the result all have length <= 'mAX_TUPLE_SIZE'+-- But there may be more than 'mAX_TUPLE_SIZE' sub-lists+chunkify xs+  | n_xs <= mAX_TUPLE_SIZE = [xs]+  | otherwise              = split xs+  where+    n_xs     = length xs+    split [] = []+    split xs = take mAX_TUPLE_SIZE xs : split (drop mAX_TUPLE_SIZE xs)++{-+************************************************************************+*                                                                      *+        LHsSigType and LHsSigWcType+*                                                                      *+********************************************************************* -}++mkLHsSigType :: LHsType GhcPs -> LHsSigType GhcPs+mkLHsSigType ty = mkHsImplicitBndrs ty++mkLHsSigWcType :: LHsType GhcPs -> LHsSigWcType GhcPs+mkLHsSigWcType ty = mkHsWildCardBndrs (mkHsImplicitBndrs ty)++mkHsSigEnv :: forall a. (LSig GhcRn -> Maybe ([Located Name], a))+                     -> [LSig GhcRn]+                     -> NameEnv a+mkHsSigEnv get_info sigs+  = mkNameEnv          (mk_pairs ordinary_sigs)+   `extendNameEnvList` (mk_pairs gen_dm_sigs)+   -- The subtlety is this: in a class decl with a+   -- default-method signature as well as a method signature+   -- we want the latter to win (#12533)+   --    class C x where+   --       op :: forall a . x a -> x a+   --       default op :: forall b . x b -> x b+   --       op x = ...(e :: b -> b)...+   -- The scoped type variables of the 'default op', namely 'b',+   -- scope over the code for op.   The 'forall a' does not!+   -- This applies both in the renamer and typechecker, both+   -- of which use this function+  where+    (gen_dm_sigs, ordinary_sigs) = partition is_gen_dm_sig sigs+    is_gen_dm_sig (dL->L _ (ClassOpSig _ True _ _)) = True+    is_gen_dm_sig _                                 = False++    mk_pairs :: [LSig GhcRn] -> [(Name, a)]+    mk_pairs sigs = [ (n,a) | Just (ns,a) <- map get_info sigs+                            , (dL->L _ n) <- ns ]++mkClassOpSigs :: [LSig GhcPs] -> [LSig GhcPs]+-- Convert TypeSig to ClassOpSig+-- The former is what is parsed, but the latter is+-- what we need in class/instance declarations+mkClassOpSigs sigs+  = map fiddle sigs+  where+    fiddle (dL->L loc (TypeSig _ nms ty))+      = cL loc (ClassOpSig noExt False nms (dropWildCards ty))+    fiddle sig = sig++typeToLHsType :: Type -> LHsType GhcPs+-- ^ Converting a Type to an HsType RdrName+-- This is needed to implement GeneralizedNewtypeDeriving.+--+-- Note that we use 'getRdrName' extensively, which+-- generates Exact RdrNames rather than strings.+typeToLHsType ty+  = go ty+  where+    go :: Type -> LHsType GhcPs+    go ty@(FunTy { ft_af = af, ft_arg = arg, ft_res = res })+      = case af of+          VisArg   -> nlHsFunTy (go arg) (go res)+          InvisArg | (theta, tau) <- tcSplitPhiTy ty+                   -> noLoc (HsQualTy { hst_ctxt = noLoc (map go theta)+                                      , hst_xqual = noExt+                                      , hst_body = go tau })++    go ty@(ForAllTy (Bndr _ argf) _)+      | (tvs, tau) <- tcSplitForAllTysSameVis argf ty+      = noLoc (HsForAllTy { hst_fvf = argToForallVisFlag argf+                          , hst_bndrs = map go_tv tvs+                          , hst_xforall = noExt+                          , hst_body = go tau })+    go (TyVarTy tv)         = nlHsTyVar (getRdrName tv)+    go (AppTy t1 t2)        = nlHsAppTy (go t1) (go t2)+    go (LitTy (NumTyLit n))+      = noLoc $ HsTyLit NoExt (HsNumTy NoSourceText n)+    go (LitTy (StrTyLit s))+      = noLoc $ HsTyLit NoExt (HsStrTy NoSourceText s)+    go ty@(TyConApp tc args)+      | tyConAppNeedsKindSig True tc (length args)+        -- We must produce an explicit kind signature here to make certain+        -- programs kind-check. See Note [Kind signatures in typeToLHsType].+      = nlHsParTy $ noLoc $ HsKindSig NoExt lhs_ty (go (tcTypeKind ty))+      | otherwise = lhs_ty+       where+        arg_flags :: [ArgFlag]+        arg_flags = tyConArgFlags tc args++        lhs_ty :: LHsType GhcPs+        lhs_ty = foldl' (\f (arg, flag) ->+                          let arg' = go arg in+                          case flag of+                            Inferred  -> f+                            Specified -> f `nlHsAppKindTy` arg'+                            Required  -> f `nlHsAppTy`     arg')+                        (nlHsTyVar (getRdrName tc))+                        (zip args arg_flags)+    go (CastTy ty _)        = go ty+    go (CoercionTy co)      = pprPanic "toLHsSigWcType" (ppr co)++         -- Source-language types have _invisible_ kind arguments,+         -- so we must remove them here (#8563)++    go_tv :: TyVar -> LHsTyVarBndr GhcPs+    go_tv tv = noLoc $ KindedTyVar noExt (noLoc (getRdrName tv))+                                   (go (tyVarKind tv))++{-+Note [Kind signatures in typeToLHsType]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+There are types that typeToLHsType can produce which require explicit kind+signatures in order to kind-check. Here is an example from #14579:++  -- type P :: forall {k} {t :: k}. Proxy t+  type P = 'Proxy++  -- type Wat :: forall a. Proxy a -> *+  newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a)+    deriving Eq++  -- type Wat2 :: forall {a}. Proxy a -> *+  type Wat2 = Wat++  -- type Glurp :: * -> *+  newtype Glurp a = MkGlurp (Wat2 (P :: Proxy a))+    deriving Eq++The derived Eq instance for Glurp (without any kind signatures) would be:++  instance Eq a => Eq (Glurp a) where+    (==) = coerce @(Wat2 P  -> Wat2 P  -> Bool)+                  @(Glurp a -> Glurp a -> Bool)+                  (==) :: Glurp a -> Glurp a -> Bool++(Where the visible type applications use types produced by typeToLHsType.)++The type P (in Wat2 P) has an underspecified kind, so we must ensure that+typeToLHsType ascribes it with its kind: Wat2 (P :: Proxy a). To accomplish+this, whenever we see an application of a tycon to some arguments, we use+the tyConAppNeedsKindSig function to determine if it requires an explicit kind+signature to resolve some ambiguity. (See Note+Note [When does a tycon application need an explicit kind signature?] for a+more detailed explanation of how this works.)++Note that we pass True to tyConAppNeedsKindSig since we are generated code with+visible kind applications, so even specified arguments count towards injective+positions in the kind of the tycon.+-}++{- *********************************************************************+*                                                                      *+    --------- HsWrappers: type args, dict args, casts ---------+*                                                                      *+********************************************************************* -}++mkLHsWrap :: HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)+mkLHsWrap co_fn (dL->L loc e) = cL loc (mkHsWrap co_fn e)++-- Avoid (HsWrap co (HsWrap co' _)).+-- See Note [Detecting forced eta expansion] in DsExpr+mkHsWrap :: HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)+mkHsWrap co_fn e | isIdHsWrapper co_fn = e+mkHsWrap co_fn (HsWrap _ co_fn' e)     = mkHsWrap (co_fn <.> co_fn') e+mkHsWrap co_fn e                       = HsWrap noExt co_fn e++mkHsWrapCo :: TcCoercionN   -- A Nominal coercion  a ~N b+           -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)+mkHsWrapCo co e = mkHsWrap (mkWpCastN co) e++mkHsWrapCoR :: TcCoercionR   -- A Representational coercion  a ~R b+            -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)+mkHsWrapCoR co e = mkHsWrap (mkWpCastR co) e++mkLHsWrapCo :: TcCoercionN -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)+mkLHsWrapCo co (dL->L loc e) = cL loc (mkHsWrapCo co e)++mkHsCmdWrap :: HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p)+mkHsCmdWrap w cmd | isIdHsWrapper w = cmd+                  | otherwise       = HsCmdWrap noExt w cmd++mkLHsCmdWrap :: HsWrapper -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)+mkLHsCmdWrap w (dL->L loc c) = cL loc (mkHsCmdWrap w c)++mkHsWrapPat :: HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)+mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p+                       | otherwise           = CoPat noExt co_fn p ty++mkHsWrapPatCo :: TcCoercionN -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)+mkHsWrapPatCo co pat ty | isTcReflCo co = pat+                        | otherwise    = CoPat noExt (mkWpCastN co) pat ty++mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc+mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr++{-+l+************************************************************************+*                                                                      *+                Bindings; with a location at the top+*                                                                      *+************************************************************************+-}++mkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]+          -> HsBind GhcPs+-- Not infix, with place holders for coercion and free vars+mkFunBind fn ms = FunBind { fun_id = fn+                          , fun_matches = mkMatchGroup Generated ms+                          , fun_co_fn = idHsWrapper+                          , fun_ext = noExt+                          , fun_tick = [] }++mkTopFunBind :: Origin -> Located Name -> [LMatch GhcRn (LHsExpr GhcRn)]+             -> HsBind GhcRn+-- In Name-land, with empty bind_fvs+mkTopFunBind origin fn ms = FunBind { fun_id = fn+                                    , fun_matches = mkMatchGroup origin ms+                                    , fun_co_fn = idHsWrapper+                                    , fun_ext  = emptyNameSet -- NB: closed+                                                              --     binding+                                    , fun_tick = [] }++mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr GhcPs -> LHsBind GhcPs+mkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs++mkVarBind :: IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p)+mkVarBind var rhs = cL (getLoc rhs) $+                    VarBind { var_ext = noExt,+                              var_id = var, var_rhs = rhs, var_inline = False }++mkPatSynBind :: Located RdrName -> HsPatSynDetails (Located RdrName)+             -> LPat GhcPs -> HsPatSynDir GhcPs -> HsBind GhcPs+mkPatSynBind name details lpat dir = PatSynBind noExt psb+  where+    psb = PSB{ psb_ext = noExt+             , psb_id = name+             , psb_args = details+             , psb_def = lpat+             , psb_dir = dir }++-- |If any of the matches in the 'FunBind' are infix, the 'FunBind' is+-- considered infix.+isInfixFunBind :: HsBindLR id1 id2 -> Bool+isInfixFunBind (FunBind _ _ (MG _ matches _) _ _)+  = any (isInfixMatch . unLoc) (unLoc matches)+isInfixFunBind _ = False+++------------+mk_easy_FunBind :: SrcSpan -> RdrName -> [LPat GhcPs]+                -> LHsExpr GhcPs -> LHsBind GhcPs+mk_easy_FunBind loc fun pats expr+  = cL loc $ mkFunBind (cL loc fun)+              [mkMatch (mkPrefixFunRhs (cL loc fun)) pats expr+                       (noLoc emptyLocalBinds)]++-- | Make a prefix, non-strict function 'HsMatchContext'+mkPrefixFunRhs :: Located id -> HsMatchContext id+mkPrefixFunRhs n = FunRhs { mc_fun = n+                          , mc_fixity = Prefix+                          , mc_strictness = NoSrcStrict }++------------+mkMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))+        -> [LPat (GhcPass p)] -> LHsExpr (GhcPass p)+        -> Located (HsLocalBinds (GhcPass p))+        -> LMatch (GhcPass p) (LHsExpr (GhcPass p))+mkMatch ctxt pats expr lbinds+  = noLoc (Match { m_ext   = noExt+                 , m_ctxt  = ctxt+                 , m_pats  = map paren pats+                 , m_grhss = GRHSs noExt (unguardedRHS noSrcSpan expr) lbinds })+  where+    paren lp@(dL->L l p)+      | patNeedsParens appPrec p = cL l (ParPat noExt lp)+      | otherwise                = lp++{-+************************************************************************+*                                                                      *+        Collecting binders+*                                                                      *+************************************************************************++Get all the binders in some HsBindGroups, IN THE ORDER OF APPEARANCE. eg.++...+where+  (x, y) = ...+  f i j  = ...+  [a, b] = ...++it should return [x, y, f, a, b] (remember, order important).++Note [Collect binders only after renaming]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+These functions should only be used on HsSyn *after* the renamer,+to return a [Name] or [Id].  Before renaming the record punning+and wild-card mechanism makes it hard to know what is bound.+So these functions should not be applied to (HsSyn RdrName)++Note [Unlifted id check in isUnliftedHsBind]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The function isUnliftedHsBind is used to complain if we make a top-level+binding for a variable of unlifted type.++Such a binding is illegal if the top-level binding would be unlifted;+but also if the local letrec generated by desugaring AbsBinds would be.+E.g.+      f :: Num a => (# a, a #)+      g :: Num a => a -> a+      f = ...g...+      g = ...g...++The top-level bindings for f,g are not unlifted (because of the Num a =>),+but the local, recursive, monomorphic bindings are:++      t = /\a \(d:Num a).+         letrec fm :: (# a, a #) = ...g...+                gm :: a -> a = ...f...+         in (fm, gm)++Here the binding for 'fm' is illegal.  So generally we check the abe_mono types.++BUT we have a special case when abs_sig is true;+  see HsBinds Note [The abs_sig field of AbsBinds]+-}++----------------- Bindings --------------------------++-- | Should we treat this as an unlifted bind? This will be true for any+-- bind that binds an unlifted variable, but we must be careful around+-- AbsBinds. See Note [Unlifted id check in isUnliftedHsBind]. For usage+-- information, see Note [Strict binds check] is DsBinds.+isUnliftedHsBind :: HsBind GhcTc -> Bool  -- works only over typechecked binds+isUnliftedHsBind bind+  | AbsBinds { abs_exports = exports, abs_sig = has_sig } <- bind+  = if has_sig+    then any (is_unlifted_id . abe_poly) exports+    else any (is_unlifted_id . abe_mono) exports+    -- If has_sig is True we wil never generate a binding for abe_mono,+    -- so we don't need to worry about it being unlifted. The abe_poly+    -- binding might not be: e.g. forall a. Num a => (# a, a #)++  | otherwise+  = any is_unlifted_id (collectHsBindBinders bind)+  where+    is_unlifted_id id = isUnliftedType (idType id)++-- | Is a binding a strict variable or pattern bind (e.g. @!x = ...@)?+isBangedHsBind :: HsBind GhcTc -> Bool+isBangedHsBind (AbsBinds { abs_binds = binds })+  = anyBag (isBangedHsBind . unLoc) binds+isBangedHsBind (FunBind {fun_matches = matches})+  | [dL->L _ match] <- unLoc $ mg_alts matches+  , FunRhs{mc_strictness = SrcStrict} <- m_ctxt match+  = True+isBangedHsBind (PatBind {pat_lhs = pat})+  = isBangedLPat pat+isBangedHsBind _+  = False++collectLocalBinders :: HsLocalBindsLR (GhcPass idL) (GhcPass idR)+                    -> [IdP (GhcPass idL)]+collectLocalBinders (HsValBinds _ binds) = collectHsIdBinders binds+                                         -- No pattern synonyms here+collectLocalBinders (HsIPBinds {})      = []+collectLocalBinders (EmptyLocalBinds _) = []+collectLocalBinders (XHsLocalBindsLR _) = []++collectHsIdBinders, collectHsValBinders+  :: HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]+-- Collect Id binders only, or Ids + pattern synonyms, respectively+collectHsIdBinders  = collect_hs_val_binders True+collectHsValBinders = collect_hs_val_binders False++collectHsBindBinders :: (SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p))=>+                        HsBindLR p idR -> [IdP p]+-- Collect both Ids and pattern-synonym binders+collectHsBindBinders b = collect_bind False b []++collectHsBindsBinders :: LHsBindsLR (GhcPass p) idR -> [IdP (GhcPass p)]+collectHsBindsBinders binds = collect_binds False binds []++collectHsBindListBinders :: [LHsBindLR (GhcPass p) idR] -> [IdP (GhcPass p)]+-- Same as collectHsBindsBinders, but works over a list of bindings+collectHsBindListBinders = foldr (collect_bind False . unLoc) []++collect_hs_val_binders :: Bool -> HsValBindsLR (GhcPass idL) (GhcPass idR)+                       -> [IdP (GhcPass idL)]+collect_hs_val_binders ps (ValBinds _ binds _) = collect_binds ps binds []+collect_hs_val_binders ps (XValBindsLR (NValBinds binds _))+  = collect_out_binds ps binds++collect_out_binds :: Bool -> [(RecFlag, LHsBinds (GhcPass p))] ->+                     [IdP (GhcPass p)]+collect_out_binds ps = foldr (collect_binds ps . snd) []++collect_binds :: Bool -> LHsBindsLR (GhcPass p) idR ->+                 [IdP (GhcPass p)] -> [IdP (GhcPass p)]+-- Collect Ids, or Ids + pattern synonyms, depending on boolean flag+collect_binds ps binds acc = foldrBag (collect_bind ps . unLoc) acc binds++collect_bind :: (SrcSpanLess (LPat p) ~ Pat p , HasSrcSpan (LPat p)) =>+                Bool -> HsBindLR p idR -> [IdP p] -> [IdP p]+collect_bind _ (PatBind { pat_lhs = p })           acc = collect_lpat p acc+collect_bind _ (FunBind { fun_id = (dL->L _ f) })  acc = f : acc+collect_bind _ (VarBind { var_id = f })            acc = f : acc+collect_bind _ (AbsBinds { abs_exports = dbinds }) acc = map abe_poly dbinds ++ acc+        -- I don't think we want the binders from the abe_binds++        -- binding (hence see AbsBinds) is in zonking in TcHsSyn+collect_bind omitPatSyn (PatSynBind _ (PSB { psb_id = (dL->L _ ps) })) acc+  | omitPatSyn                  = acc+  | otherwise                   = ps : acc+collect_bind _ (PatSynBind _ (XPatSynBind _)) acc = acc+collect_bind _ (XHsBindsLR _) acc = acc++collectMethodBinders :: LHsBindsLR idL idR -> [Located (IdP idL)]+-- Used exclusively for the bindings of an instance decl which are all FunBinds+collectMethodBinders binds = foldrBag (get . unLoc) [] binds+  where+    get (FunBind { fun_id = f }) fs = f : fs+    get _                        fs = fs+       -- Someone else complains about non-FunBinds++----------------- Statements --------------------------+collectLStmtsBinders :: [LStmtLR (GhcPass idL) (GhcPass idR) body]+                     -> [IdP (GhcPass idL)]+collectLStmtsBinders = concatMap collectLStmtBinders++collectStmtsBinders :: [StmtLR (GhcPass idL) (GhcPass idR) body]+                    -> [IdP (GhcPass idL)]+collectStmtsBinders = concatMap collectStmtBinders++collectLStmtBinders :: LStmtLR (GhcPass idL) (GhcPass idR) body+                    -> [IdP (GhcPass idL)]+collectLStmtBinders = collectStmtBinders . unLoc++collectStmtBinders :: StmtLR (GhcPass idL) (GhcPass idR) body+                   -> [IdP (GhcPass idL)]+  -- Id Binders for a Stmt... [but what about pattern-sig type vars]?+collectStmtBinders (BindStmt _ pat _ _ _)  = collectPatBinders pat+collectStmtBinders (LetStmt _  binds)      = collectLocalBinders (unLoc binds)+collectStmtBinders (BodyStmt {})           = []+collectStmtBinders (LastStmt {})           = []+collectStmtBinders (ParStmt _ xs _ _)      = collectLStmtsBinders+                                    $ [s | ParStmtBlock _ ss _ _ <- xs, s <- ss]+collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts+collectStmtBinders (RecStmt { recS_stmts = ss })     = collectLStmtsBinders ss+collectStmtBinders (ApplicativeStmt _ args _) = concatMap collectArgBinders args+ where+  collectArgBinders (_, ApplicativeArgOne _ pat _ _) = collectPatBinders pat+  collectArgBinders (_, ApplicativeArgMany _ _ _ pat) = collectPatBinders pat+  collectArgBinders _ = []+collectStmtBinders XStmtLR{} = panic "collectStmtBinders"+++----------------- Patterns --------------------------+collectPatBinders :: LPat (GhcPass p) -> [IdP (GhcPass p)]+collectPatBinders pat = collect_lpat pat []++collectPatsBinders :: [LPat (GhcPass p)] -> [IdP (GhcPass p)]+collectPatsBinders pats = foldr collect_lpat [] pats++-------------+collect_lpat :: (SrcSpanLess (LPat p) ~ Pat p , HasSrcSpan (LPat p)) =>+                 LPat p -> [IdP p] -> [IdP p]+collect_lpat p bndrs+  = go (unLoc p)+  where+    go (VarPat _ var)             = unLoc var : bndrs+    go (WildPat _)                = bndrs+    go (LazyPat _ pat)            = collect_lpat pat bndrs+    go (BangPat _ pat)            = collect_lpat pat bndrs+    go (AsPat _ a pat)            = unLoc a : collect_lpat pat bndrs+    go (ViewPat _ _ pat)          = collect_lpat pat bndrs+    go (ParPat _ pat)             = collect_lpat pat bndrs++    go (ListPat _ pats)           = foldr collect_lpat bndrs pats+    go (TuplePat _ pats _)        = foldr collect_lpat bndrs pats+    go (SumPat _ pat _ _)         = collect_lpat pat bndrs++    go (ConPatIn _ ps)            = foldr collect_lpat bndrs (hsConPatArgs ps)+    go (ConPatOut {pat_args=ps})  = foldr collect_lpat bndrs (hsConPatArgs ps)+        -- See Note [Dictionary binders in ConPatOut]+    go (LitPat _ _)               = bndrs+    go (NPat {})                  = bndrs+    go (NPlusKPat _ n _ _ _ _)    = unLoc n : bndrs++    go (SigPat _ pat _)           = collect_lpat pat bndrs++    go (SplicePat _ (HsSpliced _ _ (HsSplicedPat pat)))+                                  = go pat+    go (SplicePat _ _)            = bndrs+    go (CoPat _ _ pat _)          = go pat+    go (XPat {})                  = bndrs++{-+Note [Dictionary binders in ConPatOut] See also same Note in DsArrows+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Do *not* gather (a) dictionary and (b) dictionary bindings as binders+of a ConPatOut pattern.  For most calls it doesn't matter, because+it's pre-typechecker and there are no ConPatOuts.  But it does matter+more in the desugarer; for example, DsUtils.mkSelectorBinds uses+collectPatBinders.  In a lazy pattern, for example f ~(C x y) = ...,+we want to generate bindings for x,y but not for dictionaries bound by+C.  (The type checker ensures they would not be used.)++Desugaring of arrow case expressions needs these bindings (see DsArrows+and arrowcase1), but SPJ (Jan 2007) says it's safer for it to use its+own pat-binder-collector:++Here's the problem.  Consider++data T a where+   C :: Num a => a -> Int -> T a++f ~(C (n+1) m) = (n,m)++Here, the pattern (C (n+1)) binds a hidden dictionary (d::Num a),+and *also* uses that dictionary to match the (n+1) pattern.  Yet, the+variables bound by the lazy pattern are n,m, *not* the dictionary d.+So in mkSelectorBinds in DsUtils, we want just m,n as the variables bound.+-}++hsGroupBinders :: HsGroup GhcRn -> [Name]+hsGroupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,+                          hs_fords = foreign_decls })+  =  collectHsValBinders val_decls+  ++ hsTyClForeignBinders tycl_decls foreign_decls+hsGroupBinders (XHsGroup {}) = panic "hsGroupBinders"++hsTyClForeignBinders :: [TyClGroup GhcRn]+                     -> [LForeignDecl GhcRn]+                     -> [Name]+-- We need to look at instance declarations too,+-- because their associated types may bind data constructors+hsTyClForeignBinders tycl_decls foreign_decls+  =    map unLoc (hsForeignDeclsBinders foreign_decls)+    ++ getSelectorNames+         (foldMap (foldMap hsLTyClDeclBinders . group_tyclds) tycl_decls+         `mappend`+         foldMap (foldMap hsLInstDeclBinders . group_instds) tycl_decls)+  where+    getSelectorNames :: ([Located Name], [LFieldOcc GhcRn]) -> [Name]+    getSelectorNames (ns, fs) = map unLoc ns ++ map (extFieldOcc . unLoc) fs++-------------------+hsLTyClDeclBinders :: Located (TyClDecl pass)+                   -> ([Located (IdP pass)], [LFieldOcc pass])+-- ^ Returns all the /binding/ names of the decl.  The first one is+-- guaranteed to be the name of the decl. The first component+-- represents all binding names except record fields; the second+-- represents field occurrences. For record fields mentioned in+-- multiple constructors, the SrcLoc will be from the first occurrence.+--+-- Each returned (Located name) has a SrcSpan for the /whole/ declaration.+-- See Note [SrcSpan for binders]++hsLTyClDeclBinders (dL->L loc (FamDecl { tcdFam = FamilyDecl+                                            { fdLName = (dL->L _ name) } }))+  = ([cL loc name], [])+hsLTyClDeclBinders (dL->L _ (FamDecl { tcdFam = XFamilyDecl _ }))+  = panic "hsLTyClDeclBinders"+hsLTyClDeclBinders (dL->L loc (SynDecl+                               { tcdLName = (dL->L _ name) }))+  = ([cL loc name], [])+hsLTyClDeclBinders (dL->L loc (ClassDecl+                               { tcdLName = (dL->L _ cls_name)+                               , tcdSigs  = sigs+                               , tcdATs   = ats }))+  = (cL loc cls_name :+     [ cL fam_loc fam_name | (dL->L fam_loc (FamilyDecl+                                        { fdLName = L _ fam_name })) <- ats ]+     +++     [ cL mem_loc mem_name | (dL->L mem_loc (ClassOpSig _ False ns _)) <- sigs+                           , (dL->L _ mem_name) <- ns ]+    , [])+hsLTyClDeclBinders (dL->L loc (DataDecl    { tcdLName = (dL->L _ name)+                                           , tcdDataDefn = defn }))+  = (\ (xs, ys) -> (cL loc name : xs, ys)) $ hsDataDefnBinders defn+hsLTyClDeclBinders (dL->L _ (XTyClDecl _)) = panic "hsLTyClDeclBinders"+hsLTyClDeclBinders _ = panic "hsLTyClDeclBinders: Impossible Match"+                             -- due to #15884+++-------------------+hsForeignDeclsBinders :: [LForeignDecl pass] -> [Located (IdP pass)]+-- See Note [SrcSpan for binders]+hsForeignDeclsBinders foreign_decls+  = [ cL decl_loc n+    | (dL->L decl_loc (ForeignImport { fd_name = (dL->L _ n) }))+        <- foreign_decls]+++-------------------+hsPatSynSelectors :: HsValBinds (GhcPass p) -> [IdP (GhcPass p)]+-- Collects record pattern-synonym selectors only; the pattern synonym+-- names are collected by collectHsValBinders.+hsPatSynSelectors (ValBinds _ _ _) = panic "hsPatSynSelectors"+hsPatSynSelectors (XValBindsLR (NValBinds binds _))+  = foldrBag addPatSynSelector [] . unionManyBags $ map snd binds++addPatSynSelector:: LHsBind p -> [IdP p] -> [IdP p]+addPatSynSelector bind sels+  | PatSynBind _ (PSB { psb_args = RecCon as }) <- unLoc bind+  = map (unLoc . recordPatSynSelectorId) as ++ sels+  | otherwise = sels++getPatSynBinds :: [(RecFlag, LHsBinds id)] -> [PatSynBind id id]+getPatSynBinds binds+  = [ psb | (_, lbinds) <- binds+          , (dL->L _ (PatSynBind _ psb)) <- bagToList lbinds ]++-------------------+hsLInstDeclBinders :: LInstDecl (GhcPass p)+                   -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])+hsLInstDeclBinders (dL->L _ (ClsInstD+                             { cid_inst = ClsInstDecl+                                          { cid_datafam_insts = dfis }}))+  = foldMap (hsDataFamInstBinders . unLoc) dfis+hsLInstDeclBinders (dL->L _ (DataFamInstD { dfid_inst = fi }))+  = hsDataFamInstBinders fi+hsLInstDeclBinders (dL->L _ (TyFamInstD {})) = mempty+hsLInstDeclBinders (dL->L _ (ClsInstD _ (XClsInstDecl {})))+  = panic "hsLInstDeclBinders"+hsLInstDeclBinders (dL->L _ (XInstDecl _))+  = panic "hsLInstDeclBinders"+hsLInstDeclBinders _ = panic "hsLInstDeclBinders: Impossible Match"+                             -- due to #15884++-------------------+-- the SrcLoc returned are for the whole declarations, not just the names+hsDataFamInstBinders :: DataFamInstDecl pass+                     -> ([Located (IdP pass)], [LFieldOcc pass])+hsDataFamInstBinders (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =+                       FamEqn { feqn_rhs = defn }}})+  = hsDataDefnBinders defn+  -- There can't be repeated symbols because only data instances have binders+hsDataFamInstBinders (DataFamInstDecl+                                    { dfid_eqn = HsIB { hsib_body = XFamEqn _}})+  = panic "hsDataFamInstBinders"+hsDataFamInstBinders (DataFamInstDecl (XHsImplicitBndrs _))+  = panic "hsDataFamInstBinders"++-------------------+-- the SrcLoc returned are for the whole declarations, not just the names+hsDataDefnBinders :: HsDataDefn pass -> ([Located (IdP pass)], [LFieldOcc pass])+hsDataDefnBinders (HsDataDefn { dd_cons = cons })+  = hsConDeclsBinders cons+  -- See Note [Binders in family instances]+hsDataDefnBinders (XHsDataDefn _) = panic "hsDataDefnBinders"++-------------------+type Seen pass = [LFieldOcc pass] -> [LFieldOcc pass]+                 -- Filters out ones that have already been seen++hsConDeclsBinders :: [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])+   -- See hsLTyClDeclBinders for what this does+   -- The function is boringly complicated because of the records+   -- And since we only have equality, we have to be a little careful+hsConDeclsBinders cons+  = go id cons+  where+    go :: Seen pass -> [LConDecl pass]+       -> ([Located (IdP pass)], [LFieldOcc pass])+    go _ [] = ([], [])+    go remSeen (r:rs)+      -- Don't re-mangle the location of field names, because we don't+      -- have a record of the full location of the field declaration anyway+      = let loc = getLoc r+        in case unLoc r of+           -- remove only the first occurrence of any seen field in order to+           -- avoid circumventing detection of duplicate fields (#9156)+           ConDeclGADT { con_names = names, con_args = args }+             -> (map (cL loc . unLoc) names ++ ns, flds ++ fs)+             where+                (remSeen', flds) = get_flds remSeen args+                (ns, fs) = go remSeen' rs++           ConDeclH98 { con_name = name, con_args = args }+             -> ([cL loc (unLoc name)] ++ ns, flds ++ fs)+             where+                (remSeen', flds) = get_flds remSeen args+                (ns, fs) = go remSeen' rs++           XConDecl _ -> panic "hsConDeclsBinders"++    get_flds :: Seen pass -> HsConDeclDetails pass+             -> (Seen pass, [LFieldOcc pass])+    get_flds remSeen (RecCon flds)+       = (remSeen', fld_names)+       where+          fld_names = remSeen (concatMap (cd_fld_names . unLoc) (unLoc flds))+          remSeen' = foldr (.) remSeen+                               [deleteBy ((==) `on` unLoc . rdrNameFieldOcc . unLoc) v+                               | v <- fld_names]+    get_flds remSeen _+       = (remSeen, [])++{-++Note [SrcSpan for binders]+~~~~~~~~~~~~~~~~~~~~~~~~~~+When extracting the (Located RdrNme) for a binder, at least for the+main name (the TyCon of a type declaration etc), we want to give it+the @SrcSpan@ of the whole /declaration/, not just the name itself+(which is how it appears in the syntax tree).  This SrcSpan (for the+entire declaration) is used as the SrcSpan for the Name that is+finally produced, and hence for error messages.  (See #8607.)++Note [Binders in family instances]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In a type or data family instance declaration, the type+constructor is an *occurrence* not a binding site+    type instance T Int = Int -> Int   -- No binders+    data instance S Bool = S1 | S2     -- Binders are S1,S2+++************************************************************************+*                                                                      *+        Collecting binders the user did not write+*                                                                      *+************************************************************************++The job of this family of functions is to run through binding sites and find the set of all Names+that were defined "implicitly", without being explicitly written by the user.++The main purpose is to find names introduced by record wildcards so that we can avoid+warning the user when they don't use those names (#4404)++Since the addition of -Wunused-record-wildcards, this function returns a pair+of [(SrcSpan, [Name])]. Each element of the list is one set of implicit+binders, the first component of the tuple is the document describes the possible+fix to the problem (by removing the ..).++This means there is some unfortunate coupling between this function and where it+is used but it's only used for one specific purpose in one place so it seemed+easier.+-}++lStmtsImplicits :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]+                -> [(SrcSpan, [Name])]+lStmtsImplicits = hs_lstmts+  where+    hs_lstmts :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]+              -> [(SrcSpan, [Name])]+    hs_lstmts = concatMap (hs_stmt . unLoc)++    hs_stmt :: StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))+            -> [(SrcSpan, [Name])]+    hs_stmt (BindStmt _ pat _ _ _) = lPatImplicits pat+    hs_stmt (ApplicativeStmt _ args _) = concatMap do_arg args+      where do_arg (_, ApplicativeArgOne _ pat _ _) = lPatImplicits pat+            do_arg (_, ApplicativeArgMany _ stmts _ _) = hs_lstmts stmts+            do_arg (_, XApplicativeArg _) = panic "lStmtsImplicits"+    hs_stmt (LetStmt _ binds)     = hs_local_binds (unLoc binds)+    hs_stmt (BodyStmt {})         = []+    hs_stmt (LastStmt {})         = []+    hs_stmt (ParStmt _ xs _ _)    = hs_lstmts [s | ParStmtBlock _ ss _ _ <- xs+                                                , s <- ss]+    hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts+    hs_stmt (RecStmt { recS_stmts = ss })     = hs_lstmts ss+    hs_stmt (XStmtLR {})          = panic "lStmtsImplicits"++    hs_local_binds (HsValBinds _ val_binds) = hsValBindsImplicits val_binds+    hs_local_binds (HsIPBinds {})           = []+    hs_local_binds (EmptyLocalBinds _)      = []+    hs_local_binds (XHsLocalBindsLR _)      = []++hsValBindsImplicits :: HsValBindsLR GhcRn (GhcPass idR) -> [(SrcSpan, [Name])]+hsValBindsImplicits (XValBindsLR (NValBinds binds _))+  = concatMap (lhsBindsImplicits . snd) binds+hsValBindsImplicits (ValBinds _ binds _)+  = lhsBindsImplicits binds++lhsBindsImplicits :: LHsBindsLR GhcRn idR -> [(SrcSpan, [Name])]+lhsBindsImplicits = foldBag (++) (lhs_bind . unLoc) []+  where+    lhs_bind (PatBind { pat_lhs = lpat }) = lPatImplicits lpat+    lhs_bind _ = []++lPatImplicits :: LPat GhcRn -> [(SrcSpan, [Name])]+lPatImplicits = hs_lpat+  where+    hs_lpat lpat = hs_pat (unLoc lpat)++    hs_lpats = foldr (\pat rest -> hs_lpat pat ++ rest) []++    hs_pat (LazyPat _ pat)      = hs_lpat pat+    hs_pat (BangPat _ pat)      = hs_lpat pat+    hs_pat (AsPat _ _ pat)      = hs_lpat pat+    hs_pat (ViewPat _ _ pat)    = hs_lpat pat+    hs_pat (ParPat _ pat)       = hs_lpat pat+    hs_pat (ListPat _ pats)     = hs_lpats pats+    hs_pat (TuplePat _ pats _)  = hs_lpats pats++    hs_pat (SigPat _ pat _)     = hs_lpat pat+    hs_pat (CoPat _ _ pat _)    = hs_pat pat++    hs_pat (ConPatIn n ps)           = details n ps+    hs_pat (ConPatOut {pat_con=con, pat_args=ps}) = details (fmap conLikeName con) ps++    hs_pat _ = []++    details :: Located Name -> HsConPatDetails GhcRn -> [(SrcSpan, [Name])]+    details _ (PrefixCon ps)   = hs_lpats ps+    details n (RecCon fs)      =+      [(err_loc, collectPatsBinders implicit_pats) | Just{} <- [rec_dotdot fs] ]+        ++ hs_lpats explicit_pats++      where implicit_pats = map (hsRecFieldArg . unLoc) implicit+            explicit_pats = map (hsRecFieldArg . unLoc) explicit+++            (explicit, implicit) = partitionEithers [if pat_explicit then Left fld else Right fld+                                                    | (i, fld) <- [0..] `zip` rec_flds fs+                                                    ,  let  pat_explicit =+                                                              maybe True ((i<) . unLoc)+                                                                         (rec_dotdot fs)]+            err_loc = maybe (getLoc n) getLoc (rec_dotdot fs)++    details _ (InfixCon p1 p2) = hs_lpat p1 ++ hs_lpat p2
+ compiler/hsSyn/PlaceHolder.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE StandaloneDeriving #-}++module PlaceHolder where++import Name+import NameSet+import RdrName+import Var++++{-+%************************************************************************+%*                                                                      *+\subsection{Annotating the syntax}+%*                                                                      *+%************************************************************************+-}++-- NB: These are intentionally open, allowing API consumers (like Haddock)+-- to declare new instances++placeHolderNamesTc :: NameSet+placeHolderNamesTc = emptyNameSet++{-+TODO:AZ: remove this, and check if we still need all the UndecidableInstances++Note [Pass sensitive types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Since the same AST types are re-used through parsing,renaming and type+checking there are naturally some places in the AST that do not have+any meaningful value prior to the pass they are assigned a value.++Historically these have been filled in with place holder values of the form++  panic "error message"++This has meant the AST is difficult to traverse using standard generic+programming techniques. The problem is addressed by introducing+pass-specific data types, implemented as a pair of open type families,+one for PostTc and one for PostRn. These are then explicitly populated+with a PlaceHolder value when they do not yet have meaning.++In terms of actual usage, we have the following++  PostTc id Kind+  PostTc id Type++  PostRn id Fixity+  PostRn id NameSet++TcId and Var are synonyms for Id++Unfortunately the type checker termination checking conditions fail for the+DataId constraint type based on this, so even though it is safe the+UndecidableInstances pragma is required where this is used.+-}+++-- |Follow the @id@, but never beyond Name. This is used in a 'HsMatchContext',+-- for printing messages related to a 'Match'+type family NameOrRdrName id where+  NameOrRdrName Id      = Name+  NameOrRdrName Name    = Name+  NameOrRdrName RdrName = RdrName
+ compiler/iface/BinFingerprint.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE CPP #-}++-- | Computing fingerprints of values serializeable with GHC's "Binary" module.+module BinFingerprint+  ( -- * Computing fingerprints+    fingerprintBinMem+  , computeFingerprint+  , putNameLiterally+  ) where++#include "HsVersions.h"++import GhcPrelude++import Fingerprint+import Binary+import Name+import Panic+import Util++fingerprintBinMem :: BinHandle -> IO Fingerprint+fingerprintBinMem bh = withBinBuffer bh f+  where+    f bs =+        -- we need to take care that we force the result here+        -- lest a reference to the ByteString may leak out of+        -- withBinBuffer.+        let fp = fingerprintByteString bs+        in fp `seq` return fp++computeFingerprint :: (Binary a)+                   => (BinHandle -> Name -> IO ())+                   -> a+                   -> IO Fingerprint+computeFingerprint put_nonbinding_name a = do+    bh <- fmap set_user_data $ openBinMem (3*1024) -- just less than a block+    put_ bh a+    fp <- fingerprintBinMem bh+    return fp+  where+    set_user_data bh =+      setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS++-- | Used when we want to fingerprint a structure without depending on the+-- fingerprints of external Names that it refers to.+putNameLiterally :: BinHandle -> Name -> IO ()+putNameLiterally bh name = ASSERT( isExternalName name ) do+    put_ bh $! nameModule name+    put_ bh $! nameOccName name
+ compiler/iface/IfaceSyn.hs view
@@ -0,0 +1,2325 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1993-1998+-}++{-# LANGUAGE CPP #-}++module IfaceSyn (+        module IfaceType,++        IfaceDecl(..), IfaceFamTyConFlav(..), IfaceClassOp(..), IfaceAT(..),+        IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec,+        IfaceExpr(..), IfaceAlt, IfaceLetBndr(..), IfaceJoinInfo(..),+        IfaceBinding(..), IfaceConAlt(..),+        IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),+        IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,+        IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),+        IfaceClassBody(..),+        IfaceBang(..),+        IfaceSrcBang(..), SrcUnpackedness(..), SrcStrictness(..),+        IfaceAxBranch(..),+        IfaceTyConParent(..),+        IfaceCompleteMatch(..),++        -- * Binding names+        IfaceTopBndr,+        putIfaceTopBndr, getIfaceTopBndr,++        -- Misc+        ifaceDeclImplicitBndrs, visibleIfConDecls,+        ifaceDeclFingerprints,++        -- Free Names+        freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,++        -- Pretty printing+        pprIfaceExpr,+        pprIfaceDecl,+        AltPpr(..), ShowSub(..), ShowHowMuch(..), showToIface, showToHeader+    ) where++#include "HsVersions.h"++import GhcPrelude++import IfaceType+import BinFingerprint+import CoreSyn( IsOrphan, isOrphan )+import PprCore()            -- Printing DFunArgs+import Demand+import Class+import FieldLabel+import NameSet+import CoAxiom ( BranchIndex )+import Name+import CostCentre+import Literal+import ForeignCall+import Annotations( AnnPayload, AnnTarget )+import BasicTypes+import Outputable+import Module+import SrcLoc+import Fingerprint+import Binary+import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )+import Var( VarBndr(..), binderVar )+import TyCon ( Role (..), Injectivity(..), tyConBndrVisArgFlag )+import Util( dropList, filterByList )+import DataCon (SrcStrictness(..), SrcUnpackedness(..))+import Lexeme (isLexSym)++import Control.Monad+import System.IO.Unsafe++infixl 3 &&&++{-+************************************************************************+*                                                                      *+                    Declarations+*                                                                      *+************************************************************************+-}++-- | A binding top-level 'Name' in an interface file (e.g. the name of an+-- 'IfaceDecl').+type IfaceTopBndr = Name+  -- It's convenient to have a Name in the IfaceSyn, although in each+  -- case the namespace is implied by the context. However, having an+  -- Name makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints+  -- very convenient. Moreover, having the key of the binder means that+  -- we can encode known-key things cleverly in the symbol table. See Note+  -- [Symbol table representation of Names]+  --+  -- We don't serialise the namespace onto the disk though; rather we+  -- drop it when serialising and add it back in when deserialising.++getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr+getIfaceTopBndr bh = get bh++putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO ()+putIfaceTopBndr bh name =+    case getUserData bh of+      UserData{ ud_put_binding_name = put_binding_name } ->+          --pprTrace "putIfaceTopBndr" (ppr name) $+          put_binding_name bh name++data IfaceDecl+  = IfaceId { ifName      :: IfaceTopBndr,+              ifType      :: IfaceType,+              ifIdDetails :: IfaceIdDetails,+              ifIdInfo    :: IfaceIdInfo }++  | IfaceData { ifName       :: IfaceTopBndr,   -- Type constructor+                ifBinders    :: [IfaceTyConBinder],+                ifResKind    :: IfaceType,      -- Result kind of type constructor+                ifCType      :: Maybe CType,    -- C type for CAPI FFI+                ifRoles      :: [Role],         -- Roles+                ifCtxt       :: IfaceContext,   -- The "stupid theta"+                ifCons       :: IfaceConDecls,  -- Includes new/data/data family info+                ifGadtSyntax :: Bool,           -- True <=> declared using+                                                -- GADT syntax+                ifParent     :: IfaceTyConParent -- The axiom, for a newtype,+                                                 -- or data/newtype family instance+    }++  | IfaceSynonym { ifName    :: IfaceTopBndr,      -- Type constructor+                   ifRoles   :: [Role],            -- Roles+                   ifBinders :: [IfaceTyConBinder],+                   ifResKind :: IfaceKind,         -- Kind of the *result*+                   ifSynRhs  :: IfaceType }++  | IfaceFamily  { ifName    :: IfaceTopBndr,      -- Type constructor+                   ifResVar  :: Maybe IfLclName,   -- Result variable name, used+                                                   -- only for pretty-printing+                                                   -- with --show-iface+                   ifBinders :: [IfaceTyConBinder],+                   ifResKind :: IfaceKind,         -- Kind of the *tycon*+                   ifFamFlav :: IfaceFamTyConFlav,+                   ifFamInj  :: Injectivity }      -- injectivity information++  | IfaceClass { ifName    :: IfaceTopBndr,             -- Name of the class TyCon+                 ifRoles   :: [Role],                   -- Roles+                 ifBinders :: [IfaceTyConBinder],+                 ifFDs     :: [FunDep IfLclName],       -- Functional dependencies+                 ifBody    :: IfaceClassBody            -- Methods, superclasses, ATs+    }++  | IfaceAxiom { ifName       :: IfaceTopBndr,        -- Axiom name+                 ifTyCon      :: IfaceTyCon,     -- LHS TyCon+                 ifRole       :: Role,           -- Role of axiom+                 ifAxBranches :: [IfaceAxBranch] -- Branches+    }++  | IfacePatSyn { ifName          :: IfaceTopBndr,           -- Name of the pattern synonym+                  ifPatIsInfix    :: Bool,+                  ifPatMatcher    :: (IfExtName, Bool),+                  ifPatBuilder    :: Maybe (IfExtName, Bool),+                  -- Everything below is redundant,+                  -- but needed to implement pprIfaceDecl+                  ifPatUnivBndrs  :: [IfaceForAllBndr],+                  ifPatExBndrs    :: [IfaceForAllBndr],+                  ifPatProvCtxt   :: IfaceContext,+                  ifPatReqCtxt    :: IfaceContext,+                  ifPatArgs       :: [IfaceType],+                  ifPatTy         :: IfaceType,+                  ifFieldLabels   :: [FieldLabel] }++-- See also 'ClassBody'+data IfaceClassBody+  -- Abstract classes don't specify their body; they only occur in @hs-boot@ and+  -- @hsig@ files.+  = IfAbstractClass+  | IfConcreteClass {+     ifClassCtxt :: IfaceContext,             -- Super classes+     ifATs       :: [IfaceAT],                -- Associated type families+     ifSigs      :: [IfaceClassOp],           -- Method signatures+     ifMinDef    :: BooleanFormula IfLclName  -- Minimal complete definition+    }++data IfaceTyConParent+  = IfNoParent+  | IfDataInstance+       IfExtName     -- Axiom name+       IfaceTyCon    -- Family TyCon (pretty-printing only, not used in TcIface)+                     -- see Note [Pretty printing via IfaceSyn] in PprTyThing+       IfaceAppArgs  -- Arguments of the family TyCon++data IfaceFamTyConFlav+  = IfaceDataFamilyTyCon                      -- Data family+  | IfaceOpenSynFamilyTyCon+  | IfaceClosedSynFamilyTyCon (Maybe (IfExtName, [IfaceAxBranch]))+    -- ^ Name of associated axiom and branches for pretty printing purposes,+    -- or 'Nothing' for an empty closed family without an axiom+    -- See Note [Pretty printing via IfaceSyn] in PprTyThing+  | IfaceAbstractClosedSynFamilyTyCon+  | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only++data IfaceClassOp+  = IfaceClassOp IfaceTopBndr+                 IfaceType                         -- Class op type+                 (Maybe (DefMethSpec IfaceType))   -- Default method+                 -- The types of both the class op itself,+                 -- and the default method, are *not* quantified+                 -- over the class variables++data IfaceAT = IfaceAT  -- See Class.ClassATItem+                  IfaceDecl          -- The associated type declaration+                  (Maybe IfaceType)  -- Default associated type instance, if any+++-- This is just like CoAxBranch+data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars    :: [IfaceTvBndr]+                                   , ifaxbEtaTyVars :: [IfaceTvBndr]+                                   , ifaxbCoVars    :: [IfaceIdBndr]+                                   , ifaxbLHS       :: IfaceAppArgs+                                   , ifaxbRoles     :: [Role]+                                   , ifaxbRHS       :: IfaceType+                                   , ifaxbIncomps   :: [BranchIndex] }+                                     -- See Note [Storing compatibility] in CoAxiom++data IfaceConDecls+  = IfAbstractTyCon     -- c.f TyCon.AbstractTyCon+  | IfDataTyCon [IfaceConDecl] -- Data type decls+  | IfNewTyCon  IfaceConDecl   -- Newtype decls++-- For IfDataTyCon and IfNewTyCon we store:+--  * the data constructor(s);+-- The field labels are stored individually in the IfaceConDecl+-- (there is some redundancy here, because a field label may occur+-- in multiple IfaceConDecls and represent the same field label)++data IfaceConDecl+  = IfCon {+        ifConName    :: IfaceTopBndr,                -- Constructor name+        ifConWrapper :: Bool,                   -- True <=> has a wrapper+        ifConInfix   :: Bool,                   -- True <=> declared infix++        -- The universal type variables are precisely those+        -- of the type constructor of this data constructor+        -- This is *easy* to guarantee when creating the IfCon+        -- but it's not so easy for the original TyCon/DataCon+        -- So this guarantee holds for IfaceConDecl, but *not* for DataCon++        ifConExTCvs   :: [IfaceBndr],  -- Existential ty/covars+        ifConUserTvBinders :: [IfaceForAllBndr],+          -- The tyvars, in the order the user wrote them+          -- INVARIANT: the set of tyvars in ifConUserTvBinders is exactly the+          --            set of tyvars (*not* covars) of ifConExTCvs, unioned+          --            with the set of ifBinders (from the parent IfaceDecl)+          --            whose tyvars do not appear in ifConEqSpec+          -- See Note [DataCon user type variable binders] in DataCon+        ifConEqSpec  :: IfaceEqSpec,        -- Equality constraints+        ifConCtxt    :: IfaceContext,       -- Non-stupid context+        ifConArgTys  :: [IfaceType],        -- Arg types+        ifConFields  :: [FieldLabel],  -- ...ditto... (field labels)+        ifConStricts :: [IfaceBang],+          -- Empty (meaning all lazy),+          -- or 1-1 corresp with arg tys+          -- See Note [Bangs on imported data constructors] in MkId+        ifConSrcStricts :: [IfaceSrcBang] } -- empty meaning no src stricts++type IfaceEqSpec = [(IfLclName,IfaceType)]++-- | This corresponds to an HsImplBang; that is, the final+-- implementation decision about the data constructor arg+data IfaceBang+  = IfNoBang | IfStrict | IfUnpack | IfUnpackCo IfaceCoercion++-- | This corresponds to HsSrcBang+data IfaceSrcBang+  = IfSrcBang SrcUnpackedness SrcStrictness++data IfaceClsInst+  = IfaceClsInst { ifInstCls  :: IfExtName,                -- See comments with+                   ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst+                   ifDFun     :: IfExtName,                -- The dfun+                   ifOFlag    :: OverlapFlag,              -- Overlap flag+                   ifInstOrph :: IsOrphan }                -- See Note [Orphans] in InstEnv+        -- There's always a separate IfaceDecl for the DFun, which gives+        -- its IdInfo with its full type and version number.+        -- The instance declarations taken together have a version number,+        -- and we don't want that to wobble gratuitously+        -- If this instance decl is *used*, we'll record a usage on the dfun;+        -- and if the head does not change it won't be used if it wasn't before++-- The ifFamInstTys field of IfaceFamInst contains a list of the rough+-- match types+data IfaceFamInst+  = IfaceFamInst { ifFamInstFam      :: IfExtName            -- Family name+                 , ifFamInstTys      :: [Maybe IfaceTyCon]   -- See above+                 , ifFamInstAxiom    :: IfExtName            -- The axiom+                 , ifFamInstOrph     :: IsOrphan             -- Just like IfaceClsInst+                 }++data IfaceRule+  = IfaceRule {+        ifRuleName   :: RuleName,+        ifActivation :: Activation,+        ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars+        ifRuleHead   :: IfExtName,      -- Head of lhs+        ifRuleArgs   :: [IfaceExpr],    -- Args of LHS+        ifRuleRhs    :: IfaceExpr,+        ifRuleAuto   :: Bool,+        ifRuleOrph   :: IsOrphan   -- Just like IfaceClsInst+    }++data IfaceAnnotation+  = IfaceAnnotation {+        ifAnnotatedTarget :: IfaceAnnTarget,+        ifAnnotatedValue  :: AnnPayload+  }++type IfaceAnnTarget = AnnTarget OccName++data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName++instance Outputable IfaceCompleteMatch where+  ppr (IfaceCompleteMatch cls ty) = text "COMPLETE" <> colon <+> ppr cls+                                                    <+> dcolon <+> ppr ty+++++-- Here's a tricky case:+--   * Compile with -O module A, and B which imports A.f+--   * Change function f in A, and recompile without -O+--   * When we read in old A.hi we read in its IdInfo (as a thunk)+--      (In earlier GHCs we used to drop IdInfo immediately on reading,+--       but we do not do that now.  Instead it's discarded when the+--       ModIface is read into the various decl pools.)+--   * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)+--      and so gives a new version.++data IfaceIdInfo+  = NoInfo                      -- When writing interface file without -O+  | HasInfo [IfaceInfoItem]     -- Has info, and here it is++data IfaceInfoItem+  = HsArity         Arity+  | HsStrictness    StrictSig+  | HsInline        InlinePragma+  | HsUnfold        Bool             -- True <=> isStrongLoopBreaker is true+                    IfaceUnfolding   -- See Note [Expose recursive functions]+  | HsNoCafRefs+  | HsLevity                         -- Present <=> never levity polymorphic++-- NB: Specialisations and rules come in separately and are+-- only later attached to the Id.  Partial reason: some are orphans.++data IfaceUnfolding+  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding+                                -- Possibly could eliminate the Bool here, the information+                                -- is also in the InlinePragma.++  | IfCompulsory IfaceExpr      -- Only used for default methods, in fact++  | IfInlineRule Arity          -- INLINE pragmas+                 Bool           -- OK to inline even if *un*-saturated+                 Bool           -- OK to inline even if context is boring+                 IfaceExpr++  | IfDFunUnfold [IfaceBndr] [IfaceExpr]+++-- We only serialise the IdDetails of top-level Ids, and even then+-- we only need a very limited selection.  Notably, none of the+-- implicit ones are needed here, because they are not put it+-- interface files++data IfaceIdDetails+  = IfVanillaId+  | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool+  | IfDFunId++{-+Note [Versioning of instances]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+See [https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance#instances]+++************************************************************************+*                                                                      *+                Functions over declarations+*                                                                      *+************************************************************************+-}++visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]+visibleIfConDecls IfAbstractTyCon  = []+visibleIfConDecls (IfDataTyCon cs) = cs+visibleIfConDecls (IfNewTyCon c)   = [c]++ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]+--  *Excludes* the 'main' name, but *includes* the implicitly-bound names+-- Deeply revolting, because it has to predict what gets bound,+-- especially the question of whether there's a wrapper for a datacon+-- See Note [Implicit TyThings] in HscTypes++-- N.B. the set of names returned here *must* match the set of+-- TyThings returned by HscTypes.implicitTyThings, in the sense that+-- TyThing.getOccName should define a bijection between the two lists.+-- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])+-- The order of the list does not matter.++ifaceDeclImplicitBndrs (IfaceData {ifName = tc_name, ifCons = cons })+  = case cons of+      IfAbstractTyCon -> []+      IfNewTyCon  cd  -> mkNewTyCoOcc (occName tc_name) : ifaceConDeclImplicitBndrs cd+      IfDataTyCon cds -> concatMap ifaceConDeclImplicitBndrs cds++ifaceDeclImplicitBndrs (IfaceClass { ifBody = IfAbstractClass })+  = []++ifaceDeclImplicitBndrs (IfaceClass { ifName = cls_tc_name+                                   , ifBody = IfConcreteClass {+                                        ifClassCtxt = sc_ctxt,+                                        ifSigs      = sigs,+                                        ifATs       = ats+                                     }})+  = --   (possibly) newtype coercion+    co_occs +++    --    data constructor (DataCon namespace)+    --    data worker (Id namespace)+    --    no wrapper (class dictionaries never have a wrapper)+    [dc_occ, dcww_occ] +++    -- associated types+    [occName (ifName at) | IfaceAT at _ <- ats ] +++    -- superclass selectors+    [mkSuperDictSelOcc n cls_tc_occ | n <- [1..n_ctxt]] +++    -- operation selectors+    [occName op | IfaceClassOp op  _ _ <- sigs]+  where+    cls_tc_occ = occName cls_tc_name+    n_ctxt = length sc_ctxt+    n_sigs = length sigs+    co_occs | is_newtype = [mkNewTyCoOcc cls_tc_occ]+            | otherwise  = []+    dcww_occ = mkDataConWorkerOcc dc_occ+    dc_occ = mkClassDataConOcc cls_tc_occ+    is_newtype = n_sigs + n_ctxt == 1 -- Sigh (keep this synced with buildClass)++ifaceDeclImplicitBndrs _ = []++ifaceConDeclImplicitBndrs :: IfaceConDecl -> [OccName]+ifaceConDeclImplicitBndrs (IfCon {+        ifConWrapper = has_wrapper, ifConName = con_name })+  = [occName con_name, work_occ] ++ wrap_occs+  where+    con_occ = occName con_name+    work_occ  = mkDataConWorkerOcc con_occ                   -- Id namespace+    wrap_occs | has_wrapper = [mkDataConWrapperOcc con_occ]  -- Id namespace+              | otherwise   = []++-- -----------------------------------------------------------------------------+-- The fingerprints of an IfaceDecl++       -- We better give each name bound by the declaration a+       -- different fingerprint!  So we calculate the fingerprint of+       -- each binder by combining the fingerprint of the whole+       -- declaration with the name of the binder. (#5614, #7215)+ifaceDeclFingerprints :: Fingerprint -> IfaceDecl -> [(OccName,Fingerprint)]+ifaceDeclFingerprints hash decl+  = (getOccName decl, hash) :+    [ (occ, computeFingerprint' (hash,occ))+    | occ <- ifaceDeclImplicitBndrs decl ]+  where+     computeFingerprint' =+       unsafeDupablePerformIO+        . computeFingerprint (panic "ifaceDeclFingerprints")++{-+************************************************************************+*                                                                      *+                Expressions+*                                                                      *+************************************************************************+-}++data IfaceExpr+  = IfaceLcl    IfLclName+  | IfaceExt    IfExtName+  | IfaceType   IfaceType+  | IfaceCo     IfaceCoercion+  | IfaceTuple  TupleSort [IfaceExpr]   -- Saturated; type arguments omitted+  | IfaceLam    IfaceLamBndr IfaceExpr+  | IfaceApp    IfaceExpr IfaceExpr+  | IfaceCase   IfaceExpr IfLclName [IfaceAlt]+  | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]+  | IfaceLet    IfaceBinding  IfaceExpr+  | IfaceCast   IfaceExpr IfaceCoercion+  | IfaceLit    Literal+  | IfaceFCall  ForeignCall IfaceType+  | IfaceTick   IfaceTickish IfaceExpr    -- from Tick tickish E++data IfaceTickish+  = IfaceHpcTick Module Int                -- from HpcTick x+  | IfaceSCC     CostCentre Bool Bool      -- from ProfNote+  | IfaceSource  RealSrcSpan String        -- from SourceNote+  -- no breakpoints: we never export these into interface files++type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)+        -- Note: IfLclName, not IfaceBndr (and same with the case binder)+        -- We reconstruct the kind/type of the thing from the context+        -- thus saving bulk in interface files++data IfaceConAlt = IfaceDefault+                 | IfaceDataAlt IfExtName+                 | IfaceLitAlt Literal++data IfaceBinding+  = IfaceNonRec IfaceLetBndr IfaceExpr+  | IfaceRec    [(IfaceLetBndr, IfaceExpr)]++-- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too+-- It's used for *non-top-level* let/rec binders+-- See Note [IdInfo on nested let-bindings]+data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo IfaceJoinInfo++data IfaceJoinInfo = IfaceNotJoinPoint+                   | IfaceJoinPoint JoinArity++{-+Note [Empty case alternatives]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In IfaceSyn an IfaceCase does not record the types of the alternatives,+unlike CorSyn Case.  But we need this type if the alternatives are empty.+Hence IfaceECase.  See Note [Empty case alternatives] in CoreSyn.++Note [Expose recursive functions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For supercompilation we want to put *all* unfoldings in the interface+file, even for functions that are recursive (or big).  So we need to+know when an unfolding belongs to a loop-breaker so that we can refrain+from inlining it (except during supercompilation).++Note [IdInfo on nested let-bindings]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Occasionally we want to preserve IdInfo on nested let bindings. The one+that came up was a NOINLINE pragma on a let-binding inside an INLINE+function.  The user (Duncan Coutts) really wanted the NOINLINE control+to cross the separate compilation boundary.++In general we retain all info that is left by CoreTidy.tidyLetBndr, since+that is what is seen by importing module with --make+++************************************************************************+*                                                                      *+              Printing IfaceDecl+*                                                                      *+************************************************************************+-}++pprAxBranch :: SDoc -> IfaceAxBranch -> SDoc+-- The TyCon might be local (just an OccName), or this might+-- be a branch for an imported TyCon, so it would be an ExtName+-- So it's easier to take an SDoc here+--+-- This function is used+--    to print interface files,+--    in debug messages+--    in :info F for GHCi, which goes via toConToIfaceDecl on the family tycon+-- For user error messages we use Coercion.pprCoAxiom and friends+pprAxBranch pp_tc (IfaceAxBranch { ifaxbTyVars = tvs+                                 , ifaxbCoVars = _cvs+                                 , ifaxbLHS = pat_tys+                                 , ifaxbRHS = rhs+                                 , ifaxbIncomps = incomps })+  = WARN( not (null _cvs), pp_tc $$ ppr _cvs )+    hang ppr_binders 2 (hang pp_lhs 2 (equals <+> ppr rhs))+    $+$+    nest 2 maybe_incomps+  where+    -- See Note [Printing foralls in type family instances] in IfaceType+    ppr_binders = pprUserIfaceForAll $ map (mkIfaceForAllTvBndr Specified) tvs+    pp_lhs = hang pp_tc 2 (pprParendIfaceAppArgs pat_tys)+    maybe_incomps = ppUnless (null incomps) $ parens $+                    text "incompatible indices:" <+> ppr incomps++instance Outputable IfaceAnnotation where+  ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value++instance NamedThing IfaceClassOp where+  getName (IfaceClassOp n _ _) = n++instance HasOccName IfaceClassOp where+  occName = getOccName++instance NamedThing IfaceConDecl where+  getName = ifConName++instance HasOccName IfaceConDecl where+  occName = getOccName++instance NamedThing IfaceDecl where+  getName = ifName++instance HasOccName IfaceDecl where+  occName = getOccName++instance Outputable IfaceDecl where+  ppr = pprIfaceDecl showToIface++{-+Note [Minimal complete definition] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The minimal complete definition should only be included if a complete+class definition is shown. Since the minimal complete definition is+anonymous we can't reuse the same mechanism that is used for the+filtering of method signatures. Instead we just check if anything at all is+filtered and hide it in that case.+-}++data ShowSub+  = ShowSub+      { ss_how_much :: ShowHowMuch+      , ss_forall :: ShowForAllFlag }++-- See Note [Printing IfaceDecl binders]+-- The alternative pretty printer referred to in the note.+newtype AltPpr = AltPpr (Maybe (OccName -> SDoc))++data ShowHowMuch+  = ShowHeader AltPpr -- ^Header information only, not rhs+  | ShowSome [OccName] AltPpr+  -- ^ Show only some sub-components. Specifically,+  --+  -- [@[]@] Print all sub-components.+  -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@;+  -- elide other sub-components to @...@+  -- May 14: the list is max 1 element long at the moment+  | ShowIface+  -- ^Everything including GHC-internal information (used in --show-iface)++{-+Note [Printing IfaceDecl binders]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The binders in an IfaceDecl are just OccNames, so we don't know what module they+come from.  But when we pretty-print a TyThing by converting to an IfaceDecl+(see PprTyThing), the TyThing may come from some other module so we really need+the module qualifier.  We solve this by passing in a pretty-printer for the+binders.++When printing an interface file (--show-iface), we want to print+everything unqualified, so we can just print the OccName directly.+-}++instance Outputable ShowHowMuch where+  ppr (ShowHeader _)    = text "ShowHeader"+  ppr ShowIface         = text "ShowIface"+  ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs++showToHeader :: ShowSub+showToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing+                       , ss_forall = ShowForAllWhen }++showToIface :: ShowSub+showToIface = ShowSub { ss_how_much = ShowIface+                      , ss_forall = ShowForAllWhen }++ppShowIface :: ShowSub -> SDoc -> SDoc+ppShowIface (ShowSub { ss_how_much = ShowIface }) doc = doc+ppShowIface _                                     _   = Outputable.empty++-- show if all sub-components or the complete interface is shown+ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]+ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc+ppShowAllSubs (ShowSub { ss_how_much = ShowIface })     doc = doc+ppShowAllSubs _                                         _   = Outputable.empty++ppShowRhs :: ShowSub -> SDoc -> SDoc+ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _   = Outputable.empty+ppShowRhs _                                        doc = doc++showSub :: HasOccName n => ShowSub -> n -> Bool+showSub (ShowSub { ss_how_much = ShowHeader _ })     _     = False+showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing+showSub (ShowSub { ss_how_much = _ })              _     = True++ppr_trim :: [Maybe SDoc] -> [SDoc]+-- Collapse a group of Nothings to a single "..."+ppr_trim xs+  = snd (foldr go (False, []) xs)+  where+    go (Just doc) (_,     so_far) = (False, doc : so_far)+    go Nothing    (True,  so_far) = (True, so_far)+    go Nothing    (False, so_far) = (True, text "..." : so_far)++isIfaceDataInstance :: IfaceTyConParent -> Bool+isIfaceDataInstance IfNoParent = False+isIfaceDataInstance _          = True++pprClassRoles :: ShowSub -> IfaceTopBndr -> [IfaceTyConBinder] -> [Role] -> SDoc+pprClassRoles ss clas binders roles =+    pprRoles (== Nominal)+             (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))+             binders+             roles++pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc+-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi+--     See Note [Pretty-printing TyThings] in PprTyThing+pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,+                             ifCtxt = context, ifResKind = kind,+                             ifRoles = roles, ifCons = condecls,+                             ifParent = parent,+                             ifGadtSyntax = gadt,+                             ifBinders = binders })++  | gadt      = vcat [ pp_roles+                     , pp_nd <+> pp_lhs <+> pp_kind <+> pp_where+                     , nest 2 (vcat pp_cons)+                     , nest 2 $ ppShowIface ss pp_extra ]+  | otherwise = vcat [ pp_roles+                     , hang (pp_nd <+> pp_lhs) 2 (add_bars pp_cons)+                     , nest 2 $ ppShowIface ss pp_extra ]+  where+    is_data_instance = isIfaceDataInstance parent+    -- See Note [Printing foralls in type family instances] in IfaceType+    pp_data_inst_forall :: SDoc+    pp_data_inst_forall = pprUserIfaceForAll forall_bndrs++    forall_bndrs :: [IfaceForAllBndr]+    forall_bndrs = [Bndr (binderVar tc_bndr) Specified | tc_bndr <- binders]++    cons       = visibleIfConDecls condecls+    pp_where   = ppWhen (gadt && not (null cons)) $ text "where"+    pp_cons    = ppr_trim (map show_con cons) :: [SDoc]+    pp_kind+      | isIfaceLiftedTypeKind kind = empty+      | otherwise = dcolon <+> ppr kind++    pp_lhs = case parent of+               IfNoParent -> pprIfaceDeclHead context ss tycon binders Nothing+               IfDataInstance{}+                          -> text "instance" <+> pp_data_inst_forall+                                             <+> pprIfaceTyConParent parent++    pp_roles+      | is_data_instance = empty+      | otherwise        = pprRoles (== Representational)+                                    (pprPrefixIfDeclBndr+                                        (ss_how_much ss)+                                        (occName tycon))+                                    binders roles+            -- Don't display roles for data family instances (yet)+            -- See discussion on #8672.++    add_bars []     = Outputable.empty+    add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs)++    ok_con dc = showSub ss dc || any (showSub ss . flSelector) (ifConFields dc)++    show_con dc+      | ok_con dc = Just $ pprIfaceConDecl ss gadt tycon binders parent dc+      | otherwise = Nothing++    pp_nd = case condecls of+              IfAbstractTyCon{} -> text "data"+              IfDataTyCon{}     -> text "data"+              IfNewTyCon{}      -> text "newtype"++    pp_extra = vcat [pprCType ctype]++pprIfaceDecl ss (IfaceClass { ifName  = clas+                            , ifRoles = roles+                            , ifFDs    = fds+                            , ifBinders = binders+                            , ifBody = IfAbstractClass })+  = vcat [ pprClassRoles ss clas binders roles+         , text "class" <+> pprIfaceDeclHead [] ss clas binders Nothing+                                <+> pprFundeps fds ]++pprIfaceDecl ss (IfaceClass { ifName  = clas+                            , ifRoles = roles+                            , ifFDs    = fds+                            , ifBinders = binders+                            , ifBody = IfConcreteClass {+                                ifATs = ats,+                                ifSigs = sigs,+                                ifClassCtxt = context,+                                ifMinDef = minDef+                              }})+  = vcat [ pprClassRoles ss clas binders roles+         , text "class" <+> pprIfaceDeclHead context ss clas binders Nothing+                                <+> pprFundeps fds <+> pp_where+         , nest 2 (vcat [ vcat asocs, vcat dsigs+                        , ppShowAllSubs ss (pprMinDef minDef)])]+    where+      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where")++      asocs = ppr_trim $ map maybeShowAssoc ats+      dsigs = ppr_trim $ map maybeShowSig sigs++      maybeShowAssoc :: IfaceAT -> Maybe SDoc+      maybeShowAssoc asc@(IfaceAT d _)+        | showSub ss d = Just $ pprIfaceAT ss asc+        | otherwise    = Nothing++      maybeShowSig :: IfaceClassOp -> Maybe SDoc+      maybeShowSig sg+        | showSub ss sg = Just $  pprIfaceClassOp ss sg+        | otherwise     = Nothing++      pprMinDef :: BooleanFormula IfLclName -> SDoc+      pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions+        text "{-# MINIMAL" <+>+        pprBooleanFormula+          (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>+        text "#-}"++pprIfaceDecl ss (IfaceSynonym { ifName    = tc+                              , ifBinders = binders+                              , ifSynRhs  = mono_ty+                              , ifResKind = res_kind})+  = hang (text "type" <+> pprIfaceDeclHead [] ss tc binders Nothing <+> equals)+       2 (sep [ pprIfaceForAll tvs, pprIfaceContextArr theta, ppr tau+              , ppUnless (isIfaceLiftedTypeKind res_kind) (dcolon <+> ppr res_kind) ])+  where+    (tvs, theta, tau) = splitIfaceSigmaTy mono_ty++pprIfaceDecl ss (IfaceFamily { ifName = tycon+                             , ifFamFlav = rhs, ifBinders = binders+                             , ifResKind = res_kind+                             , ifResVar = res_var, ifFamInj = inj })+  | IfaceDataFamilyTyCon <- rhs+  = text "data family" <+> pprIfaceDeclHead [] ss tycon binders Nothing++  | otherwise+  = hang (text "type family"+            <+> pprIfaceDeclHead [] ss tycon binders (Just res_kind)+            <+> ppShowRhs ss (pp_where rhs))+       2 (pp_inj res_var inj <+> ppShowRhs ss (pp_rhs rhs))+    $$+    nest 2 (ppShowRhs ss (pp_branches rhs))+  where+    pp_where (IfaceClosedSynFamilyTyCon {}) = text "where"+    pp_where _                              = empty++    pp_inj Nothing    _   = empty+    pp_inj (Just res) inj+       | Injective injectivity <- inj = hsep [ equals, ppr res+                                             , pp_inj_cond res injectivity]+       | otherwise = hsep [ equals, ppr res ]++    pp_inj_cond res inj = case filterByList inj binders of+       []  -> empty+       tvs -> hsep [vbar, ppr res, text "->", interppSP (map ifTyConBinderName tvs)]++    pp_rhs IfaceDataFamilyTyCon+      = ppShowIface ss (text "data")+    pp_rhs IfaceOpenSynFamilyTyCon+      = ppShowIface ss (text "open")+    pp_rhs IfaceAbstractClosedSynFamilyTyCon+      = ppShowIface ss (text "closed, abstract")+    pp_rhs (IfaceClosedSynFamilyTyCon {})+      = empty  -- see pp_branches+    pp_rhs IfaceBuiltInSynFamTyCon+      = ppShowIface ss (text "built-in")++    pp_branches (IfaceClosedSynFamilyTyCon (Just (ax, brs)))+      = vcat (map (pprAxBranch+                     (pprPrefixIfDeclBndr+                       (ss_how_much ss)+                       (occName tycon))+                  ) brs)+        $$ ppShowIface ss (text "axiom" <+> ppr ax)+    pp_branches _ = Outputable.empty++pprIfaceDecl _ (IfacePatSyn { ifName = name,+                              ifPatUnivBndrs = univ_bndrs, ifPatExBndrs = ex_bndrs,+                              ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,+                              ifPatArgs = arg_tys,+                              ifPatTy = pat_ty} )+  = sdocWithDynFlags mk_msg+  where+    mk_msg dflags+      = hang (text "pattern" <+> pprPrefixOcc name)+           2 (dcolon <+> sep [univ_msg+                             , pprIfaceContextArr req_ctxt+                             , ppWhen insert_empty_ctxt $ parens empty <+> darrow+                             , ex_msg+                             , pprIfaceContextArr prov_ctxt+                             , pprIfaceType $ foldr (IfaceFunTy VisArg) pat_ty arg_tys ])+      where+        univ_msg = pprUserIfaceForAll univ_bndrs+        ex_msg   = pprUserIfaceForAll ex_bndrs++        insert_empty_ctxt = null req_ctxt+            && not (null prov_ctxt && isEmpty dflags ex_msg)++pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,+                              ifIdDetails = details, ifIdInfo = info })+  = vcat [ hang (pprPrefixIfDeclBndr (ss_how_much ss) (occName var) <+> dcolon)+              2 (pprIfaceSigmaType (ss_forall ss) ty)+         , ppShowIface ss (ppr details)+         , ppShowIface ss (ppr info) ]++pprIfaceDecl _ (IfaceAxiom { ifName = name, ifTyCon = tycon+                           , ifAxBranches = branches })+  = hang (text "axiom" <+> ppr name <+> dcolon)+       2 (vcat $ map (pprAxBranch (ppr tycon)) branches)++pprCType :: Maybe CType -> SDoc+pprCType Nothing      = Outputable.empty+pprCType (Just cType) = text "C type:" <+> ppr cType++-- if, for each role, suppress_if role is True, then suppress the role+-- output+pprRoles :: (Role -> Bool) -> SDoc -> [IfaceTyConBinder]+         -> [Role] -> SDoc+pprRoles suppress_if tyCon bndrs roles+  = sdocWithDynFlags $ \dflags ->+      let froles = suppressIfaceInvisibles dflags bndrs roles+      in ppUnless (all suppress_if froles || null froles) $+         text "type role" <+> tyCon <+> hsep (map ppr froles)++pprInfixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc+pprInfixIfDeclBndr (ShowSome _ (AltPpr (Just ppr_bndr))) name+  = pprInfixVar (isSymOcc name) (ppr_bndr name)+pprInfixIfDeclBndr _ name+  = pprInfixVar (isSymOcc name) (ppr name)++pprPrefixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc+pprPrefixIfDeclBndr (ShowHeader (AltPpr (Just ppr_bndr))) name+  = parenSymOcc name (ppr_bndr name)+pprPrefixIfDeclBndr (ShowSome _ (AltPpr (Just ppr_bndr))) name+  = parenSymOcc name (ppr_bndr name)+pprPrefixIfDeclBndr _ name+  = parenSymOcc name (ppr name)++instance Outputable IfaceClassOp where+   ppr = pprIfaceClassOp showToIface++pprIfaceClassOp :: ShowSub -> IfaceClassOp -> SDoc+pprIfaceClassOp ss (IfaceClassOp n ty dm)+  = pp_sig n ty $$ generic_dm+  where+   generic_dm | Just (GenericDM dm_ty) <- dm+              =  text "default" <+> pp_sig n dm_ty+              | otherwise+              = empty+   pp_sig n ty+     = pprPrefixIfDeclBndr (ss_how_much ss) (occName n)+     <+> dcolon+     <+> pprIfaceSigmaType ShowForAllWhen ty++instance Outputable IfaceAT where+   ppr = pprIfaceAT showToIface++pprIfaceAT :: ShowSub -> IfaceAT -> SDoc+pprIfaceAT ss (IfaceAT d mb_def)+  = vcat [ pprIfaceDecl ss d+         , case mb_def of+              Nothing  -> Outputable.empty+              Just rhs -> nest 2 $+                          text "Default:" <+> ppr rhs ]++instance Outputable IfaceTyConParent where+  ppr p = pprIfaceTyConParent p++pprIfaceTyConParent :: IfaceTyConParent -> SDoc+pprIfaceTyConParent IfNoParent+  = Outputable.empty+pprIfaceTyConParent (IfDataInstance _ tc tys)+  = pprIfaceTypeApp topPrec tc tys++pprIfaceDeclHead :: IfaceContext -> ShowSub -> Name+                 -> [IfaceTyConBinder]   -- of the tycon, for invisible-suppression+                 -> Maybe IfaceKind+                 -> SDoc+pprIfaceDeclHead context ss tc_occ bndrs m_res_kind+  = sdocWithDynFlags $ \ dflags ->+    sep [ pprIfaceContextArr context+        , pprPrefixIfDeclBndr (ss_how_much ss) (occName tc_occ)+          <+> pprIfaceTyConBinders (suppressIfaceInvisibles dflags bndrs bndrs)+        , maybe empty (\res_kind -> dcolon <+> pprIfaceType res_kind) m_res_kind ]++pprIfaceConDecl :: ShowSub -> Bool+                -> IfaceTopBndr+                -> [IfaceTyConBinder]+                -> IfaceTyConParent+                -> IfaceConDecl -> SDoc+pprIfaceConDecl ss gadt_style tycon tc_binders parent+        (IfCon { ifConName = name, ifConInfix = is_infix,+                 ifConUserTvBinders = user_tvbs,+                 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,+                 ifConStricts = stricts, ifConFields = fields })+  | gadt_style = pp_prefix_con <+> dcolon <+> ppr_gadt_ty+  | otherwise  = ppr_ex_quant pp_h98_con+  where+    pp_h98_con+      | not (null fields) = pp_prefix_con <+> pp_field_args+      | is_infix+      , [ty1, ty2] <- pp_args+      = sep [ ty1+            , pprInfixIfDeclBndr how_much (occName name)+            , ty2]+      | otherwise = pp_prefix_con <+> sep pp_args++    how_much = ss_how_much ss+    tys_w_strs :: [(IfaceBang, IfaceType)]+    tys_w_strs = zip stricts arg_tys+    pp_prefix_con = pprPrefixIfDeclBndr how_much (occName name)++    -- If we're pretty-printing a H98-style declaration with existential+    -- quantification, then user_tvbs will always consist of the universal+    -- tyvar binders followed by the existential tyvar binders. So to recover+    -- the visibilities of the existential tyvar binders, we can simply drop+    -- the universal tyvar binders from user_tvbs.+    ex_tvbs = dropList tc_binders user_tvbs+    ppr_ex_quant = pprIfaceForAllPartMust ex_tvbs ctxt+    pp_gadt_res_ty = mk_user_con_res_ty eq_spec+    ppr_gadt_ty = pprIfaceForAllPart user_tvbs ctxt pp_tau++        -- A bit gruesome this, but we can't form the full con_tau, and ppr it,+        -- because we don't have a Name for the tycon, only an OccName+    pp_tau | null fields+           = case pp_args ++ [pp_gadt_res_ty] of+                (t:ts) -> fsep (t : map (arrow <+>) ts)+                []     -> panic "pp_con_taus"+           | otherwise+           = sep [pp_field_args, arrow <+> pp_gadt_res_ty]++    ppr_bang IfNoBang = whenPprDebug $ char '_'+    ppr_bang IfStrict = char '!'+    ppr_bang IfUnpack = text "{-# UNPACK #-}"+    ppr_bang (IfUnpackCo co) = text "! {-# UNPACK #-}" <>+                               pprParendIfaceCoercion co++    pprFieldArgTy, pprArgTy :: (IfaceBang, IfaceType) -> SDoc+    -- If using record syntax, the only reason one would need to parenthesize+    -- a compound field type is if it's preceded by a bang pattern.+    pprFieldArgTy (bang, ty) = ppr_arg_ty (bang_prec bang) bang ty+    -- If not using record syntax, a compound field type might need to be+    -- parenthesize if one of the following holds:+    --+    -- 1. We're using Haskell98 syntax.+    -- 2. The field type is preceded with a bang pattern.+    pprArgTy (bang, ty) = ppr_arg_ty (max gadt_prec (bang_prec bang)) bang ty++    ppr_arg_ty :: PprPrec -> IfaceBang -> IfaceType -> SDoc+    ppr_arg_ty prec bang ty = ppr_bang bang <> pprPrecIfaceType prec ty++    -- If we're displaying the fields GADT-style, e.g.,+    --+    --   data Foo a where+    --     MkFoo :: Maybe a -> Foo+    --+    -- Then there is no inherent need to parenthesize compound fields like+    -- `Maybe a` (bang patterns notwithstanding). If we're displaying the+    -- fields Haskell98-style, e.g.,+    --+    --   data Foo a = MkFoo (Maybe a)+    --+    -- Then we *must* parenthesize compound fields like (Maybe a).+    gadt_prec :: PprPrec+    gadt_prec+      | gadt_style = topPrec+      | otherwise  = appPrec++    -- The presence of bang patterns or UNPACK annotations requires+    -- surrounding the type with parentheses, if needed (#13699)+    bang_prec :: IfaceBang -> PprPrec+    bang_prec IfNoBang     = topPrec+    bang_prec IfStrict     = appPrec+    bang_prec IfUnpack     = appPrec+    bang_prec IfUnpackCo{} = appPrec++    pp_args :: [SDoc] -- No records, e.g., `  Maybe a  ->  Int -> ...` or+                      --                   `!(Maybe a) -> !Int -> ...`+    pp_args = map pprArgTy tys_w_strs++    pp_field_args :: SDoc -- Records, e.g., { x ::   Maybe a,  y ::  Int } or+                          --                { x :: !(Maybe a), y :: !Int }+    pp_field_args = braces $ sep $ punctuate comma $ ppr_trim $+                    zipWith maybe_show_label fields tys_w_strs++    maybe_show_label :: FieldLabel -> (IfaceBang, IfaceType) -> Maybe SDoc+    maybe_show_label lbl bty+      | showSub ss sel = Just (pprPrefixIfDeclBndr how_much occ+                                <+> dcolon <+> pprFieldArgTy bty)+      | otherwise      = Nothing+      where+        sel = flSelector lbl+        occ = mkVarOccFS (flLabel lbl)++    mk_user_con_res_ty :: IfaceEqSpec -> SDoc+    -- See Note [Result type of a data family GADT]+    mk_user_con_res_ty eq_spec+      | IfDataInstance _ tc tys <- parent+      = pprIfaceType (IfaceTyConApp tc (substIfaceAppArgs gadt_subst tys))+      | otherwise+      = ppr_tc_app gadt_subst+      where+        gadt_subst = mkIfaceTySubst eq_spec++    -- When pretty-printing a GADT return type, we:+    --+    -- 1. Take the data tycon binders, extract their variable names and+    --    visibilities, and construct suitable arguments from them. (This is+    --    the role of mk_tc_app_args.)+    -- 2. Apply the GADT substitution constructed from the eq_spec.+    --    (See Note [Result type of a data family GADT].)+    -- 3. Pretty-print the data type constructor applied to its arguments.+    --    This process will omit any invisible arguments, such as coercion+    --    variables, if necessary. (See Note+    --    [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep.)+    ppr_tc_app gadt_subst =+      pprPrefixIfDeclBndr how_much (occName tycon)+      <+> pprIfaceAppArgs+            (substIfaceAppArgs gadt_subst (mk_tc_app_args tc_binders))++    mk_tc_app_args :: [IfaceTyConBinder] -> IfaceAppArgs+    mk_tc_app_args [] = IA_Nil+    mk_tc_app_args (Bndr bndr vis:tc_bndrs) =+      IA_Arg (IfaceTyVar (ifaceBndrName bndr)) (tyConBndrVisArgFlag vis)+             (mk_tc_app_args tc_bndrs)++instance Outputable IfaceRule where+  ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,+                   ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,+                   ifRuleOrph = orph })+    = sep [ hsep [ pprRuleName name+                 , if isOrphan orph then text "[orphan]" else Outputable.empty+                 , ppr act+                 , pp_foralls ]+          , nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),+                        text "=" <+> ppr rhs]) ]+    where+      pp_foralls = ppUnless (null bndrs) $ forAllLit <+> pprIfaceBndrs bndrs <> dot++instance Outputable IfaceClsInst where+  ppr (IfaceClsInst { ifDFun = dfun_id, ifOFlag = flag+                    , ifInstCls = cls, ifInstTys = mb_tcs+                    , ifInstOrph = orph })+    = hang (text "instance" <+> ppr flag+              <+> (if isOrphan orph then text "[orphan]" else Outputable.empty)+              <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))+         2 (equals <+> ppr dfun_id)++instance Outputable IfaceFamInst where+  ppr (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs+                    , ifFamInstAxiom = tycon_ax, ifFamInstOrph = orph })+    = hang (text "family instance"+              <+> (if isOrphan orph then text "[orphan]" else Outputable.empty)+              <+> ppr fam <+> pprWithCommas (brackets . ppr_rough) mb_tcs)+         2 (equals <+> ppr tycon_ax)++ppr_rough :: Maybe IfaceTyCon -> SDoc+ppr_rough Nothing   = dot+ppr_rough (Just tc) = ppr tc++{-+Note [Result type of a data family GADT]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+   data family T a+   data instance T (p,q) where+      T1 :: T (Int, Maybe c)+      T2 :: T (Bool, q)++The IfaceDecl actually looks like++   data TPr p q where+      T1 :: forall p q. forall c. (p~Int,q~Maybe c) => TPr p q+      T2 :: forall p q. (p~Bool) => TPr p q++To reconstruct the result types for T1 and T2 that we+want to pretty print, we substitute the eq-spec+[p->Int, q->Maybe c] in the arg pattern (p,q) to give+   T (Int, Maybe c)+Remember that in IfaceSyn, the TyCon and DataCon share the same+universal type variables.++----------------------------- Printing IfaceExpr ------------------------------------+-}++instance Outputable IfaceExpr where+    ppr e = pprIfaceExpr noParens e++noParens :: SDoc -> SDoc+noParens pp = pp++pprParendIfaceExpr :: IfaceExpr -> SDoc+pprParendIfaceExpr = pprIfaceExpr parens++-- | Pretty Print an IfaceExpre+--+-- The first argument should be a function that adds parens in context that need+-- an atomic value (e.g. function args)+pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc++pprIfaceExpr _       (IfaceLcl v)       = ppr v+pprIfaceExpr _       (IfaceExt v)       = ppr v+pprIfaceExpr _       (IfaceLit l)       = ppr l+pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)+pprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty+pprIfaceExpr _       (IfaceCo co)       = text "@~" <+> pprParendIfaceCoercion co++pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])+pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (pprWithCommas ppr as)++pprIfaceExpr add_par i@(IfaceLam _ _)+  = add_par (sep [char '\\' <+> sep (map pprIfaceLamBndr bndrs) <+> arrow,+                  pprIfaceExpr noParens body])+  where+    (bndrs,body) = collect [] i+    collect bs (IfaceLam b e) = collect (b:bs) e+    collect bs e              = (reverse bs, e)++pprIfaceExpr add_par (IfaceECase scrut ty)+  = add_par (sep [ text "case" <+> pprIfaceExpr noParens scrut+                 , text "ret_ty" <+> pprParendIfaceType ty+                 , text "of {}" ])++pprIfaceExpr add_par (IfaceCase scrut bndr [(con, bs, rhs)])+  = add_par (sep [text "case"+                        <+> pprIfaceExpr noParens scrut <+> text "of"+                        <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,+                  pprIfaceExpr noParens rhs <+> char '}'])++pprIfaceExpr add_par (IfaceCase scrut bndr alts)+  = add_par (sep [text "case"+                        <+> pprIfaceExpr noParens scrut <+> text "of"+                        <+> ppr bndr <+> char '{',+                  nest 2 (sep (map ppr_alt alts)) <+> char '}'])++pprIfaceExpr _       (IfaceCast expr co)+  = sep [pprParendIfaceExpr expr,+         nest 2 (text "`cast`"),+         pprParendIfaceCoercion co]++pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)+  = add_par (sep [text "let {",+                  nest 2 (ppr_bind (b, rhs)),+                  text "} in",+                  pprIfaceExpr noParens body])++pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)+  = add_par (sep [text "letrec {",+                  nest 2 (sep (map ppr_bind pairs)),+                  text "} in",+                  pprIfaceExpr noParens body])++pprIfaceExpr add_par (IfaceTick tickish e)+  = add_par (pprIfaceTickish tickish <+> pprIfaceExpr noParens e)++ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc+ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,+                         arrow <+> pprIfaceExpr noParens rhs]++ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc+ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)++ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc+ppr_bind (IfLetBndr b ty info ji, rhs)+  = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr ji <+> ppr info),+         equals <+> pprIfaceExpr noParens rhs]++------------------+pprIfaceTickish :: IfaceTickish -> SDoc+pprIfaceTickish (IfaceHpcTick m ix)+  = braces (text "tick" <+> ppr m <+> ppr ix)+pprIfaceTickish (IfaceSCC cc tick scope)+  = braces (pprCostCentreCore cc <+> ppr tick <+> ppr scope)+pprIfaceTickish (IfaceSource src _names)+  = braces (pprUserRealSpan True src)++------------------+pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc+pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun $+                                          nest 2 (pprParendIfaceExpr arg) : args+pprIfaceApp fun                args = sep (pprParendIfaceExpr fun : args)++------------------+instance Outputable IfaceConAlt where+    ppr IfaceDefault      = text "DEFAULT"+    ppr (IfaceLitAlt l)   = ppr l+    ppr (IfaceDataAlt d)  = ppr d++------------------+instance Outputable IfaceIdDetails where+  ppr IfVanillaId       = Outputable.empty+  ppr (IfRecSelId tc b) = text "RecSel" <+> ppr tc+                          <+> if b+                                then text "<naughty>"+                                else Outputable.empty+  ppr IfDFunId          = text "DFunId"++instance Outputable IfaceIdInfo where+  ppr NoInfo       = Outputable.empty+  ppr (HasInfo is) = text "{-" <+> pprWithCommas ppr is+                     <+> text "-}"++instance Outputable IfaceInfoItem where+  ppr (HsUnfold lb unf)     = text "Unfolding"+                              <> ppWhen lb (text "(loop-breaker)")+                              <> colon <+> ppr unf+  ppr (HsInline prag)       = text "Inline:" <+> ppr prag+  ppr (HsArity arity)       = text "Arity:" <+> int arity+  ppr (HsStrictness str) = text "Strictness:" <+> pprIfaceStrictSig str+  ppr HsNoCafRefs           = text "HasNoCafRefs"+  ppr HsLevity              = text "Never levity-polymorphic"++instance Outputable IfaceJoinInfo where+  ppr IfaceNotJoinPoint   = empty+  ppr (IfaceJoinPoint ar) = angleBrackets (text "join" <+> ppr ar)++instance Outputable IfaceUnfolding where+  ppr (IfCompulsory e)     = text "<compulsory>" <+> parens (ppr e)+  ppr (IfCoreUnfold s e)   = (if s+                                then text "<stable>"+                                else Outputable.empty)+                              <+> parens (ppr e)+  ppr (IfInlineRule a uok bok e) = sep [text "InlineRule"+                                            <+> ppr (a,uok,bok),+                                        pprParendIfaceExpr e]+  ppr (IfDFunUnfold bs es) = hang (text "DFun:" <+> sep (map ppr bs) <> dot)+                                2 (sep (map pprParendIfaceExpr es))++{-+************************************************************************+*                                                                      *+              Finding the Names in IfaceSyn+*                                                                      *+************************************************************************++This is used for dependency analysis in MkIface, so that we+fingerprint a declaration before the things that depend on it.  It+is specific to interface-file fingerprinting in the sense that we+don't collect *all* Names: for example, the DFun of an instance is+recorded textually rather than by its fingerprint when+fingerprinting the instance, so DFuns are not dependencies.+-}++freeNamesIfDecl :: IfaceDecl -> NameSet+freeNamesIfDecl (IfaceId { ifType = t, ifIdDetails = d, ifIdInfo = i})+  = freeNamesIfType t &&&+    freeNamesIfIdInfo i &&&+    freeNamesIfIdDetails d++freeNamesIfDecl (IfaceData { ifBinders = bndrs, ifResKind = res_k+                           , ifParent = p, ifCtxt = ctxt, ifCons = cons })+  = freeNamesIfVarBndrs bndrs &&&+    freeNamesIfType res_k &&&+    freeNamesIfaceTyConParent p &&&+    freeNamesIfContext ctxt &&&+    freeNamesIfConDecls cons++freeNamesIfDecl (IfaceSynonym { ifBinders = bndrs, ifResKind = res_k+                              , ifSynRhs = rhs })+  = freeNamesIfVarBndrs bndrs &&&+    freeNamesIfKind res_k &&&+    freeNamesIfType rhs++freeNamesIfDecl (IfaceFamily { ifBinders = bndrs, ifResKind = res_k+                             , ifFamFlav = flav })+  = freeNamesIfVarBndrs bndrs &&&+    freeNamesIfKind res_k &&&+    freeNamesIfFamFlav flav++freeNamesIfDecl (IfaceClass{ ifBinders = bndrs, ifBody = cls_body })+  = freeNamesIfVarBndrs bndrs &&&+    freeNamesIfClassBody cls_body++freeNamesIfDecl (IfaceAxiom { ifTyCon = tc, ifAxBranches = branches })+  = freeNamesIfTc tc &&&+    fnList freeNamesIfAxBranch branches++freeNamesIfDecl (IfacePatSyn { ifPatMatcher = (matcher, _)+                             , ifPatBuilder = mb_builder+                             , ifPatUnivBndrs = univ_bndrs+                             , ifPatExBndrs = ex_bndrs+                             , ifPatProvCtxt = prov_ctxt+                             , ifPatReqCtxt = req_ctxt+                             , ifPatArgs = args+                             , ifPatTy = pat_ty+                             , ifFieldLabels = lbls })+  = unitNameSet matcher &&&+    maybe emptyNameSet (unitNameSet . fst) mb_builder &&&+    freeNamesIfVarBndrs univ_bndrs &&&+    freeNamesIfVarBndrs ex_bndrs &&&+    freeNamesIfContext prov_ctxt &&&+    freeNamesIfContext req_ctxt &&&+    fnList freeNamesIfType args &&&+    freeNamesIfType pat_ty &&&+    mkNameSet (map flSelector lbls)++freeNamesIfClassBody :: IfaceClassBody -> NameSet+freeNamesIfClassBody IfAbstractClass+  = emptyNameSet+freeNamesIfClassBody (IfConcreteClass{ ifClassCtxt = ctxt, ifATs = ats, ifSigs = sigs })+  = freeNamesIfContext ctxt  &&&+    fnList freeNamesIfAT ats &&&+    fnList freeNamesIfClsSig sigs++freeNamesIfAxBranch :: IfaceAxBranch -> NameSet+freeNamesIfAxBranch (IfaceAxBranch { ifaxbTyVars   = tyvars+                                   , ifaxbCoVars   = covars+                                   , ifaxbLHS      = lhs+                                   , ifaxbRHS      = rhs })+  = fnList freeNamesIfTvBndr tyvars &&&+    fnList freeNamesIfIdBndr covars &&&+    freeNamesIfAppArgs lhs &&&+    freeNamesIfType rhs++freeNamesIfIdDetails :: IfaceIdDetails -> NameSet+freeNamesIfIdDetails (IfRecSelId tc _) =+  either freeNamesIfTc freeNamesIfDecl tc+freeNamesIfIdDetails _                 = emptyNameSet++-- All other changes are handled via the version info on the tycon+freeNamesIfFamFlav :: IfaceFamTyConFlav -> NameSet+freeNamesIfFamFlav IfaceOpenSynFamilyTyCon             = emptyNameSet+freeNamesIfFamFlav IfaceDataFamilyTyCon                = emptyNameSet+freeNamesIfFamFlav (IfaceClosedSynFamilyTyCon (Just (ax, br)))+  = unitNameSet ax &&& fnList freeNamesIfAxBranch br+freeNamesIfFamFlav (IfaceClosedSynFamilyTyCon Nothing) = emptyNameSet+freeNamesIfFamFlav IfaceAbstractClosedSynFamilyTyCon   = emptyNameSet+freeNamesIfFamFlav IfaceBuiltInSynFamTyCon             = emptyNameSet++freeNamesIfContext :: IfaceContext -> NameSet+freeNamesIfContext = fnList freeNamesIfType++freeNamesIfAT :: IfaceAT -> NameSet+freeNamesIfAT (IfaceAT decl mb_def)+  = freeNamesIfDecl decl &&&+    case mb_def of+      Nothing  -> emptyNameSet+      Just rhs -> freeNamesIfType rhs++freeNamesIfClsSig :: IfaceClassOp -> NameSet+freeNamesIfClsSig (IfaceClassOp _n ty dm) = freeNamesIfType ty &&& freeNamesDM dm++freeNamesDM :: Maybe (DefMethSpec IfaceType) -> NameSet+freeNamesDM (Just (GenericDM ty)) = freeNamesIfType ty+freeNamesDM _                     = emptyNameSet++freeNamesIfConDecls :: IfaceConDecls -> NameSet+freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c+freeNamesIfConDecls (IfNewTyCon  c) = freeNamesIfConDecl c+freeNamesIfConDecls _                   = emptyNameSet++freeNamesIfConDecl :: IfaceConDecl -> NameSet+freeNamesIfConDecl (IfCon { ifConExTCvs  = ex_tvs, ifConCtxt = ctxt+                          , ifConArgTys  = arg_tys+                          , ifConFields  = flds+                          , ifConEqSpec  = eq_spec+                          , ifConStricts = bangs })+  = fnList freeNamesIfBndr ex_tvs &&&+    freeNamesIfContext ctxt &&&+    fnList freeNamesIfType arg_tys &&&+    mkNameSet (map flSelector flds) &&&+    fnList freeNamesIfType (map snd eq_spec) &&& -- equality constraints+    fnList freeNamesIfBang bangs++freeNamesIfBang :: IfaceBang -> NameSet+freeNamesIfBang (IfUnpackCo co) = freeNamesIfCoercion co+freeNamesIfBang _               = emptyNameSet++freeNamesIfKind :: IfaceType -> NameSet+freeNamesIfKind = freeNamesIfType++freeNamesIfAppArgs :: IfaceAppArgs -> NameSet+freeNamesIfAppArgs (IA_Arg t _ ts) = freeNamesIfType t &&& freeNamesIfAppArgs ts+freeNamesIfAppArgs IA_Nil          = emptyNameSet++freeNamesIfType :: IfaceType -> NameSet+freeNamesIfType (IfaceFreeTyVar _)    = emptyNameSet+freeNamesIfType (IfaceTyVar _)        = emptyNameSet+freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfAppArgs t+freeNamesIfType (IfaceTyConApp tc ts) = freeNamesIfTc tc &&& freeNamesIfAppArgs ts+freeNamesIfType (IfaceTupleTy _ _ ts) = freeNamesIfAppArgs ts+freeNamesIfType (IfaceLitTy _)        = emptyNameSet+freeNamesIfType (IfaceForAllTy tv t)  = freeNamesIfVarBndr tv &&& freeNamesIfType t+freeNamesIfType (IfaceFunTy _ s t)    = freeNamesIfType s &&& freeNamesIfType t+freeNamesIfType (IfaceCastTy t c)     = freeNamesIfType t &&& freeNamesIfCoercion c+freeNamesIfType (IfaceCoercionTy c)   = freeNamesIfCoercion c++freeNamesIfMCoercion :: IfaceMCoercion -> NameSet+freeNamesIfMCoercion IfaceMRefl    = emptyNameSet+freeNamesIfMCoercion (IfaceMCo co) = freeNamesIfCoercion co++freeNamesIfCoercion :: IfaceCoercion -> NameSet+freeNamesIfCoercion (IfaceReflCo t) = freeNamesIfType t+freeNamesIfCoercion (IfaceGReflCo _ t mco)+  = freeNamesIfType t &&& freeNamesIfMCoercion mco+freeNamesIfCoercion (IfaceFunCo _ c1 c2)+  = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2+freeNamesIfCoercion (IfaceTyConAppCo _ tc cos)+  = freeNamesIfTc tc &&& fnList freeNamesIfCoercion cos+freeNamesIfCoercion (IfaceAppCo c1 c2)+  = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2+freeNamesIfCoercion (IfaceForAllCo _ kind_co co)+  = freeNamesIfCoercion kind_co &&& freeNamesIfCoercion co+freeNamesIfCoercion (IfaceFreeCoVar _) = emptyNameSet+freeNamesIfCoercion (IfaceCoVarCo _)   = emptyNameSet+freeNamesIfCoercion (IfaceHoleCo _)    = emptyNameSet+freeNamesIfCoercion (IfaceAxiomInstCo ax _ cos)+  = unitNameSet ax &&& fnList freeNamesIfCoercion cos+freeNamesIfCoercion (IfaceUnivCo p _ t1 t2)+  = freeNamesIfProv p &&& freeNamesIfType t1 &&& freeNamesIfType t2+freeNamesIfCoercion (IfaceSymCo c)+  = freeNamesIfCoercion c+freeNamesIfCoercion (IfaceTransCo c1 c2)+  = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2+freeNamesIfCoercion (IfaceNthCo _ co)+  = freeNamesIfCoercion co+freeNamesIfCoercion (IfaceLRCo _ co)+  = freeNamesIfCoercion co+freeNamesIfCoercion (IfaceInstCo co co2)+  = freeNamesIfCoercion co &&& freeNamesIfCoercion co2+freeNamesIfCoercion (IfaceKindCo c)+  = freeNamesIfCoercion c+freeNamesIfCoercion (IfaceSubCo co)+  = freeNamesIfCoercion co+freeNamesIfCoercion (IfaceAxiomRuleCo _ax cos)+  -- the axiom is just a string, so we don't count it as a name.+  = fnList freeNamesIfCoercion cos++freeNamesIfProv :: IfaceUnivCoProv -> NameSet+freeNamesIfProv IfaceUnsafeCoerceProv    = emptyNameSet+freeNamesIfProv (IfacePhantomProv co)    = freeNamesIfCoercion co+freeNamesIfProv (IfaceProofIrrelProv co) = freeNamesIfCoercion co+freeNamesIfProv (IfacePluginProv _)      = emptyNameSet++freeNamesIfVarBndr :: VarBndr IfaceBndr vis -> NameSet+freeNamesIfVarBndr (Bndr bndr _) = freeNamesIfBndr bndr++freeNamesIfVarBndrs :: [VarBndr IfaceBndr vis] -> NameSet+freeNamesIfVarBndrs = fnList freeNamesIfVarBndr++freeNamesIfBndr :: IfaceBndr -> NameSet+freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b+freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b++freeNamesIfBndrs :: [IfaceBndr] -> NameSet+freeNamesIfBndrs = fnList freeNamesIfBndr++freeNamesIfLetBndr :: IfaceLetBndr -> NameSet+-- Remember IfaceLetBndr is used only for *nested* bindings+-- The IdInfo can contain an unfolding (in the case of+-- local INLINE pragmas), so look there too+freeNamesIfLetBndr (IfLetBndr _name ty info _ji) = freeNamesIfType ty+                                                 &&& freeNamesIfIdInfo info++freeNamesIfTvBndr :: IfaceTvBndr -> NameSet+freeNamesIfTvBndr (_fs,k) = freeNamesIfKind k+    -- kinds can have Names inside, because of promotion++freeNamesIfIdBndr :: IfaceIdBndr -> NameSet+freeNamesIfIdBndr (_fs,k) = freeNamesIfKind k++freeNamesIfIdInfo :: IfaceIdInfo -> NameSet+freeNamesIfIdInfo NoInfo      = emptyNameSet+freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i++freeNamesItem :: IfaceInfoItem -> NameSet+freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u+freeNamesItem _              = emptyNameSet++freeNamesIfUnfold :: IfaceUnfolding -> NameSet+freeNamesIfUnfold (IfCoreUnfold _ e)     = freeNamesIfExpr e+freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e+freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e+freeNamesIfUnfold (IfDFunUnfold bs es)   = freeNamesIfBndrs bs &&& fnList freeNamesIfExpr es++freeNamesIfExpr :: IfaceExpr -> NameSet+freeNamesIfExpr (IfaceExt v)          = unitNameSet v+freeNamesIfExpr (IfaceFCall _ ty)     = freeNamesIfType ty+freeNamesIfExpr (IfaceType ty)        = freeNamesIfType ty+freeNamesIfExpr (IfaceCo co)          = freeNamesIfCoercion co+freeNamesIfExpr (IfaceTuple _ as)     = fnList freeNamesIfExpr as+freeNamesIfExpr (IfaceLam (b,_) body) = freeNamesIfBndr b &&& freeNamesIfExpr body+freeNamesIfExpr (IfaceApp f a)        = freeNamesIfExpr f &&& freeNamesIfExpr a+freeNamesIfExpr (IfaceCast e co)      = freeNamesIfExpr e &&& freeNamesIfCoercion co+freeNamesIfExpr (IfaceTick _ e)       = freeNamesIfExpr e+freeNamesIfExpr (IfaceECase e ty)     = freeNamesIfExpr e &&& freeNamesIfType ty+freeNamesIfExpr (IfaceCase s _ alts)+  = freeNamesIfExpr s &&& fnList fn_alt alts &&& fn_cons alts+  where+    fn_alt (_con,_bs,r) = freeNamesIfExpr r++    -- Depend on the data constructors.  Just one will do!+    -- Note [Tracking data constructors]+    fn_cons []                            = emptyNameSet+    fn_cons ((IfaceDefault    ,_,_) : xs) = fn_cons xs+    fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con+    fn_cons (_                      : _ ) = emptyNameSet++freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)+  = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body++freeNamesIfExpr (IfaceLet (IfaceRec as) x)+  = fnList fn_pair as &&& freeNamesIfExpr x+  where+    fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs++freeNamesIfExpr _ = emptyNameSet++freeNamesIfTc :: IfaceTyCon -> NameSet+freeNamesIfTc tc = unitNameSet (ifaceTyConName tc)+-- ToDo: shouldn't we include IfaceIntTc & co.?++freeNamesIfRule :: IfaceRule -> NameSet+freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f+                           , ifRuleArgs = es, ifRuleRhs = rhs })+  = unitNameSet f &&&+    fnList freeNamesIfBndr bs &&&+    fnList freeNamesIfExpr es &&&+    freeNamesIfExpr rhs++freeNamesIfFamInst :: IfaceFamInst -> NameSet+freeNamesIfFamInst (IfaceFamInst { ifFamInstFam = famName+                                 , ifFamInstAxiom = axName })+  = unitNameSet famName &&&+    unitNameSet axName++freeNamesIfaceTyConParent :: IfaceTyConParent -> NameSet+freeNamesIfaceTyConParent IfNoParent = emptyNameSet+freeNamesIfaceTyConParent (IfDataInstance ax tc tys)+  = unitNameSet ax &&& freeNamesIfTc tc &&& freeNamesIfAppArgs tys++-- helpers+(&&&) :: NameSet -> NameSet -> NameSet+(&&&) = unionNameSet++fnList :: (a -> NameSet) -> [a] -> NameSet+fnList f = foldr (&&&) emptyNameSet . map f++{-+Note [Tracking data constructors]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In a case expression+   case e of { C a -> ...; ... }+You might think that we don't need to include the datacon C+in the free names, because its type will probably show up in+the free names of 'e'.  But in rare circumstances this may+not happen.   Here's the one that bit me:++   module DynFlags where+     import {-# SOURCE #-} Packages( PackageState )+     data DynFlags = DF ... PackageState ...++   module Packages where+     import DynFlags+     data PackageState = PS ...+     lookupModule (df :: DynFlags)+        = case df of+              DF ...p... -> case p of+                               PS ... -> ...++Now, lookupModule depends on DynFlags, but the transitive dependency+on the *locally-defined* type PackageState is not visible. We need+to take account of the use of the data constructor PS in the pattern match.+++************************************************************************+*                                                                      *+                Binary instances+*                                                                      *+************************************************************************++Note that there is a bit of subtlety here when we encode names. While+IfaceTopBndrs is really just a synonym for Name, we need to take care to+encode them with {get,put}IfaceTopBndr. The difference becomes important when+we go to fingerprint an IfaceDecl. See Note [Fingerprinting IfaceDecls] for+details.++-}++instance Binary IfaceDecl where+    put_ bh (IfaceId name ty details idinfo) = do+        putByte bh 0+        putIfaceTopBndr bh name+        lazyPut bh (ty, details, idinfo)+        -- See Note [Lazy deserialization of IfaceId]++    put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9) = do+        putByte bh 2+        putIfaceTopBndr bh a1+        put_ bh a2+        put_ bh a3+        put_ bh a4+        put_ bh a5+        put_ bh a6+        put_ bh a7+        put_ bh a8+        put_ bh a9++    put_ bh (IfaceSynonym a1 a2 a3 a4 a5) = do+        putByte bh 3+        putIfaceTopBndr bh a1+        put_ bh a2+        put_ bh a3+        put_ bh a4+        put_ bh a5++    put_ bh (IfaceFamily a1 a2 a3 a4 a5 a6) = do+        putByte bh 4+        putIfaceTopBndr bh a1+        put_ bh a2+        put_ bh a3+        put_ bh a4+        put_ bh a5+        put_ bh a6++    -- NB: Written in a funny way to avoid an interface change+    put_ bh (IfaceClass {+                ifName    = a2,+                ifRoles   = a3,+                ifBinders = a4,+                ifFDs     = a5,+                ifBody = IfConcreteClass {+                    ifClassCtxt = a1,+                    ifATs  = a6,+                    ifSigs = a7,+                    ifMinDef  = a8+                }}) = do+        putByte bh 5+        put_ bh a1+        putIfaceTopBndr bh a2+        put_ bh a3+        put_ bh a4+        put_ bh a5+        put_ bh a6+        put_ bh a7+        put_ bh a8++    put_ bh (IfaceAxiom a1 a2 a3 a4) = do+        putByte bh 6+        putIfaceTopBndr bh a1+        put_ bh a2+        put_ bh a3+        put_ bh a4++    put_ bh (IfacePatSyn a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11) = do+        putByte bh 7+        putIfaceTopBndr bh a1+        put_ bh a2+        put_ bh a3+        put_ bh a4+        put_ bh a5+        put_ bh a6+        put_ bh a7+        put_ bh a8+        put_ bh a9+        put_ bh a10+        put_ bh a11++    put_ bh (IfaceClass {+                ifName    = a1,+                ifRoles   = a2,+                ifBinders = a3,+                ifFDs     = a4,+                ifBody = IfAbstractClass }) = do+        putByte bh 8+        putIfaceTopBndr bh a1+        put_ bh a2+        put_ bh a3+        put_ bh a4++    get bh = do+        h <- getByte bh+        case h of+            0 -> do name    <- get bh+                    ~(ty, details, idinfo) <- lazyGet bh+                    -- See Note [Lazy deserialization of IfaceId]+                    return (IfaceId name ty details idinfo)+            1 -> error "Binary.get(TyClDecl): ForeignType"+            2 -> do a1  <- getIfaceTopBndr bh+                    a2  <- get bh+                    a3  <- get bh+                    a4  <- get bh+                    a5  <- get bh+                    a6  <- get bh+                    a7  <- get bh+                    a8  <- get bh+                    a9  <- get bh+                    return (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9)+            3 -> do a1 <- getIfaceTopBndr bh+                    a2 <- get bh+                    a3 <- get bh+                    a4 <- get bh+                    a5 <- get bh+                    return (IfaceSynonym a1 a2 a3 a4 a5)+            4 -> do a1 <- getIfaceTopBndr bh+                    a2 <- get bh+                    a3 <- get bh+                    a4 <- get bh+                    a5 <- get bh+                    a6 <- get bh+                    return (IfaceFamily a1 a2 a3 a4 a5 a6)+            5 -> do a1 <- get bh+                    a2 <- getIfaceTopBndr bh+                    a3 <- get bh+                    a4 <- get bh+                    a5 <- get bh+                    a6 <- get bh+                    a7 <- get bh+                    a8 <- get bh+                    return (IfaceClass {+                        ifName    = a2,+                        ifRoles   = a3,+                        ifBinders = a4,+                        ifFDs     = a5,+                        ifBody = IfConcreteClass {+                            ifClassCtxt = a1,+                            ifATs  = a6,+                            ifSigs = a7,+                            ifMinDef  = a8+                        }})+            6 -> do a1 <- getIfaceTopBndr bh+                    a2 <- get bh+                    a3 <- get bh+                    a4 <- get bh+                    return (IfaceAxiom a1 a2 a3 a4)+            7 -> do a1 <- getIfaceTopBndr bh+                    a2 <- get bh+                    a3 <- get bh+                    a4 <- get bh+                    a5 <- get bh+                    a6 <- get bh+                    a7 <- get bh+                    a8 <- get bh+                    a9 <- get bh+                    a10 <- get bh+                    a11 <- get bh+                    return (IfacePatSyn a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11)+            8 -> do a1 <- getIfaceTopBndr bh+                    a2 <- get bh+                    a3 <- get bh+                    a4 <- get bh+                    return (IfaceClass {+                        ifName    = a1,+                        ifRoles   = a2,+                        ifBinders = a3,+                        ifFDs     = a4,+                        ifBody = IfAbstractClass })+            _ -> panic (unwords ["Unknown IfaceDecl tag:", show h])++{- Note [Lazy deserialization of IfaceId]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The use of lazyPut and lazyGet in the IfaceId Binary instance is+purely for performance reasons, to avoid deserializing details about+identifiers that will never be used. It's not involved in tying the+knot in the type checker. It saved ~1% of the total build time of GHC.++When we read an interface file, we extend the PTE, a mapping of Names+to TyThings, with the declarations we have read. The extension of the+PTE is strict in the Names, but not in the TyThings themselves.+LoadIface.loadDecl calculates the list of (Name, TyThing) bindings to+add to the PTE. For an IfaceId, there's just one binding to add; and+the ty, details, and idinfo fields of an IfaceId are used only in the+TyThing. So by reading those fields lazily we may be able to save the+work of ever having to deserialize them (into IfaceType, etc.).++For IfaceData and IfaceClass, loadDecl creates extra implicit bindings+(the constructors and field selectors of the data declaration, or the+methods of the class), whose Names depend on more than just the Name+of the type constructor or class itself. So deserializing them lazily+would be more involved. Similar comments apply to the other+constructors of IfaceDecl with the additional point that they probably+represent a small proportion of all declarations.+-}++instance Binary IfaceFamTyConFlav where+    put_ bh IfaceDataFamilyTyCon              = putByte bh 0+    put_ bh IfaceOpenSynFamilyTyCon           = putByte bh 1+    put_ bh (IfaceClosedSynFamilyTyCon mb)    = putByte bh 2 >> put_ bh mb+    put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 3+    put_ _ IfaceBuiltInSynFamTyCon+        = pprPanic "Cannot serialize IfaceBuiltInSynFamTyCon, used for pretty-printing only" Outputable.empty++    get bh = do { h <- getByte bh+                ; case h of+                    0 -> return IfaceDataFamilyTyCon+                    1 -> return IfaceOpenSynFamilyTyCon+                    2 -> do { mb <- get bh+                            ; return (IfaceClosedSynFamilyTyCon mb) }+                    3 -> return IfaceAbstractClosedSynFamilyTyCon+                    _ -> pprPanic "Binary.get(IfaceFamTyConFlav): Invalid tag"+                                  (ppr (fromIntegral h :: Int)) }++instance Binary IfaceClassOp where+    put_ bh (IfaceClassOp n ty def) = do+        putIfaceTopBndr bh n+        put_ bh ty+        put_ bh def+    get bh = do+        n   <- getIfaceTopBndr bh+        ty  <- get bh+        def <- get bh+        return (IfaceClassOp n ty def)++instance Binary IfaceAT where+    put_ bh (IfaceAT dec defs) = do+        put_ bh dec+        put_ bh defs+    get bh = do+        dec  <- get bh+        defs <- get bh+        return (IfaceAT dec defs)++instance Binary IfaceAxBranch where+    put_ bh (IfaceAxBranch a1 a2 a3 a4 a5 a6 a7) = do+        put_ bh a1+        put_ bh a2+        put_ bh a3+        put_ bh a4+        put_ bh a5+        put_ bh a6+        put_ bh a7+    get bh = do+        a1 <- get bh+        a2 <- get bh+        a3 <- get bh+        a4 <- get bh+        a5 <- get bh+        a6 <- get bh+        a7 <- get bh+        return (IfaceAxBranch a1 a2 a3 a4 a5 a6 a7)++instance Binary IfaceConDecls where+    put_ bh IfAbstractTyCon  = putByte bh 0+    put_ bh (IfDataTyCon cs) = putByte bh 1 >> put_ bh cs+    put_ bh (IfNewTyCon c)   = putByte bh 2 >> put_ bh c+    get bh = do+        h <- getByte bh+        case h of+            0 -> return IfAbstractTyCon+            1 -> liftM IfDataTyCon (get bh)+            2 -> liftM IfNewTyCon (get bh)+            _ -> error "Binary(IfaceConDecls).get: Invalid IfaceConDecls"++instance Binary IfaceConDecl where+    put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11) = do+        putIfaceTopBndr bh a1+        put_ bh a2+        put_ bh a3+        put_ bh a4+        put_ bh a5+        put_ bh a6+        put_ bh a7+        put_ bh a8+        put_ bh (length a9)+        mapM_ (put_ bh) a9+        put_ bh a10+        put_ bh a11+    get bh = do+        a1 <- getIfaceTopBndr bh+        a2 <- get bh+        a3 <- get bh+        a4 <- get bh+        a5 <- get bh+        a6 <- get bh+        a7 <- get bh+        a8 <- get bh+        n_fields <- get bh+        a9 <- replicateM n_fields (get bh)+        a10 <- get bh+        a11 <- get bh+        return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11)++instance Binary IfaceBang where+    put_ bh IfNoBang        = putByte bh 0+    put_ bh IfStrict        = putByte bh 1+    put_ bh IfUnpack        = putByte bh 2+    put_ bh (IfUnpackCo co) = putByte bh 3 >> put_ bh co++    get bh = do+            h <- getByte bh+            case h of+              0 -> do return IfNoBang+              1 -> do return IfStrict+              2 -> do return IfUnpack+              _ -> do { a <- get bh; return (IfUnpackCo a) }++instance Binary IfaceSrcBang where+    put_ bh (IfSrcBang a1 a2) =+      do put_ bh a1+         put_ bh a2++    get bh =+      do a1 <- get bh+         a2 <- get bh+         return (IfSrcBang a1 a2)++instance Binary IfaceClsInst where+    put_ bh (IfaceClsInst cls tys dfun flag orph) = do+        put_ bh cls+        put_ bh tys+        put_ bh dfun+        put_ bh flag+        put_ bh orph+    get bh = do+        cls  <- get bh+        tys  <- get bh+        dfun <- get bh+        flag <- get bh+        orph <- get bh+        return (IfaceClsInst cls tys dfun flag orph)++instance Binary IfaceFamInst where+    put_ bh (IfaceFamInst fam tys name orph) = do+        put_ bh fam+        put_ bh tys+        put_ bh name+        put_ bh orph+    get bh = do+        fam      <- get bh+        tys      <- get bh+        name     <- get bh+        orph     <- get bh+        return (IfaceFamInst fam tys name orph)++instance Binary IfaceRule where+    put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) = do+        put_ bh a1+        put_ bh a2+        put_ bh a3+        put_ bh a4+        put_ bh a5+        put_ bh a6+        put_ bh a7+        put_ bh a8+    get bh = do+        a1 <- get bh+        a2 <- get bh+        a3 <- get bh+        a4 <- get bh+        a5 <- get bh+        a6 <- get bh+        a7 <- get bh+        a8 <- get bh+        return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8)++instance Binary IfaceAnnotation where+    put_ bh (IfaceAnnotation a1 a2) = do+        put_ bh a1+        put_ bh a2+    get bh = do+        a1 <- get bh+        a2 <- get bh+        return (IfaceAnnotation a1 a2)++instance Binary IfaceIdDetails where+    put_ bh IfVanillaId      = putByte bh 0+    put_ bh (IfRecSelId a b) = putByte bh 1 >> put_ bh a >> put_ bh b+    put_ bh IfDFunId         = putByte bh 2+    get bh = do+        h <- getByte bh+        case h of+            0 -> return IfVanillaId+            1 -> do { a <- get bh; b <- get bh; return (IfRecSelId a b) }+            _ -> return IfDFunId++instance Binary IfaceIdInfo where+    put_ bh NoInfo      = putByte bh 0+    put_ bh (HasInfo i) = putByte bh 1 >> lazyPut bh i -- NB lazyPut++    get bh = do+        h <- getByte bh+        case h of+            0 -> return NoInfo+            _ -> liftM HasInfo $ lazyGet bh    -- NB lazyGet++instance Binary IfaceInfoItem where+    put_ bh (HsArity aa)          = putByte bh 0 >> put_ bh aa+    put_ bh (HsStrictness ab)     = putByte bh 1 >> put_ bh ab+    put_ bh (HsUnfold lb ad)      = putByte bh 2 >> put_ bh lb >> put_ bh ad+    put_ bh (HsInline ad)         = putByte bh 3 >> put_ bh ad+    put_ bh HsNoCafRefs           = putByte bh 4+    put_ bh HsLevity              = putByte bh 5+    get bh = do+        h <- getByte bh+        case h of+            0 -> liftM HsArity $ get bh+            1 -> liftM HsStrictness $ get bh+            2 -> do lb <- get bh+                    ad <- get bh+                    return (HsUnfold lb ad)+            3 -> liftM HsInline $ get bh+            4 -> return HsNoCafRefs+            _ -> return HsLevity++instance Binary IfaceUnfolding where+    put_ bh (IfCoreUnfold s e) = do+        putByte bh 0+        put_ bh s+        put_ bh e+    put_ bh (IfInlineRule a b c d) = do+        putByte bh 1+        put_ bh a+        put_ bh b+        put_ bh c+        put_ bh d+    put_ bh (IfDFunUnfold as bs) = do+        putByte bh 2+        put_ bh as+        put_ bh bs+    put_ bh (IfCompulsory e) = do+        putByte bh 3+        put_ bh e+    get bh = do+        h <- getByte bh+        case h of+            0 -> do s <- get bh+                    e <- get bh+                    return (IfCoreUnfold s e)+            1 -> do a <- get bh+                    b <- get bh+                    c <- get bh+                    d <- get bh+                    return (IfInlineRule a b c d)+            2 -> do as <- get bh+                    bs <- get bh+                    return (IfDFunUnfold as bs)+            _ -> do e <- get bh+                    return (IfCompulsory e)+++instance Binary IfaceExpr where+    put_ bh (IfaceLcl aa) = do+        putByte bh 0+        put_ bh aa+    put_ bh (IfaceType ab) = do+        putByte bh 1+        put_ bh ab+    put_ bh (IfaceCo ab) = do+        putByte bh 2+        put_ bh ab+    put_ bh (IfaceTuple ac ad) = do+        putByte bh 3+        put_ bh ac+        put_ bh ad+    put_ bh (IfaceLam (ae, os) af) = do+        putByte bh 4+        put_ bh ae+        put_ bh os+        put_ bh af+    put_ bh (IfaceApp ag ah) = do+        putByte bh 5+        put_ bh ag+        put_ bh ah+    put_ bh (IfaceCase ai aj ak) = do+        putByte bh 6+        put_ bh ai+        put_ bh aj+        put_ bh ak+    put_ bh (IfaceLet al am) = do+        putByte bh 7+        put_ bh al+        put_ bh am+    put_ bh (IfaceTick an ao) = do+        putByte bh 8+        put_ bh an+        put_ bh ao+    put_ bh (IfaceLit ap) = do+        putByte bh 9+        put_ bh ap+    put_ bh (IfaceFCall as at) = do+        putByte bh 10+        put_ bh as+        put_ bh at+    put_ bh (IfaceExt aa) = do+        putByte bh 11+        put_ bh aa+    put_ bh (IfaceCast ie ico) = do+        putByte bh 12+        put_ bh ie+        put_ bh ico+    put_ bh (IfaceECase a b) = do+        putByte bh 13+        put_ bh a+        put_ bh b+    get bh = do+        h <- getByte bh+        case h of+            0 -> do aa <- get bh+                    return (IfaceLcl aa)+            1 -> do ab <- get bh+                    return (IfaceType ab)+            2 -> do ab <- get bh+                    return (IfaceCo ab)+            3 -> do ac <- get bh+                    ad <- get bh+                    return (IfaceTuple ac ad)+            4 -> do ae <- get bh+                    os <- get bh+                    af <- get bh+                    return (IfaceLam (ae, os) af)+            5 -> do ag <- get bh+                    ah <- get bh+                    return (IfaceApp ag ah)+            6 -> do ai <- get bh+                    aj <- get bh+                    ak <- get bh+                    return (IfaceCase ai aj ak)+            7 -> do al <- get bh+                    am <- get bh+                    return (IfaceLet al am)+            8 -> do an <- get bh+                    ao <- get bh+                    return (IfaceTick an ao)+            9 -> do ap <- get bh+                    return (IfaceLit ap)+            10 -> do as <- get bh+                     at <- get bh+                     return (IfaceFCall as at)+            11 -> do aa <- get bh+                     return (IfaceExt aa)+            12 -> do ie <- get bh+                     ico <- get bh+                     return (IfaceCast ie ico)+            13 -> do a <- get bh+                     b <- get bh+                     return (IfaceECase a b)+            _ -> panic ("get IfaceExpr " ++ show h)++instance Binary IfaceTickish where+    put_ bh (IfaceHpcTick m ix) = do+        putByte bh 0+        put_ bh m+        put_ bh ix+    put_ bh (IfaceSCC cc tick push) = do+        putByte bh 1+        put_ bh cc+        put_ bh tick+        put_ bh push+    put_ bh (IfaceSource src name) = do+        putByte bh 2+        put_ bh (srcSpanFile src)+        put_ bh (srcSpanStartLine src)+        put_ bh (srcSpanStartCol src)+        put_ bh (srcSpanEndLine src)+        put_ bh (srcSpanEndCol src)+        put_ bh name++    get bh = do+        h <- getByte bh+        case h of+            0 -> do m <- get bh+                    ix <- get bh+                    return (IfaceHpcTick m ix)+            1 -> do cc <- get bh+                    tick <- get bh+                    push <- get bh+                    return (IfaceSCC cc tick push)+            2 -> do file <- get bh+                    sl <- get bh+                    sc <- get bh+                    el <- get bh+                    ec <- get bh+                    let start = mkRealSrcLoc file sl sc+                        end = mkRealSrcLoc file el ec+                    name <- get bh+                    return (IfaceSource (mkRealSrcSpan start end) name)+            _ -> panic ("get IfaceTickish " ++ show h)++instance Binary IfaceConAlt where+    put_ bh IfaceDefault      = putByte bh 0+    put_ bh (IfaceDataAlt aa) = putByte bh 1 >> put_ bh aa+    put_ bh (IfaceLitAlt ac)  = putByte bh 2 >> put_ bh ac+    get bh = do+        h <- getByte bh+        case h of+            0 -> return IfaceDefault+            1 -> liftM IfaceDataAlt $ get bh+            _ -> liftM IfaceLitAlt  $ get bh++instance Binary IfaceBinding where+    put_ bh (IfaceNonRec aa ab) = putByte bh 0 >> put_ bh aa >> put_ bh ab+    put_ bh (IfaceRec ac)       = putByte bh 1 >> put_ bh ac+    get bh = do+        h <- getByte bh+        case h of+            0 -> do { aa <- get bh; ab <- get bh; return (IfaceNonRec aa ab) }+            _ -> do { ac <- get bh; return (IfaceRec ac) }++instance Binary IfaceLetBndr where+    put_ bh (IfLetBndr a b c d) = do+            put_ bh a+            put_ bh b+            put_ bh c+            put_ bh d+    get bh = do a <- get bh+                b <- get bh+                c <- get bh+                d <- get bh+                return (IfLetBndr a b c d)++instance Binary IfaceJoinInfo where+    put_ bh IfaceNotJoinPoint = putByte bh 0+    put_ bh (IfaceJoinPoint ar) = do+        putByte bh 1+        put_ bh ar+    get bh = do+        h <- getByte bh+        case h of+            0 -> return IfaceNotJoinPoint+            _ -> liftM IfaceJoinPoint $ get bh++instance Binary IfaceTyConParent where+    put_ bh IfNoParent = putByte bh 0+    put_ bh (IfDataInstance ax pr ty) = do+        putByte bh 1+        put_ bh ax+        put_ bh pr+        put_ bh ty+    get bh = do+        h <- getByte bh+        case h of+            0 -> return IfNoParent+            _ -> do+                ax <- get bh+                pr <- get bh+                ty <- get bh+                return $ IfDataInstance ax pr ty++instance Binary IfaceCompleteMatch where+  put_ bh (IfaceCompleteMatch cs ts) = put_ bh cs >> put_ bh ts+  get bh = IfaceCompleteMatch <$> get bh <*> get bh
+ compiler/iface/IfaceType.hs view
@@ -0,0 +1,1902 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1993-1998+++This module defines interface types and binders+-}++{-# LANGUAGE CPP, FlexibleInstances, BangPatterns #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE TupleSections #-}+    -- FlexibleInstances for Binary (DefMethSpec IfaceType)++module IfaceType (+        IfExtName, IfLclName,++        IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),+        IfaceMCoercion(..),+        IfaceUnivCoProv(..),+        IfaceTyCon(..), IfaceTyConInfo(..), IfaceTyConSort(..),+        IfaceTyLit(..), IfaceAppArgs(..),+        IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,+        IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,+        IfaceForAllBndr, ArgFlag(..), AnonArgFlag(..),+        ForallVisFlag(..), ShowForAllFlag(..),+        mkIfaceForAllTvBndr,++        ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,+        ifTyConBinderVar, ifTyConBinderName,++        -- Equality testing+        isIfaceLiftedTypeKind,++        -- Conversion from IfaceAppArgs to IfaceTypes/ArgFlags+        appArgsIfaceTypes, appArgsIfaceTypesArgFlags,++        -- Printing+        pprIfaceType, pprParendIfaceType, pprPrecIfaceType,+        pprIfaceContext, pprIfaceContextArr,+        pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,+        pprIfaceBndrs, pprIfaceAppArgs, pprParendIfaceAppArgs,+        pprIfaceForAllPart, pprIfaceForAllPartMust, pprIfaceForAll,+        pprIfaceSigmaType, pprIfaceTyLit,+        pprIfaceCoercion, pprParendIfaceCoercion,+        splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,+        pprIfaceCoTcApp, pprTyTcApp, pprIfacePrefixApp,++        suppressIfaceInvisibles,+        stripIfaceInvisVars,+        stripInvisArgs,++        mkIfaceTySubst, substIfaceTyVar, substIfaceAppArgs, inDomIfaceTySubst+    ) where++#include "HsVersions.h"++import GhcPrelude++import {-# SOURCE #-} TysWiredIn ( coercibleTyCon, heqTyCon+                                 , liftedRepDataConTyCon )+import {-# SOURCE #-} TyCoRep    ( isRuntimeRepTy )++import DynFlags+import TyCon hiding ( pprPromotionQuote )+import CoAxiom+import Var+import PrelNames+import Name+import BasicTypes+import Binary+import Outputable+import FastString+import FastStringEnv+import Util++import Data.Maybe( isJust )+import qualified Data.Semigroup as Semi++{-+************************************************************************+*                                                                      *+                Local (nested) binders+*                                                                      *+************************************************************************+-}++type IfLclName = FastString     -- A local name in iface syntax++type IfExtName = Name   -- An External or WiredIn Name can appear in IfaceSyn+                        -- (However Internal or System Names never should)++data IfaceBndr          -- Local (non-top-level) binders+  = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr+  | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr++type IfaceIdBndr  = (IfLclName, IfaceType)+type IfaceTvBndr  = (IfLclName, IfaceKind)++ifaceTvBndrName :: IfaceTvBndr -> IfLclName+ifaceTvBndrName (n,_) = n++ifaceIdBndrName :: IfaceIdBndr -> IfLclName+ifaceIdBndrName (n,_) = n++ifaceBndrName :: IfaceBndr -> IfLclName+ifaceBndrName (IfaceTvBndr bndr) = ifaceTvBndrName bndr+ifaceBndrName (IfaceIdBndr bndr) = ifaceIdBndrName bndr++type IfaceLamBndr = (IfaceBndr, IfaceOneShot)++data IfaceOneShot    -- See Note [Preserve OneShotInfo] in CoreTicy+  = IfaceNoOneShot   -- and Note [The oneShot function] in MkId+  | IfaceOneShot+++{-+%************************************************************************+%*                                                                      *+                IfaceType+%*                                                                      *+%************************************************************************+-}++-------------------------------+type IfaceKind     = IfaceType++-- | A kind of universal type, used for types and kinds.+--+-- Any time a 'Type' is pretty-printed, it is first converted to an 'IfaceType'+-- before being printed. See Note [Pretty printing via IfaceSyn] in PprTyThing+data IfaceType+  = IfaceFreeTyVar TyVar                -- See Note [Free tyvars in IfaceType]+  | IfaceTyVar     IfLclName            -- Type/coercion variable only, not tycon+  | IfaceLitTy     IfaceTyLit+  | IfaceAppTy     IfaceType IfaceAppArgs+                             -- See Note [Suppressing invisible arguments] for+                             -- an explanation of why the second field isn't+                             -- IfaceType, analogous to AppTy.+  | IfaceFunTy     AnonArgFlag IfaceType IfaceType+  | IfaceForAllTy  IfaceForAllBndr IfaceType+  | IfaceTyConApp  IfaceTyCon IfaceAppArgs  -- Not necessarily saturated+                                            -- Includes newtypes, synonyms, tuples+  | IfaceCastTy     IfaceType IfaceCoercion+  | IfaceCoercionTy IfaceCoercion++  | IfaceTupleTy                  -- Saturated tuples (unsaturated ones use IfaceTyConApp)+       TupleSort                  -- What sort of tuple?+       PromotionFlag                 -- A bit like IfaceTyCon+       IfaceAppArgs               -- arity = length args+          -- For promoted data cons, the kind args are omitted++type IfacePredType = IfaceType+type IfaceContext = [IfacePredType]++data IfaceTyLit+  = IfaceNumTyLit Integer+  | IfaceStrTyLit FastString+  deriving (Eq)++type IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis+type IfaceForAllBndr  = VarBndr IfaceBndr ArgFlag++-- | Make an 'IfaceForAllBndr' from an 'IfaceTvBndr'.+mkIfaceForAllTvBndr :: ArgFlag -> IfaceTvBndr -> IfaceForAllBndr+mkIfaceForAllTvBndr vis var = Bndr (IfaceTvBndr var) vis++-- | Stores the arguments in a type application as a list.+-- See @Note [Suppressing invisible arguments]@.+data IfaceAppArgs+  = IA_Nil+  | IA_Arg IfaceType    -- The type argument++           ArgFlag      -- The argument's visibility. We store this here so+                        -- that we can:+                        --+                        -- 1. Avoid pretty-printing invisible (i.e., specified+                        --    or inferred) arguments when+                        --    -fprint-explicit-kinds isn't enabled, or+                        -- 2. When -fprint-explicit-kinds *is*, enabled, print+                        --    specified arguments in @(...) and inferred+                        --    arguments in @{...}.++           IfaceAppArgs -- The rest of the arguments++instance Semi.Semigroup IfaceAppArgs where+  IA_Nil <> xs              = xs+  IA_Arg ty argf rest <> xs = IA_Arg ty argf (rest Semi.<> xs)++instance Monoid IfaceAppArgs where+  mempty = IA_Nil+  mappend = (Semi.<>)++-- Encodes type constructors, kind constructors,+-- coercion constructors, the lot.+-- We have to tag them in order to pretty print them+-- properly.+data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName+                             , ifaceTyConInfo :: IfaceTyConInfo }+    deriving (Eq)++-- | The various types of TyCons which have special, built-in syntax.+data IfaceTyConSort = IfaceNormalTyCon          -- ^ a regular tycon++                    | IfaceTupleTyCon !Arity !TupleSort+                      -- ^ e.g. @(a, b, c)@ or @(#a, b, c#)@.+                      -- The arity is the tuple width, not the tycon arity+                      -- (which is twice the width in the case of unboxed+                      -- tuples).++                    | IfaceSumTyCon !Arity+                      -- ^ e.g. @(a | b | c)@++                    | IfaceEqualityTyCon+                      -- ^ A heterogeneous equality TyCon+                      --   (i.e. eqPrimTyCon, eqReprPrimTyCon, heqTyCon)+                      -- that is actually being applied to two types+                      -- of the same kind.  This affects pretty-printing+                      -- only: see Note [Equality predicates in IfaceType]+                    deriving (Eq)++{- Note [Free tyvars in IfaceType]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Nowadays (since Nov 16, 2016) we pretty-print a Type by converting to+an IfaceType and pretty printing that.  This eliminates a lot of+pretty-print duplication, and it matches what we do with pretty-+printing TyThings. See Note [Pretty printing via IfaceSyn] in PprTyThing.++It works fine for closed types, but when printing debug traces (e.g.+when using -ddump-tc-trace) we print a lot of /open/ types.  These+types are full of TcTyVars, and it's absolutely crucial to print them+in their full glory, with their unique, TcTyVarDetails etc.++So we simply embed a TyVar in IfaceType with the IfaceFreeTyVar constructor.+Note that:++* We never expect to serialise an IfaceFreeTyVar into an interface file, nor+  to deserialise one.  IfaceFreeTyVar is used only in the "convert to IfaceType+  and then pretty-print" pipeline.++We do the same for covars, naturally.++Note [Equality predicates in IfaceType]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+GHC has several varieties of type equality (see Note [The equality types story]+in TysPrim for details).  In an effort to avoid confusing users, we suppress+the differences during pretty printing unless certain flags are enabled.+Here is how each equality predicate* is printed in homogeneous and+heterogeneous contexts, depending on which combination of the+-fprint-explicit-kinds and -fprint-equality-relations flags is used:++--------------------------------------------------------------------------------------------+|         Predicate             |        Neither flag        |    -fprint-explicit-kinds   |+|-------------------------------|----------------------------|-----------------------------|+| a ~ b         (homogeneous)   |        a ~ b               | (a :: Type) ~  (b :: Type)  |+| a ~~ b,       homogeneously   |        a ~ b               | (a :: Type) ~  (b :: Type)  |+| a ~~ b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |+| a ~# b,       homogeneously   |        a ~ b               | (a :: Type) ~  (b :: Type)  |+| a ~# b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |+| Coercible a b (homogeneous)   |        Coercible a b       | Coercible @Type a b         |+| a ~R# b,      homogeneously   |        Coercible a b       | Coercible @Type a b         |+| a ~R# b,      heterogeneously |        a ~R# b             | (a :: Type) ~R# (c :: k)    |+|-------------------------------|----------------------------|-----------------------------|+|         Predicate             | -fprint-equality-relations |          Both flags         |+|-------------------------------|----------------------------|-----------------------------|+| a ~ b         (homogeneous)   |        a ~  b              | (a :: Type) ~  (b :: Type)  |+| a ~~ b,       homogeneously   |        a ~~ b              | (a :: Type) ~~ (b :: Type)  |+| a ~~ b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |+| a ~# b,       homogeneously   |        a ~# b              | (a :: Type) ~# (b :: Type)  |+| a ~# b,       heterogeneously |        a ~# c              | (a :: Type) ~# (c :: k)     |+| Coercible a b (homogeneous)   |        Coercible a b       | Coercible @Type a b         |+| a ~R# b,      homogeneously   |        a ~R# b             | (a :: Type) ~R# (b :: Type) |+| a ~R# b,      heterogeneously |        a ~R# b             | (a :: Type) ~R# (c :: k)    |+--------------------------------------------------------------------------------------------++(* There is no heterogeneous, representational, lifted equality counterpart+to (~~). There could be, but there seems to be no use for it.)++This table adheres to the following rules:++A. With -fprint-equality-relations, print the true equality relation.+B. Without -fprint-equality-relations:+     i. If the equality is representational and homogeneous, use Coercible.+    ii. Otherwise, if the equality is representational, use ~R#.+   iii. If the equality is nominal and homogeneous, use ~.+    iv. Otherwise, if the equality is nominal, use ~~.+C. With -fprint-explicit-kinds, print kinds on both sides of an infix operator,+   as above; or print the kind with Coercible.+D. Without -fprint-explicit-kinds, don't print kinds.++A hetero-kinded equality is used homogeneously when it is applied to two+identical kinds. Unfortunately, determining this from an IfaceType isn't+possible since we can't see through type synonyms. Consequently, we need to+record whether this particular application is homogeneous in IfaceTyConSort+for the purposes of pretty-printing.++See Note [The equality types story] in TysPrim.+-}++data IfaceTyConInfo   -- Used to guide pretty-printing+                      -- and to disambiguate D from 'D (they share a name)+  = IfaceTyConInfo { ifaceTyConIsPromoted :: PromotionFlag+                   , ifaceTyConSort       :: IfaceTyConSort }+    deriving (Eq)++data IfaceMCoercion+  = IfaceMRefl+  | IfaceMCo IfaceCoercion++data IfaceCoercion+  = IfaceReflCo       IfaceType+  | IfaceGReflCo      Role IfaceType (IfaceMCoercion)+  | IfaceFunCo        Role IfaceCoercion IfaceCoercion+  | IfaceTyConAppCo   Role IfaceTyCon [IfaceCoercion]+  | IfaceAppCo        IfaceCoercion IfaceCoercion+  | IfaceForAllCo     IfaceBndr IfaceCoercion IfaceCoercion+  | IfaceCoVarCo      IfLclName+  | IfaceAxiomInstCo  IfExtName BranchIndex [IfaceCoercion]+  | IfaceAxiomRuleCo  IfLclName [IfaceCoercion]+       -- There are only a fixed number of CoAxiomRules, so it suffices+       -- to use an IfaceLclName to distinguish them.+       -- See Note [Adding built-in type families] in TcTypeNats+  | IfaceUnivCo       IfaceUnivCoProv Role IfaceType IfaceType+  | IfaceSymCo        IfaceCoercion+  | IfaceTransCo      IfaceCoercion IfaceCoercion+  | IfaceNthCo        Int IfaceCoercion+  | IfaceLRCo         LeftOrRight IfaceCoercion+  | IfaceInstCo       IfaceCoercion IfaceCoercion+  | IfaceKindCo       IfaceCoercion+  | IfaceSubCo        IfaceCoercion+  | IfaceFreeCoVar    CoVar    -- See Note [Free tyvars in IfaceType]+  | IfaceHoleCo       CoVar    -- ^ See Note [Holes in IfaceCoercion]++data IfaceUnivCoProv+  = IfaceUnsafeCoerceProv+  | IfacePhantomProv IfaceCoercion+  | IfaceProofIrrelProv IfaceCoercion+  | IfacePluginProv String++{- Note [Holes in IfaceCoercion]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When typechecking fails the typechecker will produce a HoleCo to stand+in place of the unproven assertion. While we generally don't want to+let these unproven assertions leak into interface files, we still need+to be able to pretty-print them as we use IfaceType's pretty-printer+to render Types. For this reason IfaceCoercion has a IfaceHoleCo+constructor; however, we fails when asked to serialize to a+IfaceHoleCo to ensure that they don't end up in an interface file.+++%************************************************************************+%*                                                                      *+                Functions over IFaceTypes+*                                                                      *+************************************************************************+-}++ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool+ifaceTyConHasKey tc key = ifaceTyConName tc `hasKey` key++isIfaceLiftedTypeKind :: IfaceKind -> Bool+isIfaceLiftedTypeKind (IfaceTyConApp tc IA_Nil)+  = isLiftedTypeKindTyConName (ifaceTyConName tc)+isIfaceLiftedTypeKind (IfaceTyConApp tc+                       (IA_Arg (IfaceTyConApp ptr_rep_lifted IA_Nil)+                               Required IA_Nil))+  =  tc `ifaceTyConHasKey` tYPETyConKey+  && ptr_rep_lifted `ifaceTyConHasKey` liftedRepDataConKey+isIfaceLiftedTypeKind _ = False++splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)+-- Mainly for printing purposes+--+-- Here we split nested IfaceSigmaTy properly.+--+-- @+-- forall t. T t => forall m a b. M m => (a -> m b) -> t a -> m (t b)+-- @+--+-- If you called @splitIfaceSigmaTy@ on this type:+--+-- @+-- ([t, m, a, b], [T t, M m], (a -> m b) -> t a -> m (t b))+-- @+splitIfaceSigmaTy ty+  = case (bndrs, theta) of+      ([], []) -> (bndrs, theta, tau)+      _        -> let (bndrs', theta', tau') = splitIfaceSigmaTy tau+                   in (bndrs ++ bndrs', theta ++ theta', tau')+  where+    (bndrs, rho)   = split_foralls ty+    (theta, tau)   = split_rho rho++    split_foralls (IfaceForAllTy bndr ty)+        = case split_foralls ty of { (bndrs, rho) -> (bndr:bndrs, rho) }+    split_foralls rho = ([], rho)++    split_rho (IfaceFunTy InvisArg ty1 ty2)+        = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }+    split_rho tau = ([], tau)++suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]+suppressIfaceInvisibles dflags tys xs+  | gopt Opt_PrintExplicitKinds dflags = xs+  | otherwise = suppress tys xs+    where+      suppress _       []      = []+      suppress []      a       = a+      suppress (k:ks) (x:xs)+        | isInvisibleTyConBinder k =     suppress ks xs+        | otherwise                = x : suppress ks xs++stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]+stripIfaceInvisVars dflags tyvars+  | gopt Opt_PrintExplicitKinds dflags = tyvars+  | otherwise = filterOut isInvisibleTyConBinder tyvars++-- | Extract an 'IfaceBndr' from an 'IfaceForAllBndr'.+ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr+ifForAllBndrVar = binderVar++-- | Extract the variable name from an 'IfaceForAllBndr'.+ifForAllBndrName :: IfaceForAllBndr -> IfLclName+ifForAllBndrName fab = ifaceBndrName (ifForAllBndrVar fab)++-- | Extract an 'IfaceBndr' from an 'IfaceTyConBinder'.+ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr+ifTyConBinderVar = binderVar++-- | Extract the variable name from an 'IfaceTyConBinder'.+ifTyConBinderName :: IfaceTyConBinder -> IfLclName+ifTyConBinderName tcb = ifaceBndrName (ifTyConBinderVar tcb)++ifTypeIsVarFree :: IfaceType -> Bool+-- Returns True if the type definitely has no variables at all+-- Just used to control pretty printing+ifTypeIsVarFree ty = go ty+  where+    go (IfaceTyVar {})         = False+    go (IfaceFreeTyVar {})     = False+    go (IfaceAppTy fun args)   = go fun && go_args args+    go (IfaceFunTy _ arg res)  = go arg && go res+    go (IfaceForAllTy {})      = False+    go (IfaceTyConApp _ args)  = go_args args+    go (IfaceTupleTy _ _ args) = go_args args+    go (IfaceLitTy _)          = True+    go (IfaceCastTy {})        = False -- Safe+    go (IfaceCoercionTy {})    = False -- Safe++    go_args IA_Nil = True+    go_args (IA_Arg arg _ args) = go arg && go_args args++{- Note [Substitution on IfaceType]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Substitutions on IfaceType are done only during pretty-printing to+construct the result type of a GADT, and does not deal with binders+(eg IfaceForAll), so it doesn't need fancy capture stuff.  -}++type IfaceTySubst = FastStringEnv IfaceType -- Note [Substitution on IfaceType]++mkIfaceTySubst :: [(IfLclName,IfaceType)] -> IfaceTySubst+-- See Note [Substitution on IfaceType]+mkIfaceTySubst eq_spec = mkFsEnv eq_spec++inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool+-- See Note [Substitution on IfaceType]+inDomIfaceTySubst subst (fs, _) = isJust (lookupFsEnv subst fs)++substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType+-- See Note [Substitution on IfaceType]+substIfaceType env ty+  = go ty+  where+    go (IfaceFreeTyVar tv)    = IfaceFreeTyVar tv+    go (IfaceTyVar tv)        = substIfaceTyVar env tv+    go (IfaceAppTy  t ts)     = IfaceAppTy  (go t) (substIfaceAppArgs env ts)+    go (IfaceFunTy af t1 t2)  = IfaceFunTy af (go t1) (go t2)+    go ty@(IfaceLitTy {})     = ty+    go (IfaceTyConApp tc tys) = IfaceTyConApp tc (substIfaceAppArgs env tys)+    go (IfaceTupleTy s i tys) = IfaceTupleTy s i (substIfaceAppArgs env tys)+    go (IfaceForAllTy {})     = pprPanic "substIfaceType" (ppr ty)+    go (IfaceCastTy ty co)    = IfaceCastTy (go ty) (go_co co)+    go (IfaceCoercionTy co)   = IfaceCoercionTy (go_co co)++    go_mco IfaceMRefl    = IfaceMRefl+    go_mco (IfaceMCo co) = IfaceMCo $ go_co co++    go_co (IfaceReflCo ty)           = IfaceReflCo (go ty)+    go_co (IfaceGReflCo r ty mco)    = IfaceGReflCo r (go ty) (go_mco mco)+    go_co (IfaceFunCo r c1 c2)       = IfaceFunCo r (go_co c1) (go_co c2)+    go_co (IfaceTyConAppCo r tc cos) = IfaceTyConAppCo r tc (go_cos cos)+    go_co (IfaceAppCo c1 c2)         = IfaceAppCo (go_co c1) (go_co c2)+    go_co (IfaceForAllCo {})         = pprPanic "substIfaceCoercion" (ppr ty)+    go_co (IfaceFreeCoVar cv)        = IfaceFreeCoVar cv+    go_co (IfaceCoVarCo cv)          = IfaceCoVarCo cv+    go_co (IfaceHoleCo cv)           = IfaceHoleCo cv+    go_co (IfaceAxiomInstCo a i cos) = IfaceAxiomInstCo a i (go_cos cos)+    go_co (IfaceUnivCo prov r t1 t2) = IfaceUnivCo (go_prov prov) r (go t1) (go t2)+    go_co (IfaceSymCo co)            = IfaceSymCo (go_co co)+    go_co (IfaceTransCo co1 co2)     = IfaceTransCo (go_co co1) (go_co co2)+    go_co (IfaceNthCo n co)          = IfaceNthCo n (go_co co)+    go_co (IfaceLRCo lr co)          = IfaceLRCo lr (go_co co)+    go_co (IfaceInstCo c1 c2)        = IfaceInstCo (go_co c1) (go_co c2)+    go_co (IfaceKindCo co)           = IfaceKindCo (go_co co)+    go_co (IfaceSubCo co)            = IfaceSubCo (go_co co)+    go_co (IfaceAxiomRuleCo n cos)   = IfaceAxiomRuleCo n (go_cos cos)++    go_cos = map go_co++    go_prov IfaceUnsafeCoerceProv    = IfaceUnsafeCoerceProv+    go_prov (IfacePhantomProv co)    = IfacePhantomProv (go_co co)+    go_prov (IfaceProofIrrelProv co) = IfaceProofIrrelProv (go_co co)+    go_prov (IfacePluginProv str)    = IfacePluginProv str++substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs+substIfaceAppArgs env args+  = go args+  where+    go IA_Nil              = IA_Nil+    go (IA_Arg ty arg tys) = IA_Arg (substIfaceType env ty) arg (go tys)++substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType+substIfaceTyVar env tv+  | Just ty <- lookupFsEnv env tv = ty+  | otherwise                     = IfaceTyVar tv+++{-+************************************************************************+*                                                                      *+                Functions over IfaceAppArgs+*                                                                      *+************************************************************************+-}++stripInvisArgs :: DynFlags -> IfaceAppArgs -> IfaceAppArgs+stripInvisArgs dflags tys+  | gopt Opt_PrintExplicitKinds dflags = tys+  | otherwise = suppress_invis tys+    where+      suppress_invis c+        = case c of+            IA_Nil -> IA_Nil+            IA_Arg t argf ts+              |  isVisibleArgFlag argf+              -> IA_Arg t argf $ suppress_invis ts+              -- Keep recursing through the remainder of the arguments, as it's+              -- possible that there are remaining invisible ones.+              -- See the "In type declarations" section of Note [VarBndrs,+              -- TyCoVarBinders, TyConBinders, and visibility] in TyCoRep.+              |  otherwise+              -> suppress_invis ts++appArgsIfaceTypes :: IfaceAppArgs -> [IfaceType]+appArgsIfaceTypes IA_Nil = []+appArgsIfaceTypes (IA_Arg t _ ts) = t : appArgsIfaceTypes ts++appArgsIfaceTypesArgFlags :: IfaceAppArgs -> [(IfaceType, ArgFlag)]+appArgsIfaceTypesArgFlags IA_Nil = []+appArgsIfaceTypesArgFlags (IA_Arg t a ts)+                                 = (t, a) : appArgsIfaceTypesArgFlags ts++ifaceVisAppArgsLength :: IfaceAppArgs -> Int+ifaceVisAppArgsLength = go 0+  where+    go !n IA_Nil = n+    go n  (IA_Arg _ argf rest)+      | isVisibleArgFlag argf = go (n+1) rest+      | otherwise             = go n rest++{-+Note [Suppressing invisible arguments]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We use the IfaceAppArgs data type to specify which of the arguments to a type+should be displayed when pretty-printing, under the control of+-fprint-explicit-kinds.+See also Type.filterOutInvisibleTypes.+For example, given++    T :: forall k. (k->*) -> k -> *    -- Ordinary kind polymorphism+    'Just :: forall k. k -> 'Maybe k   -- Promoted++we want++    T * Tree Int    prints as    T Tree Int+    'Just *         prints as    Just *++For type constructors (IfaceTyConApp), IfaceAppArgs is a quite natural fit,+since the corresponding Core constructor:++    data Type+      = ...+      | TyConApp TyCon [Type]++Already puts all of its arguments into a list. So when converting a Type to an+IfaceType (see toIfaceAppArgsX in ToIface), we simply use the kind of the TyCon+(which is cached) to guide the process of converting the argument Types into an+IfaceAppArgs list.++We also want this behavior for IfaceAppTy, since given:++    data Proxy (a :: k)+    f :: forall (t :: forall a. a -> Type). Proxy Type (t Bool True)++We want to print the return type as `Proxy (t True)` without the use of+-fprint-explicit-kinds (#15330). Accomplishing this is trickier than in the+tycon case, because the corresponding Core constructor for IfaceAppTy:++    data Type+      = ...+      | AppTy Type Type++Only stores one argument at a time. Therefore, when converting an AppTy to an+IfaceAppTy (in toIfaceTypeX in ToIface), we:++1. Flatten the chain of AppTys down as much as possible+2. Use typeKind to determine the function Type's kind+3. Use this kind to guide the process of converting the argument Types into an+   IfaceAppArgs list.++By flattening the arguments like this, we obtain two benefits:++(a) We can reuse the same machinery to pretty-print IfaceTyConApp arguments as+    we do IfaceTyApp arguments, which means that we only need to implement the+    logic to filter out invisible arguments once.+(b) Unlike for tycons, finding the kind of a type in general (through typeKind)+    is not a constant-time operation, so by flattening the arguments first, we+    decrease the number of times we have to call typeKind.++Note [Pretty-printing invisible arguments]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Note [Suppressing invisible arguments] is all about how to avoid printing+invisible arguments when the -fprint-explicit-kinds flag is disables. Well,+what about when it's enabled? Then we can and should print invisible kind+arguments, and this Note explains how we do it.++As two running examples, consider the following code:++  {-# LANGUAGE PolyKinds #-}+  data T1 a+  data T2 (a :: k)++When displaying these types (with -fprint-explicit-kinds on), we could just+do the following:++  T1 k a+  T2 k a++That certainly gets the job done. But it lacks a crucial piece of information:+is the `k` argument inferred or specified? To communicate this, we use visible+kind application syntax to distinguish the two cases:++  T1 @{k} a+  T2 @k   a++Here, @{k} indicates that `k` is an inferred argument, and @k indicates that+`k` is a specified argument. (See+Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep for+a lengthier explanation on what "inferred" and "specified" mean.)++************************************************************************+*                                                                      *+                Pretty-printing+*                                                                      *+************************************************************************+-}++if_print_coercions :: SDoc  -- ^ if printing coercions+                   -> SDoc  -- ^ otherwise+                   -> SDoc+if_print_coercions yes no+  = sdocWithDynFlags $ \dflags ->+    getPprStyle $ \style ->+    if gopt Opt_PrintExplicitCoercions dflags+         || dumpStyle style || debugStyle style+    then yes+    else no++pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc+pprIfaceInfixApp ctxt_prec pp_tc pp_ty1 pp_ty2+  = maybeParen ctxt_prec opPrec $+    sep [pp_ty1, pp_tc <+> pp_ty2]++pprIfacePrefixApp :: PprPrec -> SDoc -> [SDoc] -> SDoc+pprIfacePrefixApp ctxt_prec pp_fun pp_tys+  | null pp_tys = pp_fun+  | otherwise   = maybeParen ctxt_prec appPrec $+                  hang pp_fun 2 (sep pp_tys)++-- ----------------------------- Printing binders ------------------------------------++instance Outputable IfaceBndr where+    ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr+    ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr False bndr++pprIfaceBndrs :: [IfaceBndr] -> SDoc+pprIfaceBndrs bs = sep (map ppr bs)++pprIfaceLamBndr :: IfaceLamBndr -> SDoc+pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b+pprIfaceLamBndr (b, IfaceOneShot)   = ppr b <> text "[OneShot]"++pprIfaceIdBndr :: IfaceIdBndr -> SDoc+pprIfaceIdBndr (name, ty) = parens (ppr name <+> dcolon <+> ppr ty)++pprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc+pprIfaceTvBndr use_parens (tv, ki)+  | isIfaceLiftedTypeKind ki = ppr tv+  | otherwise                = maybe_parens (ppr tv <+> dcolon <+> ppr ki)+  where+    maybe_parens | use_parens = parens+                 | otherwise  = id++pprIfaceTyConBinders :: [IfaceTyConBinder] -> SDoc+pprIfaceTyConBinders = sep . map go+  where+    go :: IfaceTyConBinder -> SDoc+    go (Bndr (IfaceIdBndr bndr) _) = pprIfaceIdBndr bndr+    go (Bndr (IfaceTvBndr bndr) vis) =+      -- See Note [Pretty-printing invisible arguments]+      case vis of+        AnonTCB  VisArg    -> ppr_bndr True+        AnonTCB  InvisArg  -> ppr_bndr True  -- Rare; just promoted GADT data constructors+                                             -- Should we print them differently?+        NamedTCB Required  -> ppr_bndr True+        NamedTCB Specified -> char '@' <> ppr_bndr True+        NamedTCB Inferred  -> char '@' <> braces (ppr_bndr False)+      where+        ppr_bndr use_parens = pprIfaceTvBndr use_parens bndr++instance Binary IfaceBndr where+    put_ bh (IfaceIdBndr aa) = do+            putByte bh 0+            put_ bh aa+    put_ bh (IfaceTvBndr ab) = do+            putByte bh 1+            put_ bh ab+    get bh = do+            h <- getByte bh+            case h of+              0 -> do aa <- get bh+                      return (IfaceIdBndr aa)+              _ -> do ab <- get bh+                      return (IfaceTvBndr ab)++instance Binary IfaceOneShot where+    put_ bh IfaceNoOneShot = do+            putByte bh 0+    put_ bh IfaceOneShot = do+            putByte bh 1+    get bh = do+            h <- getByte bh+            case h of+              0 -> do return IfaceNoOneShot+              _ -> do return IfaceOneShot++-- ----------------------------- Printing IfaceType ------------------------------------++---------------------------------+instance Outputable IfaceType where+  ppr ty = pprIfaceType ty++pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc+pprIfaceType       = pprPrecIfaceType topPrec+pprParendIfaceType = pprPrecIfaceType appPrec++pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc+-- We still need `eliminateRuntimeRep`, since the `pprPrecIfaceType` maybe+-- called from other places, besides `:type` and `:info`.+pprPrecIfaceType prec ty = eliminateRuntimeRep (ppr_ty prec) ty++ppr_sigma :: PprPrec -> IfaceType -> SDoc+ppr_sigma ctxt_prec ty+  = maybeParen ctxt_prec funPrec (pprIfaceSigmaType ShowForAllMust ty)++ppr_ty :: PprPrec -> IfaceType -> SDoc+ppr_ty ctxt_prec ty@(IfaceForAllTy {})        = ppr_sigma ctxt_prec ty+ppr_ty ctxt_prec ty@(IfaceFunTy InvisArg _ _) = ppr_sigma ctxt_prec ty++ppr_ty _         (IfaceFreeTyVar tyvar) = ppr tyvar  -- This is the main reason for IfaceFreeTyVar!+ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar  -- See Note [TcTyVars in IfaceType]+ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys+ppr_ty ctxt_prec (IfaceTupleTy i p tys) = pprTuple ctxt_prec i p tys+ppr_ty _         (IfaceLitTy n)         = pprIfaceTyLit n+        -- Function types+ppr_ty ctxt_prec (IfaceFunTy _ ty1 ty2)  -- Should be VisArg+  = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.+    maybeParen ctxt_prec funPrec $+    sep [ppr_ty funPrec ty1, sep (ppr_fun_tail ty2)]+  where+    ppr_fun_tail (IfaceFunTy VisArg ty1 ty2)+      = (arrow <+> ppr_ty funPrec ty1) : ppr_fun_tail ty2+    ppr_fun_tail other_ty+      = [arrow <+> pprIfaceType other_ty]++ppr_ty ctxt_prec (IfaceAppTy t ts)+  = if_print_coercions+      ppr_app_ty+      ppr_app_ty_no_casts+  where+    ppr_app_ty =+        sdocWithDynFlags $ \dflags ->+        pprIfacePrefixApp ctxt_prec+                          (ppr_ty funPrec t)+                          (map (ppr_app_arg appPrec) (tys_wo_kinds dflags))++    tys_wo_kinds dflags = appArgsIfaceTypesArgFlags $ stripInvisArgs dflags ts++    -- Strip any casts from the head of the application+    ppr_app_ty_no_casts =+        case t of+          IfaceCastTy head _ -> ppr_ty ctxt_prec (mk_app_tys head ts)+          _                  -> ppr_app_ty++    mk_app_tys :: IfaceType -> IfaceAppArgs -> IfaceType+    mk_app_tys (IfaceTyConApp tc tys1) tys2 =+        IfaceTyConApp tc (tys1 `mappend` tys2)+    mk_app_tys t1 tys2 = IfaceAppTy t1 tys2++ppr_ty ctxt_prec (IfaceCastTy ty co)+  = if_print_coercions+      (parens (ppr_ty topPrec ty <+> text "|>" <+> ppr co))+      (ppr_ty ctxt_prec ty)++ppr_ty ctxt_prec (IfaceCoercionTy co)+  = if_print_coercions+      (ppr_co ctxt_prec co)+      (text "<>")++{- Note [Defaulting RuntimeRep variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+RuntimeRep variables are considered by many (most?) users to be little+more than syntactic noise. When the notion was introduced there was a+signficant and understandable push-back from those with pedagogy in+mind, which argued that RuntimeRep variables would throw a wrench into+nearly any teach approach since they appear in even the lowly ($)+function's type,++    ($) :: forall (w :: RuntimeRep) a (b :: TYPE w). (a -> b) -> a -> b++which is significantly less readable than its non RuntimeRep-polymorphic type of++    ($) :: (a -> b) -> a -> b++Moreover, unboxed types don't appear all that often in run-of-the-mill+Haskell programs, so it makes little sense to make all users pay this+syntactic overhead.++For this reason it was decided that we would hide RuntimeRep variables+for now (see #11549). We do this by defaulting all type variables of+kind RuntimeRep to LiftedRep. This is done in a pass right before+pretty-printing (defaultRuntimeRepVars, controlled by+-fprint-explicit-runtime-reps)++This applies to /quantified/ variables like 'w' above.  What about+variables that are /free/ in the type being printed, which certainly+happens in error messages.  Suppose (#16074) we are reporting a+mismatch between two skolems+          (a :: RuntimeRep) ~ (b :: RuntimeRep)+We certainly don't want to say "Can't match LiftedRep ~ LiftedRep"!++But if we are printing the type+    (forall (a :: Type r). blah+we do want to turn that (free) r into LiftedRep, so it prints as+    (forall a. blah)++Conclusion: keep track of whether we we are in the kind of a+binder; ohly if so, convert free RuntimeRep variables to LiftedRep.+-}++-- | Default 'RuntimeRep' variables to 'LiftedPtr'. e.g.+--+-- @+-- ($) :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).+--        (a -> b) -> a -> b+-- @+--+-- turns in to,+--+-- @ ($) :: forall a (b :: *). (a -> b) -> a -> b @+--+-- We do this to prevent RuntimeRep variables from incurring a significant+-- syntactic overhead in otherwise simple type signatures (e.g. ($)). See+-- Note [Defaulting RuntimeRep variables] and #11549 for further discussion.+--+defaultRuntimeRepVars :: IfaceType -> IfaceType+defaultRuntimeRepVars ty = go False emptyFsEnv ty+  where+    go :: Bool              -- True <=> Inside the kind of a binder+       -> FastStringEnv ()  -- Set of enclosing forall-ed RuntimeRep variables+       -> IfaceType         --  (replace them with LiftedRep)+       -> IfaceType+    go ink subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty)+     | isRuntimeRep var_kind+      , isInvisibleArgFlag argf -- Don't default *visible* quantification+                                -- or we get the mess in #13963+      = let subs' = extendFsEnv subs var ()+            -- Record that we should replace it with LiftedRep,+            -- and recurse, discarding the forall+        in go ink subs' ty++    go ink subs (IfaceForAllTy bndr ty)+      = IfaceForAllTy (go_ifacebndr subs bndr) (go ink subs ty)++    go _ subs ty@(IfaceTyVar tv)+      | tv `elemFsEnv` subs+      = IfaceTyConApp liftedRep IA_Nil+      | otherwise+      = ty++    go in_kind _ ty@(IfaceFreeTyVar tv)+      -- See Note [Defaulting RuntimeRep variables], about free vars+      | in_kind && TyCoRep.isRuntimeRepTy (tyVarKind tv)+      = IfaceTyConApp liftedRep IA_Nil+      | otherwise+      = ty++    go ink subs (IfaceTyConApp tc tc_args)+      = IfaceTyConApp tc (go_args ink subs tc_args)++    go ink subs (IfaceTupleTy sort is_prom tc_args)+      = IfaceTupleTy sort is_prom (go_args ink subs tc_args)++    go ink subs (IfaceFunTy af arg res)+      = IfaceFunTy af (go ink subs arg) (go ink subs res)++    go ink subs (IfaceAppTy t ts)+      = IfaceAppTy (go ink subs t) (go_args ink subs ts)++    go ink subs (IfaceCastTy x co)+      = IfaceCastTy (go ink subs x) co++    go _ _ ty@(IfaceLitTy {}) = ty+    go _ _ ty@(IfaceCoercionTy {}) = ty++    go_ifacebndr :: FastStringEnv () -> IfaceForAllBndr -> IfaceForAllBndr+    go_ifacebndr subs (Bndr (IfaceIdBndr (n, t)) argf)+      = Bndr (IfaceIdBndr (n, go True subs t)) argf+    go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf)+      = Bndr (IfaceTvBndr (n, go True subs t)) argf++    go_args :: Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs+    go_args _ _ IA_Nil = IA_Nil+    go_args ink subs (IA_Arg ty argf args)+      = IA_Arg (go ink subs ty) argf (go_args ink subs args)++    liftedRep :: IfaceTyCon+    liftedRep = IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon)+      where dc_name = getName liftedRepDataConTyCon++    isRuntimeRep :: IfaceType -> Bool+    isRuntimeRep (IfaceTyConApp tc _) =+        tc `ifaceTyConHasKey` runtimeRepTyConKey+    isRuntimeRep _ = False++eliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc+eliminateRuntimeRep f ty+  = sdocWithDynFlags $ \dflags ->+    getPprStyle      $ \sty    ->+    if userStyle sty && not (gopt Opt_PrintExplicitRuntimeReps dflags)+      then f (defaultRuntimeRepVars ty)+      else f ty++instance Outputable IfaceAppArgs where+  ppr tca = pprIfaceAppArgs tca++pprIfaceAppArgs, pprParendIfaceAppArgs :: IfaceAppArgs -> SDoc+pprIfaceAppArgs  = ppr_app_args topPrec+pprParendIfaceAppArgs = ppr_app_args appPrec++ppr_app_args :: PprPrec -> IfaceAppArgs -> SDoc+ppr_app_args ctx_prec = go+  where+    go :: IfaceAppArgs -> SDoc+    go IA_Nil             = empty+    go (IA_Arg t argf ts) = ppr_app_arg ctx_prec (t, argf) <+> go ts++-- See Note [Pretty-printing invisible arguments]+ppr_app_arg :: PprPrec -> (IfaceType, ArgFlag) -> SDoc+ppr_app_arg ctx_prec (t, argf) =+  sdocWithDynFlags $ \dflags ->+  let print_kinds = gopt Opt_PrintExplicitKinds dflags+  in case argf of+       Required  -> ppr_ty ctx_prec t+       Specified |  print_kinds+                 -> char '@' <> ppr_ty appPrec t+       Inferred  |  print_kinds+                 -> char '@' <> braces (ppr_ty topPrec t)+       _         -> empty++-------------------+pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc+pprIfaceForAllPart tvs ctxt sdoc+  = ppr_iface_forall_part ShowForAllWhen tvs ctxt sdoc++-- | Like 'pprIfaceForAllPart', but always uses an explicit @forall@.+pprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc+pprIfaceForAllPartMust tvs ctxt sdoc+  = ppr_iface_forall_part ShowForAllMust tvs ctxt sdoc++pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc+pprIfaceForAllCoPart tvs sdoc+  = sep [ pprIfaceForAllCo tvs, sdoc ]++ppr_iface_forall_part :: ShowForAllFlag+                      -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc+ppr_iface_forall_part show_forall tvs ctxt sdoc+  = sep [ case show_forall of+            ShowForAllMust -> pprIfaceForAll tvs+            ShowForAllWhen -> pprUserIfaceForAll tvs+        , pprIfaceContextArr ctxt+        , sdoc]++-- | Render the "forall ... ." or "forall ... ->" bit of a type.+pprIfaceForAll :: [IfaceForAllBndr] -> SDoc+pprIfaceForAll [] = empty+pprIfaceForAll bndrs@(Bndr _ vis : _)+  = sep [ add_separator (forAllLit <+> fsep docs)+        , pprIfaceForAll bndrs' ]+  where+    (bndrs', docs) = ppr_itv_bndrs bndrs vis++    add_separator stuff = case vis of+                            Required -> stuff <+> arrow+                            _inv     -> stuff <>  dot+++-- | Render the ... in @(forall ... .)@ or @(forall ... ->)@.+-- Returns both the list of not-yet-rendered binders and the doc.+-- No anonymous binders here!+ppr_itv_bndrs :: [IfaceForAllBndr]+             -> ArgFlag  -- ^ visibility of the first binder in the list+             -> ([IfaceForAllBndr], [SDoc])+ppr_itv_bndrs all_bndrs@(bndr@(Bndr _ vis) : bndrs) vis1+  | vis `sameVis` vis1 = let (bndrs', doc) = ppr_itv_bndrs bndrs vis1 in+                         (bndrs', pprIfaceForAllBndr bndr : doc)+  | otherwise   = (all_bndrs, [])+ppr_itv_bndrs [] _ = ([], [])++pprIfaceForAllCo :: [(IfLclName, IfaceCoercion)] -> SDoc+pprIfaceForAllCo []  = empty+pprIfaceForAllCo tvs = text "forall" <+> pprIfaceForAllCoBndrs tvs <> dot++pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc+pprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs++pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc+pprIfaceForAllBndr (Bndr (IfaceTvBndr tv) Inferred)+  = sdocWithDynFlags $ \dflags ->+                          if gopt Opt_PrintExplicitForalls dflags+                          then braces $ pprIfaceTvBndr False tv+                          else pprIfaceTvBndr True tv+pprIfaceForAllBndr (Bndr (IfaceTvBndr tv) _)  = pprIfaceTvBndr True tv+pprIfaceForAllBndr (Bndr (IfaceIdBndr idv) _) = pprIfaceIdBndr idv++pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc+pprIfaceForAllCoBndr (tv, kind_co)+  = parens (ppr tv <+> dcolon <+> pprIfaceCoercion kind_co)++-- | Show forall flag+--+-- Unconditionally show the forall quantifier with ('ShowForAllMust')+-- or when ('ShowForAllWhen') the names used are free in the binder+-- or when compiling with -fprint-explicit-foralls.+data ShowForAllFlag = ShowForAllMust | ShowForAllWhen++pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc+pprIfaceSigmaType show_forall ty+  = eliminateRuntimeRep ppr_fn ty+  where+    ppr_fn iface_ty =+      let (tvs, theta, tau) = splitIfaceSigmaTy iface_ty+       in ppr_iface_forall_part show_forall tvs theta (ppr tau)++pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc+pprUserIfaceForAll tvs+   = sdocWithDynFlags $ \dflags ->+     -- See Note [When to print foralls]+     ppWhen (any tv_has_kind_var tvs+             || any tv_is_required tvs+             || gopt Opt_PrintExplicitForalls dflags) $+     pprIfaceForAll tvs+   where+     tv_has_kind_var (Bndr (IfaceTvBndr (_,kind)) _)+       = not (ifTypeIsVarFree kind)+     tv_has_kind_var _ = False++     tv_is_required = isVisibleArgFlag . binderArgFlag++{-+Note [When to print foralls]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We opt to explicitly pretty-print `forall`s if any of the following+criteria are met:++1. -fprint-explicit-foralls is on.++2. A bound type variable has a polymorphic kind. E.g.,++     forall k (a::k). Proxy a -> Proxy a++   Since a's kind mentions a variable k, we print the foralls.++3. A bound type variable is a visible argument (#14238).+   Suppose we are printing the kind of:++     T :: forall k -> k -> Type++   The "forall k ->" notation means that this kind argument is required.+   That is, it must be supplied at uses of T. E.g.,++     f :: T (Type->Type)  Monad -> Int++   So we print an explicit "T :: forall k -> k -> Type",+   because omitting it and printing "T :: k -> Type" would be+   utterly misleading.++   See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]+   in TyCoRep.++N.B. Until now (Aug 2018) we didn't check anything for coercion variables.++Note [Printing foralls in type family instances]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We use the same criteria as in Note [When to print foralls] to determine+whether a type family instance should be pretty-printed with an explicit+`forall`. Example:++  type family Foo (a :: k) :: k where+    Foo Maybe       = []+    Foo (a :: Type) = Int+    Foo a           = a++Without -fprint-explicit-foralls enabled, this will be pretty-printed as:++type family Foo (a :: k) :: k where+  Foo Maybe = []+  Foo a = Int+  forall k (a :: k). Foo a = a++Note that only the third equation has an explicit forall, since it has a type+variable with a non-Type kind. (If -fprint-explicit-foralls were enabled, then+the second equation would be preceded with `forall a.`.)++There is one tricky point in the implementation: what visibility+do we give the type variables in a type family instance? Type family instances+only store type *variables*, not type variable *binders*, and only the latter+has visibility information. We opt to default the visibility of each of these+type variables to Specified because users can't ever instantiate these+variables manually, so the choice of visibility is only relevant to+pretty-printing. (This is why the `k` in `forall k (a :: k). ...` above is+printed the way it is, even though it wasn't written explicitly in the+original source code.)++We adopt the same strategy for data family instances. Example:++  data family DF (a :: k)+  data instance DF '[a, b] = DFList++That data family instance is pretty-printed as:++  data instance forall j (a :: j) (b :: j). DF '[a, b] = DFList++This is despite that the representation tycon for this data instance (call it+$DF:List) actually has different visibilities for its binders.+However, the visibilities of these binders are utterly irrelevant to the+programmer, who cares only about the specificity of variables in `DF`'s type,+not $DF:List's type. Therefore, we opt to pretty-print all variables in data+family instances as Specified.++Note [Printing promoted type constructors]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider this GHCi session (#14343)+    > _ :: Proxy '[ 'True ]+    error:+      Found hole: _ :: Proxy '['True]++This would be bad, because the '[' looks like a character literal.+Solution: in type-level lists and tuples, add a leading space+if the first type is itself promoted.  See pprSpaceIfPromotedTyCon.+-}+++-------------------++-- | Prefix a space if the given 'IfaceType' is a promoted 'TyCon'.+-- See Note [Printing promoted type constructors]+pprSpaceIfPromotedTyCon :: IfaceType -> SDoc -> SDoc+pprSpaceIfPromotedTyCon (IfaceTyConApp tyCon _)+  = case ifaceTyConIsPromoted (ifaceTyConInfo tyCon) of+      IsPromoted -> (space <>)+      _ -> id+pprSpaceIfPromotedTyCon _+  = id++-- See equivalent function in TyCoRep.hs+pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc+-- Given a type-level list (t1 ': t2), see if we can print+-- it in list notation [t1, ...].+-- Precondition: Opt_PrintExplicitKinds is off+pprIfaceTyList ctxt_prec ty1 ty2+  = case gather ty2 of+      (arg_tys, Nothing)+        -> char '\'' <> brackets (pprSpaceIfPromotedTyCon ty1 (fsep+                        (punctuate comma (map (ppr_ty topPrec) (ty1:arg_tys)))))+      (arg_tys, Just tl)+        -> maybeParen ctxt_prec funPrec $ hang (ppr_ty funPrec ty1)+           2 (fsep [ colon <+> ppr_ty funPrec ty | ty <- arg_tys ++ [tl]])+  where+    gather :: IfaceType -> ([IfaceType], Maybe IfaceType)+     -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn]+     --             = (tys, Just tl) means ty is of form t1:t2:...tn:tl+    gather (IfaceTyConApp tc tys)+      | tc `ifaceTyConHasKey` consDataConKey+      , IA_Arg _ argf (IA_Arg ty1 Required (IA_Arg ty2 Required IA_Nil)) <- tys+      , isInvisibleArgFlag argf+      , (args, tl) <- gather ty2+      = (ty1:args, tl)+      | tc `ifaceTyConHasKey` nilDataConKey+      = ([], Nothing)+    gather ty = ([], Just ty)++pprIfaceTypeApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc+pprIfaceTypeApp prec tc args = pprTyTcApp prec tc args++pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc+pprTyTcApp ctxt_prec tc tys =+    sdocWithDynFlags $ \dflags ->+    getPprStyle $ \style ->+    pprTyTcApp' ctxt_prec tc tys dflags style++pprTyTcApp' :: PprPrec -> IfaceTyCon -> IfaceAppArgs+            -> DynFlags -> PprStyle -> SDoc+pprTyTcApp' ctxt_prec tc tys dflags style+  | ifaceTyConName tc `hasKey` ipClassKey+  , IA_Arg (IfaceLitTy (IfaceStrTyLit n))+           Required (IA_Arg ty Required IA_Nil) <- tys+  = maybeParen ctxt_prec funPrec+    $ char '?' <> ftext n <> text "::" <> ppr_ty topPrec ty++  | IfaceTupleTyCon arity sort <- ifaceTyConSort info+  , not (debugStyle style)+  , arity == ifaceVisAppArgsLength tys+  = pprTuple ctxt_prec sort (ifaceTyConIsPromoted info) tys++  | IfaceSumTyCon arity <- ifaceTyConSort info+  = pprSum arity (ifaceTyConIsPromoted info) tys++  | tc `ifaceTyConHasKey` consDataConKey+  , not (gopt Opt_PrintExplicitKinds dflags)+  , IA_Arg _ argf (IA_Arg ty1 Required (IA_Arg ty2 Required IA_Nil)) <- tys+  , isInvisibleArgFlag argf+  = pprIfaceTyList ctxt_prec ty1 ty2++  | tc `ifaceTyConHasKey` tYPETyConKey+  , IA_Arg (IfaceTyConApp rep IA_Nil) Required IA_Nil <- tys+  , rep `ifaceTyConHasKey` liftedRepDataConKey+  = kindType++  | otherwise+  = getPprDebug $ \dbg ->+    if | not dbg && tc `ifaceTyConHasKey` errorMessageTypeErrorFamKey+         -- Suppress detail unles you _really_ want to see+         -> text "(TypeError ...)"++       | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys)+         -> doc++       | otherwise+         -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc tys_wo_kinds+  where+    info = ifaceTyConInfo tc+    tys_wo_kinds = appArgsIfaceTypesArgFlags $ stripInvisArgs dflags tys++-- | Pretty-print a type-level equality.+-- Returns (Just doc) if the argument is a /saturated/ application+-- of   eqTyCon          (~)+--      eqPrimTyCon      (~#)+--      eqReprPrimTyCon  (~R#)+--      heqTyCon         (~~)+--+-- See Note [Equality predicates in IfaceType]+-- and Note [The equality types story] in TysPrim+ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc+ppr_equality ctxt_prec tc args+  | hetero_eq_tc+  , [k1, k2, t1, t2] <- args+  = Just $ print_equality (k1, k2, t1, t2)++  | hom_eq_tc+  , [k, t1, t2] <- args+  = Just $ print_equality (k, k, t1, t2)++  | otherwise+  = Nothing+  where+    homogeneous = tc_name `hasKey` eqTyConKey -- (~)+               || hetero_tc_used_homogeneously+      where+        hetero_tc_used_homogeneously+          = case ifaceTyConSort $ ifaceTyConInfo tc of+                          IfaceEqualityTyCon -> True+                          _other             -> False+             -- True <=> a heterogeneous equality whose arguments+             --          are (in this case) of the same kind++    tc_name = ifaceTyConName tc+    pp = ppr_ty+    hom_eq_tc = tc_name `hasKey` eqTyConKey            -- (~)+    hetero_eq_tc = tc_name `hasKey` eqPrimTyConKey     -- (~#)+                || tc_name `hasKey` eqReprPrimTyConKey -- (~R#)+                || tc_name `hasKey` heqTyConKey        -- (~~)+    nominal_eq_tc = tc_name `hasKey` heqTyConKey       -- (~~)+                 || tc_name `hasKey` eqPrimTyConKey    -- (~#)+    print_equality args =+        sdocWithDynFlags $ \dflags ->+        getPprStyle      $ \style  ->+        print_equality' args style dflags++    print_equality' (ki1, ki2, ty1, ty2) style dflags+      | -- If -fprint-equality-relations is on, just print the original TyCon+        print_eqs+      = ppr_infix_eq (ppr tc)++      | -- Homogeneous use of heterogeneous equality (ty1 ~~ ty2)+        --                 or unlifted equality      (ty1 ~# ty2)+        nominal_eq_tc, homogeneous+      = ppr_infix_eq (text "~")++      | -- Heterogeneous use of unlifted equality (ty1 ~# ty2)+        not homogeneous+      = ppr_infix_eq (ppr heqTyCon)++      | -- Homogeneous use of representational unlifted equality (ty1 ~R# ty2)+        tc_name `hasKey` eqReprPrimTyConKey, homogeneous+      = let ki | print_kinds = [pp appPrec ki1]+               | otherwise   = []+        in pprIfacePrefixApp ctxt_prec (ppr coercibleTyCon)+                            (ki ++ [pp appPrec ty1, pp appPrec ty2])++        -- The other cases work as you'd expect+      | otherwise+      = ppr_infix_eq (ppr tc)+      where+        ppr_infix_eq :: SDoc -> SDoc+        ppr_infix_eq eq_op = pprIfaceInfixApp ctxt_prec eq_op+                               (pp_ty_ki ty1 ki1) (pp_ty_ki ty2 ki2)+          where+            pp_ty_ki ty ki+              | print_kinds+              = parens (pp topPrec ty <+> dcolon <+> pp opPrec ki)+              | otherwise+              = pp opPrec ty++        print_kinds = gopt Opt_PrintExplicitKinds dflags+        print_eqs   = gopt Opt_PrintEqualityRelations dflags ||+                      dumpStyle style || debugStyle style+++pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc+pprIfaceCoTcApp ctxt_prec tc tys =+  ppr_iface_tc_app (\prec (co, _) -> ppr_co prec co) ctxt_prec tc+    (map (, Required) tys)+    -- We are trying to re-use ppr_iface_tc_app here, which requires its+    -- arguments to be accompanied by visibilities. But visibility is+    -- irrelevant when printing coercions, so just default everything to+    -- Required.++-- | Pretty-prints an application of a type constructor to some arguments+-- (whose visibilities are known). This is polymorphic (over @a@) since we use+-- this function to pretty-print two different things:+--+-- 1. Types (from `pprTyTcApp'`)+--+-- 2. Coercions (from 'pprIfaceCoTcApp')+ppr_iface_tc_app :: (PprPrec -> (a, ArgFlag) -> SDoc)+                 -> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc+ppr_iface_tc_app pp _ tc [ty]+  | tc `ifaceTyConHasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp topPrec ty)++ppr_iface_tc_app pp ctxt_prec tc tys+  | tc `ifaceTyConHasKey` liftedTypeKindTyConKey+  = kindType++  | not (isSymOcc (nameOccName (ifaceTyConName tc)))+  = pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp appPrec) tys)++  | [ ty1@(_, Required)+    , ty2@(_, Required) ] <- tys+      -- Infix, two visible arguments (we know nothing of precedence though).+      -- Don't apply this special case if one of the arguments is invisible,+      -- lest we print something like (@LiftedRep -> @LiftedRep) (#15941).+  = pprIfaceInfixApp ctxt_prec (ppr tc)+                     (pp opPrec ty1) (pp opPrec ty2)++  | otherwise+  = pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp appPrec) tys)++pprSum :: Arity -> PromotionFlag -> IfaceAppArgs -> SDoc+pprSum _arity is_promoted args+  =   -- drop the RuntimeRep vars.+      -- See Note [Unboxed tuple RuntimeRep vars] in TyCon+    let tys   = appArgsIfaceTypes args+        args' = drop (length tys `div` 2) tys+    in pprPromotionQuoteI is_promoted+       <> sumParens (pprWithBars (ppr_ty topPrec) args')++pprTuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc+pprTuple ctxt_prec ConstraintTuple NotPromoted IA_Nil+  = maybeParen ctxt_prec appPrec $+    text "() :: Constraint"++-- All promoted constructors have kind arguments+pprTuple _ sort IsPromoted args+  = let tys = appArgsIfaceTypes args+        args' = drop (length tys `div` 2) tys+        spaceIfPromoted = case args' of+          arg0:_ -> pprSpaceIfPromotedTyCon arg0+          _ -> id+    in pprPromotionQuoteI IsPromoted <>+       tupleParens sort (spaceIfPromoted (pprWithCommas pprIfaceType args'))++pprTuple _ sort promoted args+  =   -- drop the RuntimeRep vars.+      -- See Note [Unboxed tuple RuntimeRep vars] in TyCon+    let tys   = appArgsIfaceTypes args+        args' = case sort of+                  UnboxedTuple -> drop (length tys `div` 2) tys+                  _            -> tys+    in+    pprPromotionQuoteI promoted <>+    tupleParens sort (pprWithCommas pprIfaceType args')++pprIfaceTyLit :: IfaceTyLit -> SDoc+pprIfaceTyLit (IfaceNumTyLit n) = integer n+pprIfaceTyLit (IfaceStrTyLit n) = text (show n)++pprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc+pprIfaceCoercion = ppr_co topPrec+pprParendIfaceCoercion = ppr_co appPrec++ppr_co :: PprPrec -> IfaceCoercion -> SDoc+ppr_co _         (IfaceReflCo ty) = angleBrackets (ppr ty) <> ppr_role Nominal+ppr_co _         (IfaceGReflCo r ty IfaceMRefl)+  = angleBrackets (ppr ty) <> ppr_role r+ppr_co ctxt_prec (IfaceGReflCo r ty (IfaceMCo co))+  = ppr_special_co ctxt_prec+    (text "GRefl" <+> ppr r <+> pprParendIfaceType ty) [co]+ppr_co ctxt_prec (IfaceFunCo r co1 co2)+  = maybeParen ctxt_prec funPrec $+    sep (ppr_co funPrec co1 : ppr_fun_tail co2)+  where+    ppr_fun_tail (IfaceFunCo r co1 co2)+      = (arrow <> ppr_role r <+> ppr_co funPrec co1) : ppr_fun_tail co2+    ppr_fun_tail other_co+      = [arrow <> ppr_role r <+> pprIfaceCoercion other_co]++ppr_co _         (IfaceTyConAppCo r tc cos)+  = parens (pprIfaceCoTcApp topPrec tc cos) <> ppr_role r+ppr_co ctxt_prec (IfaceAppCo co1 co2)+  = maybeParen ctxt_prec appPrec $+    ppr_co funPrec co1 <+> pprParendIfaceCoercion co2+ppr_co ctxt_prec co@(IfaceForAllCo {})+  = maybeParen ctxt_prec funPrec $+    pprIfaceForAllCoPart tvs (pprIfaceCoercion inner_co)+  where+    (tvs, inner_co) = split_co co++    split_co (IfaceForAllCo (IfaceTvBndr (name, _)) kind_co co')+      = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'')+    split_co (IfaceForAllCo (IfaceIdBndr (name, _)) kind_co co')+      = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'')+    split_co co' = ([], co')++-- Why these three? See Note [TcTyVars in IfaceType]+ppr_co _ (IfaceFreeCoVar covar) = ppr covar+ppr_co _ (IfaceCoVarCo covar)   = ppr covar+ppr_co _ (IfaceHoleCo covar)    = braces (ppr covar)++ppr_co ctxt_prec (IfaceUnivCo IfaceUnsafeCoerceProv r ty1 ty2)+  = maybeParen ctxt_prec appPrec $+    text "UnsafeCo" <+> ppr r <+>+    pprParendIfaceType ty1 <+> pprParendIfaceType ty2++ppr_co _ (IfaceUnivCo prov role ty1 ty2)+  = text "Univ" <> (parens $+      sep [ ppr role <+> pprIfaceUnivCoProv prov+          , dcolon <+>  ppr ty1 <> comma <+> ppr ty2 ])++ppr_co ctxt_prec (IfaceInstCo co ty)+  = maybeParen ctxt_prec appPrec $+    text "Inst" <+> pprParendIfaceCoercion co+                        <+> pprParendIfaceCoercion ty++ppr_co ctxt_prec (IfaceAxiomRuleCo tc cos)+  = maybeParen ctxt_prec appPrec $ ppr tc <+> parens (interpp'SP cos)++ppr_co ctxt_prec (IfaceAxiomInstCo n i cos)+  = ppr_special_co ctxt_prec (ppr n <> brackets (ppr i)) cos+ppr_co ctxt_prec (IfaceSymCo co)+  = ppr_special_co ctxt_prec (text "Sym") [co]+ppr_co ctxt_prec (IfaceTransCo co1 co2)+  = maybeParen ctxt_prec opPrec $+    ppr_co opPrec co1 <+> semi <+> ppr_co opPrec co2+ppr_co ctxt_prec (IfaceNthCo d co)+  = ppr_special_co ctxt_prec (text "Nth:" <> int d) [co]+ppr_co ctxt_prec (IfaceLRCo lr co)+  = ppr_special_co ctxt_prec (ppr lr) [co]+ppr_co ctxt_prec (IfaceSubCo co)+  = ppr_special_co ctxt_prec (text "Sub") [co]+ppr_co ctxt_prec (IfaceKindCo co)+  = ppr_special_co ctxt_prec (text "Kind") [co]++ppr_special_co :: PprPrec -> SDoc -> [IfaceCoercion] -> SDoc+ppr_special_co ctxt_prec doc cos+  = maybeParen ctxt_prec appPrec+               (sep [doc, nest 4 (sep (map pprParendIfaceCoercion cos))])++ppr_role :: Role -> SDoc+ppr_role r = underscore <> pp_role+  where pp_role = case r of+                    Nominal          -> char 'N'+                    Representational -> char 'R'+                    Phantom          -> char 'P'++------------------+pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc+pprIfaceUnivCoProv IfaceUnsafeCoerceProv+  = text "unsafe"+pprIfaceUnivCoProv (IfacePhantomProv co)+  = text "phantom" <+> pprParendIfaceCoercion co+pprIfaceUnivCoProv (IfaceProofIrrelProv co)+  = text "irrel" <+> pprParendIfaceCoercion co+pprIfaceUnivCoProv (IfacePluginProv s)+  = text "plugin" <+> doubleQuotes (text s)++-------------------+instance Outputable IfaceTyCon where+  ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)++pprPromotionQuote :: IfaceTyCon -> SDoc+pprPromotionQuote tc =+    pprPromotionQuoteI $ ifaceTyConIsPromoted $ ifaceTyConInfo tc++pprPromotionQuoteI  :: PromotionFlag -> SDoc+pprPromotionQuoteI NotPromoted = empty+pprPromotionQuoteI IsPromoted    = char '\''++instance Outputable IfaceCoercion where+  ppr = pprIfaceCoercion++instance Binary IfaceTyCon where+   put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i++   get bh = do n <- get bh+               i <- get bh+               return (IfaceTyCon n i)++instance Binary IfaceTyConSort where+   put_ bh IfaceNormalTyCon             = putByte bh 0+   put_ bh (IfaceTupleTyCon arity sort) = putByte bh 1 >> put_ bh arity >> put_ bh sort+   put_ bh (IfaceSumTyCon arity)        = putByte bh 2 >> put_ bh arity+   put_ bh IfaceEqualityTyCon           = putByte bh 3++   get bh = do+       n <- getByte bh+       case n of+         0 -> return IfaceNormalTyCon+         1 -> IfaceTupleTyCon <$> get bh <*> get bh+         2 -> IfaceSumTyCon <$> get bh+         _ -> return IfaceEqualityTyCon++instance Binary IfaceTyConInfo where+   put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s++   get bh = IfaceTyConInfo <$> get bh <*> get bh++instance Outputable IfaceTyLit where+  ppr = pprIfaceTyLit++instance Binary IfaceTyLit where+  put_ bh (IfaceNumTyLit n)  = putByte bh 1 >> put_ bh n+  put_ bh (IfaceStrTyLit n)  = putByte bh 2 >> put_ bh n++  get bh =+    do tag <- getByte bh+       case tag of+         1 -> do { n <- get bh+                 ; return (IfaceNumTyLit n) }+         2 -> do { n <- get bh+                 ; return (IfaceStrTyLit n) }+         _ -> panic ("get IfaceTyLit " ++ show tag)++instance Binary IfaceAppArgs where+  put_ bh tk =+    case tk of+      IA_Arg t a ts -> putByte bh 0 >> put_ bh t >> put_ bh a >> put_ bh ts+      IA_Nil        -> putByte bh 1++  get bh =+    do c <- getByte bh+       case c of+         0 -> do+           t  <- get bh+           a  <- get bh+           ts <- get bh+           return $! IA_Arg t a ts+         1 -> return IA_Nil+         _ -> panic ("get IfaceAppArgs " ++ show c)++-------------------++-- Some notes about printing contexts+--+-- In the event that we are printing a singleton context (e.g. @Eq a@) we can+-- omit parentheses. However, we must take care to set the precedence correctly+-- to opPrec, since something like @a :~: b@ must be parenthesized (see+-- #9658).+--+-- When printing a larger context we use 'fsep' instead of 'sep' so that+-- the context doesn't get displayed as a giant column. Rather than,+--  instance (Eq a,+--            Eq b,+--            Eq c,+--            Eq d,+--            Eq e,+--            Eq f,+--            Eq g,+--            Eq h,+--            Eq i,+--            Eq j,+--            Eq k,+--            Eq l) =>+--           Eq (a, b, c, d, e, f, g, h, i, j, k, l)+--+-- we want+--+--  instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,+--            Eq j, Eq k, Eq l) =>+--           Eq (a, b, c, d, e, f, g, h, i, j, k, l)++++-- | Prints "(C a, D b) =>", including the arrow.+-- Used when we want to print a context in a type, so we+-- use 'funPrec' to decide whether to parenthesise a singleton+-- predicate; e.g.   Num a => a -> a+pprIfaceContextArr :: [IfacePredType] -> SDoc+pprIfaceContextArr []     = empty+pprIfaceContextArr [pred] = ppr_ty funPrec pred <+> darrow+pprIfaceContextArr preds  = ppr_parend_preds preds <+> darrow++-- | Prints a context or @()@ if empty+-- You give it the context precedence+pprIfaceContext :: PprPrec -> [IfacePredType] -> SDoc+pprIfaceContext _    []     = text "()"+pprIfaceContext prec [pred] = ppr_ty prec pred+pprIfaceContext _    preds  = ppr_parend_preds preds++ppr_parend_preds :: [IfacePredType] -> SDoc+ppr_parend_preds preds = parens (fsep (punctuate comma (map ppr preds)))++instance Binary IfaceType where+    put_ _ (IfaceFreeTyVar tv)+       = pprPanic "Can't serialise IfaceFreeTyVar" (ppr tv)++    put_ bh (IfaceForAllTy aa ab) = do+            putByte bh 0+            put_ bh aa+            put_ bh ab+    put_ bh (IfaceTyVar ad) = do+            putByte bh 1+            put_ bh ad+    put_ bh (IfaceAppTy ae af) = do+            putByte bh 2+            put_ bh ae+            put_ bh af+    put_ bh (IfaceFunTy af ag ah) = do+            putByte bh 3+            put_ bh af+            put_ bh ag+            put_ bh ah+    put_ bh (IfaceTyConApp tc tys)+      = do { putByte bh 5; put_ bh tc; put_ bh tys }+    put_ bh (IfaceCastTy a b)+      = do { putByte bh 6; put_ bh a; put_ bh b }+    put_ bh (IfaceCoercionTy a)+      = do { putByte bh 7; put_ bh a }+    put_ bh (IfaceTupleTy s i tys)+      = do { putByte bh 8; put_ bh s; put_ bh i; put_ bh tys }+    put_ bh (IfaceLitTy n)+      = do { putByte bh 9; put_ bh n }++    get bh = do+            h <- getByte bh+            case h of+              0 -> do aa <- get bh+                      ab <- get bh+                      return (IfaceForAllTy aa ab)+              1 -> do ad <- get bh+                      return (IfaceTyVar ad)+              2 -> do ae <- get bh+                      af <- get bh+                      return (IfaceAppTy ae af)+              3 -> do af <- get bh+                      ag <- get bh+                      ah <- get bh+                      return (IfaceFunTy af ag ah)+              5 -> do { tc <- get bh; tys <- get bh+                      ; return (IfaceTyConApp tc tys) }+              6 -> do { a <- get bh; b <- get bh+                      ; return (IfaceCastTy a b) }+              7 -> do { a <- get bh+                      ; return (IfaceCoercionTy a) }++              8 -> do { s <- get bh; i <- get bh; tys <- get bh+                      ; return (IfaceTupleTy s i tys) }+              _  -> do n <- get bh+                       return (IfaceLitTy n)++instance Binary IfaceMCoercion where+  put_ bh IfaceMRefl = do+          putByte bh 1+  put_ bh (IfaceMCo co) = do+          putByte bh 2+          put_ bh co++  get bh = do+    tag <- getByte bh+    case tag of+         1 -> return IfaceMRefl+         2 -> do a <- get bh+                 return $ IfaceMCo a+         _ -> panic ("get IfaceMCoercion " ++ show tag)++instance Binary IfaceCoercion where+  put_ bh (IfaceReflCo a) = do+          putByte bh 1+          put_ bh a+  put_ bh (IfaceGReflCo a b c) = do+          putByte bh 2+          put_ bh a+          put_ bh b+          put_ bh c+  put_ bh (IfaceFunCo a b c) = do+          putByte bh 3+          put_ bh a+          put_ bh b+          put_ bh c+  put_ bh (IfaceTyConAppCo a b c) = do+          putByte bh 4+          put_ bh a+          put_ bh b+          put_ bh c+  put_ bh (IfaceAppCo a b) = do+          putByte bh 5+          put_ bh a+          put_ bh b+  put_ bh (IfaceForAllCo a b c) = do+          putByte bh 6+          put_ bh a+          put_ bh b+          put_ bh c+  put_ bh (IfaceCoVarCo a) = do+          putByte bh 7+          put_ bh a+  put_ bh (IfaceAxiomInstCo a b c) = do+          putByte bh 8+          put_ bh a+          put_ bh b+          put_ bh c+  put_ bh (IfaceUnivCo a b c d) = do+          putByte bh 9+          put_ bh a+          put_ bh b+          put_ bh c+          put_ bh d+  put_ bh (IfaceSymCo a) = do+          putByte bh 10+          put_ bh a+  put_ bh (IfaceTransCo a b) = do+          putByte bh 11+          put_ bh a+          put_ bh b+  put_ bh (IfaceNthCo a b) = do+          putByte bh 12+          put_ bh a+          put_ bh b+  put_ bh (IfaceLRCo a b) = do+          putByte bh 13+          put_ bh a+          put_ bh b+  put_ bh (IfaceInstCo a b) = do+          putByte bh 14+          put_ bh a+          put_ bh b+  put_ bh (IfaceKindCo a) = do+          putByte bh 15+          put_ bh a+  put_ bh (IfaceSubCo a) = do+          putByte bh 16+          put_ bh a+  put_ bh (IfaceAxiomRuleCo a b) = do+          putByte bh 17+          put_ bh a+          put_ bh b+  put_ _ (IfaceFreeCoVar cv)+       = pprPanic "Can't serialise IfaceFreeCoVar" (ppr cv)+  put_ _  (IfaceHoleCo cv)+       = pprPanic "Can't serialise IfaceHoleCo" (ppr cv)+          -- See Note [Holes in IfaceCoercion]++  get bh = do+      tag <- getByte bh+      case tag of+           1 -> do a <- get bh+                   return $ IfaceReflCo a+           2 -> do a <- get bh+                   b <- get bh+                   c <- get bh+                   return $ IfaceGReflCo a b c+           3 -> do a <- get bh+                   b <- get bh+                   c <- get bh+                   return $ IfaceFunCo a b c+           4 -> do a <- get bh+                   b <- get bh+                   c <- get bh+                   return $ IfaceTyConAppCo a b c+           5 -> do a <- get bh+                   b <- get bh+                   return $ IfaceAppCo a b+           6 -> do a <- get bh+                   b <- get bh+                   c <- get bh+                   return $ IfaceForAllCo a b c+           7 -> do a <- get bh+                   return $ IfaceCoVarCo a+           8 -> do a <- get bh+                   b <- get bh+                   c <- get bh+                   return $ IfaceAxiomInstCo a b c+           9 -> do a <- get bh+                   b <- get bh+                   c <- get bh+                   d <- get bh+                   return $ IfaceUnivCo a b c d+           10-> do a <- get bh+                   return $ IfaceSymCo a+           11-> do a <- get bh+                   b <- get bh+                   return $ IfaceTransCo a b+           12-> do a <- get bh+                   b <- get bh+                   return $ IfaceNthCo a b+           13-> do a <- get bh+                   b <- get bh+                   return $ IfaceLRCo a b+           14-> do a <- get bh+                   b <- get bh+                   return $ IfaceInstCo a b+           15-> do a <- get bh+                   return $ IfaceKindCo a+           16-> do a <- get bh+                   return $ IfaceSubCo a+           17-> do a <- get bh+                   b <- get bh+                   return $ IfaceAxiomRuleCo a b+           _ -> panic ("get IfaceCoercion " ++ show tag)++instance Binary IfaceUnivCoProv where+  put_ bh IfaceUnsafeCoerceProv = putByte bh 1+  put_ bh (IfacePhantomProv a) = do+          putByte bh 2+          put_ bh a+  put_ bh (IfaceProofIrrelProv a) = do+          putByte bh 3+          put_ bh a+  put_ bh (IfacePluginProv a) = do+          putByte bh 4+          put_ bh a++  get bh = do+      tag <- getByte bh+      case tag of+           1 -> return $ IfaceUnsafeCoerceProv+           2 -> do a <- get bh+                   return $ IfacePhantomProv a+           3 -> do a <- get bh+                   return $ IfaceProofIrrelProv a+           4 -> do a <- get bh+                   return $ IfacePluginProv a+           _ -> panic ("get IfaceUnivCoProv " ++ show tag)+++instance Binary (DefMethSpec IfaceType) where+    put_ bh VanillaDM     = putByte bh 0+    put_ bh (GenericDM t) = putByte bh 1 >> put_ bh t+    get bh = do+            h <- getByte bh+            case h of+              0 -> return VanillaDM+              _ -> do { t <- get bh; return (GenericDM t) }
+ compiler/iface/IfaceType.hs-boot view
@@ -0,0 +1,15 @@+-- Used only by ToIface.hs-boot++module IfaceType( IfaceType, IfaceTyCon, IfaceForAllBndr+                , IfaceCoercion, IfaceTyLit, IfaceAppArgs ) where++import Var (VarBndr, ArgFlag)++data IfaceAppArgs++data IfaceType+data IfaceTyCon+data IfaceTyLit+data IfaceCoercion+data IfaceBndr+type IfaceForAllBndr  = VarBndr IfaceBndr ArgFlag
+ compiler/iface/ToIface.hs view
@@ -0,0 +1,650 @@+{-# LANGUAGE CPP #-}++-- | Functions for converting Core things to interface file things.+module ToIface+    ( -- * Binders+      toIfaceTvBndr+    , toIfaceTvBndrs+    , toIfaceIdBndr+    , toIfaceBndr+    , toIfaceForAllBndr+    , toIfaceTyCoVarBinders+    , toIfaceTyVar+      -- * Types+    , toIfaceType, toIfaceTypeX+    , toIfaceKind+    , toIfaceTcArgs+    , toIfaceTyCon+    , toIfaceTyCon_name+    , toIfaceTyLit+      -- * Tidying types+    , tidyToIfaceType+    , tidyToIfaceContext+    , tidyToIfaceTcArgs+      -- * Coercions+    , toIfaceCoercion, toIfaceCoercionX+      -- * Pattern synonyms+    , patSynToIfaceDecl+      -- * Expressions+    , toIfaceExpr+    , toIfaceBang+    , toIfaceSrcBang+    , toIfaceLetBndr+    , toIfaceIdDetails+    , toIfaceIdInfo+    , toIfUnfolding+    , toIfaceOneShot+    , toIfaceTickish+    , toIfaceBind+    , toIfaceAlt+    , toIfaceCon+    , toIfaceApp+    , toIfaceVar+    ) where++#include "HsVersions.h"++import GhcPrelude++import IfaceSyn+import DataCon+import Id+import IdInfo+import CoreSyn+import TyCon hiding ( pprPromotionQuote )+import CoAxiom+import TysPrim ( eqPrimTyCon, eqReprPrimTyCon )+import TysWiredIn ( heqTyCon )+import MkId ( noinlineIdName )+import PrelNames+import Name+import BasicTypes+import Type+import PatSyn+import Outputable+import FastString+import Util+import Var+import VarEnv+import VarSet+import TyCoRep+import Demand ( isTopSig )++import Data.Maybe ( catMaybes )++----------------+toIfaceTvBndr :: TyVar -> IfaceTvBndr+toIfaceTvBndr = toIfaceTvBndrX emptyVarSet++toIfaceTvBndrX :: VarSet -> TyVar -> IfaceTvBndr+toIfaceTvBndrX fr tyvar = ( occNameFS (getOccName tyvar)+                          , toIfaceTypeX fr (tyVarKind tyvar)+                          )++toIfaceTvBndrs :: [TyVar] -> [IfaceTvBndr]+toIfaceTvBndrs = map toIfaceTvBndr++toIfaceIdBndr :: Id -> IfaceIdBndr+toIfaceIdBndr = toIfaceIdBndrX emptyVarSet++toIfaceIdBndrX :: VarSet -> CoVar -> IfaceIdBndr+toIfaceIdBndrX fr covar = ( occNameFS (getOccName covar)+                          , toIfaceTypeX fr (varType covar)+                          )++toIfaceBndr :: Var -> IfaceBndr+toIfaceBndr var+  | isId var  = IfaceIdBndr (toIfaceIdBndr var)+  | otherwise = IfaceTvBndr (toIfaceTvBndr var)++toIfaceBndrX :: VarSet -> Var -> IfaceBndr+toIfaceBndrX fr var+  | isId var  = IfaceIdBndr (toIfaceIdBndrX fr var)+  | otherwise = IfaceTvBndr (toIfaceTvBndrX fr var)++toIfaceTyCoVarBinder :: VarBndr Var vis -> VarBndr IfaceBndr vis+toIfaceTyCoVarBinder (Bndr tv vis) = Bndr (toIfaceBndr tv) vis++toIfaceTyCoVarBinders :: [VarBndr Var vis] -> [VarBndr IfaceBndr vis]+toIfaceTyCoVarBinders = map toIfaceTyCoVarBinder++{-+************************************************************************+*                                                                      *+        Conversion from Type to IfaceType+*                                                                      *+************************************************************************+-}++toIfaceKind :: Type -> IfaceType+toIfaceKind = toIfaceType++---------------------+toIfaceType :: Type -> IfaceType+toIfaceType = toIfaceTypeX emptyVarSet++toIfaceTypeX :: VarSet -> Type -> IfaceType+-- (toIfaceTypeX free ty)+--    translates the tyvars in 'free' as IfaceFreeTyVars+--+-- Synonyms are retained in the interface type+toIfaceTypeX fr (TyVarTy tv)   -- See Note [TcTyVars in IfaceType] in IfaceType+  | tv `elemVarSet` fr         = IfaceFreeTyVar tv+  | otherwise                  = IfaceTyVar (toIfaceTyVar tv)+toIfaceTypeX fr ty@(AppTy {})  =+  -- Flatten as many argument AppTys as possible, then turn them into an+  -- IfaceAppArgs list.+  -- See Note [Suppressing invisible arguments] in IfaceType.+  let (head, args) = splitAppTys ty+  in IfaceAppTy (toIfaceTypeX fr head) (toIfaceAppTyArgsX fr head args)+toIfaceTypeX _  (LitTy n)      = IfaceLitTy (toIfaceTyLit n)+toIfaceTypeX fr (ForAllTy b t) = IfaceForAllTy (toIfaceForAllBndrX fr b)+                                               (toIfaceTypeX (fr `delVarSet` binderVar b) t)+toIfaceTypeX fr (FunTy { ft_arg = t1, ft_res = t2, ft_af = af })+  = IfaceFunTy af (toIfaceTypeX fr t1) (toIfaceTypeX fr t2)+toIfaceTypeX fr (CastTy ty co)  = IfaceCastTy (toIfaceTypeX fr ty) (toIfaceCoercionX fr co)+toIfaceTypeX fr (CoercionTy co) = IfaceCoercionTy (toIfaceCoercionX fr co)++toIfaceTypeX fr (TyConApp tc tys)+    -- tuples+  | Just sort <- tyConTuple_maybe tc+  , n_tys == arity+  = IfaceTupleTy sort NotPromoted (toIfaceTcArgsX fr tc tys)++  | Just dc <- isPromotedDataCon_maybe tc+  , isTupleDataCon dc+  , n_tys == 2*arity+  = IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgsX fr tc (drop arity tys))++  | tc `elem` [ eqPrimTyCon, eqReprPrimTyCon, heqTyCon ]+  , (k1:k2:_) <- tys+  = let info = IfaceTyConInfo NotPromoted sort+        sort | k1 `eqType` k2 = IfaceEqualityTyCon+             | otherwise      = IfaceNormalTyCon+    in IfaceTyConApp (IfaceTyCon (tyConName tc) info) (toIfaceTcArgsX fr tc tys)++    -- other applications+  | otherwise+  = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTcArgsX fr tc tys)+  where+    arity = tyConArity tc+    n_tys = length tys++toIfaceTyVar :: TyVar -> FastString+toIfaceTyVar = occNameFS . getOccName++toIfaceCoVar :: CoVar -> FastString+toIfaceCoVar = occNameFS . getOccName++toIfaceForAllBndr :: TyCoVarBinder -> IfaceForAllBndr+toIfaceForAllBndr = toIfaceForAllBndrX emptyVarSet++toIfaceForAllBndrX :: VarSet -> TyCoVarBinder -> IfaceForAllBndr+toIfaceForAllBndrX fr (Bndr v vis) = Bndr (toIfaceBndrX fr v) vis++----------------+toIfaceTyCon :: TyCon -> IfaceTyCon+toIfaceTyCon tc+  = IfaceTyCon tc_name info+  where+    tc_name = tyConName tc+    info    = IfaceTyConInfo promoted sort+    promoted | isPromotedDataCon tc = IsPromoted+             | otherwise            = NotPromoted++    tupleSort :: TyCon -> Maybe IfaceTyConSort+    tupleSort tc' =+        case tyConTuple_maybe tc' of+          Just UnboxedTuple -> let arity = tyConArity tc' `div` 2+                               in Just $ IfaceTupleTyCon arity UnboxedTuple+          Just sort         -> let arity = tyConArity tc'+                               in Just $ IfaceTupleTyCon arity sort+          Nothing           -> Nothing++    sort+      | Just tsort <- tupleSort tc           = tsort++      | Just dcon <- isPromotedDataCon_maybe tc+      , let tc' = dataConTyCon dcon+      , Just tsort <- tupleSort tc'          = tsort++      | isUnboxedSumTyCon tc+      , Just cons <- isDataSumTyCon_maybe tc = IfaceSumTyCon (length cons)++      | otherwise                            = IfaceNormalTyCon+++toIfaceTyCon_name :: Name -> IfaceTyCon+toIfaceTyCon_name n = IfaceTyCon n info+  where info = IfaceTyConInfo NotPromoted IfaceNormalTyCon+  -- Used for the "rough-match" tycon stuff,+  -- where pretty-printing is not an issue++toIfaceTyLit :: TyLit -> IfaceTyLit+toIfaceTyLit (NumTyLit x) = IfaceNumTyLit x+toIfaceTyLit (StrTyLit x) = IfaceStrTyLit x++----------------+toIfaceCoercion :: Coercion -> IfaceCoercion+toIfaceCoercion = toIfaceCoercionX emptyVarSet++toIfaceCoercionX :: VarSet -> Coercion -> IfaceCoercion+-- (toIfaceCoercionX free ty)+--    translates the tyvars in 'free' as IfaceFreeTyVars+toIfaceCoercionX fr co+  = go co+  where+    go_mco MRefl     = IfaceMRefl+    go_mco (MCo co)  = IfaceMCo $ go co++    go (Refl ty)            = IfaceReflCo (toIfaceTypeX fr ty)+    go (GRefl r ty mco)     = IfaceGReflCo r (toIfaceTypeX fr ty) (go_mco mco)+    go (CoVarCo cv)+      -- See [TcTyVars in IfaceType] in IfaceType+      | cv `elemVarSet` fr  = IfaceFreeCoVar cv+      | otherwise           = IfaceCoVarCo (toIfaceCoVar cv)+    go (HoleCo h)           = IfaceHoleCo  (coHoleCoVar h)++    go (AppCo co1 co2)      = IfaceAppCo  (go co1) (go co2)+    go (SymCo co)           = IfaceSymCo (go co)+    go (TransCo co1 co2)    = IfaceTransCo (go co1) (go co2)+    go (NthCo _r d co)      = IfaceNthCo d (go co)+    go (LRCo lr co)         = IfaceLRCo lr (go co)+    go (InstCo co arg)      = IfaceInstCo (go co) (go arg)+    go (KindCo c)           = IfaceKindCo (go c)+    go (SubCo co)           = IfaceSubCo (go co)+    go (AxiomRuleCo co cs)  = IfaceAxiomRuleCo (coaxrName co) (map go cs)+    go (AxiomInstCo c i cs) = IfaceAxiomInstCo (coAxiomName c) i (map go cs)+    go (UnivCo p r t1 t2)   = IfaceUnivCo (go_prov p) r+                                          (toIfaceTypeX fr t1)+                                          (toIfaceTypeX fr t2)+    go (TyConAppCo r tc cos)+      | tc `hasKey` funTyConKey+      , [_,_,_,_] <- cos         = pprPanic "toIfaceCoercion" (ppr co)+      | otherwise                = IfaceTyConAppCo r (toIfaceTyCon tc) (map go cos)+    go (FunCo r co1 co2)   = IfaceFunCo r (go co1) (go co2)++    go (ForAllCo tv k co) = IfaceForAllCo (toIfaceBndr tv)+                                          (toIfaceCoercionX fr' k)+                                          (toIfaceCoercionX fr' co)+                          where+                            fr' = fr `delVarSet` tv++    go_prov :: UnivCoProvenance -> IfaceUnivCoProv+    go_prov UnsafeCoerceProv    = IfaceUnsafeCoerceProv+    go_prov (PhantomProv co)    = IfacePhantomProv (go co)+    go_prov (ProofIrrelProv co) = IfaceProofIrrelProv (go co)+    go_prov (PluginProv str)    = IfacePluginProv str++toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs+toIfaceTcArgs = toIfaceTcArgsX emptyVarSet++toIfaceTcArgsX :: VarSet -> TyCon -> [Type] -> IfaceAppArgs+toIfaceTcArgsX fr tc ty_args = toIfaceAppArgsX fr (tyConKind tc) ty_args++toIfaceAppTyArgsX :: VarSet -> Type -> [Type] -> IfaceAppArgs+toIfaceAppTyArgsX fr ty ty_args = toIfaceAppArgsX fr (typeKind ty) ty_args++toIfaceAppArgsX :: VarSet -> Kind -> [Type] -> IfaceAppArgs+-- See Note [Suppressing invisible arguments] in IfaceType+-- We produce a result list of args describing visibility+-- The awkward case is+--    T :: forall k. * -> k+-- And consider+--    T (forall j. blah) * blib+-- Is 'blib' visible?  It depends on the visibility flag on j,+-- so we have to substitute for k.  Annoying!+toIfaceAppArgsX fr kind ty_args+  = go (mkEmptyTCvSubst in_scope) kind ty_args+  where+    in_scope = mkInScopeSet (tyCoVarsOfTypes ty_args)++    go _   _                   []     = IA_Nil+    go env ty                  ts+      | Just ty' <- coreView ty+      = go env ty' ts+    go env (ForAllTy (Bndr tv vis) res) (t:ts)+      = IA_Arg t' vis ts'+      where+        t'  = toIfaceTypeX fr t+        ts' = go (extendTCvSubst env tv t) res ts++    go env (FunTy { ft_res = res }) (t:ts) -- No type-class args in tycon apps+      = IA_Arg (toIfaceTypeX fr t) Required (go env res ts)++    go env ty ts@(t1:ts1)+      | not (isEmptyTCvSubst env)+      = go (zapTCvSubst env) (substTy env ty) ts+        -- See Note [Care with kind instantiation] in Type.hs++      | otherwise+      = -- There's a kind error in the type we are trying to print+        -- e.g. kind = k, ty_args = [Int]+        -- This is probably a compiler bug, so we print a trace and+        -- carry on as if it were FunTy.  Without the test for+        -- isEmptyTCvSubst we'd get an infinite loop (#15473)+        WARN( True, ppr kind $$ ppr ty_args )+        IA_Arg (toIfaceTypeX fr t1) Required (go env ty ts1)++tidyToIfaceType :: TidyEnv -> Type -> IfaceType+tidyToIfaceType env ty = toIfaceType (tidyType env ty)++tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceAppArgs+tidyToIfaceTcArgs env tc tys = toIfaceTcArgs tc (tidyTypes env tys)++tidyToIfaceContext :: TidyEnv -> ThetaType -> IfaceContext+tidyToIfaceContext env theta = map (tidyToIfaceType env) theta++{-+************************************************************************+*                                                                      *+        Conversion of pattern synonyms+*                                                                      *+************************************************************************+-}++patSynToIfaceDecl :: PatSyn -> IfaceDecl+patSynToIfaceDecl ps+  = IfacePatSyn { ifName          = getName $ ps+                , ifPatMatcher    = to_if_pr (patSynMatcher ps)+                , ifPatBuilder    = fmap to_if_pr (patSynBuilder ps)+                , ifPatIsInfix    = patSynIsInfix ps+                , ifPatUnivBndrs  = map toIfaceForAllBndr univ_bndrs'+                , ifPatExBndrs    = map toIfaceForAllBndr ex_bndrs'+                , ifPatProvCtxt   = tidyToIfaceContext env2 prov_theta+                , ifPatReqCtxt    = tidyToIfaceContext env2 req_theta+                , ifPatArgs       = map (tidyToIfaceType env2) args+                , ifPatTy         = tidyToIfaceType env2 rhs_ty+                , ifFieldLabels   = (patSynFieldLabels ps)+                }+  where+    (_univ_tvs, req_theta, _ex_tvs, prov_theta, args, rhs_ty) = patSynSig ps+    univ_bndrs = patSynUnivTyVarBinders ps+    ex_bndrs   = patSynExTyVarBinders ps+    (env1, univ_bndrs') = tidyTyCoVarBinders emptyTidyEnv univ_bndrs+    (env2, ex_bndrs')   = tidyTyCoVarBinders env1 ex_bndrs+    to_if_pr (id, needs_dummy) = (idName id, needs_dummy)++{-+************************************************************************+*                                                                      *+        Conversion of other things+*                                                                      *+************************************************************************+-}++toIfaceBang :: TidyEnv -> HsImplBang -> IfaceBang+toIfaceBang _    HsLazy              = IfNoBang+toIfaceBang _   (HsUnpack Nothing)   = IfUnpack+toIfaceBang env (HsUnpack (Just co)) = IfUnpackCo (toIfaceCoercion (tidyCo env co))+toIfaceBang _   HsStrict             = IfStrict++toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang+toIfaceSrcBang (HsSrcBang _ unpk bang) = IfSrcBang unpk bang++toIfaceLetBndr :: Id -> IfaceLetBndr+toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))+                               (toIfaceType (idType id))+                               (toIfaceIdInfo (idInfo id))+                               (toIfaceJoinInfo (isJoinId_maybe id))+  -- Put into the interface file any IdInfo that CoreTidy.tidyLetBndr+  -- has left on the Id.  See Note [IdInfo on nested let-bindings] in IfaceSyn++toIfaceIdDetails :: IdDetails -> IfaceIdDetails+toIfaceIdDetails VanillaId                      = IfVanillaId+toIfaceIdDetails (DFunId {})                    = IfDFunId+toIfaceIdDetails (RecSelId { sel_naughty = n+                           , sel_tycon = tc })  =+  let iface = case tc of+                RecSelData ty_con -> Left (toIfaceTyCon ty_con)+                RecSelPatSyn pat_syn -> Right (patSynToIfaceDecl pat_syn)+  in IfRecSelId iface n++  -- The remaining cases are all "implicit Ids" which don't+  -- appear in interface files at all+toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)+                         IfVanillaId   -- Unexpected; the other++toIfaceIdInfo :: IdInfo -> IfaceIdInfo+toIfaceIdInfo id_info+  = case catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,+                    inline_hsinfo,  unfold_hsinfo, levity_hsinfo] of+       []    -> NoInfo+       infos -> HasInfo infos+               -- NB: strictness and arity must appear in the list before unfolding+               -- See TcIface.tcUnfolding+  where+    ------------  Arity  --------------+    arity_info = arityInfo id_info+    arity_hsinfo | arity_info == 0 = Nothing+                 | otherwise       = Just (HsArity arity_info)++    ------------ Caf Info --------------+    caf_info   = cafInfo id_info+    caf_hsinfo = case caf_info of+                   NoCafRefs -> Just HsNoCafRefs+                   _other    -> Nothing++    ------------  Strictness  --------------+        -- No point in explicitly exporting TopSig+    sig_info = strictnessInfo id_info+    strict_hsinfo | not (isTopSig sig_info) = Just (HsStrictness sig_info)+                  | otherwise               = Nothing++    ------------  Unfolding  --------------+    unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)+    loop_breaker  = isStrongLoopBreaker (occInfo id_info)++    ------------  Inline prag  --------------+    inline_prag = inlinePragInfo id_info+    inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing+                  | otherwise = Just (HsInline inline_prag)++    ------------  Levity polymorphism  ----------+    levity_hsinfo | isNeverLevPolyIdInfo id_info = Just HsLevity+                  | otherwise                    = Nothing++toIfaceJoinInfo :: Maybe JoinArity -> IfaceJoinInfo+toIfaceJoinInfo (Just ar) = IfaceJoinPoint ar+toIfaceJoinInfo Nothing   = IfaceNotJoinPoint++--------------------------+toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem+toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs+                                , uf_src = src+                                , uf_guidance = guidance })+  = Just $ HsUnfold lb $+    case src of+        InlineStable+          -> case guidance of+               UnfWhen {ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok =  boring_ok }+                      -> IfInlineRule arity unsat_ok boring_ok if_rhs+               _other -> IfCoreUnfold True if_rhs+        InlineCompulsory -> IfCompulsory if_rhs+        InlineRhs        -> IfCoreUnfold False if_rhs+        -- Yes, even if guidance is UnfNever, expose the unfolding+        -- If we didn't want to expose the unfolding, TidyPgm would+        -- have stuck in NoUnfolding.  For supercompilation we want+        -- to see that unfolding!+  where+    if_rhs = toIfaceExpr rhs++toIfUnfolding lb (DFunUnfolding { df_bndrs = bndrs, df_args = args })+  = Just (HsUnfold lb (IfDFunUnfold (map toIfaceBndr bndrs) (map toIfaceExpr args)))+      -- No need to serialise the data constructor;+      -- we can recover it from the type of the dfun++toIfUnfolding _ (OtherCon {}) = Nothing+  -- The binding site of an Id doesn't have OtherCon, except perhaps+  -- where we have called zapUnfolding; and that evald'ness info is+  -- not needed by importing modules++toIfUnfolding _ BootUnfolding = Nothing+  -- Can't happen; we only have BootUnfolding for imported binders++toIfUnfolding _ NoUnfolding = Nothing++{-+************************************************************************+*                                                                      *+        Conversion of expressions+*                                                                      *+************************************************************************+-}++toIfaceExpr :: CoreExpr -> IfaceExpr+toIfaceExpr (Var v)         = toIfaceVar v+toIfaceExpr (Lit l)         = IfaceLit l+toIfaceExpr (Type ty)       = IfaceType (toIfaceType ty)+toIfaceExpr (Coercion co)   = IfaceCo   (toIfaceCoercion co)+toIfaceExpr (Lam x b)       = IfaceLam (toIfaceBndr x, toIfaceOneShot x) (toIfaceExpr b)+toIfaceExpr (App f a)       = toIfaceApp f [a]+toIfaceExpr (Case s x ty as)+  | null as                 = IfaceECase (toIfaceExpr s) (toIfaceType ty)+  | otherwise               = IfaceCase (toIfaceExpr s) (getOccFS x) (map toIfaceAlt as)+toIfaceExpr (Let b e)       = IfaceLet (toIfaceBind b) (toIfaceExpr e)+toIfaceExpr (Cast e co)     = IfaceCast (toIfaceExpr e) (toIfaceCoercion co)+toIfaceExpr (Tick t e)+  | Just t' <- toIfaceTickish t = IfaceTick t' (toIfaceExpr e)+  | otherwise                   = toIfaceExpr e++toIfaceOneShot :: Id -> IfaceOneShot+toIfaceOneShot id | isId id+                  , OneShotLam <- oneShotInfo (idInfo id)+                  = IfaceOneShot+                  | otherwise+                  = IfaceNoOneShot++---------------------+toIfaceTickish :: Tickish Id -> Maybe IfaceTickish+toIfaceTickish (ProfNote cc tick push) = Just (IfaceSCC cc tick push)+toIfaceTickish (HpcTick modl ix)       = Just (IfaceHpcTick modl ix)+toIfaceTickish (SourceNote src names)  = Just (IfaceSource src names)+toIfaceTickish (Breakpoint {})         = Nothing+   -- Ignore breakpoints, since they are relevant only to GHCi, and+   -- should not be serialised (#8333)++---------------------+toIfaceBind :: Bind Id -> IfaceBinding+toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)+toIfaceBind (Rec prs)    = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]++---------------------+toIfaceAlt :: (AltCon, [Var], CoreExpr)+           -> (IfaceConAlt, [FastString], IfaceExpr)+toIfaceAlt (c,bs,r) = (toIfaceCon c, map getOccFS bs, toIfaceExpr r)++---------------------+toIfaceCon :: AltCon -> IfaceConAlt+toIfaceCon (DataAlt dc) = IfaceDataAlt (getName dc)+toIfaceCon (LitAlt l)   = IfaceLitAlt l+toIfaceCon DEFAULT      = IfaceDefault++---------------------+toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr+toIfaceApp (App f a) as = toIfaceApp f (a:as)+toIfaceApp (Var v) as+  = case isDataConWorkId_maybe v of+        -- We convert the *worker* for tuples into IfaceTuples+        Just dc |  saturated+                ,  Just tup_sort <- tyConTuple_maybe tc+                -> IfaceTuple tup_sort tup_args+          where+            val_args  = dropWhile isTypeArg as+            saturated = val_args `lengthIs` idArity v+            tup_args  = map toIfaceExpr val_args+            tc        = dataConTyCon dc++        _ -> mkIfaceApps (toIfaceVar v) as++toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as++mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr+mkIfaceApps f as = foldl' (\f a -> IfaceApp f (toIfaceExpr a)) f as++---------------------+toIfaceVar :: Id -> IfaceExpr+toIfaceVar v+    | isBootUnfolding (idUnfolding v)+    = -- See Note [Inlining and hs-boot files]+      IfaceApp (IfaceApp (IfaceExt noinlineIdName)+                         (IfaceType (toIfaceType (idType v))))+               (IfaceExt name) -- don't use mkIfaceApps, or infinite loop++    | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))+                                      -- Foreign calls have special syntax++    | isExternalName name             = IfaceExt name+    | otherwise                       = IfaceLcl (getOccFS name)+  where name = idName v+++{- Note [Inlining and hs-boot files]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider this example (#10083, #12789):++    ---------- RSR.hs-boot ------------+    module RSR where+      data RSR+      eqRSR :: RSR -> RSR -> Bool++    ---------- SR.hs ------------+    module SR where+      import {-# SOURCE #-} RSR+      data SR = MkSR RSR+      eqSR (MkSR r1) (MkSR r2) = eqRSR r1 r2++    ---------- RSR.hs ------------+    module RSR where+      import SR+      data RSR = MkRSR SR -- deriving( Eq )+      eqRSR (MkRSR s1) (MkRSR s2) = (eqSR s1 s2)+      foo x y = not (eqRSR x y)++When compiling RSR we get this code++    RSR.eqRSR :: RSR -> RSR -> Bool+    RSR.eqRSR = \ (ds1 :: RSR.RSR) (ds2 :: RSR.RSR) ->+                case ds1 of _ { RSR.MkRSR s1 ->+                case ds2 of _ { RSR.MkRSR s2 ->+                SR.eqSR s1 s2 }}++    RSR.foo :: RSR -> RSR -> Bool+    RSR.foo = \ (x :: RSR) (y :: RSR) -> not (RSR.eqRSR x y)++Now, when optimising foo:+    Inline eqRSR (small, non-rec)+    Inline eqSR  (small, non-rec)+but the result of inlining eqSR from SR is another call to eqRSR, so+everything repeats.  Neither eqSR nor eqRSR are (apparently) loop+breakers.++Solution: in the unfolding of eqSR in SR.hi, replace `eqRSR` in SR+with `noinline eqRSR`, so that eqRSR doesn't get inlined.  This means+that when GHC inlines `eqSR`, it will not also inline `eqRSR`, exactly+as would have been the case if `foo` had been defined in SR.hs (and+marked as a loop-breaker).++But how do we arrange for this to happen?  There are two ingredients:++    1. When we serialize out unfoldings to IfaceExprs (toIfaceVar),+    for every variable reference we see if we are referring to an+    'Id' that came from an hs-boot file.  If so, we add a `noinline`+    to the reference.++    2. But how do we know if a reference came from an hs-boot file+    or not?  We could record this directly in the 'IdInfo', but+    actually we deduce this by looking at the unfolding: 'Id's+    that come from boot files are given a special unfolding+    (upon typechecking) 'BootUnfolding' which say that there is+    no unfolding, and the reason is because the 'Id' came from+    a boot file.++Here is a solution that doesn't work: when compiling RSR,+add a NOINLINE pragma to every function exported by the boot-file+for RSR (if it exists).  Doing so makes the bootstrapped GHC itself+slower by 8% overall (on #9872a-d, and T1969: the reason+is that these NOINLINE'd functions now can't be profitably inlined+outside of the hs-boot loop.++-}
+ compiler/iface/ToIface.hs-boot view
@@ -0,0 +1,18 @@+module ToIface where++import {-# SOURCE #-} TyCoRep+import {-# SOURCE #-} IfaceType( IfaceType, IfaceTyCon, IfaceForAllBndr+                               , IfaceCoercion, IfaceTyLit, IfaceAppArgs )+import Var ( TyCoVarBinder )+import VarEnv ( TidyEnv )+import TyCon ( TyCon )+import VarSet( VarSet )++-- For TyCoRep+toIfaceTypeX :: VarSet -> Type -> IfaceType+toIfaceTyLit :: TyLit -> IfaceTyLit+toIfaceForAllBndr :: TyCoVarBinder -> IfaceForAllBndr+toIfaceTyCon :: TyCon -> IfaceTyCon+toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs+toIfaceCoercionX :: VarSet -> Coercion -> IfaceCoercion+tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceAppArgs
+ compiler/main/Annotations.hs view
@@ -0,0 +1,134 @@+-- |+-- Support for source code annotation feature of GHC. That is the ANN pragma.+--+-- (c) The University of Glasgow 2006+-- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998+--+module Annotations (+        -- * Main Annotation data types+        Annotation(..), AnnPayload,+        AnnTarget(..), CoreAnnTarget,+        getAnnTargetName_maybe,++        -- * AnnEnv for collecting and querying Annotations+        AnnEnv,+        mkAnnEnv, extendAnnEnvList, plusAnnEnv, emptyAnnEnv,+        findAnns, findAnnsByTypeRep,+        deserializeAnns+    ) where++import GhcPrelude++import Binary+import Module           ( Module )+import Name+import Outputable+import GHC.Serialized+import UniqFM+import Unique++import Control.Monad+import Data.Maybe+import Data.Typeable+import Data.Word        ( Word8 )+++-- | Represents an annotation after it has been sufficiently desugared from+-- it's initial form of 'HsDecls.AnnDecl'+data Annotation = Annotation {+        ann_target :: CoreAnnTarget,    -- ^ The target of the annotation+        ann_value  :: AnnPayload+    }++type AnnPayload = Serialized    -- ^ The "payload" of an annotation+                                --   allows recovery of its value at a given type,+                                --   and can be persisted to an interface file++-- | An annotation target+data AnnTarget name+  = NamedTarget name          -- ^ We are annotating something with a name:+                              --      a type or identifier+  | ModuleTarget Module       -- ^ We are annotating a particular module++-- | The kind of annotation target found in the middle end of the compiler+type CoreAnnTarget = AnnTarget Name++instance Functor AnnTarget where+    fmap f (NamedTarget nm) = NamedTarget (f nm)+    fmap _ (ModuleTarget mod) = ModuleTarget mod++-- | Get the 'name' of an annotation target if it exists.+getAnnTargetName_maybe :: AnnTarget name -> Maybe name+getAnnTargetName_maybe (NamedTarget nm) = Just nm+getAnnTargetName_maybe _                = Nothing++instance Uniquable name => Uniquable (AnnTarget name) where+    getUnique (NamedTarget nm) = getUnique nm+    getUnique (ModuleTarget mod) = deriveUnique (getUnique mod) 0+    -- deriveUnique prevents OccName uniques clashing with NamedTarget++instance Outputable name => Outputable (AnnTarget name) where+    ppr (NamedTarget nm) = text "Named target" <+> ppr nm+    ppr (ModuleTarget mod) = text "Module target" <+> ppr mod++instance Binary name => Binary (AnnTarget name) where+    put_ bh (NamedTarget a) = do+        putByte bh 0+        put_ bh a+    put_ bh (ModuleTarget a) = do+        putByte bh 1+        put_ bh a+    get bh = do+        h <- getByte bh+        case h of+            0 -> liftM NamedTarget  $ get bh+            _ -> liftM ModuleTarget $ get bh++instance Outputable Annotation where+    ppr ann = ppr (ann_target ann)++-- | A collection of annotations+-- Can't use a type synonym or we hit bug #2412 due to source import+newtype AnnEnv = MkAnnEnv (UniqFM [AnnPayload])++-- | An empty annotation environment.+emptyAnnEnv :: AnnEnv+emptyAnnEnv = MkAnnEnv emptyUFM++-- | Construct a new annotation environment that contains the list of+-- annotations provided.+mkAnnEnv :: [Annotation] -> AnnEnv+mkAnnEnv = extendAnnEnvList emptyAnnEnv++-- | Add the given annotation to the environment.+extendAnnEnvList :: AnnEnv -> [Annotation] -> AnnEnv+extendAnnEnvList (MkAnnEnv env) anns+  = MkAnnEnv $ addListToUFM_C (++) env $+    map (\ann -> (getUnique (ann_target ann), [ann_value ann])) anns++-- | Union two annotation environments.+plusAnnEnv :: AnnEnv -> AnnEnv -> AnnEnv+plusAnnEnv (MkAnnEnv env1) (MkAnnEnv env2) = MkAnnEnv $ plusUFM_C (++) env1 env2++-- | Find the annotations attached to the given target as 'Typeable'+--   values of your choice. If no deserializer is specified,+--   only transient annotations will be returned.+findAnns :: Typeable a => ([Word8] -> a) -> AnnEnv -> CoreAnnTarget -> [a]+findAnns deserialize (MkAnnEnv ann_env)+  = (mapMaybe (fromSerialized deserialize))+    . (lookupWithDefaultUFM ann_env [])++-- | Find the annotations attached to the given target as 'Typeable'+--   values of your choice. If no deserializer is specified,+--   only transient annotations will be returned.+findAnnsByTypeRep :: AnnEnv -> CoreAnnTarget -> TypeRep -> [[Word8]]+findAnnsByTypeRep (MkAnnEnv ann_env) target tyrep+  = [ ws | Serialized tyrep' ws <- lookupWithDefaultUFM ann_env [] target+    , tyrep' == tyrep ]++-- | Deserialize all annotations of a given type. This happens lazily, that is+--   no deserialization will take place until the [a] is actually demanded and+--   the [a] can also be empty (the UniqFM is not filtered).+deserializeAnns :: Typeable a => ([Word8] -> a) -> AnnEnv -> UniqFM [a]+deserializeAnns deserialize (MkAnnEnv ann_env)+  = mapUFM (mapMaybe (fromSerialized deserialize)) ann_env
+ compiler/main/CmdLineParser.hs view
@@ -0,0 +1,340 @@+{-# LANGUAGE CPP #-}++-------------------------------------------------------------------------------+--+-- | Command-line parser+--+-- This is an abstract command-line parser used by DynFlags.+--+-- (c) The University of Glasgow 2005+--+-------------------------------------------------------------------------------++module CmdLineParser+    (+      processArgs, OptKind(..), GhcFlagMode(..),+      CmdLineP(..), getCmdLineState, putCmdLineState,+      Flag(..), defFlag, defGhcFlag, defGhciFlag, defHiddenFlag,+      errorsToGhcException,++      Err(..), Warn(..), WarnReason(..),++      EwM, runEwM, addErr, addWarn, addFlagWarn, getArg, getCurLoc, liftEwM,+      deprecate+    ) where++#include "HsVersions.h"++import GhcPrelude++import Util+import Outputable+import Panic+import Bag+import SrcLoc+import Json++import Data.Function+import Data.List++import Control.Monad (liftM, ap)++--------------------------------------------------------+--         The Flag and OptKind types+--------------------------------------------------------++data Flag m = Flag+    {   flagName    :: String,     -- Flag, without the leading "-"+        flagOptKind :: OptKind m,  -- What to do if we see it+        flagGhcMode :: GhcFlagMode    -- Which modes this flag affects+    }++defFlag :: String -> OptKind m -> Flag m+defFlag name optKind = Flag name optKind AllModes++defGhcFlag :: String -> OptKind m -> Flag m+defGhcFlag name optKind = Flag name optKind OnlyGhc++defGhciFlag :: String -> OptKind m -> Flag m+defGhciFlag name optKind = Flag name optKind OnlyGhci++defHiddenFlag :: String -> OptKind m -> Flag m+defHiddenFlag name optKind = Flag name optKind HiddenFlag++-- | GHC flag modes describing when a flag has an effect.+data GhcFlagMode+    = OnlyGhc  -- ^ The flag only affects the non-interactive GHC+    | OnlyGhci -- ^ The flag only affects the interactive GHC+    | AllModes -- ^ The flag affects multiple ghc modes+    | HiddenFlag -- ^ This flag should not be seen in cli completion++data OptKind m                             -- Suppose the flag is -f+    = NoArg     (EwM m ())                 -- -f all by itself+    | HasArg    (String -> EwM m ())       -- -farg or -f arg+    | SepArg    (String -> EwM m ())       -- -f arg+    | Prefix    (String -> EwM m ())       -- -farg+    | OptPrefix (String -> EwM m ())       -- -f or -farg (i.e. the arg is optional)+    | OptIntSuffix (Maybe Int -> EwM m ()) -- -f or -f=n; pass n to fn+    | IntSuffix (Int -> EwM m ())          -- -f or -f=n; pass n to fn+    | FloatSuffix (Float -> EwM m ())      -- -f or -f=n; pass n to fn+    | PassFlag  (String -> EwM m ())       -- -f; pass "-f" fn+    | AnySuffix (String -> EwM m ())       -- -f or -farg; pass entire "-farg" to fn+++--------------------------------------------------------+--         The EwM monad+--------------------------------------------------------++-- | Used when filtering warnings: if a reason is given+-- it can be filtered out when displaying.+data WarnReason+  = NoReason+  | ReasonDeprecatedFlag+  | ReasonUnrecognisedFlag+  deriving (Eq, Show)++instance Outputable WarnReason where+  ppr = text . show++instance ToJson WarnReason where+  json NoReason = JSNull+  json reason   = JSString $ show reason++-- | A command-line error message+newtype Err  = Err { errMsg :: Located String }++-- | A command-line warning message and the reason it arose+data Warn = Warn+  {   warnReason :: WarnReason,+      warnMsg    :: Located String+  }++type Errs  = Bag Err+type Warns = Bag Warn++-- EwM ("errors and warnings monad") is a monad+-- transformer for m that adds an (err, warn) state+newtype EwM m a = EwM { unEwM :: Located String -- Current parse arg+                              -> Errs -> Warns+                              -> m (Errs, Warns, a) }++instance Monad m => Functor (EwM m) where+    fmap = liftM++instance Monad m => Applicative (EwM m) where+    pure v = EwM (\_ e w -> return (e, w, v))+    (<*>) = ap++instance Monad m => Monad (EwM m) where+    (EwM f) >>= k = EwM (\l e w -> do (e', w', r) <- f l e w+                                      unEwM (k r) l e' w')++runEwM :: EwM m a -> m (Errs, Warns, a)+runEwM action = unEwM action (panic "processArgs: no arg yet") emptyBag emptyBag++setArg :: Located String -> EwM m () -> EwM m ()+setArg l (EwM f) = EwM (\_ es ws -> f l es ws)++addErr :: Monad m => String -> EwM m ()+addErr e = EwM (\(L loc _) es ws -> return (es `snocBag` Err (L loc e), ws, ()))++addWarn :: Monad m => String -> EwM m ()+addWarn = addFlagWarn NoReason++addFlagWarn :: Monad m => WarnReason -> String -> EwM m ()+addFlagWarn reason msg = EwM $+  (\(L loc _) es ws -> return (es, ws `snocBag` Warn reason (L loc msg), ()))++deprecate :: Monad m => String -> EwM m ()+deprecate s = do+    arg <- getArg+    addFlagWarn ReasonDeprecatedFlag (arg ++ " is deprecated: " ++ s)++getArg :: Monad m => EwM m String+getArg = EwM (\(L _ arg) es ws -> return (es, ws, arg))++getCurLoc :: Monad m => EwM m SrcSpan+getCurLoc = EwM (\(L loc _) es ws -> return (es, ws, loc))++liftEwM :: Monad m => m a -> EwM m a+liftEwM action = EwM (\_ es ws -> do { r <- action; return (es, ws, r) })+++--------------------------------------------------------+-- A state monad for use in the command-line parser+--------------------------------------------------------++-- (CmdLineP s) typically instantiates the 'm' in (EwM m) and (OptKind m)+newtype CmdLineP s a = CmdLineP { runCmdLine :: s -> (a, s) }++instance Functor (CmdLineP s) where+    fmap = liftM++instance Applicative (CmdLineP s) where+    pure a = CmdLineP $ \s -> (a, s)+    (<*>) = ap++instance Monad (CmdLineP s) where+    m >>= k = CmdLineP $ \s ->+                  let (a, s') = runCmdLine m s+                  in runCmdLine (k a) s'+++getCmdLineState :: CmdLineP s s+getCmdLineState   = CmdLineP $ \s -> (s,s)+putCmdLineState :: s -> CmdLineP s ()+putCmdLineState s = CmdLineP $ \_ -> ((),s)+++--------------------------------------------------------+--         Processing arguments+--------------------------------------------------------++processArgs :: Monad m+            => [Flag m]               -- cmdline parser spec+            -> [Located String]       -- args+            -> m ( [Located String],  -- spare args+                   [Err],  -- errors+                   [Warn] ) -- warnings+processArgs spec args = do+    (errs, warns, spare) <- runEwM action+    return (spare, bagToList errs, bagToList warns)+  where+    action = process args []++    -- process :: [Located String] -> [Located String] -> EwM m [Located String]+    process [] spare = return (reverse spare)++    process (locArg@(L _ ('-' : arg)) : args) spare =+        case findArg spec arg of+            Just (rest, opt_kind) ->+                case processOneArg opt_kind rest arg args of+                    Left err ->+                        let b = process args spare+                        in (setArg locArg $ addErr err) >> b++                    Right (action,rest) ->+                        let b = process rest spare+                        in (setArg locArg $ action) >> b++            Nothing -> process args (locArg : spare)++    process (arg : args) spare = process args (arg : spare)+++processOneArg :: OptKind m -> String -> String -> [Located String]+              -> Either String (EwM m (), [Located String])+processOneArg opt_kind rest arg args+  = let dash_arg = '-' : arg+        rest_no_eq = dropEq rest+    in case opt_kind of+        NoArg  a -> ASSERT(null rest) Right (a, args)++        HasArg f | notNull rest_no_eq -> Right (f rest_no_eq, args)+                 | otherwise -> case args of+                                    []               -> missingArgErr dash_arg+                                    (L _ arg1:args1) -> Right (f arg1, args1)++        -- See #9776+        SepArg f -> case args of+                        []               -> missingArgErr dash_arg+                        (L _ arg1:args1) -> Right (f arg1, args1)++        -- See #12625+        Prefix f | notNull rest_no_eq -> Right (f rest_no_eq, args)+                 | otherwise          -> missingArgErr  dash_arg++        PassFlag f  | notNull rest -> unknownFlagErr dash_arg+                    | otherwise    -> Right (f dash_arg, args)++        OptIntSuffix f | null rest                     -> Right (f Nothing,  args)+                       | Just n <- parseInt rest_no_eq -> Right (f (Just n), args)+                       | otherwise -> Left ("malformed integer argument in " ++ dash_arg)++        IntSuffix f | Just n <- parseInt rest_no_eq -> Right (f n, args)+                    | otherwise -> Left ("malformed integer argument in " ++ dash_arg)++        FloatSuffix f | Just n <- parseFloat rest_no_eq -> Right (f n, args)+                      | otherwise -> Left ("malformed float argument in " ++ dash_arg)++        OptPrefix f       -> Right (f rest_no_eq, args)+        AnySuffix f       -> Right (f dash_arg, args)++findArg :: [Flag m] -> String -> Maybe (String, OptKind m)+findArg spec arg =+    case sortBy (compare `on` (length . fst)) -- prefer longest matching flag+           [ (removeSpaces rest, optKind)+           | flag <- spec,+             let optKind  = flagOptKind flag,+             Just rest <- [stripPrefix (flagName flag) arg],+             arg_ok optKind rest arg ]+    of+        []      -> Nothing+        (one:_) -> Just one++arg_ok :: OptKind t -> [Char] -> String -> Bool+arg_ok (NoArg           _)  rest _   = null rest+arg_ok (HasArg          _)  _    _   = True+arg_ok (SepArg          _)  rest _   = null rest+arg_ok (Prefix          _)  _    _   = True -- Missing argument checked for in processOneArg t+                                            -- to improve error message (#12625)+arg_ok (OptIntSuffix    _)  _    _   = True+arg_ok (IntSuffix       _)  _    _   = True+arg_ok (FloatSuffix     _)  _    _   = True+arg_ok (OptPrefix       _)  _    _   = True+arg_ok (PassFlag        _)  rest _   = null rest+arg_ok (AnySuffix       _)  _    _   = True++-- | Parse an Int+--+-- Looks for "433" or "=342", with no trailing gubbins+--   * n or =n      => Just n+--   * gibberish    => Nothing+parseInt :: String -> Maybe Int+parseInt s = case reads s of+                 ((n,""):_) -> Just n+                 _          -> Nothing++parseFloat :: String -> Maybe Float+parseFloat s = case reads s of+                   ((n,""):_) -> Just n+                   _          -> Nothing++-- | Discards a leading equals sign+dropEq :: String -> String+dropEq ('=' : s) = s+dropEq s         = s++unknownFlagErr :: String -> Either String a+unknownFlagErr f = Left ("unrecognised flag: " ++ f)++missingArgErr :: String -> Either String a+missingArgErr f = Left ("missing argument for flag: " ++ f)++--------------------------------------------------------+-- Utils+--------------------------------------------------------+++-- See Note [Handling errors when parsing flags]+errorsToGhcException :: [(String,    -- Location+                          String)]   -- Error+                     -> GhcException+errorsToGhcException errs =+    UsageError $ intercalate "\n" $ [ l ++ ": " ++ e | (l, e) <- errs ]++{- Note [Handling errors when parsing commandline flags]++Parsing of static and mode flags happens before any session is started, i.e.,+before the first call to 'GHC.withGhc'. Therefore, to report errors for+invalid usage of these two types of flags, we can not call any function that+needs DynFlags, as there are no DynFlags available yet (unsafeGlobalDynFlags+is not set either). So we always print "on the commandline" as the location,+which is true except for Api users, which is probably ok.++When reporting errors for invalid usage of dynamic flags we /can/ make use of+DynFlags, and we do so explicitly in DynFlags.parseDynamicFlagsFull.++Before, we called unsafeGlobalDynFlags when an invalid (combination of)+flag(s) was given on the commandline, resulting in panics (#9963).+-}
+ compiler/main/Constants.hs view
@@ -0,0 +1,46 @@+{-+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[Constants]{Info about this compilation}+-}++module Constants (module Constants) where++import GhcPrelude++import Config++hiVersion :: Integer+hiVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Integer++-- All pretty arbitrary:++mAX_TUPLE_SIZE :: Int+mAX_TUPLE_SIZE = 62 -- Should really match the number+                    -- of decls in Data.Tuple++mAX_CTUPLE_SIZE :: Int   -- Constraint tuples+mAX_CTUPLE_SIZE = 62     -- Should match the number of decls in GHC.Classes++mAX_SUM_SIZE :: Int+mAX_SUM_SIZE = 62++-- | Default maximum depth for both class instance search and type family+-- reduction. See also #5395.+mAX_REDUCTION_DEPTH :: Int+mAX_REDUCTION_DEPTH = 200++-- | Default maximum constraint-solver iterations+-- Typically there should be very few+mAX_SOLVER_ITERATIONS :: Int+mAX_SOLVER_ITERATIONS = 4++wORD64_SIZE :: Int+wORD64_SIZE = 8++-- Size of float in bytes.+fLOAT_SIZE :: Int+fLOAT_SIZE = 4++tARGET_MAX_CHAR :: Int+tARGET_MAX_CHAR = 0x10ffff
+ compiler/main/DriverPhases.hs view
@@ -0,0 +1,372 @@+{-# LANGUAGE CPP #-}++-----------------------------------------------------------------------------+--  $Id: DriverPhases.hs,v 1.38 2005/05/17 11:01:59 simonmar Exp $+--+-- GHC Driver+--+-- (c) The University of Glasgow 2002+--+-----------------------------------------------------------------------------++module DriverPhases (+   HscSource(..), isHsBootOrSig, isHsigFile, hscSourceString,+   Phase(..),+   happensBefore, eqPhase, anyHsc, isStopLn,+   startPhase,+   phaseInputExt,++   isHaskellishSuffix,+   isHaskellSrcSuffix,+   isBackpackishSuffix,+   isObjectSuffix,+   isCishSuffix,+   isDynLibSuffix,+   isHaskellUserSrcSuffix,+   isHaskellSigSuffix,+   isSourceSuffix,++   isHaskellishTarget,++   isHaskellishFilename,+   isHaskellSrcFilename,+   isHaskellSigFilename,+   isObjectFilename,+   isCishFilename,+   isDynLibFilename,+   isHaskellUserSrcFilename,+   isSourceFilename+ ) where++#include "HsVersions.h"++import GhcPrelude++import {-# SOURCE #-} DynFlags+import Outputable+import Platform+import System.FilePath+import Binary+import Util++-----------------------------------------------------------------------------+-- Phases++{-+   Phase of the           | Suffix saying | Flag saying   | (suffix of)+   compilation system     | ``start here''| ``stop after''| output file++   literate pre-processor | .lhs          | -             | -+   C pre-processor (opt.) | -             | -E            | -+   Haskell compiler       | .hs           | -C, -S        | .hc, .s+   C compiler (opt.)      | .hc or .c     | -S            | .s+   assembler              | .s  or .S     | -c            | .o+   linker                 | other         | -             | a.out+-}++-- Note [HscSource types]+-- ~~~~~~~~~~~~~~~~~~~~~~+-- There are three types of source file for Haskell code:+--+--      * HsSrcFile is an ordinary hs file which contains code,+--+--      * HsBootFile is an hs-boot file, which is used to break+--        recursive module imports (there will always be an+--        HsSrcFile associated with it), and+--+--      * HsigFile is an hsig file, which contains only type+--        signatures and is used to specify signatures for+--        modules.+--+-- Syntactically, hs-boot files and hsig files are quite similar: they+-- only include type signatures and must be associated with an+-- actual HsSrcFile.  isHsBootOrSig allows us to abstract over code+-- which is indifferent to which.  However, there are some important+-- differences, mostly owing to the fact that hsigs are proper+-- modules (you `import Sig` directly) whereas HsBootFiles are+-- temporary placeholders (you `import {-# SOURCE #-} Mod).+-- When we finish compiling the true implementation of an hs-boot,+-- we replace the HomeModInfo with the real HsSrcFile.  An HsigFile, on the+-- other hand, is never replaced (in particular, we *cannot* use the+-- HomeModInfo of the original HsSrcFile backing the signature, since it+-- will export too many symbols.)+--+-- Additionally, while HsSrcFile is the only Haskell file+-- which has *code*, we do generate .o files for HsigFile, because+-- this is how the recompilation checker figures out if a file+-- needs to be recompiled.  These are fake object files which+-- should NOT be linked against.++data HscSource+   = HsSrcFile | HsBootFile | HsigFile+     deriving( Eq, Ord, Show )+        -- Ord needed for the finite maps we build in CompManager++instance Binary HscSource where+    put_ bh HsSrcFile = putByte bh 0+    put_ bh HsBootFile = putByte bh 1+    put_ bh HsigFile = putByte bh 2+    get bh = do+        h <- getByte bh+        case h of+            0 -> return HsSrcFile+            1 -> return HsBootFile+            _ -> return HsigFile++hscSourceString :: HscSource -> String+hscSourceString HsSrcFile   = ""+hscSourceString HsBootFile  = "[boot]"+hscSourceString HsigFile    = "[sig]"++-- See Note [isHsBootOrSig]+isHsBootOrSig :: HscSource -> Bool+isHsBootOrSig HsBootFile = True+isHsBootOrSig HsigFile   = True+isHsBootOrSig _          = False++isHsigFile :: HscSource -> Bool+isHsigFile HsigFile = True+isHsigFile _        = False++data Phase+        = Unlit HscSource+        | Cpp   HscSource+        | HsPp  HscSource+        | Hsc   HscSource+        | Ccxx          -- Compile C+++        | Cc            -- Compile C+        | Cobjc         -- Compile Objective-C+        | Cobjcxx       -- Compile Objective-C+++        | HCc           -- Haskellised C (as opposed to vanilla C) compilation+        | As Bool       -- Assembler for regular assembly files (Bool: with-cpp)+        | LlvmOpt       -- Run LLVM opt tool over llvm assembly+        | LlvmLlc       -- LLVM bitcode to native assembly+        | LlvmMangle    -- Fix up TNTC by processing assembly produced by LLVM+        | CmmCpp        -- pre-process Cmm source+        | Cmm           -- parse & compile Cmm code+        | MergeForeign  -- merge in the foreign object files++        -- The final phase is a pseudo-phase that tells the pipeline to stop.+        -- There is no runPhase case for it.+        | StopLn        -- Stop, but linking will follow, so generate .o file+  deriving (Eq, Show)++instance Outputable Phase where+    ppr p = text (show p)++anyHsc :: Phase+anyHsc = Hsc (panic "anyHsc")++isStopLn :: Phase -> Bool+isStopLn StopLn = True+isStopLn _      = False++eqPhase :: Phase -> Phase -> Bool+-- Equality of constructors, ignoring the HscSource field+-- NB: the HscSource field can be 'bot'; see anyHsc above+eqPhase (Unlit _)   (Unlit _)  = True+eqPhase (Cpp   _)   (Cpp   _)  = True+eqPhase (HsPp  _)   (HsPp  _)  = True+eqPhase (Hsc   _)   (Hsc   _)  = True+eqPhase Cc          Cc         = True+eqPhase Cobjc       Cobjc      = True+eqPhase HCc         HCc        = True+eqPhase (As x)      (As y)     = x == y+eqPhase LlvmOpt     LlvmOpt    = True+eqPhase LlvmLlc     LlvmLlc    = True+eqPhase LlvmMangle  LlvmMangle = True+eqPhase CmmCpp      CmmCpp     = True+eqPhase Cmm         Cmm        = True+eqPhase MergeForeign MergeForeign  = True+eqPhase StopLn      StopLn     = True+eqPhase Ccxx        Ccxx       = True+eqPhase Cobjcxx     Cobjcxx    = True+eqPhase _           _          = False++{- Note [Partial ordering on phases]++We want to know which phases will occur before which others. This is used for+sanity checking, to ensure that the pipeline will stop at some point (see+DriverPipeline.runPipeline).++A < B iff A occurs before B in a normal compilation pipeline.++There is explicitly not a total ordering on phases, because in registerised+builds, the phase `HsC` doesn't happen before nor after any other phase.++Although we check that a normal user doesn't set the stop_phase to HsC through+use of -C with registerised builds (in Main.checkOptions), it is still+possible for a ghc-api user to do so. So be careful when using the function+happensBefore, and don't think that `not (a <= b)` implies `b < a`.+-}+happensBefore :: DynFlags -> Phase -> Phase -> Bool+happensBefore dflags p1 p2 = p1 `happensBefore'` p2+    where StopLn `happensBefore'` _ = False+          x      `happensBefore'` y = after_x `eqPhase` y+                                   || after_x `happensBefore'` y+              where after_x = nextPhase dflags x++nextPhase :: DynFlags -> Phase -> Phase+nextPhase dflags p+    -- A conservative approximation to the next phase, used in happensBefore+    = case p of+      Unlit sf   -> Cpp  sf+      Cpp   sf   -> HsPp sf+      HsPp  sf   -> Hsc  sf+      Hsc   _    -> maybeHCc+      LlvmOpt    -> LlvmLlc+      LlvmLlc    -> LlvmMangle+      LlvmMangle -> As False+      As _       -> MergeForeign+      Ccxx       -> As False+      Cc         -> As False+      Cobjc      -> As False+      Cobjcxx    -> As False+      CmmCpp     -> Cmm+      Cmm        -> maybeHCc+      HCc        -> As False+      MergeForeign -> StopLn+      StopLn     -> panic "nextPhase: nothing after StopLn"+    where maybeHCc = if platformUnregisterised (targetPlatform dflags)+                     then HCc+                     else As False++-- the first compilation phase for a given file is determined+-- by its suffix.+startPhase :: String -> Phase+startPhase "lhs"      = Unlit HsSrcFile+startPhase "lhs-boot" = Unlit HsBootFile+startPhase "lhsig"    = Unlit HsigFile+startPhase "hs"       = Cpp   HsSrcFile+startPhase "hs-boot"  = Cpp   HsBootFile+startPhase "hsig"     = Cpp   HsigFile+startPhase "hscpp"    = HsPp  HsSrcFile+startPhase "hspp"     = Hsc   HsSrcFile+startPhase "hc"       = HCc+startPhase "c"        = Cc+startPhase "cpp"      = Ccxx+startPhase "C"        = Cc+startPhase "m"        = Cobjc+startPhase "M"        = Cobjcxx+startPhase "mm"       = Cobjcxx+startPhase "cc"       = Ccxx+startPhase "cxx"      = Ccxx+startPhase "s"        = As False+startPhase "S"        = As True+startPhase "ll"       = LlvmOpt+startPhase "bc"       = LlvmLlc+startPhase "lm_s"     = LlvmMangle+startPhase "o"        = StopLn+startPhase "cmm"      = CmmCpp+startPhase "cmmcpp"   = Cmm+startPhase _          = StopLn     -- all unknown file types++-- This is used to determine the extension for the output from the+-- current phase (if it generates a new file).  The extension depends+-- on the next phase in the pipeline.+phaseInputExt :: Phase -> String+phaseInputExt (Unlit HsSrcFile)   = "lhs"+phaseInputExt (Unlit HsBootFile)  = "lhs-boot"+phaseInputExt (Unlit HsigFile)    = "lhsig"+phaseInputExt (Cpp   _)           = "lpp"       -- intermediate only+phaseInputExt (HsPp  _)           = "hscpp"     -- intermediate only+phaseInputExt (Hsc   _)           = "hspp"      -- intermediate only+        -- NB: as things stand, phaseInputExt (Hsc x) must not evaluate x+        --     because runPipeline uses the StopBefore phase to pick the+        --     output filename.  That could be fixed, but watch out.+phaseInputExt HCc                 = "hc"+phaseInputExt Ccxx                = "cpp"+phaseInputExt Cobjc               = "m"+phaseInputExt Cobjcxx             = "mm"+phaseInputExt Cc                  = "c"+phaseInputExt (As True)           = "S"+phaseInputExt (As False)          = "s"+phaseInputExt LlvmOpt             = "ll"+phaseInputExt LlvmLlc             = "bc"+phaseInputExt LlvmMangle          = "lm_s"+phaseInputExt CmmCpp              = "cmmcpp"+phaseInputExt Cmm                 = "cmm"+phaseInputExt MergeForeign        = "o"+phaseInputExt StopLn              = "o"++haskellish_src_suffixes, backpackish_suffixes, haskellish_suffixes, cish_suffixes,+    haskellish_user_src_suffixes, haskellish_sig_suffixes+ :: [String]+-- When a file with an extension in the haskellish_src_suffixes group is+-- loaded in --make mode, its imports will be loaded too.+haskellish_src_suffixes      = haskellish_user_src_suffixes +++                               [ "hspp", "hscpp" ]+haskellish_suffixes          = haskellish_src_suffixes +++                               [ "hc", "cmm", "cmmcpp" ]+cish_suffixes                = [ "c", "cpp", "C", "cc", "cxx", "s", "S", "ll", "bc", "lm_s", "m", "M", "mm" ]++-- Will not be deleted as temp files:+haskellish_user_src_suffixes =+  haskellish_sig_suffixes ++ [ "hs", "lhs", "hs-boot", "lhs-boot" ]+haskellish_sig_suffixes      = [ "hsig", "lhsig" ]+backpackish_suffixes         = [ "bkp" ]++objish_suffixes :: Platform -> [String]+-- Use the appropriate suffix for the system on which+-- the GHC-compiled code will run+objish_suffixes platform = case platformOS platform of+  OSMinGW32 -> [ "o", "O", "obj", "OBJ" ]+  _         -> [ "o" ]++dynlib_suffixes :: Platform -> [String]+dynlib_suffixes platform = case platformOS platform of+  OSMinGW32 -> ["dll", "DLL"]+  OSDarwin  -> ["dylib", "so"]+  _         -> ["so"]++isHaskellishSuffix, isBackpackishSuffix, isHaskellSrcSuffix, isCishSuffix,+    isHaskellUserSrcSuffix, isHaskellSigSuffix+ :: String -> Bool+isHaskellishSuffix     s = s `elem` haskellish_suffixes+isBackpackishSuffix    s = s `elem` backpackish_suffixes+isHaskellSigSuffix     s = s `elem` haskellish_sig_suffixes+isHaskellSrcSuffix     s = s `elem` haskellish_src_suffixes+isCishSuffix           s = s `elem` cish_suffixes+isHaskellUserSrcSuffix s = s `elem` haskellish_user_src_suffixes++isObjectSuffix, isDynLibSuffix :: Platform -> String -> Bool+isObjectSuffix platform s = s `elem` objish_suffixes platform+isDynLibSuffix platform s = s `elem` dynlib_suffixes platform++isSourceSuffix :: String -> Bool+isSourceSuffix suff  = isHaskellishSuffix suff+                    || isCishSuffix suff+                    || isBackpackishSuffix suff++-- | When we are given files (modified by -x arguments) we need+-- to determine if they are Haskellish or not to figure out+-- how we should try to compile it.  The rules are:+--+--      1. If no -x flag was specified, we check to see if+--         the file looks like a module name, has no extension,+--         or has a Haskell source extension.+--+--      2. If an -x flag was specified, we just make sure the+--         specified suffix is a Haskell one.+isHaskellishTarget :: (String, Maybe Phase) -> Bool+isHaskellishTarget (f,Nothing) =+  looksLikeModuleName f || isHaskellSrcFilename f || not (hasExtension f)+isHaskellishTarget (_,Just phase) =+  phase `notElem` [ As True, As False, Cc, Cobjc, Cobjcxx, CmmCpp, Cmm+                  , StopLn]++isHaskellishFilename, isHaskellSrcFilename, isCishFilename,+    isHaskellUserSrcFilename, isSourceFilename, isHaskellSigFilename+ :: FilePath -> Bool+-- takeExtension return .foo, so we drop 1 to get rid of the .+isHaskellishFilename     f = isHaskellishSuffix     (drop 1 $ takeExtension f)+isHaskellSrcFilename     f = isHaskellSrcSuffix     (drop 1 $ takeExtension f)+isCishFilename           f = isCishSuffix           (drop 1 $ takeExtension f)+isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (drop 1 $ takeExtension f)+isSourceFilename         f = isSourceSuffix         (drop 1 $ takeExtension f)+isHaskellSigFilename     f = isHaskellSigSuffix     (drop 1 $ takeExtension f)++isObjectFilename, isDynLibFilename :: Platform -> FilePath -> Bool+isObjectFilename platform f = isObjectSuffix platform (drop 1 $ takeExtension f)+isDynLibFilename platform f = isDynLibSuffix platform (drop 1 $ takeExtension f)+
+ compiler/main/DynFlags.hs view
@@ -0,0 +1,5939 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}++-------------------------------------------------------------------------------+--+-- | Dynamic flags+--+-- Most flags are dynamic flags, which means they can change from compilation+-- to compilation using @OPTIONS_GHC@ pragmas, and in a multi-session GHC each+-- session can be using different dynamic flags. Dynamic flags can also be set+-- at the prompt in GHCi.+--+-- (c) The University of Glasgow 2005+--+-------------------------------------------------------------------------------++{-# OPTIONS_GHC -fno-cse #-}+-- -fno-cse is needed for GLOBAL_VAR's to behave properly++module DynFlags (+        -- * Dynamic flags and associated configuration types+        DumpFlag(..),+        GeneralFlag(..),+        WarningFlag(..), WarnReason(..),+        Language(..),+        PlatformConstants(..),+        FatalMessager, LogAction, FlushOut(..), FlushErr(..),+        ProfAuto(..),+        glasgowExtsFlags,+        warningGroups, warningHierarchies,+        hasPprDebug, hasNoDebugOutput, hasNoStateHack, hasNoOptCoercion,+        dopt, dopt_set, dopt_unset,+        gopt, gopt_set, gopt_unset, setGeneralFlag', unSetGeneralFlag',+        wopt, wopt_set, wopt_unset,+        wopt_fatal, wopt_set_fatal, wopt_unset_fatal,+        xopt, xopt_set, xopt_unset,+        xopt_set_unlessExplSpec,+        lang_set,+        useUnicodeSyntax,+        useStarIsType,+        whenGeneratingDynamicToo, ifGeneratingDynamicToo,+        whenCannotGenerateDynamicToo,+        dynamicTooMkDynamicDynFlags,+        DynFlags(..),+        FlagSpec(..),+        HasDynFlags(..), ContainsDynFlags(..),+        RtsOptsEnabled(..),+        HscTarget(..), isObjectTarget, defaultObjectTarget,+        targetRetainsAllBindings,+        GhcMode(..), isOneShot,+        GhcLink(..), isNoLink,+        PackageFlag(..), PackageArg(..), ModRenaming(..),+        packageFlagsChanged,+        IgnorePackageFlag(..), TrustFlag(..),+        PackageDBFlag(..), PkgConfRef(..),+        Option(..), showOpt,+        DynLibLoader(..),+        fFlags, fLangFlags, xFlags,+        wWarningFlags,+        dynFlagDependencies,+        tablesNextToCode, mkTablesNextToCode,+        makeDynFlagsConsistent,+        shouldUseColor,+        shouldUseHexWordLiterals,+        positionIndependent,+        optimisationFlags,++        Way(..), mkBuildTag, wayRTSOnly, addWay', updateWays,+        wayGeneralFlags, wayUnsetGeneralFlags,++        thisPackage, thisComponentId, thisUnitIdInsts,++        -- ** Log output+        putLogMsg,++        -- ** Safe Haskell+        SafeHaskellMode(..),+        safeHaskellOn, safeHaskellModeEnabled,+        safeImportsOn, safeLanguageOn, safeInferOn,+        packageTrustOn,+        safeDirectImpsReq, safeImplicitImpsReq,+        unsafeFlags, unsafeFlagsForInfer,++        -- ** LLVM Targets+        LlvmTarget(..), LlvmTargets, LlvmPasses, LlvmConfig,++        -- ** System tool settings and locations+        Settings(..),+        targetPlatform, programName, projectVersion,+        ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings,+        versionedAppDir,+        extraGccViaCFlags, systemPackageConfig,+        pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_dll, pgm_T,+        pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc,+        pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_a, opt_l, opt_i,+        opt_P_signature,+        opt_windres, opt_lo, opt_lc, opt_lcc,++        -- ** Manipulating DynFlags+        addPluginModuleName,+        defaultDynFlags,                -- Settings -> DynFlags+        defaultWays,+        interpWays,+        interpreterProfiled, interpreterDynamic,+        initDynFlags,                   -- DynFlags -> IO DynFlags+        defaultFatalMessager,+        defaultLogAction,+        defaultLogActionHPrintDoc,+        defaultLogActionHPutStrDoc,+        defaultFlushOut,+        defaultFlushErr,++        getOpts,                        -- DynFlags -> (DynFlags -> [a]) -> [a]+        getVerbFlags,+        updOptLevel,+        setTmpDir,+        setUnitId,+        interpretPackageEnv,+        canonicalizeHomeModule,+        canonicalizeModuleIfHome,++        -- ** Parsing DynFlags+        parseDynamicFlagsCmdLine,+        parseDynamicFilePragma,+        parseDynamicFlagsFull,++        -- ** Available DynFlags+        allNonDeprecatedFlags,+        flagsAll,+        flagsDynamic,+        flagsPackage,+        flagsForCompletion,++        supportedLanguagesAndExtensions,+        languageExtensions,++        -- ** DynFlags C compiler options+        picCCOpts, picPOpts,++        -- * Compiler configuration suitable for display to the user+        compilerInfo,++        rtsIsProfiled,+        dynamicGhc,++#include "GHCConstantsHaskellExports.hs"+        bLOCK_SIZE_W,+        wORD_SIZE_IN_BITS,+        tAG_MASK,+        mAX_PTR_TAG,+        tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD,++        unsafeGlobalDynFlags, setUnsafeGlobalDynFlags,++        -- * SSE and AVX+        isSseEnabled,+        isSse2Enabled,+        isSse4_2Enabled,+        isBmiEnabled,+        isBmi2Enabled,+        isAvxEnabled,+        isAvx2Enabled,+        isAvx512cdEnabled,+        isAvx512erEnabled,+        isAvx512fEnabled,+        isAvx512pfEnabled,++        -- * Linker/compiler information+        LinkerInfo(..),+        CompilerInfo(..),++        -- * File cleanup+        FilesToClean(..), emptyFilesToClean,++        -- * Include specifications+        IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes,+++        -- * Make use of the Cmm CFG+        CfgWeights(..), backendMaintainsCfg+  ) where++#include "HsVersions.h"++import GhcPrelude++import Platform+import PlatformConstants+import Module+import PackageConfig+import {-# SOURCE #-} Plugins+import {-# SOURCE #-} Hooks+import {-# SOURCE #-} PrelNames ( mAIN )+import {-# SOURCE #-} Packages (PackageState, emptyPackageState)+import DriverPhases     ( Phase(..), phaseInputExt )+import Config+import CmdLineParser hiding (WarnReason(..))+import qualified CmdLineParser as Cmd+import Constants+import Panic+import qualified PprColour as Col+import Util+import Maybes+import MonadUtils+import qualified Pretty+import SrcLoc+import BasicTypes       ( IntWithInf, treatZeroAsInf )+import FastString+import Fingerprint+import Outputable+import Foreign.C        ( CInt(..) )+import System.IO.Unsafe ( unsafeDupablePerformIO )+import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessageAnn+                               , getCaretDiagnostic )+import Json+import SysTools.Terminal ( stderrSupportsAnsiColors )+import SysTools.BaseDir ( expandToolDir, expandTopDir )++import System.IO.Unsafe ( unsafePerformIO )+import Data.IORef+import Control.Arrow ((&&&))+import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.Trans.Writer+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Except+import Control.Exception (throwIO)++import Data.Ord+import Data.Bits+import Data.Char+import Data.Int+import Data.List+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Word+import System.FilePath+import System.Directory+import System.Environment (getEnv, lookupEnv)+import System.IO+import System.IO.Error+import Text.ParserCombinators.ReadP hiding (char)+import Text.ParserCombinators.ReadP as R++import EnumSet (EnumSet)+import qualified EnumSet++import GHC.Foreign (withCString, peekCString)+import qualified GHC.LanguageExtensions as LangExt++#if defined(GHCI)+import Foreign (Ptr) -- needed for 2nd stage+#endif++-- Note [Updating flag description in the User's Guide]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- If you modify anything in this file please make sure that your changes are+-- described in the User's Guide. Please update the flag description in the+-- users guide (docs/users_guide) whenever you add or change a flag.++-- Note [Supporting CLI completion]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- The command line interface completion (in for example bash) is an easy way+-- for the developer to learn what flags are available from GHC.+-- GHC helps by separating which flags are available when compiling with GHC,+-- and which flags are available when using GHCi.+-- A flag is assumed to either work in both these modes, or only in one of them.+-- When adding or changing a flag, please consider for which mode the flag will+-- have effect, and annotate it accordingly. For Flags use defFlag, defGhcFlag,+-- defGhciFlag, and for FlagSpec use flagSpec or flagGhciSpec.++-- Note [Adding a language extension]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- There are a few steps to adding (or removing) a language extension,+--+--  * Adding the extension to GHC.LanguageExtensions+--+--    The Extension type in libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs+--    is the canonical list of language extensions known by GHC.+--+--  * Adding a flag to DynFlags.xFlags+--+--    This is fairly self-explanatory. The name should be concise, memorable,+--    and consistent with any previous implementations of the similar idea in+--    other Haskell compilers.+--+--  * Adding the flag to the documentation+--+--    This is the same as any other flag. See+--    Note [Updating flag description in the User's Guide]+--+--  * Adding the flag to Cabal+--+--    The Cabal library has its own list of all language extensions supported+--    by all major compilers. This is the list that user code being uploaded+--    to Hackage is checked against to ensure language extension validity.+--    Consequently, it is very important that this list remains up-to-date.+--+--    To this end, there is a testsuite test (testsuite/tests/driver/T4437.hs)+--    whose job it is to ensure these GHC's extensions are consistent with+--    Cabal.+--+--    The recommended workflow is,+--+--     1. Temporarily add your new language extension to the+--        expectedGhcOnlyExtensions list in T4437 to ensure the test doesn't+--        break while Cabal is updated.+--+--     2. After your GHC change is accepted, submit a Cabal pull request adding+--        your new extension to Cabal's list (found in+--        Cabal/Language/Haskell/Extension.hs).+--+--     3. After your Cabal change is accepted, let the GHC developers know so+--        they can update the Cabal submodule and remove the extensions from+--        expectedGhcOnlyExtensions.+--+--  * Adding the flag to the GHC Wiki+--+--    There is a change log tracking language extension additions and removals+--    on the GHC wiki:  https://gitlab.haskell.org/ghc/ghc/wikis/language-pragma-history+--+--  See #4437 and #8176.++-- -----------------------------------------------------------------------------+-- DynFlags++data DumpFlag+-- See Note [Updating flag description in the User's Guide]++   -- debugging flags+   = Opt_D_dump_cmm+   | Opt_D_dump_cmm_from_stg+   | Opt_D_dump_cmm_raw+   | Opt_D_dump_cmm_verbose+   -- All of the cmm subflags (there are a lot!) automatically+   -- enabled if you run -ddump-cmm-verbose+   -- Each flag corresponds to exact stage of Cmm pipeline.+   | Opt_D_dump_cmm_cfg+   | Opt_D_dump_cmm_cbe+   | Opt_D_dump_cmm_switch+   | Opt_D_dump_cmm_proc+   | Opt_D_dump_cmm_sp+   | Opt_D_dump_cmm_sink+   | Opt_D_dump_cmm_caf+   | Opt_D_dump_cmm_procmap+   | Opt_D_dump_cmm_split+   | Opt_D_dump_cmm_info+   | Opt_D_dump_cmm_cps+   -- end cmm subflags+   | Opt_D_dump_cfg_weights -- ^ Dump the cfg used for block layout.+   | Opt_D_dump_asm+   | Opt_D_dump_asm_native+   | Opt_D_dump_asm_liveness+   | Opt_D_dump_asm_regalloc+   | Opt_D_dump_asm_regalloc_stages+   | Opt_D_dump_asm_conflicts+   | Opt_D_dump_asm_stats+   | Opt_D_dump_asm_expanded+   | Opt_D_dump_llvm+   | Opt_D_dump_core_stats+   | Opt_D_dump_deriv+   | Opt_D_dump_ds+   | Opt_D_dump_ds_preopt+   | Opt_D_dump_foreign+   | Opt_D_dump_inlinings+   | Opt_D_dump_rule_firings+   | Opt_D_dump_rule_rewrites+   | Opt_D_dump_simpl_trace+   | Opt_D_dump_occur_anal+   | Opt_D_dump_parsed+   | Opt_D_dump_parsed_ast+   | Opt_D_dump_rn+   | Opt_D_dump_rn_ast+   | Opt_D_dump_shape+   | Opt_D_dump_simpl+   | Opt_D_dump_simpl_iterations+   | Opt_D_dump_spec+   | Opt_D_dump_prep+   | Opt_D_dump_stg+   | Opt_D_dump_call_arity+   | Opt_D_dump_exitify+   | Opt_D_dump_stranal+   | Opt_D_dump_str_signatures+   | Opt_D_dump_tc+   | Opt_D_dump_tc_ast+   | Opt_D_dump_types+   | Opt_D_dump_rules+   | Opt_D_dump_cse+   | Opt_D_dump_worker_wrapper+   | Opt_D_dump_rn_trace+   | Opt_D_dump_rn_stats+   | Opt_D_dump_opt_cmm+   | Opt_D_dump_simpl_stats+   | Opt_D_dump_cs_trace -- Constraint solver in type checker+   | Opt_D_dump_tc_trace+   | Opt_D_dump_ec_trace -- Pattern match exhaustiveness checker+   | Opt_D_dump_if_trace+   | Opt_D_dump_vt_trace+   | Opt_D_dump_splices+   | Opt_D_th_dec_file+   | Opt_D_dump_BCOs+   | Opt_D_dump_ticked+   | Opt_D_dump_rtti+   | Opt_D_source_stats+   | Opt_D_verbose_stg2stg+   | Opt_D_dump_hi+   | Opt_D_dump_hi_diffs+   | Opt_D_dump_mod_cycles+   | Opt_D_dump_mod_map+   | Opt_D_dump_timings+   | Opt_D_dump_view_pattern_commoning+   | Opt_D_verbose_core2core+   | Opt_D_dump_debug+   | Opt_D_dump_json+   | Opt_D_ppr_debug+   | Opt_D_no_debug_output+   deriving (Eq, Show, Enum)+++-- | Enumerates the simple on-or-off dynamic flags+data GeneralFlag+-- See Note [Updating flag description in the User's Guide]++   = Opt_DumpToFile                     -- ^ Append dump output to files instead of stdout.+   | Opt_D_faststring_stats+   | Opt_D_dump_minimal_imports+   | Opt_DoCoreLinting+   | Opt_DoStgLinting+   | Opt_DoCmmLinting+   | Opt_DoAsmLinting+   | Opt_DoAnnotationLinting+   | Opt_NoLlvmMangler                 -- hidden flag+   | Opt_FastLlvm                      -- hidden flag++   | Opt_WarnIsError                    -- -Werror; makes warnings fatal+   | Opt_ShowWarnGroups                 -- Show the group a warning belongs to+   | Opt_HideSourcePaths                -- Hide module source/object paths++   | Opt_PrintExplicitForalls+   | Opt_PrintExplicitKinds+   | Opt_PrintExplicitCoercions+   | Opt_PrintExplicitRuntimeReps+   | Opt_PrintEqualityRelations+   | Opt_PrintUnicodeSyntax+   | Opt_PrintExpandedSynonyms+   | Opt_PrintPotentialInstances+   | Opt_PrintTypecheckerElaboration++   -- optimisation opts+   | Opt_CallArity+   | Opt_Exitification+   | Opt_Strictness+   | Opt_LateDmdAnal                    -- #6087+   | Opt_KillAbsence+   | Opt_KillOneShot+   | Opt_FullLaziness+   | Opt_FloatIn+   | Opt_LateSpecialise+   | Opt_Specialise+   | Opt_SpecialiseAggressively+   | Opt_CrossModuleSpecialise+   | Opt_StaticArgumentTransformation+   | Opt_CSE+   | Opt_StgCSE+   | Opt_StgLiftLams+   | Opt_LiberateCase+   | Opt_SpecConstr+   | Opt_SpecConstrKeen+   | Opt_DoLambdaEtaExpansion+   | Opt_IgnoreAsserts+   | Opt_DoEtaReduction+   | Opt_CaseMerge+   | Opt_CaseFolding                    -- Constant folding through case-expressions+   | Opt_UnboxStrictFields+   | Opt_UnboxSmallStrictFields+   | Opt_DictsCheap+   | Opt_EnableRewriteRules             -- Apply rewrite rules during simplification+   | Opt_RegsGraph                      -- do graph coloring register allocation+   | Opt_RegsIterative                  -- do iterative coalescing graph coloring register allocation+   | Opt_PedanticBottoms                -- Be picky about how we treat bottom+   | Opt_LlvmTBAA                       -- Use LLVM TBAA infastructure for improving AA (hidden flag)+   | Opt_LlvmFillUndefWithGarbage       -- Testing for undef bugs (hidden flag)+   | Opt_IrrefutableTuples+   | Opt_CmmSink+   | Opt_CmmElimCommonBlocks+   | Opt_AsmShortcutting+   | Opt_OmitYields+   | Opt_FunToThunk               -- allow WwLib.mkWorkerArgs to remove all value lambdas+   | Opt_DictsStrict                     -- be strict in argument dictionaries+   | Opt_DmdTxDictSel              -- use a special demand transformer for dictionary selectors+   | Opt_Loopification                  -- See Note [Self-recursive tail calls]+   | Opt_CfgBlocklayout             -- ^ Use the cfg based block layout algorithm.+   | Opt_WeightlessBlocklayout         -- ^ Layout based on last instruction per block.+   | Opt_CprAnal+   | Opt_WorkerWrapper+   | Opt_SolveConstantDicts+   | Opt_AlignmentSanitisation+   | Opt_CatchBottoms+   | Opt_NumConstantFolding++   -- PreInlining is on by default. The option is there just to see how+   -- bad things get if you turn it off!+   | Opt_SimplPreInlining++   -- Interface files+   | Opt_IgnoreInterfacePragmas+   | Opt_OmitInterfacePragmas+   | Opt_ExposeAllUnfoldings+   | Opt_WriteInterface -- forces .hi files to be written even with -fno-code+   | Opt_WriteHie -- generate .hie files++   -- profiling opts+   | Opt_AutoSccsOnIndividualCafs+   | Opt_ProfCountEntries++   -- misc opts+   | Opt_Pp+   | Opt_ForceRecomp+   | Opt_IgnoreOptimChanges+   | Opt_IgnoreHpcChanges+   | Opt_ExcessPrecision+   | Opt_EagerBlackHoling+   | Opt_NoHsMain+   | Opt_SplitSections+   | Opt_StgStats+   | Opt_HideAllPackages+   | Opt_HideAllPluginPackages+   | Opt_PrintBindResult+   | Opt_Haddock+   | Opt_HaddockOptions+   | Opt_BreakOnException+   | Opt_BreakOnError+   | Opt_PrintEvldWithShow+   | Opt_PrintBindContents+   | Opt_GenManifest+   | Opt_EmbedManifest+   | Opt_SharedImplib+   | Opt_BuildingCabalPackage+   | Opt_IgnoreDotGhci+   | Opt_GhciSandbox+   | Opt_GhciHistory+   | Opt_GhciLeakCheck+   | Opt_ValidateHie+   | Opt_LocalGhciHistory+   | Opt_NoIt+   | Opt_HelpfulErrors+   | Opt_DeferTypeErrors+   | Opt_DeferTypedHoles+   | Opt_DeferOutOfScopeVariables+   | Opt_PIC                         -- ^ @-fPIC@+   | Opt_PIE                         -- ^ @-fPIE@+   | Opt_PICExecutable               -- ^ @-pie@+   | Opt_ExternalDynamicRefs+   | Opt_SccProfilingOn+   | Opt_Ticky+   | Opt_Ticky_Allocd+   | Opt_Ticky_LNE+   | Opt_Ticky_Dyn_Thunk+   | Opt_RPath+   | Opt_RelativeDynlibPaths+   | Opt_Hpc+   | Opt_FlatCache+   | Opt_ExternalInterpreter+   | Opt_OptimalApplicativeDo+   | Opt_VersionMacros+   | Opt_WholeArchiveHsLibs+   -- copy all libs into a single folder prior to linking binaries+   -- this should elivate the excessive command line limit restrictions+   -- on windows, by only requiring a single -L argument instead of+   -- one for each dependency.  At the time of this writing, gcc+   -- forwards all -L flags to the collect2 command without using a+   -- response file and as such breaking apart.+   | Opt_SingleLibFolder+   | Opt_KeepCAFs++   -- output style opts+   | Opt_ErrorSpans -- Include full span info in error messages,+                    -- instead of just the start position.+   | Opt_DeferDiagnostics+   | Opt_DiagnosticsShowCaret -- Show snippets of offending code+   | Opt_PprCaseAsLet+   | Opt_PprShowTicks+   | Opt_ShowHoleConstraints+    -- Options relating to the display of valid hole fits+    -- when generating an error message for a typed hole+    -- See Note [Valid hole fits include] in TcHoleErrors.hs+   | Opt_ShowValidHoleFits+   | Opt_SortValidHoleFits+   | Opt_SortBySizeHoleFits+   | Opt_SortBySubsumHoleFits+   | Opt_AbstractRefHoleFits+   | Opt_UnclutterValidHoleFits+   | Opt_ShowTypeAppOfHoleFits+   | Opt_ShowTypeAppVarsOfHoleFits+   | Opt_ShowDocsOfHoleFits+   | Opt_ShowTypeOfHoleFits+   | Opt_ShowProvOfHoleFits+   | Opt_ShowMatchesOfHoleFits++   | Opt_ShowLoadedModules+   | Opt_HexWordLiterals -- See Note [Print Hexadecimal Literals]++   -- Suppress all coercions, them replacing with '...'+   | Opt_SuppressCoercions+   | Opt_SuppressVarKinds+   -- Suppress module id prefixes on variables.+   | Opt_SuppressModulePrefixes+   -- Suppress type applications.+   | Opt_SuppressTypeApplications+   -- Suppress info such as arity and unfoldings on identifiers.+   | Opt_SuppressIdInfo+   -- Suppress separate type signatures in core, but leave types on+   -- lambda bound vars+   | Opt_SuppressUnfoldings+   -- Suppress the details of even stable unfoldings+   | Opt_SuppressTypeSignatures+   -- Suppress unique ids on variables.+   -- Except for uniques, as some simplifier phases introduce new+   -- variables that have otherwise identical names.+   | Opt_SuppressUniques+   | Opt_SuppressStgExts+   | Opt_SuppressTicks     -- Replaces Opt_PprShowTicks+   | Opt_SuppressTimestamps -- ^ Suppress timestamps in dumps++   -- temporary flags+   | Opt_AutoLinkPackages+   | Opt_ImplicitImportQualified++   -- keeping stuff+   | Opt_KeepHscppFiles+   | Opt_KeepHiDiffs+   | Opt_KeepHcFiles+   | Opt_KeepSFiles+   | Opt_KeepTmpFiles+   | Opt_KeepRawTokenStream+   | Opt_KeepLlvmFiles+   | Opt_KeepHiFiles+   | Opt_KeepOFiles++   | Opt_BuildDynamicToo++   -- safe haskell flags+   | Opt_DistrustAllPackages+   | Opt_PackageTrust+   | Opt_PluginTrustworthy++   | Opt_G_NoStateHack+   | Opt_G_NoOptCoercion+   deriving (Eq, Show, Enum)++-- Check whether a flag should be considered an "optimisation flag"+-- for purposes of recompilation avoidance (see+-- Note [Ignoring some flag changes] in FlagChecker). Being listed here is+-- not a guarantee that the flag has no other effect. We could, and+-- perhaps should, separate out the flags that have some minor impact on+-- program semantics and/or error behavior (e.g., assertions), but+-- then we'd need to go to extra trouble (and an additional flag)+-- to allow users to ignore the optimisation level even though that+-- means ignoring some change.+optimisationFlags :: EnumSet GeneralFlag+optimisationFlags = EnumSet.fromList+   [ Opt_CallArity+   , Opt_Strictness+   , Opt_LateDmdAnal+   , Opt_KillAbsence+   , Opt_KillOneShot+   , Opt_FullLaziness+   , Opt_FloatIn+   , Opt_LateSpecialise+   , Opt_Specialise+   , Opt_SpecialiseAggressively+   , Opt_CrossModuleSpecialise+   , Opt_StaticArgumentTransformation+   , Opt_CSE+   , Opt_StgCSE+   , Opt_StgLiftLams+   , Opt_LiberateCase+   , Opt_SpecConstr+   , Opt_SpecConstrKeen+   , Opt_DoLambdaEtaExpansion+   , Opt_IgnoreAsserts+   , Opt_DoEtaReduction+   , Opt_CaseMerge+   , Opt_CaseFolding+   , Opt_UnboxStrictFields+   , Opt_UnboxSmallStrictFields+   , Opt_DictsCheap+   , Opt_EnableRewriteRules+   , Opt_RegsGraph+   , Opt_RegsIterative+   , Opt_PedanticBottoms+   , Opt_LlvmTBAA+   , Opt_LlvmFillUndefWithGarbage+   , Opt_IrrefutableTuples+   , Opt_CmmSink+   , Opt_CmmElimCommonBlocks+   , Opt_AsmShortcutting+   , Opt_OmitYields+   , Opt_FunToThunk+   , Opt_DictsStrict+   , Opt_DmdTxDictSel+   , Opt_Loopification+   , Opt_CfgBlocklayout+   , Opt_WeightlessBlocklayout+   , Opt_CprAnal+   , Opt_WorkerWrapper+   , Opt_SolveConstantDicts+   , Opt_CatchBottoms+   , Opt_IgnoreAsserts+   ]++-- | Used when outputting warnings: if a reason is given, it is+-- displayed. If a warning isn't controlled by a flag, this is made+-- explicit at the point of use.+data WarnReason+  = NoReason+  -- | Warning was enabled with the flag+  | Reason !WarningFlag+  -- | Warning was made an error because of -Werror or -Werror=WarningFlag+  | ErrReason !(Maybe WarningFlag)+  deriving Show++-- | Used to differentiate the scope an include needs to apply to.+-- We have to split the include paths to avoid accidentally forcing recursive+-- includes since -I overrides the system search paths. See #14312.+data IncludeSpecs+  = IncludeSpecs { includePathsQuote  :: [String]+                 , includePathsGlobal :: [String]+                 }+  deriving Show++-- | Append to the list of includes a path that shall be included using `-I`+-- when the C compiler is called. These paths override system search paths.+addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs+addGlobalInclude spec paths  = let f = includePathsGlobal spec+                               in spec { includePathsGlobal = f ++ paths }++-- | Append to the list of includes a path that shall be included using+-- `-iquote` when the C compiler is called. These paths only apply when quoted+-- includes are used. e.g. #include "foo.h"+addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs+addQuoteInclude spec paths  = let f = includePathsQuote spec+                              in spec { includePathsQuote = f ++ paths }++-- | Concatenate and flatten the list of global and quoted includes returning+-- just a flat list of paths.+flattenIncludes :: IncludeSpecs -> [String]+flattenIncludes specs = includePathsQuote specs ++ includePathsGlobal specs++instance Outputable WarnReason where+  ppr = text . show++instance ToJson WarnReason where+  json NoReason = JSNull+  json (Reason wf) = JSString (show wf)+  json (ErrReason Nothing) = JSString "Opt_WarnIsError"+  json (ErrReason (Just wf)) = JSString (show wf)++data WarningFlag =+-- See Note [Updating flag description in the User's Guide]+     Opt_WarnDuplicateExports+   | Opt_WarnDuplicateConstraints+   | Opt_WarnRedundantConstraints+   | Opt_WarnHiShadows+   | Opt_WarnImplicitPrelude+   | Opt_WarnIncompletePatterns+   | Opt_WarnIncompleteUniPatterns+   | Opt_WarnIncompletePatternsRecUpd+   | Opt_WarnOverflowedLiterals+   | Opt_WarnEmptyEnumerations+   | Opt_WarnMissingFields+   | Opt_WarnMissingImportList+   | Opt_WarnMissingMethods+   | Opt_WarnMissingSignatures+   | Opt_WarnMissingLocalSignatures+   | Opt_WarnNameShadowing+   | Opt_WarnOverlappingPatterns+   | Opt_WarnTypeDefaults+   | Opt_WarnMonomorphism+   | Opt_WarnUnusedTopBinds+   | Opt_WarnUnusedLocalBinds+   | Opt_WarnUnusedPatternBinds+   | Opt_WarnUnusedImports+   | Opt_WarnUnusedMatches+   | Opt_WarnUnusedTypePatterns+   | Opt_WarnUnusedForalls+   | Opt_WarnUnusedRecordWildcards+   | Opt_WarnRedundantRecordWildcards+   | Opt_WarnWarningsDeprecations+   | Opt_WarnDeprecatedFlags+   | Opt_WarnMissingMonadFailInstances -- since 8.0+   | Opt_WarnSemigroup -- since 8.0+   | Opt_WarnDodgyExports+   | Opt_WarnDodgyImports+   | Opt_WarnOrphans+   | Opt_WarnAutoOrphans+   | Opt_WarnIdentities+   | Opt_WarnTabs+   | Opt_WarnUnrecognisedPragmas+   | Opt_WarnDodgyForeignImports+   | Opt_WarnUnusedDoBind+   | Opt_WarnWrongDoBind+   | Opt_WarnAlternativeLayoutRuleTransitional+   | Opt_WarnUnsafe+   | Opt_WarnSafe+   | Opt_WarnTrustworthySafe+   | Opt_WarnMissedSpecs+   | Opt_WarnAllMissedSpecs+   | Opt_WarnUnsupportedCallingConventions+   | Opt_WarnUnsupportedLlvmVersion+   | Opt_WarnMissedExtraSharedLib+   | Opt_WarnInlineRuleShadowing+   | Opt_WarnTypedHoles+   | Opt_WarnPartialTypeSignatures+   | Opt_WarnMissingExportedSignatures+   | Opt_WarnUntickedPromotedConstructors+   | Opt_WarnDerivingTypeable+   | Opt_WarnDeferredTypeErrors+   | Opt_WarnDeferredOutOfScopeVariables+   | Opt_WarnNonCanonicalMonadInstances   -- since 8.0+   | Opt_WarnNonCanonicalMonadFailInstances   -- since 8.0, removed 8.8+   | Opt_WarnNonCanonicalMonoidInstances  -- since 8.0+   | Opt_WarnMissingPatternSynonymSignatures -- since 8.0+   | Opt_WarnUnrecognisedWarningFlags     -- since 8.0+   | Opt_WarnSimplifiableClassConstraints -- Since 8.2+   | Opt_WarnCPPUndef                     -- Since 8.2+   | Opt_WarnUnbangedStrictPatterns       -- Since 8.2+   | Opt_WarnMissingHomeModules           -- Since 8.2+   | Opt_WarnPartialFields                -- Since 8.4+   | Opt_WarnMissingExportList+   | Opt_WarnInaccessibleCode+   | Opt_WarnStarIsType                   -- Since 8.6+   | Opt_WarnStarBinder                   -- Since 8.6+   | Opt_WarnImplicitKindVars             -- Since 8.6+   | Opt_WarnSpaceAfterBang+   | Opt_WarnMissingDerivingStrategies    -- Since 8.8+   deriving (Eq, Show, Enum)++data Language = Haskell98 | Haskell2010+   deriving (Eq, Enum, Show)++instance Outputable Language where+    ppr = text . show++-- | The various Safe Haskell modes+data SafeHaskellMode+   = Sf_None+   | Sf_Unsafe+   | Sf_Trustworthy+   | Sf_Safe+   | Sf_Ignore+   deriving (Eq)++instance Show SafeHaskellMode where+    show Sf_None         = "None"+    show Sf_Unsafe       = "Unsafe"+    show Sf_Trustworthy  = "Trustworthy"+    show Sf_Safe         = "Safe"+    show Sf_Ignore       = "Ignore"++instance Outputable SafeHaskellMode where+    ppr = text . show++-- | Contains not only a collection of 'GeneralFlag's but also a plethora of+-- information relating to the compilation of a single file or GHC session+data DynFlags = DynFlags {+  ghcMode               :: GhcMode,+  ghcLink               :: GhcLink,+  hscTarget             :: HscTarget,+  settings              :: Settings,+  integerLibrary        :: IntegerLibrary,+    -- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overriden+    --   by GHC-API users. See Note [The integer library] in PrelNames+  llvmTargets           :: LlvmTargets,+  llvmPasses            :: LlvmPasses,+  verbosity             :: Int,         -- ^ Verbosity level: see Note [Verbosity levels]+  optLevel              :: Int,         -- ^ Optimisation level+  debugLevel            :: Int,         -- ^ How much debug information to produce+  simplPhases           :: Int,         -- ^ Number of simplifier phases+  maxSimplIterations    :: Int,         -- ^ Max simplifier iterations+  maxPmCheckIterations  :: Int,         -- ^ Max no iterations for pm checking+  ruleCheck             :: Maybe String,+  inlineCheck           :: Maybe String, -- ^ A prefix to report inlining decisions about+  strictnessBefore      :: [Int],       -- ^ Additional demand analysis++  parMakeCount          :: Maybe Int,   -- ^ The number of modules to compile in parallel+                                        --   in --make mode, where Nothing ==> compile as+                                        --   many in parallel as there are CPUs.++  enableTimeStats       :: Bool,        -- ^ Enable RTS timing statistics?+  ghcHeapSize           :: Maybe Int,   -- ^ The heap size to set.++  maxRelevantBinds      :: Maybe Int,   -- ^ Maximum number of bindings from the type envt+                                        --   to show in type error messages+  maxValidHoleFits      :: Maybe Int,   -- ^ Maximum number of hole fits to show+                                        --   in typed hole error messages+  maxRefHoleFits        :: Maybe Int,   -- ^ Maximum number of refinement hole+                                        --   fits to show in typed hole error+                                        --   messages+  refLevelHoleFits      :: Maybe Int,   -- ^ Maximum level of refinement for+                                        --   refinement hole fits in typed hole+                                        --   error messages+  maxUncoveredPatterns  :: Int,         -- ^ Maximum number of unmatched patterns to show+                                        --   in non-exhaustiveness warnings+  simplTickFactor       :: Int,         -- ^ Multiplier for simplifier ticks+  specConstrThreshold   :: Maybe Int,   -- ^ Threshold for SpecConstr+  specConstrCount       :: Maybe Int,   -- ^ Max number of specialisations for any one function+  specConstrRecursive   :: Int,         -- ^ Max number of specialisations for recursive types+                                        --   Not optional; otherwise ForceSpecConstr can diverge.+  binBlobThreshold      :: Word,        -- ^ Binary literals (e.g. strings) whose size is above+                                        --   this threshold will be dumped in a binary file+                                        --   by the assembler code generator (0 to disable)+  liberateCaseThreshold :: Maybe Int,   -- ^ Threshold for LiberateCase+  floatLamArgs          :: Maybe Int,   -- ^ Arg count for lambda floating+                                        --   See CoreMonad.FloatOutSwitches++  liftLamsRecArgs       :: Maybe Int,   -- ^ Maximum number of arguments after lambda lifting a+                                        --   recursive function.+  liftLamsNonRecArgs    :: Maybe Int,   -- ^ Maximum number of arguments after lambda lifting a+                                        --   non-recursive function.+  liftLamsKnown         :: Bool,        -- ^ Lambda lift even when this turns a known call+                                        --   into an unknown call.++  cmmProcAlignment      :: Maybe Int,   -- ^ Align Cmm functions at this boundary or use default.++  historySize           :: Int,         -- ^ Simplification history size++  importPaths           :: [FilePath],+  mainModIs             :: Module,+  mainFunIs             :: Maybe String,+  reductionDepth        :: IntWithInf,   -- ^ Typechecker maximum stack depth+  solverIterations      :: IntWithInf,   -- ^ Number of iterations in the constraints solver+                                         --   Typically only 1 is needed++  thisInstalledUnitId   :: InstalledUnitId,+  thisComponentId_      :: Maybe ComponentId,+  thisUnitIdInsts_      :: Maybe [(ModuleName, Module)],++  -- ways+  ways                  :: [Way],       -- ^ Way flags from the command line+  buildTag              :: String,      -- ^ The global \"way\" (e.g. \"p\" for prof)++  -- For object splitting+  splitInfo             :: Maybe (String,Int),++  -- paths etc.+  objectDir             :: Maybe String,+  dylibInstallName      :: Maybe String,+  hiDir                 :: Maybe String,+  hieDir                :: Maybe String,+  stubDir               :: Maybe String,+  dumpDir               :: Maybe String,++  objectSuf             :: String,+  hcSuf                 :: String,+  hiSuf                 :: String,+  hieSuf                :: String,++  canGenerateDynamicToo :: IORef Bool,+  dynObjectSuf          :: String,+  dynHiSuf              :: String,++  outputFile            :: Maybe String,+  dynOutputFile         :: Maybe String,+  outputHi              :: Maybe String,+  dynLibLoader          :: DynLibLoader,++  -- | This is set by 'DriverPipeline.runPipeline' based on where+  --    its output is going.+  dumpPrefix            :: Maybe FilePath,++  -- | Override the 'dumpPrefix' set by 'DriverPipeline.runPipeline'.+  --    Set by @-ddump-file-prefix@+  dumpPrefixForce       :: Maybe FilePath,++  ldInputs              :: [Option],++  includePaths          :: IncludeSpecs,+  libraryPaths          :: [String],+  frameworkPaths        :: [String],    -- used on darwin only+  cmdlineFrameworks     :: [String],    -- ditto++  rtsOpts               :: Maybe String,+  rtsOptsEnabled        :: RtsOptsEnabled,+  rtsOptsSuggestions    :: Bool,++  hpcDir                :: String,      -- ^ Path to store the .mix files++  -- Plugins+  pluginModNames        :: [ModuleName],+  pluginModNameOpts     :: [(ModuleName,String)],+  frontendPluginOpts    :: [String],+    -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse*+    -- order that they're specified on the command line.+  cachedPlugins         :: [LoadedPlugin],+    -- ^ plugins dynamically loaded after processing arguments. What will be+    -- loaded here is directed by pluginModNames. Arguments are loaded from+    -- pluginModNameOpts. The purpose of this field is to cache the plugins so+    -- they don't have to be loaded each time they are needed.  See+    -- 'DynamicLoading.initializePlugins'.+  staticPlugins            :: [StaticPlugin],+    -- ^ staic plugins which do not need dynamic loading. These plugins are+    -- intended to be added by GHC API users directly to this list.+    --+    -- To add dynamically loaded plugins through the GHC API see+    -- 'addPluginModuleName' instead.++  -- GHC API hooks+  hooks                 :: Hooks,++  --  For ghc -M+  depMakefile           :: FilePath,+  depIncludePkgDeps     :: Bool,+  depExcludeMods        :: [ModuleName],+  depSuffixes           :: [String],++  --  Package flags+  packageDBFlags        :: [PackageDBFlag],+        -- ^ The @-package-db@ flags given on the command line, In+        -- *reverse* order that they're specified on the command line.+        -- This is intended to be applied with the list of "initial"+        -- package databases derived from @GHC_PACKAGE_PATH@; see+        -- 'getPackageConfRefs'.++  ignorePackageFlags    :: [IgnorePackageFlag],+        -- ^ The @-ignore-package@ flags from the command line.+        -- In *reverse* order that they're specified on the command line.+  packageFlags          :: [PackageFlag],+        -- ^ The @-package@ and @-hide-package@ flags from the command-line.+        -- In *reverse* order that they're specified on the command line.+  pluginPackageFlags    :: [PackageFlag],+        -- ^ The @-plugin-package-id@ flags from command line.+        -- In *reverse* order that they're specified on the command line.+  trustFlags            :: [TrustFlag],+        -- ^ The @-trust@ and @-distrust@ flags.+        -- In *reverse* order that they're specified on the command line.+  packageEnv            :: Maybe FilePath,+        -- ^ Filepath to the package environment file (if overriding default)++  -- Package state+  -- NB. do not modify this field, it is calculated by+  -- Packages.initPackages+  pkgDatabase           :: Maybe [(FilePath, [PackageConfig])],+  pkgState              :: PackageState,++  -- Temporary files+  -- These have to be IORefs, because the defaultCleanupHandler needs to+  -- know what to clean when an exception happens+  filesToClean          :: IORef FilesToClean,+  dirsToClean           :: IORef (Map FilePath FilePath),+  -- The next available suffix to uniquely name a temp file, updated atomically+  nextTempSuffix        :: IORef Int,++  -- Names of files which were generated from -ddump-to-file; used to+  -- track which ones we need to truncate because it's our first run+  -- through+  generatedDumps        :: IORef (Set FilePath),++  -- hsc dynamic flags+  dumpFlags             :: EnumSet DumpFlag,+  generalFlags          :: EnumSet GeneralFlag,+  warningFlags          :: EnumSet WarningFlag,+  fatalWarningFlags     :: EnumSet WarningFlag,+  -- Don't change this without updating extensionFlags:+  language              :: Maybe Language,+  -- | Safe Haskell mode+  safeHaskell           :: SafeHaskellMode,+  safeInfer             :: Bool,+  safeInferred          :: Bool,+  -- We store the location of where some extension and flags were turned on so+  -- we can produce accurate error messages when Safe Haskell fails due to+  -- them.+  thOnLoc               :: SrcSpan,+  newDerivOnLoc         :: SrcSpan,+  overlapInstLoc        :: SrcSpan,+  incoherentOnLoc       :: SrcSpan,+  pkgTrustOnLoc         :: SrcSpan,+  warnSafeOnLoc         :: SrcSpan,+  warnUnsafeOnLoc       :: SrcSpan,+  trustworthyOnLoc      :: SrcSpan,+  -- Don't change this without updating extensionFlags:+  -- Here we collect the settings of the language extensions+  -- from the command line, the ghci config file and+  -- from interactive :set / :seti commands.+  extensions            :: [OnOff LangExt.Extension],+  -- extensionFlags should always be equal to+  --     flattenExtensionFlags language extensions+  -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used+  -- by template-haskell+  extensionFlags        :: EnumSet LangExt.Extension,++  -- Unfolding control+  -- See Note [Discounts and thresholds] in CoreUnfold+  ufCreationThreshold   :: Int,+  ufUseThreshold        :: Int,+  ufFunAppDiscount      :: Int,+  ufDictDiscount        :: Int,+  ufKeenessFactor       :: Float,+  ufDearOp              :: Int,+  ufVeryAggressive      :: Bool,++  maxWorkerArgs         :: Int,++  ghciHistSize          :: Int,++  -- | MsgDoc output action: use "ErrUtils" instead of this if you can+  log_action            :: LogAction,+  flushOut              :: FlushOut,+  flushErr              :: FlushErr,++  ghcVersionFile        :: Maybe FilePath,+  haddockOptions        :: Maybe String,++  -- | GHCi scripts specified by -ghci-script, in reverse order+  ghciScripts           :: [String],++  -- Output style options+  pprUserLength         :: Int,+  pprCols               :: Int,++  useUnicode            :: Bool,+  useColor              :: OverridingBool,+  canUseColor           :: Bool,+  colScheme             :: Col.Scheme,++  -- | what kind of {-# SCC #-} to add automatically+  profAuto              :: ProfAuto,++  interactivePrint      :: Maybe String,++  nextWrapperNum        :: IORef (ModuleEnv Int),++  -- | Machine dependent flags (-m<blah> stuff)+  sseVersion            :: Maybe SseVersion,+  bmiVersion            :: Maybe BmiVersion,+  avx                   :: Bool,+  avx2                  :: Bool,+  avx512cd              :: Bool, -- Enable AVX-512 Conflict Detection Instructions.+  avx512er              :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions.+  avx512f               :: Bool, -- Enable AVX-512 instructions.+  avx512pf              :: Bool, -- Enable AVX-512 PreFetch Instructions.++  -- | Run-time linker information (what options we need, etc.)+  rtldInfo              :: IORef (Maybe LinkerInfo),++  -- | Run-time compiler information+  rtccInfo              :: IORef (Maybe CompilerInfo),++  -- Constants used to control the amount of optimization done.++  -- | Max size, in bytes, of inline array allocations.+  maxInlineAllocSize    :: Int,++  -- | Only inline memcpy if it generates no more than this many+  -- pseudo (roughly: Cmm) instructions.+  maxInlineMemcpyInsns  :: Int,++  -- | Only inline memset if it generates no more than this many+  -- pseudo (roughly: Cmm) instructions.+  maxInlineMemsetInsns  :: Int,++  -- | Reverse the order of error messages in GHC/GHCi+  reverseErrors         :: Bool,++  -- | Limit the maximum number of errors to show+  maxErrors             :: Maybe Int,++  -- | Unique supply configuration for testing build determinism+  initialUnique         :: Int,+  uniqueIncrement       :: Int,++  -- | Temporary: CFG Edge weights for fast iterations+  cfgWeightInfo         :: CfgWeights+}++-- | Edge weights to use when generating a CFG from CMM+data CfgWeights+    = CFGWeights+    { uncondWeight :: Int+    , condBranchWeight :: Int+    , switchWeight :: Int+    , callWeight :: Int+    , likelyCondWeight :: Int+    , unlikelyCondWeight :: Int+    , infoTablePenalty :: Int+    , backEdgeBonus :: Int+    }++defaultCfgWeights :: CfgWeights+defaultCfgWeights+    = CFGWeights+    { uncondWeight = 1000+    , condBranchWeight = 800+    , switchWeight = 1+    , callWeight = -10+    , likelyCondWeight = 900+    , unlikelyCondWeight = 300+    , infoTablePenalty = 300+    , backEdgeBonus = 400+    }++parseCfgWeights :: String -> CfgWeights -> CfgWeights+parseCfgWeights s oldWeights =+        foldl' (\cfg (n,v) -> update n v cfg) oldWeights assignments+    where+        assignments = map assignment $ settings s+        update "uncondWeight" n w =+            w {uncondWeight = n}+        update "condBranchWeight" n w =+            w {condBranchWeight = n}+        update "switchWeight" n w =+            w {switchWeight = n}+        update "callWeight" n w =+            w {callWeight = n}+        update "likelyCondWeight" n w =+            w {likelyCondWeight = n}+        update "unlikelyCondWeight" n w =+            w {unlikelyCondWeight = n}+        update "infoTablePenalty" n w =+            w {infoTablePenalty = n}+        update "backEdgeBonus" n w =+            w {backEdgeBonus = n}+        update other _ _+            = panic $ other +++                      " is not a cfg weight parameter. " +++                      exampleString+        settings s+            | (s1,rest) <- break (== ',') s+            , null rest+            = [s1]+            | (s1,rest) <- break (== ',') s+            = [s1] ++ settings (drop 1 rest)+            | otherwise = panic $ "Invalid cfg parameters." ++ exampleString+        assignment as+            | (name, _:val) <- break (== '=') as+            = (name,read val)+            | otherwise+            = panic $ "Invalid cfg parameters." ++ exampleString+        exampleString = "Example parameters: uncondWeight=1000," +++            "condBranchWeight=800,switchWeight=0,callWeight=300" +++            ",likelyCondWeight=900,unlikelyCondWeight=300" +++            ",infoTablePenalty=300,backEdgeBonus=400"++backendMaintainsCfg :: DynFlags -> Bool+backendMaintainsCfg dflags = case (platformArch $ targetPlatform dflags) of+    -- ArchX86 -- Should work but not tested so disabled currently.+    ArchX86_64 -> True+    _otherwise -> False++class HasDynFlags m where+    getDynFlags :: m DynFlags++{- It would be desirable to have the more generalised++  instance (MonadTrans t, Monad m, HasDynFlags m) => HasDynFlags (t m) where+      getDynFlags = lift getDynFlags++instance definition. However, that definition would overlap with the+`HasDynFlags (GhcT m)` instance. Instead we define instances for a+couple of common Monad transformers explicitly. -}++instance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where+    getDynFlags = lift getDynFlags++instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where+    getDynFlags = lift getDynFlags++instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where+    getDynFlags = lift getDynFlags++instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where+    getDynFlags = lift getDynFlags++class ContainsDynFlags t where+    extractDynFlags :: t -> DynFlags++data ProfAuto+  = NoProfAuto         -- ^ no SCC annotations added+  | ProfAutoAll        -- ^ top-level and nested functions are annotated+  | ProfAutoTop        -- ^ top-level functions annotated only+  | ProfAutoExports    -- ^ exported functions annotated only+  | ProfAutoCalls      -- ^ annotate call-sites+  deriving (Eq,Enum)++data LlvmTarget = LlvmTarget+  { lDataLayout :: String+  , lCPU        :: String+  , lAttributes :: [String]+  }++type LlvmTargets = [(String, LlvmTarget)]+type LlvmPasses = [(Int, String)]+type LlvmConfig = (LlvmTargets, LlvmPasses)++data Settings = Settings {+  sTargetPlatform        :: Platform,       -- Filled in by SysTools+  sGhcUsagePath          :: FilePath,       -- ditto+  sGhciUsagePath         :: FilePath,       -- ditto+  sToolDir               :: Maybe FilePath, -- ditto+  sTopDir                :: FilePath,       -- ditto+  sTmpDir                :: String,      -- no trailing '/'+  sProgramName           :: String,+  sProjectVersion        :: String,+  -- You shouldn't need to look things up in rawSettings directly.+  -- They should have their own fields instead.+  sRawSettings           :: [(String, String)],+  sExtraGccViaCFlags     :: [String],+  sSystemPackageConfig   :: FilePath,+  sLdSupportsCompactUnwind :: Bool,+  sLdSupportsBuildId       :: Bool,+  sLdSupportsFilelist      :: Bool,+  sLdIsGnuLd               :: Bool,+  sGccSupportsNoPie        :: Bool,+  -- commands for particular phases+  sPgm_L                 :: String,+  sPgm_P                 :: (String,[Option]),+  sPgm_F                 :: String,+  sPgm_c                 :: (String,[Option]),+  sPgm_a                 :: (String,[Option]),+  sPgm_l                 :: (String,[Option]),+  sPgm_dll               :: (String,[Option]),+  sPgm_T                 :: String,+  sPgm_windres           :: String,+  sPgm_libtool           :: String,+  sPgm_ar                :: String,+  sPgm_ranlib            :: String,+  sPgm_lo                :: (String,[Option]), -- LLVM: opt llvm optimiser+  sPgm_lc                :: (String,[Option]), -- LLVM: llc static compiler+  sPgm_lcc               :: (String,[Option]), -- LLVM: c compiler+  sPgm_i                 :: String,+  -- options for particular phases+  sOpt_L                 :: [String],+  sOpt_P                 :: [String],+  sOpt_P_fingerprint     :: Fingerprint, -- cached Fingerprint of sOpt_P+                                         -- See Note [Repeated -optP hashing]+  sOpt_F                 :: [String],+  sOpt_c                 :: [String],+  sOpt_a                 :: [String],+  sOpt_l                 :: [String],+  sOpt_windres           :: [String],+  sOpt_lo                :: [String], -- LLVM: llvm optimiser+  sOpt_lc                :: [String], -- LLVM: llc static compiler+  sOpt_lcc               :: [String], -- LLVM: c compiler+  sOpt_i                 :: [String], -- iserv options++  sPlatformConstants     :: PlatformConstants+ }++targetPlatform :: DynFlags -> Platform+targetPlatform dflags = sTargetPlatform (settings dflags)+programName :: DynFlags -> String+programName dflags = sProgramName (settings dflags)+projectVersion :: DynFlags -> String+projectVersion dflags = sProjectVersion (settings dflags)+ghcUsagePath          :: DynFlags -> FilePath+ghcUsagePath dflags = sGhcUsagePath (settings dflags)+ghciUsagePath         :: DynFlags -> FilePath+ghciUsagePath dflags = sGhciUsagePath (settings dflags)+toolDir               :: DynFlags -> Maybe FilePath+toolDir dflags = sToolDir (settings dflags)+topDir                :: DynFlags -> FilePath+topDir dflags = sTopDir (settings dflags)+tmpDir                :: DynFlags -> String+tmpDir dflags = sTmpDir (settings dflags)+rawSettings           :: DynFlags -> [(String, String)]+rawSettings dflags = sRawSettings (settings dflags)+extraGccViaCFlags     :: DynFlags -> [String]+extraGccViaCFlags dflags = sExtraGccViaCFlags (settings dflags)+systemPackageConfig   :: DynFlags -> FilePath+systemPackageConfig dflags = sSystemPackageConfig (settings dflags)+pgm_L                 :: DynFlags -> String+pgm_L dflags = sPgm_L (settings dflags)+pgm_P                 :: DynFlags -> (String,[Option])+pgm_P dflags = sPgm_P (settings dflags)+pgm_F                 :: DynFlags -> String+pgm_F dflags = sPgm_F (settings dflags)+pgm_c                 :: DynFlags -> (String,[Option])+pgm_c dflags = sPgm_c (settings dflags)+pgm_a                 :: DynFlags -> (String,[Option])+pgm_a dflags = sPgm_a (settings dflags)+pgm_l                 :: DynFlags -> (String,[Option])+pgm_l dflags = sPgm_l (settings dflags)+pgm_dll               :: DynFlags -> (String,[Option])+pgm_dll dflags = sPgm_dll (settings dflags)+pgm_T                 :: DynFlags -> String+pgm_T dflags = sPgm_T (settings dflags)+pgm_windres           :: DynFlags -> String+pgm_windres dflags = sPgm_windres (settings dflags)+pgm_libtool           :: DynFlags -> String+pgm_libtool dflags = sPgm_libtool (settings dflags)+pgm_lcc               :: DynFlags -> (String,[Option])+pgm_lcc dflags = sPgm_lcc (settings dflags)+pgm_ar                :: DynFlags -> String+pgm_ar dflags = sPgm_ar (settings dflags)+pgm_ranlib            :: DynFlags -> String+pgm_ranlib dflags = sPgm_ranlib (settings dflags)+pgm_lo                :: DynFlags -> (String,[Option])+pgm_lo dflags = sPgm_lo (settings dflags)+pgm_lc                :: DynFlags -> (String,[Option])+pgm_lc dflags = sPgm_lc (settings dflags)+pgm_i                 :: DynFlags -> String+pgm_i dflags = sPgm_i (settings dflags)+opt_L                 :: DynFlags -> [String]+opt_L dflags = sOpt_L (settings dflags)+opt_P                 :: DynFlags -> [String]+opt_P dflags = concatMap (wayOptP (targetPlatform dflags)) (ways dflags)+            ++ sOpt_P (settings dflags)++-- This function packages everything that's needed to fingerprint opt_P+-- flags. See Note [Repeated -optP hashing].+opt_P_signature       :: DynFlags -> ([String], Fingerprint)+opt_P_signature dflags =+  ( concatMap (wayOptP (targetPlatform dflags)) (ways dflags)+  , sOpt_P_fingerprint (settings dflags))++opt_F                 :: DynFlags -> [String]+opt_F dflags = sOpt_F (settings dflags)+opt_c                 :: DynFlags -> [String]+opt_c dflags = concatMap (wayOptc (targetPlatform dflags)) (ways dflags)+            ++ sOpt_c (settings dflags)+opt_a                 :: DynFlags -> [String]+opt_a dflags = sOpt_a (settings dflags)+opt_l                 :: DynFlags -> [String]+opt_l dflags = concatMap (wayOptl (targetPlatform dflags)) (ways dflags)+            ++ sOpt_l (settings dflags)+opt_windres           :: DynFlags -> [String]+opt_windres dflags = sOpt_windres (settings dflags)+opt_lcc                :: DynFlags -> [String]+opt_lcc dflags = sOpt_lcc (settings dflags)+opt_lo                :: DynFlags -> [String]+opt_lo dflags = sOpt_lo (settings dflags)+opt_lc                :: DynFlags -> [String]+opt_lc dflags = sOpt_lc (settings dflags)+opt_i                 :: DynFlags -> [String]+opt_i dflags = sOpt_i (settings dflags)++-- | The directory for this version of ghc in the user's app directory+-- (typically something like @~/.ghc/x86_64-linux-7.6.3@)+--+versionedAppDir :: DynFlags -> MaybeT IO FilePath+versionedAppDir dflags = do+  -- Make sure we handle the case the HOME isn't set (see #11678)+  appdir <- tryMaybeT $ getAppUserDataDirectory (programName dflags)+  return $ appdir </> versionedFilePath dflags++-- | A filepath like @x86_64-linux-7.6.3@ with the platform string to use when+-- constructing platform-version-dependent files that need to co-exist.+--+versionedFilePath :: DynFlags -> FilePath+versionedFilePath dflags =     TARGET_ARCH+                        ++ '-':TARGET_OS+                        ++ '-':projectVersion dflags+  -- NB: This functionality is reimplemented in Cabal, so if you+  -- change it, be sure to update Cabal.++-- | The target code type of the compilation (if any).+--+-- Whenever you change the target, also make sure to set 'ghcLink' to+-- something sensible.+--+-- 'HscNothing' can be used to avoid generating any output, however, note+-- that:+--+--  * If a program uses Template Haskell the typechecker may need to run code+--    from an imported module.  To facilitate this, code generation is enabled+--    for modules imported by modules that use template haskell.+--    See Note [-fno-code mode].+--+data HscTarget+  = HscC           -- ^ Generate C code.+  | HscAsm         -- ^ Generate assembly using the native code generator.+  | HscLlvm        -- ^ Generate assembly using the llvm code generator.+  | HscInterpreted -- ^ Generate bytecode.  (Requires 'LinkInMemory')+  | HscNothing     -- ^ Don't generate any code.  See notes above.+  deriving (Eq, Show)++-- | Will this target result in an object file on the disk?+isObjectTarget :: HscTarget -> Bool+isObjectTarget HscC     = True+isObjectTarget HscAsm   = True+isObjectTarget HscLlvm  = True+isObjectTarget _        = False++-- | Does this target retain *all* top-level bindings for a module,+-- rather than just the exported bindings, in the TypeEnv and compiled+-- code (if any)?  In interpreted mode we do this, so that GHCi can+-- call functions inside a module.  In HscNothing mode we also do it,+-- so that Haddock can get access to the GlobalRdrEnv for a module+-- after typechecking it.+targetRetainsAllBindings :: HscTarget -> Bool+targetRetainsAllBindings HscInterpreted = True+targetRetainsAllBindings HscNothing     = True+targetRetainsAllBindings _              = False++-- | The 'GhcMode' tells us whether we're doing multi-module+-- compilation (controlled via the "GHC" API) or one-shot+-- (single-module) compilation.  This makes a difference primarily to+-- the "Finder": in one-shot mode we look for interface files for+-- imported modules, but in multi-module mode we look for source files+-- in order to check whether they need to be recompiled.+data GhcMode+  = CompManager         -- ^ @\-\-make@, GHCi, etc.+  | OneShot             -- ^ @ghc -c Foo.hs@+  | MkDepend            -- ^ @ghc -M@, see "Finder" for why we need this+  deriving Eq++instance Outputable GhcMode where+  ppr CompManager = text "CompManager"+  ppr OneShot     = text "OneShot"+  ppr MkDepend    = text "MkDepend"++isOneShot :: GhcMode -> Bool+isOneShot OneShot = True+isOneShot _other  = False++-- | What to do in the link step, if there is one.+data GhcLink+  = NoLink              -- ^ Don't link at all+  | LinkBinary          -- ^ Link object code into a binary+  | LinkInMemory        -- ^ Use the in-memory dynamic linker (works for both+                        --   bytecode and object code).+  | LinkDynLib          -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)+  | LinkStaticLib       -- ^ Link objects into a static lib+  deriving (Eq, Show)++isNoLink :: GhcLink -> Bool+isNoLink NoLink = True+isNoLink _      = False++-- | We accept flags which make packages visible, but how they select+-- the package varies; this data type reflects what selection criterion+-- is used.+data PackageArg =+      PackageArg String    -- ^ @-package@, by 'PackageName'+    | UnitIdArg UnitId     -- ^ @-package-id@, by 'UnitId'+  deriving (Eq, Show)+instance Outputable PackageArg where+    ppr (PackageArg pn) = text "package" <+> text pn+    ppr (UnitIdArg uid) = text "unit" <+> ppr uid++-- | Represents the renaming that may be associated with an exposed+-- package, e.g. the @rns@ part of @-package "foo (rns)"@.+--+-- Here are some example parsings of the package flags (where+-- a string literal is punned to be a 'ModuleName':+--+--      * @-package foo@ is @ModRenaming True []@+--      * @-package foo ()@ is @ModRenaming False []@+--      * @-package foo (A)@ is @ModRenaming False [("A", "A")]@+--      * @-package foo (A as B)@ is @ModRenaming False [("A", "B")]@+--      * @-package foo with (A as B)@ is @ModRenaming True [("A", "B")]@+data ModRenaming = ModRenaming {+    modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope?+    modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope+                                               --   under name @n@.+  } deriving (Eq)+instance Outputable ModRenaming where+    ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns)++-- | Flags for manipulating the set of non-broken packages.+newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@+  deriving (Eq)++-- | Flags for manipulating package trust.+data TrustFlag+  = TrustPackage    String -- ^ @-trust@+  | DistrustPackage String -- ^ @-distrust@+  deriving (Eq)++-- | Flags for manipulating packages visibility.+data PackageFlag+  = ExposePackage   String PackageArg ModRenaming -- ^ @-package@, @-package-id@+  | HidePackage     String -- ^ @-hide-package@+  deriving (Eq) -- NB: equality instance is used by packageFlagsChanged++data PackageDBFlag+  = PackageDB PkgConfRef+  | NoUserPackageDB+  | NoGlobalPackageDB+  | ClearPackageDBs+  deriving (Eq)++packageFlagsChanged :: DynFlags -> DynFlags -> Bool+packageFlagsChanged idflags1 idflags0 =+  packageFlags idflags1 /= packageFlags idflags0 ||+  ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 ||+  pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 ||+  trustFlags idflags1 /= trustFlags idflags0 ||+  packageDBFlags idflags1 /= packageDBFlags idflags0 ||+  packageGFlags idflags1 /= packageGFlags idflags0+ where+   packageGFlags dflags = map (`gopt` dflags)+     [ Opt_HideAllPackages+     , Opt_HideAllPluginPackages+     , Opt_AutoLinkPackages ]++instance Outputable PackageFlag where+    ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn)+    ppr (HidePackage str) = text "-hide-package" <+> text str++defaultHscTarget :: Platform -> HscTarget+defaultHscTarget = defaultObjectTarget++-- | The 'HscTarget' value corresponding to the default way to create+-- object files on the current platform.+defaultObjectTarget :: Platform -> HscTarget+defaultObjectTarget platform+  | platformUnregisterised platform     =  HscC+  | cGhcWithNativeCodeGen == "YES"      =  HscAsm+  | otherwise                           =  HscLlvm++tablesNextToCode :: DynFlags -> Bool+tablesNextToCode dflags+    = mkTablesNextToCode (platformUnregisterised (targetPlatform dflags))++-- Determines whether we will be compiling+-- info tables that reside just before the entry code, or with an+-- indirection to the entry code.  See TABLES_NEXT_TO_CODE in+-- includes/rts/storage/InfoTables.h.+mkTablesNextToCode :: Bool -> Bool+mkTablesNextToCode unregisterised+    = not unregisterised && cGhcEnableTablesNextToCode == "YES"++data DynLibLoader+  = Deployable+  | SystemDependent+  deriving Eq++data RtsOptsEnabled+  = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly+  | RtsOptsAll+  deriving (Show)++shouldUseColor :: DynFlags -> Bool+shouldUseColor dflags = overrideWith (canUseColor dflags) (useColor dflags)++shouldUseHexWordLiterals :: DynFlags -> Bool+shouldUseHexWordLiterals dflags =+  Opt_HexWordLiterals `EnumSet.member` generalFlags dflags++-- | Are we building with @-fPIE@ or @-fPIC@ enabled?+positionIndependent :: DynFlags -> Bool+positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags++-----------------------------------------------------------------------------+-- Ways++-- The central concept of a "way" is that all objects in a given+-- program must be compiled in the same "way".  Certain options change+-- parameters of the virtual machine, eg. profiling adds an extra word+-- to the object header, so profiling objects cannot be linked with+-- non-profiling objects.++-- After parsing the command-line options, we determine which "way" we+-- are building - this might be a combination way, eg. profiling+threaded.++-- We then find the "build-tag" associated with this way, and this+-- becomes the suffix used to find .hi files and libraries used in+-- this compilation.++data Way+  = WayCustom String -- for GHC API clients building custom variants+  | WayThreaded+  | WayDebug+  | WayProf+  | WayEventLog+  | WayDyn+  deriving (Eq, Ord, Show)++allowed_combination :: [Way] -> Bool+allowed_combination way = and [ x `allowedWith` y+                              | x <- way, y <- way, x < y ]+  where+        -- Note ordering in these tests: the left argument is+        -- <= the right argument, according to the Ord instance+        -- on Way above.++        -- dyn is allowed with everything+        _ `allowedWith` WayDyn                  = True+        WayDyn `allowedWith` _                  = True++        -- debug is allowed with everything+        _ `allowedWith` WayDebug                = True+        WayDebug `allowedWith` _                = True++        (WayCustom {}) `allowedWith` _          = True+        WayThreaded `allowedWith` WayProf       = True+        WayThreaded `allowedWith` WayEventLog   = True+        WayProf     `allowedWith` WayEventLog   = True+        _ `allowedWith` _                       = False++mkBuildTag :: [Way] -> String+mkBuildTag ways = concat (intersperse "_" (map wayTag ways))++wayTag :: Way -> String+wayTag (WayCustom xs) = xs+wayTag WayThreaded = "thr"+wayTag WayDebug    = "debug"+wayTag WayDyn      = "dyn"+wayTag WayProf     = "p"+wayTag WayEventLog = "l"++wayRTSOnly :: Way -> Bool+wayRTSOnly (WayCustom {}) = False+wayRTSOnly WayThreaded = True+wayRTSOnly WayDebug    = True+wayRTSOnly WayDyn      = False+wayRTSOnly WayProf     = False+wayRTSOnly WayEventLog = True++wayDesc :: Way -> String+wayDesc (WayCustom xs) = xs+wayDesc WayThreaded = "Threaded"+wayDesc WayDebug    = "Debug"+wayDesc WayDyn      = "Dynamic"+wayDesc WayProf     = "Profiling"+wayDesc WayEventLog = "RTS Event Logging"++-- Turn these flags on when enabling this way+wayGeneralFlags :: Platform -> Way -> [GeneralFlag]+wayGeneralFlags _ (WayCustom {}) = []+wayGeneralFlags _ WayThreaded = []+wayGeneralFlags _ WayDebug    = []+wayGeneralFlags _ WayDyn      = [Opt_PIC, Opt_ExternalDynamicRefs]+    -- We could get away without adding -fPIC when compiling the+    -- modules of a program that is to be linked with -dynamic; the+    -- program itself does not need to be position-independent, only+    -- the libraries need to be.  HOWEVER, GHCi links objects into a+    -- .so before loading the .so using the system linker.  Since only+    -- PIC objects can be linked into a .so, we have to compile even+    -- modules of the main program with -fPIC when using -dynamic.+wayGeneralFlags _ WayProf     = [Opt_SccProfilingOn]+wayGeneralFlags _ WayEventLog = []++-- Turn these flags off when enabling this way+wayUnsetGeneralFlags :: Platform -> Way -> [GeneralFlag]+wayUnsetGeneralFlags _ (WayCustom {}) = []+wayUnsetGeneralFlags _ WayThreaded = []+wayUnsetGeneralFlags _ WayDebug    = []+wayUnsetGeneralFlags _ WayDyn      = [-- There's no point splitting+                                      -- when we're going to be dynamically+                                      -- linking. Plus it breaks compilation+                                      -- on OSX x86.+                                      Opt_SplitSections]+wayUnsetGeneralFlags _ WayProf     = []+wayUnsetGeneralFlags _ WayEventLog = []++wayOptc :: Platform -> Way -> [String]+wayOptc _ (WayCustom {}) = []+wayOptc platform WayThreaded = case platformOS platform of+                               OSOpenBSD -> ["-pthread"]+                               OSNetBSD  -> ["-pthread"]+                               _         -> []+wayOptc _ WayDebug      = []+wayOptc _ WayDyn        = []+wayOptc _ WayProf       = ["-DPROFILING"]+wayOptc _ WayEventLog   = ["-DTRACING"]++wayOptl :: Platform -> Way -> [String]+wayOptl _ (WayCustom {}) = []+wayOptl platform WayThreaded =+        case platformOS platform of+        OSFreeBSD  -> ["-pthread"]+        OSOpenBSD  -> ["-pthread"]+        OSNetBSD   -> ["-pthread"]+        _          -> []+wayOptl _ WayDebug      = []+wayOptl _ WayDyn        = []+wayOptl _ WayProf       = []+wayOptl _ WayEventLog   = []++wayOptP :: Platform -> Way -> [String]+wayOptP _ (WayCustom {}) = []+wayOptP _ WayThreaded = []+wayOptP _ WayDebug    = []+wayOptP _ WayDyn      = []+wayOptP _ WayProf     = ["-DPROFILING"]+wayOptP _ WayEventLog = ["-DTRACING"]++whenGeneratingDynamicToo :: MonadIO m => DynFlags -> m () -> m ()+whenGeneratingDynamicToo dflags f = ifGeneratingDynamicToo dflags f (return ())++ifGeneratingDynamicToo :: MonadIO m => DynFlags -> m a -> m a -> m a+ifGeneratingDynamicToo dflags f g = generateDynamicTooConditional dflags f g g++whenCannotGenerateDynamicToo :: MonadIO m => DynFlags -> m () -> m ()+whenCannotGenerateDynamicToo dflags f+    = ifCannotGenerateDynamicToo dflags f (return ())++ifCannotGenerateDynamicToo :: MonadIO m => DynFlags -> m a -> m a -> m a+ifCannotGenerateDynamicToo dflags f g+    = generateDynamicTooConditional dflags g f g++generateDynamicTooConditional :: MonadIO m+                              => DynFlags -> m a -> m a -> m a -> m a+generateDynamicTooConditional dflags canGen cannotGen notTryingToGen+    = if gopt Opt_BuildDynamicToo dflags+      then do let ref = canGenerateDynamicToo dflags+              b <- liftIO $ readIORef ref+              if b then canGen else cannotGen+      else notTryingToGen++dynamicTooMkDynamicDynFlags :: DynFlags -> DynFlags+dynamicTooMkDynamicDynFlags dflags0+    = let dflags1 = addWay' WayDyn dflags0+          dflags2 = dflags1 {+                        outputFile = dynOutputFile dflags1,+                        hiSuf = dynHiSuf dflags1,+                        objectSuf = dynObjectSuf dflags1+                    }+          dflags3 = updateWays dflags2+          dflags4 = gopt_unset dflags3 Opt_BuildDynamicToo+      in dflags4++-----------------------------------------------------------------------------++-- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value+initDynFlags :: DynFlags -> IO DynFlags+initDynFlags dflags = do+ let -- We can't build with dynamic-too on Windows, as labels before+     -- the fork point are different depending on whether we are+     -- building dynamically or not.+     platformCanGenerateDynamicToo+         = platformOS (targetPlatform dflags) /= OSMinGW32+ refCanGenerateDynamicToo <- newIORef platformCanGenerateDynamicToo+ refNextTempSuffix <- newIORef 0+ refFilesToClean <- newIORef emptyFilesToClean+ refDirsToClean <- newIORef Map.empty+ refGeneratedDumps <- newIORef Set.empty+ refRtldInfo <- newIORef Nothing+ refRtccInfo <- newIORef Nothing+ wrapperNum <- newIORef emptyModuleEnv+ canUseUnicode <- do let enc = localeEncoding+                         str = "‘’"+                     (withCString enc str $ \cstr ->+                          do str' <- peekCString enc cstr+                             return (str == str'))+                         `catchIOError` \_ -> return False+ canUseColor <- stderrSupportsAnsiColors+ maybeGhcColorsEnv  <- lookupEnv "GHC_COLORS"+ maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS"+ let adjustCols (Just env) = Col.parseScheme env+     adjustCols Nothing    = id+ let (useColor', colScheme') =+       (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv)+       (useColor dflags, colScheme dflags)+ return dflags{+        canGenerateDynamicToo = refCanGenerateDynamicToo,+        nextTempSuffix = refNextTempSuffix,+        filesToClean   = refFilesToClean,+        dirsToClean    = refDirsToClean,+        generatedDumps = refGeneratedDumps,+        nextWrapperNum = wrapperNum,+        useUnicode    = canUseUnicode,+        useColor      = useColor',+        canUseColor   = canUseColor,+        colScheme     = colScheme',+        rtldInfo      = refRtldInfo,+        rtccInfo      = refRtccInfo+        }++-- | The normal 'DynFlags'. Note that they are not suitable for use in this form+-- and must be fully initialized by 'GHC.runGhc' first.+defaultDynFlags :: Settings -> LlvmConfig -> DynFlags+defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =+-- See Note [Updating flag description in the User's Guide]+     DynFlags {+        ghcMode                 = CompManager,+        ghcLink                 = LinkBinary,+        hscTarget               = defaultHscTarget (sTargetPlatform mySettings),+        integerLibrary          = cIntegerLibraryType,+        verbosity               = 0,+        optLevel                = 0,+        debugLevel              = 0,+        simplPhases             = 2,+        maxSimplIterations      = 4,+        maxPmCheckIterations    = 2000000,+        ruleCheck               = Nothing,+        inlineCheck             = Nothing,+        binBlobThreshold        = 500000, -- 500K is a good default (see #16190)+        maxRelevantBinds        = Just 6,+        maxValidHoleFits   = Just 6,+        maxRefHoleFits     = Just 6,+        refLevelHoleFits   = Nothing,+        maxUncoveredPatterns    = 4,+        simplTickFactor         = 100,+        specConstrThreshold     = Just 2000,+        specConstrCount         = Just 3,+        specConstrRecursive     = 3,+        liberateCaseThreshold   = Just 2000,+        floatLamArgs            = Just 0, -- Default: float only if no fvs+        liftLamsRecArgs         = Just 5, -- Default: the number of available argument hardware registers on x86_64+        liftLamsNonRecArgs      = Just 5, -- Default: the number of available argument hardware registers on x86_64+        liftLamsKnown           = False,  -- Default: don't turn known calls into unknown ones+        cmmProcAlignment        = Nothing,++        historySize             = 20,+        strictnessBefore        = [],++        parMakeCount            = Just 1,++        enableTimeStats         = False,+        ghcHeapSize             = Nothing,++        importPaths             = ["."],+        mainModIs               = mAIN,+        mainFunIs               = Nothing,+        reductionDepth          = treatZeroAsInf mAX_REDUCTION_DEPTH,+        solverIterations        = treatZeroAsInf mAX_SOLVER_ITERATIONS,++        thisInstalledUnitId     = toInstalledUnitId mainUnitId,+        thisUnitIdInsts_        = Nothing,+        thisComponentId_        = Nothing,++        objectDir               = Nothing,+        dylibInstallName        = Nothing,+        hiDir                   = Nothing,+        hieDir                  = Nothing,+        stubDir                 = Nothing,+        dumpDir                 = Nothing,++        objectSuf               = phaseInputExt StopLn,+        hcSuf                   = phaseInputExt HCc,+        hiSuf                   = "hi",+        hieSuf                  = "hie",++        canGenerateDynamicToo   = panic "defaultDynFlags: No canGenerateDynamicToo",+        dynObjectSuf            = "dyn_" ++ phaseInputExt StopLn,+        dynHiSuf                = "dyn_hi",++        pluginModNames          = [],+        pluginModNameOpts       = [],+        frontendPluginOpts      = [],+        cachedPlugins           = [],+        staticPlugins           = [],+        hooks                   = emptyHooks,++        outputFile              = Nothing,+        dynOutputFile           = Nothing,+        outputHi                = Nothing,+        dynLibLoader            = SystemDependent,+        dumpPrefix              = Nothing,+        dumpPrefixForce         = Nothing,+        ldInputs                = [],+        includePaths            = IncludeSpecs [] [],+        libraryPaths            = [],+        frameworkPaths          = [],+        cmdlineFrameworks       = [],+        rtsOpts                 = Nothing,+        rtsOptsEnabled          = RtsOptsSafeOnly,+        rtsOptsSuggestions      = True,++        hpcDir                  = ".hpc",++        packageDBFlags          = [],+        packageFlags            = [],+        pluginPackageFlags      = [],+        ignorePackageFlags      = [],+        trustFlags              = [],+        packageEnv              = Nothing,+        pkgDatabase             = Nothing,+        -- This gets filled in with GHC.setSessionDynFlags+        pkgState                = emptyPackageState,+        ways                    = defaultWays mySettings,+        buildTag                = mkBuildTag (defaultWays mySettings),+        splitInfo               = Nothing,+        settings                = mySettings,+        llvmTargets             = myLlvmTargets,+        llvmPasses              = myLlvmPasses,++        -- ghc -M values+        depMakefile       = "Makefile",+        depIncludePkgDeps = False,+        depExcludeMods    = [],+        depSuffixes       = [],+        -- end of ghc -M values+        nextTempSuffix = panic "defaultDynFlags: No nextTempSuffix",+        filesToClean   = panic "defaultDynFlags: No filesToClean",+        dirsToClean    = panic "defaultDynFlags: No dirsToClean",+        generatedDumps = panic "defaultDynFlags: No generatedDumps",+        ghcVersionFile = Nothing,+        haddockOptions = Nothing,+        dumpFlags = EnumSet.empty,+        generalFlags = EnumSet.fromList (defaultFlags mySettings),+        warningFlags = EnumSet.fromList standardWarnings,+        fatalWarningFlags = EnumSet.empty,+        ghciScripts = [],+        language = Nothing,+        safeHaskell = Sf_None,+        safeInfer   = True,+        safeInferred = True,+        thOnLoc = noSrcSpan,+        newDerivOnLoc = noSrcSpan,+        overlapInstLoc = noSrcSpan,+        incoherentOnLoc = noSrcSpan,+        pkgTrustOnLoc = noSrcSpan,+        warnSafeOnLoc = noSrcSpan,+        warnUnsafeOnLoc = noSrcSpan,+        trustworthyOnLoc = noSrcSpan,+        extensions = [],+        extensionFlags = flattenExtensionFlags Nothing [],++        -- The ufCreationThreshold threshold must be reasonably high to+        -- take account of possible discounts.+        -- E.g. 450 is not enough in 'fulsom' for Interval.sqr to inline+        -- into Csg.calc (The unfolding for sqr never makes it into the+        -- interface file.)+        ufCreationThreshold = 750,+        ufUseThreshold      = 60,+        ufFunAppDiscount    = 60,+        -- Be fairly keen to inline a function if that means+        -- we'll be able to pick the right method from a dictionary+        ufDictDiscount      = 30,+        ufKeenessFactor     = 1.5,+        ufDearOp            = 40,+        ufVeryAggressive    = False,++        maxWorkerArgs = 10,++        ghciHistSize = 50, -- keep a log of length 50 by default++        -- Logging++        log_action = defaultLogAction,++        flushOut = defaultFlushOut,+        flushErr = defaultFlushErr,+        pprUserLength = 5,+        pprCols = 100,+        useUnicode = False,+        useColor = Auto,+        canUseColor = False,+        colScheme = Col.defaultScheme,+        profAuto = NoProfAuto,+        interactivePrint = Nothing,+        nextWrapperNum = panic "defaultDynFlags: No nextWrapperNum",+        sseVersion = Nothing,+        bmiVersion = Nothing,+        avx = False,+        avx2 = False,+        avx512cd = False,+        avx512er = False,+        avx512f = False,+        avx512pf = False,+        rtldInfo = panic "defaultDynFlags: no rtldInfo",+        rtccInfo = panic "defaultDynFlags: no rtccInfo",++        maxInlineAllocSize = 128,+        maxInlineMemcpyInsns = 32,+        maxInlineMemsetInsns = 32,++        initialUnique = 0,+        uniqueIncrement = 1,++        reverseErrors = False,+        maxErrors     = Nothing,+        cfgWeightInfo = defaultCfgWeights+      }++defaultWays :: Settings -> [Way]+defaultWays settings = if pc_DYNAMIC_BY_DEFAULT (sPlatformConstants settings)+                       then [WayDyn]+                       else []++interpWays :: [Way]+interpWays+  | dynamicGhc = [WayDyn]+  | rtsIsProfiled = [WayProf]+  | otherwise = []++interpreterProfiled :: DynFlags -> Bool+interpreterProfiled dflags+  | gopt Opt_ExternalInterpreter dflags = gopt Opt_SccProfilingOn dflags+  | otherwise = rtsIsProfiled++interpreterDynamic :: DynFlags -> Bool+interpreterDynamic dflags+  | gopt Opt_ExternalInterpreter dflags = WayDyn `elem` ways dflags+  | otherwise = dynamicGhc++--------------------------------------------------------------------------+--+-- Note [JSON Error Messages]+--+-- When the user requests the compiler output to be dumped as json+-- we used to collect them all in an IORef and then print them at the end.+-- This doesn't work very well with GHCi. (See #14078) So instead we now+-- use the simpler method of just outputting a JSON document inplace to+-- stdout.+--+-- Before the compiler calls log_action, it has already turned the `ErrMsg`+-- into a formatted message. This means that we lose some possible+-- information to provide to the user but refactoring log_action is quite+-- invasive as it is called in many places. So, for now I left it alone+-- and we can refine its behaviour as users request different output.++type FatalMessager = String -> IO ()++type LogAction = DynFlags+              -> WarnReason+              -> Severity+              -> SrcSpan+              -> PprStyle+              -> MsgDoc+              -> IO ()++defaultFatalMessager :: FatalMessager+defaultFatalMessager = hPutStrLn stderr+++-- See Note [JSON Error Messages]+--+jsonLogAction :: LogAction+jsonLogAction dflags reason severity srcSpan _style msg+  = do+    defaultLogActionHPutStrDoc dflags stdout (doc $$ text "")+                               (mkCodeStyle CStyle)+    where+      doc = renderJSON $+              JSObject [ ( "span", json srcSpan )+                       , ( "doc" , JSString (showSDoc dflags msg) )+                       , ( "severity", json severity )+                       , ( "reason" ,   json reason )+                       ]+++defaultLogAction :: LogAction+defaultLogAction dflags reason severity srcSpan style msg+    = case severity of+      SevOutput      -> printOut msg style+      SevDump        -> printOut (msg $$ blankLine) style+      SevInteractive -> putStrSDoc msg style+      SevInfo        -> printErrs msg style+      SevFatal       -> printErrs msg style+      SevWarning     -> printWarns+      SevError       -> printWarns+    where+      printOut   = defaultLogActionHPrintDoc  dflags stdout+      printErrs  = defaultLogActionHPrintDoc  dflags stderr+      putStrSDoc = defaultLogActionHPutStrDoc dflags stdout+      -- Pretty print the warning flag, if any (#10752)+      message = mkLocMessageAnn flagMsg severity srcSpan msg++      printWarns = do+        hPutChar stderr '\n'+        caretDiagnostic <-+            if gopt Opt_DiagnosticsShowCaret dflags+            then getCaretDiagnostic severity srcSpan+            else pure empty+        printErrs (message $+$ caretDiagnostic)+            (setStyleColoured True style)+        -- careful (#2302): printErrs prints in UTF-8,+        -- whereas converting to string first and using+        -- hPutStr would just emit the low 8 bits of+        -- each unicode char.++      flagMsg =+        case reason of+          NoReason -> Nothing+          Reason wflag -> do+            spec <- flagSpecOf wflag+            return ("-W" ++ flagSpecName spec ++ warnFlagGrp wflag)+          ErrReason Nothing ->+            return "-Werror"+          ErrReason (Just wflag) -> do+            spec <- flagSpecOf wflag+            return $+              "-W" ++ flagSpecName spec ++ warnFlagGrp wflag +++              ", -Werror=" ++ flagSpecName spec++      warnFlagGrp flag+          | gopt Opt_ShowWarnGroups dflags =+                case smallestGroups flag of+                    [] -> ""+                    groups -> " (in " ++ intercalate ", " (map ("-W"++) groups) ++ ")"+          | otherwise = ""++-- | Like 'defaultLogActionHPutStrDoc' but appends an extra newline.+defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO ()+defaultLogActionHPrintDoc dflags h d sty+ = defaultLogActionHPutStrDoc dflags h (d $$ text "") sty++defaultLogActionHPutStrDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO ()+defaultLogActionHPutStrDoc dflags h d sty+  -- Don't add a newline at the end, so that successive+  -- calls to this log-action can output all on the same line+  = printSDoc Pretty.PageMode dflags h sty d++newtype FlushOut = FlushOut (IO ())++defaultFlushOut :: FlushOut+defaultFlushOut = FlushOut $ hFlush stdout++newtype FlushErr = FlushErr (IO ())++defaultFlushErr :: FlushErr+defaultFlushErr = FlushErr $ hFlush stderr++{-+Note [Verbosity levels]+~~~~~~~~~~~~~~~~~~~~~~~+    0   |   print errors & warnings only+    1   |   minimal verbosity: print "compiling M ... done." for each module.+    2   |   equivalent to -dshow-passes+    3   |   equivalent to existing "ghc -v"+    4   |   "ghc -v -ddump-most"+    5   |   "ghc -v -ddump-all"+-}++data OnOff a = On a+             | Off a+  deriving (Eq, Show)++instance Outputable a => Outputable (OnOff a) where+  ppr (On x)  = text "On" <+> ppr x+  ppr (Off x) = text "Off" <+> ppr x++-- OnOffs accumulate in reverse order, so we use foldr in order to+-- process them in the right order+flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension+flattenExtensionFlags ml = foldr f defaultExtensionFlags+    where f (On f)  flags = EnumSet.insert f flags+          f (Off f) flags = EnumSet.delete f flags+          defaultExtensionFlags = EnumSet.fromList (languageExtensions ml)++languageExtensions :: Maybe Language -> [LangExt.Extension]++languageExtensions Nothing+    -- Nothing => the default case+    = LangExt.NondecreasingIndentation -- This has been on by default for some time+    : delete LangExt.DatatypeContexts  -- The Haskell' committee decided to+                                       -- remove datatype contexts from the+                                       -- language:+   -- http://www.haskell.org/pipermail/haskell-prime/2011-January/003335.html+      (languageExtensions (Just Haskell2010))++   -- NB: MonoPatBinds is no longer the default++languageExtensions (Just Haskell98)+    = [LangExt.ImplicitPrelude,+       -- See Note [When is StarIsType enabled]+       LangExt.StarIsType,+       LangExt.MonomorphismRestriction,+       LangExt.NPlusKPatterns,+       LangExt.DatatypeContexts,+       LangExt.TraditionalRecordSyntax,+       LangExt.NondecreasingIndentation+           -- strictly speaking non-standard, but we always had this+           -- on implicitly before the option was added in 7.1, and+           -- turning it off breaks code, so we're keeping it on for+           -- backwards compatibility.  Cabal uses -XHaskell98 by+           -- default unless you specify another language.+      ]++languageExtensions (Just Haskell2010)+    = [LangExt.ImplicitPrelude,+       -- See Note [When is StarIsType enabled]+       LangExt.StarIsType,+       LangExt.MonomorphismRestriction,+       LangExt.DatatypeContexts,+       LangExt.TraditionalRecordSyntax,+       LangExt.EmptyDataDecls,+       LangExt.ForeignFunctionInterface,+       LangExt.PatternGuards,+       LangExt.DoAndIfThenElse,+       LangExt.RelaxedPolyRec]++hasPprDebug :: DynFlags -> Bool+hasPprDebug = dopt Opt_D_ppr_debug++hasNoDebugOutput :: DynFlags -> Bool+hasNoDebugOutput = dopt Opt_D_no_debug_output++hasNoStateHack :: DynFlags -> Bool+hasNoStateHack = gopt Opt_G_NoStateHack++hasNoOptCoercion :: DynFlags -> Bool+hasNoOptCoercion = gopt Opt_G_NoOptCoercion+++-- | Test whether a 'DumpFlag' is set+dopt :: DumpFlag -> DynFlags -> Bool+dopt f dflags = (f `EnumSet.member` dumpFlags dflags)+             || (verbosity dflags >= 4 && enableIfVerbose f)+    where enableIfVerbose Opt_D_dump_tc_trace               = False+          enableIfVerbose Opt_D_dump_rn_trace               = False+          enableIfVerbose Opt_D_dump_cs_trace               = False+          enableIfVerbose Opt_D_dump_if_trace               = False+          enableIfVerbose Opt_D_dump_vt_trace               = False+          enableIfVerbose Opt_D_dump_tc                     = False+          enableIfVerbose Opt_D_dump_rn                     = False+          enableIfVerbose Opt_D_dump_shape                  = False+          enableIfVerbose Opt_D_dump_rn_stats               = False+          enableIfVerbose Opt_D_dump_hi_diffs               = False+          enableIfVerbose Opt_D_verbose_core2core           = False+          enableIfVerbose Opt_D_verbose_stg2stg             = False+          enableIfVerbose Opt_D_dump_splices                = False+          enableIfVerbose Opt_D_th_dec_file                 = False+          enableIfVerbose Opt_D_dump_rule_firings           = False+          enableIfVerbose Opt_D_dump_rule_rewrites          = False+          enableIfVerbose Opt_D_dump_simpl_trace            = False+          enableIfVerbose Opt_D_dump_rtti                   = False+          enableIfVerbose Opt_D_dump_inlinings              = False+          enableIfVerbose Opt_D_dump_core_stats             = False+          enableIfVerbose Opt_D_dump_asm_stats              = False+          enableIfVerbose Opt_D_dump_types                  = False+          enableIfVerbose Opt_D_dump_simpl_iterations       = False+          enableIfVerbose Opt_D_dump_ticked                 = False+          enableIfVerbose Opt_D_dump_view_pattern_commoning = False+          enableIfVerbose Opt_D_dump_mod_cycles             = False+          enableIfVerbose Opt_D_dump_mod_map                = False+          enableIfVerbose Opt_D_dump_ec_trace               = False+          enableIfVerbose _                                 = True++-- | Set a 'DumpFlag'+dopt_set :: DynFlags -> DumpFlag -> DynFlags+dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) }++-- | Unset a 'DumpFlag'+dopt_unset :: DynFlags -> DumpFlag -> DynFlags+dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) }++-- | Test whether a 'GeneralFlag' is set+gopt :: GeneralFlag -> DynFlags -> Bool+gopt f dflags  = f `EnumSet.member` generalFlags dflags++-- | Set a 'GeneralFlag'+gopt_set :: DynFlags -> GeneralFlag -> DynFlags+gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) }++-- | Unset a 'GeneralFlag'+gopt_unset :: DynFlags -> GeneralFlag -> DynFlags+gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) }++-- | Test whether a 'WarningFlag' is set+wopt :: WarningFlag -> DynFlags -> Bool+wopt f dflags  = f `EnumSet.member` warningFlags dflags++-- | Set a 'WarningFlag'+wopt_set :: DynFlags -> WarningFlag -> DynFlags+wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) }++-- | Unset a 'WarningFlag'+wopt_unset :: DynFlags -> WarningFlag -> DynFlags+wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) }++-- | Test whether a 'WarningFlag' is set as fatal+wopt_fatal :: WarningFlag -> DynFlags -> Bool+wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags++-- | Mark a 'WarningFlag' as fatal (do not set the flag)+wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags+wopt_set_fatal dfs f+    = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) }++-- | Mark a 'WarningFlag' as not fatal+wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags+wopt_unset_fatal dfs f+    = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) }++-- | Test whether a 'LangExt.Extension' is set+xopt :: LangExt.Extension -> DynFlags -> Bool+xopt f dflags = f `EnumSet.member` extensionFlags dflags++-- | Set a 'LangExt.Extension'+xopt_set :: DynFlags -> LangExt.Extension -> DynFlags+xopt_set dfs f+    = let onoffs = On f : extensions dfs+      in dfs { extensions = onoffs,+               extensionFlags = flattenExtensionFlags (language dfs) onoffs }++-- | Unset a 'LangExt.Extension'+xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags+xopt_unset dfs f+    = let onoffs = Off f : extensions dfs+      in dfs { extensions = onoffs,+               extensionFlags = flattenExtensionFlags (language dfs) onoffs }++-- | Set or unset a 'LangExt.Extension', unless it has been explicitly+--   set or unset before.+xopt_set_unlessExplSpec+        :: LangExt.Extension+        -> (DynFlags -> LangExt.Extension -> DynFlags)+        -> DynFlags -> DynFlags+xopt_set_unlessExplSpec ext setUnset dflags =+    let referedExts = stripOnOff <$> extensions dflags+        stripOnOff (On x)  = x+        stripOnOff (Off x) = x+    in+        if ext `elem` referedExts then dflags else setUnset dflags ext++lang_set :: DynFlags -> Maybe Language -> DynFlags+lang_set dflags lang =+   dflags {+            language = lang,+            extensionFlags = flattenExtensionFlags lang (extensions dflags)+          }++-- | An internal helper to check whether to use unicode syntax for output.+--+-- Note: You should very likely be using 'Outputable.unicodeSyntax' instead+-- of this function.+useUnicodeSyntax :: DynFlags -> Bool+useUnicodeSyntax = gopt Opt_PrintUnicodeSyntax++useStarIsType :: DynFlags -> Bool+useStarIsType = xopt LangExt.StarIsType++-- | Set the Haskell language standard to use+setLanguage :: Language -> DynP ()+setLanguage l = upd (`lang_set` Just l)++-- | Some modules have dependencies on others through the DynFlags rather than textual imports+dynFlagDependencies :: DynFlags -> [ModuleName]+dynFlagDependencies = pluginModNames++-- | Is the -fpackage-trust mode on+packageTrustOn :: DynFlags -> Bool+packageTrustOn = gopt Opt_PackageTrust++-- | Is Safe Haskell on in some way (including inference mode)+safeHaskellOn :: DynFlags -> Bool+safeHaskellOn dflags = safeHaskellModeEnabled dflags || safeInferOn dflags++safeHaskellModeEnabled :: DynFlags -> Bool+safeHaskellModeEnabled dflags = safeHaskell dflags `elem` [Sf_Unsafe, Sf_Trustworthy+                                                   , Sf_Safe ]+++-- | Is the Safe Haskell safe language in use+safeLanguageOn :: DynFlags -> Bool+safeLanguageOn dflags = safeHaskell dflags == Sf_Safe++-- | Is the Safe Haskell safe inference mode active+safeInferOn :: DynFlags -> Bool+safeInferOn = safeInfer++-- | Test if Safe Imports are on in some form+safeImportsOn :: DynFlags -> Bool+safeImportsOn dflags = safeHaskell dflags == Sf_Unsafe ||+                       safeHaskell dflags == Sf_Trustworthy ||+                       safeHaskell dflags == Sf_Safe++-- | Set a 'Safe Haskell' flag+setSafeHaskell :: SafeHaskellMode -> DynP ()+setSafeHaskell s = updM f+    where f dfs = do+              let sf = safeHaskell dfs+              safeM <- combineSafeFlags sf s+              case s of+                Sf_Safe -> return $ dfs { safeHaskell = safeM, safeInfer = False }+                -- leave safe inferrence on in Trustworthy mode so we can warn+                -- if it could have been inferred safe.+                Sf_Trustworthy -> do+                  l <- getCurLoc+                  return $ dfs { safeHaskell = safeM, trustworthyOnLoc = l }+                -- leave safe inference on in Unsafe mode as well.+                _ -> return $ dfs { safeHaskell = safeM }++-- | Are all direct imports required to be safe for this Safe Haskell mode?+-- Direct imports are when the code explicitly imports a module+safeDirectImpsReq :: DynFlags -> Bool+safeDirectImpsReq d = safeLanguageOn d++-- | Are all implicit imports required to be safe for this Safe Haskell mode?+-- Implicit imports are things in the prelude. e.g System.IO when print is used.+safeImplicitImpsReq :: DynFlags -> Bool+safeImplicitImpsReq d = safeLanguageOn d++-- | Combine two Safe Haskell modes correctly. Used for dealing with multiple flags.+-- This makes Safe Haskell very much a monoid but for now I prefer this as I don't+-- want to export this functionality from the module but do want to export the+-- type constructors.+combineSafeFlags :: SafeHaskellMode -> SafeHaskellMode -> DynP SafeHaskellMode+combineSafeFlags a b | a == Sf_None         = return b+                     | b == Sf_None         = return a+                     | a == Sf_Ignore || b == Sf_Ignore = return Sf_Ignore+                     | a == b               = return a+                     | otherwise            = addErr errm >> pure a+    where errm = "Incompatible Safe Haskell flags! ("+                    ++ show a ++ ", " ++ show b ++ ")"++-- | A list of unsafe flags under Safe Haskell. Tuple elements are:+--     * name of the flag+--     * function to get srcspan that enabled the flag+--     * function to test if the flag is on+--     * function to turn the flag off+unsafeFlags, unsafeFlagsForInfer+  :: [(String, DynFlags -> SrcSpan, DynFlags -> Bool, DynFlags -> DynFlags)]+unsafeFlags = [ ("-XGeneralizedNewtypeDeriving", newDerivOnLoc,+                    xopt LangExt.GeneralizedNewtypeDeriving,+                    flip xopt_unset LangExt.GeneralizedNewtypeDeriving)+              , ("-XTemplateHaskell", thOnLoc,+                    xopt LangExt.TemplateHaskell,+                    flip xopt_unset LangExt.TemplateHaskell)+              ]+unsafeFlagsForInfer = unsafeFlags+++-- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order+getOpts :: DynFlags             -- ^ 'DynFlags' to retrieve the options from+        -> (DynFlags -> [a])    -- ^ Relevant record accessor: one of the @opt_*@ accessors+        -> [a]                  -- ^ Correctly ordered extracted options+getOpts dflags opts = reverse (opts dflags)+        -- We add to the options from the front, so we need to reverse the list++-- | Gets the verbosity flag for the current verbosity level. This is fed to+-- other tools, so GHC-specific verbosity flags like @-ddump-most@ are not included+getVerbFlags :: DynFlags -> [String]+getVerbFlags dflags+  | verbosity dflags >= 4 = ["-v"]+  | otherwise             = []++setObjectDir, setHiDir, setHieDir, setStubDir, setDumpDir, setOutputDir,+         setDynObjectSuf, setDynHiSuf,+         setDylibInstallName,+         setObjectSuf, setHiSuf, setHieSuf, setHcSuf, parseDynLibLoaderMode,+         setPgmP, addOptl, addOptc, addOptP,+         addCmdlineFramework, addHaddockOpts, addGhciScript,+         setInteractivePrint+   :: String -> DynFlags -> DynFlags+setOutputFile, setDynOutputFile, setOutputHi, setDumpPrefixForce+   :: Maybe String -> DynFlags -> DynFlags++setObjectDir  f d = d { objectDir  = Just f}+setHiDir      f d = d { hiDir      = Just f}+setHieDir     f d = d { hieDir     = Just f}+setStubDir    f d = d { stubDir    = Just f+                      , includePaths = addGlobalInclude (includePaths d) [f] }+  -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file+  -- \#included from the .hc file when compiling via C (i.e. unregisterised+  -- builds).+setDumpDir    f d = d { dumpDir    = Just f}+setOutputDir  f = setObjectDir f+                . setHieDir f+                . setHiDir f+                . setStubDir f+                . setDumpDir f+setDylibInstallName  f d = d { dylibInstallName = Just f}++setObjectSuf    f d = d { objectSuf    = f}+setDynObjectSuf f d = d { dynObjectSuf = f}+setHiSuf        f d = d { hiSuf        = f}+setHieSuf       f d = d { hieSuf       = f}+setDynHiSuf     f d = d { dynHiSuf     = f}+setHcSuf        f d = d { hcSuf        = f}++setOutputFile f d = d { outputFile = f}+setDynOutputFile f d = d { dynOutputFile = f}+setOutputHi   f d = d { outputHi   = f}++setJsonLogAction :: DynFlags -> DynFlags+setJsonLogAction d = d { log_action = jsonLogAction }++thisComponentId :: DynFlags -> ComponentId+thisComponentId dflags =+  case thisComponentId_ dflags of+    Just cid -> cid+    Nothing  ->+      case thisUnitIdInsts_ dflags of+        Just _  ->+          throwGhcException $ CmdLineError ("Use of -instantiated-with requires -this-component-id")+        Nothing -> ComponentId (unitIdFS (thisPackage dflags))++thisUnitIdInsts :: DynFlags -> [(ModuleName, Module)]+thisUnitIdInsts dflags =+    case thisUnitIdInsts_ dflags of+        Just insts -> insts+        Nothing    -> []++thisPackage :: DynFlags -> UnitId+thisPackage dflags =+    case thisUnitIdInsts_ dflags of+        Nothing -> default_uid+        Just insts+          | all (\(x,y) -> mkHoleModule x == y) insts+          -> newUnitId (thisComponentId dflags) insts+          | otherwise+          -> default_uid+  where+    default_uid = DefiniteUnitId (DefUnitId (thisInstalledUnitId dflags))++parseUnitIdInsts :: String -> [(ModuleName, Module)]+parseUnitIdInsts str = case filter ((=="").snd) (readP_to_S parse str) of+    [(r, "")] -> r+    _ -> throwGhcException $ CmdLineError ("Can't parse -instantiated-with: " ++ str)+  where parse = sepBy parseEntry (R.char ',')+        parseEntry = do+            n <- parseModuleName+            _ <- R.char '='+            m <- parseModuleId+            return (n, m)++setUnitIdInsts :: String -> DynFlags -> DynFlags+setUnitIdInsts s d =+    d { thisUnitIdInsts_ = Just (parseUnitIdInsts s) }++setComponentId :: String -> DynFlags -> DynFlags+setComponentId s d =+    d { thisComponentId_ = Just (ComponentId (fsLit s)) }++addPluginModuleName :: String -> DynFlags -> DynFlags+addPluginModuleName name d = d { pluginModNames = (mkModuleName name) : (pluginModNames d) }++clearPluginModuleNames :: DynFlags -> DynFlags+clearPluginModuleNames d =+    d { pluginModNames = []+      , pluginModNameOpts = []+      , cachedPlugins = [] }++addPluginModuleNameOption :: String -> DynFlags -> DynFlags+addPluginModuleNameOption optflag d = d { pluginModNameOpts = (mkModuleName m, option) : (pluginModNameOpts d) }+  where (m, rest) = break (== ':') optflag+        option = case rest of+          [] -> "" -- should probably signal an error+          (_:plug_opt) -> plug_opt -- ignore the ':' from break++addFrontendPluginOption :: String -> DynFlags -> DynFlags+addFrontendPluginOption s d = d { frontendPluginOpts = s : frontendPluginOpts d }++parseDynLibLoaderMode f d =+ case splitAt 8 f of+   ("deploy", "")       -> d { dynLibLoader = Deployable }+   ("sysdep", "")       -> d { dynLibLoader = SystemDependent }+   _                    -> throwGhcException (CmdLineError ("Unknown dynlib loader: " ++ f))++setDumpPrefixForce f d = d { dumpPrefixForce = f}++-- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]+-- Config.hs should really use Option.+setPgmP   f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P   = (pgm, map Option args)})+addOptl   f = alterSettings (\s -> s { sOpt_l   = f : sOpt_l s})+addOptc   f = alterSettings (\s -> s { sOpt_c   = f : sOpt_c s})+addOptP   f = alterSettings (\s -> s { sOpt_P   = f : sOpt_P s+                                     , sOpt_P_fingerprint = fingerprintStrings (f : sOpt_P s)+                                     })+                                     -- See Note [Repeated -optP hashing]+  where+  fingerprintStrings ss = fingerprintFingerprints $ map fingerprintString ss+++setDepMakefile :: FilePath -> DynFlags -> DynFlags+setDepMakefile f d = d { depMakefile = f }++setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags+setDepIncludePkgDeps b d = d { depIncludePkgDeps = b }++addDepExcludeMod :: String -> DynFlags -> DynFlags+addDepExcludeMod m d+    = d { depExcludeMods = mkModuleName m : depExcludeMods d }++addDepSuffix :: FilePath -> DynFlags -> DynFlags+addDepSuffix s d = d { depSuffixes = s : depSuffixes d }++addCmdlineFramework f d = d { cmdlineFrameworks = f : cmdlineFrameworks d}++addGhcVersionFile :: FilePath -> DynFlags -> DynFlags+addGhcVersionFile f d = d { ghcVersionFile = Just f }++addHaddockOpts f d = d { haddockOptions = Just f}++addGhciScript f d = d { ghciScripts = f : ghciScripts d}++setInteractivePrint f d = d { interactivePrint = Just f}++-- -----------------------------------------------------------------------------+-- Command-line options++-- | When invoking external tools as part of the compilation pipeline, we+-- pass these a sequence of options on the command-line. Rather than+-- just using a list of Strings, we use a type that allows us to distinguish+-- between filepaths and 'other stuff'. The reason for this is that+-- this type gives us a handle on transforming filenames, and filenames only,+-- to whatever format they're expected to be on a particular platform.+data Option+ = FileOption -- an entry that _contains_ filename(s) / filepaths.+              String  -- a non-filepath prefix that shouldn't be+                      -- transformed (e.g., "/out=")+              String  -- the filepath/filename portion+ | Option     String+ deriving ( Eq )++showOpt :: Option -> String+showOpt (FileOption pre f) = pre ++ f+showOpt (Option s)  = s++-----------------------------------------------------------------------------+-- Setting the optimisation level++updOptLevel :: Int -> DynFlags -> DynFlags+-- ^ Sets the 'DynFlags' to be appropriate to the optimisation level+updOptLevel n dfs+  = dfs2{ optLevel = final_n }+  where+   final_n = max 0 (min 2 n)    -- Clamp to 0 <= n <= 2+   dfs1 = foldr (flip gopt_unset) dfs  remove_gopts+   dfs2 = foldr (flip gopt_set)   dfs1 extra_gopts++   extra_gopts  = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]+   remove_gopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]++{- **********************************************************************+%*                                                                      *+                DynFlags parser+%*                                                                      *+%********************************************************************* -}++-- -----------------------------------------------------------------------------+-- Parsing the dynamic flags.+++-- | Parse dynamic flags from a list of command line arguments.  Returns the+-- the parsed 'DynFlags', the left-over arguments, and a list of warnings.+-- Throws a 'UsageError' if errors occurred during parsing (such as unknown+-- flags or missing arguments).+parseDynamicFlagsCmdLine :: MonadIO m => DynFlags -> [Located String]+                         -> m (DynFlags, [Located String], [Warn])+                            -- ^ Updated 'DynFlags', left-over arguments, and+                            -- list of warnings.+parseDynamicFlagsCmdLine = parseDynamicFlagsFull flagsAll True+++-- | Like 'parseDynamicFlagsCmdLine' but does not allow the package flags+-- (-package, -hide-package, -ignore-package, -hide-all-packages, -package-db).+-- Used to parse flags set in a modules pragma.+parseDynamicFilePragma :: MonadIO m => DynFlags -> [Located String]+                       -> m (DynFlags, [Located String], [Warn])+                          -- ^ Updated 'DynFlags', left-over arguments, and+                          -- list of warnings.+parseDynamicFilePragma = parseDynamicFlagsFull flagsDynamic False+++-- | Parses the dynamically set flags for GHC. This is the most general form of+-- the dynamic flag parser that the other methods simply wrap. It allows+-- saying which flags are valid flags and indicating if we are parsing+-- arguments from the command line or from a file pragma.+parseDynamicFlagsFull :: MonadIO m+                  => [Flag (CmdLineP DynFlags)]    -- ^ valid flags to match against+                  -> Bool                          -- ^ are the arguments from the command line?+                  -> DynFlags                      -- ^ current dynamic flags+                  -> [Located String]              -- ^ arguments to parse+                  -> m (DynFlags, [Located String], [Warn])+parseDynamicFlagsFull activeFlags cmdline dflags0 args = do+  let ((leftover, errs, warns), dflags1)+          = runCmdLine (processArgs activeFlags args) dflags0++  -- See Note [Handling errors when parsing commandline flags]+  unless (null errs) $ liftIO $ throwGhcExceptionIO $ errorsToGhcException $+    map ((showPpr dflags0 . getLoc &&& unLoc) . errMsg) $ errs++  -- check for disabled flags in safe haskell+  let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1+      dflags3 = updateWays dflags2+      theWays = ways dflags3++  unless (allowed_combination theWays) $ liftIO $+      throwGhcExceptionIO (CmdLineError ("combination not supported: " +++                               intercalate "/" (map wayDesc theWays)))++  let chooseOutput+        | isJust (outputFile dflags3)          -- Only iff user specified -o ...+        , not (isJust (dynOutputFile dflags3)) -- but not -dyno+        = return $ dflags3 { dynOutputFile = Just $ dynOut (fromJust $ outputFile dflags3) }+        | otherwise+        = return dflags3+        where+          dynOut = flip addExtension (dynObjectSuf dflags3) . dropExtension+  dflags4 <- ifGeneratingDynamicToo dflags3 chooseOutput (return dflags3)++  let (dflags5, consistency_warnings) = makeDynFlagsConsistent dflags4++  -- Set timer stats & heap size+  when (enableTimeStats dflags5) $ liftIO enableTimingStats+  case (ghcHeapSize dflags5) of+    Just x -> liftIO (setHeapSize x)+    _      -> return ()++  liftIO $ setUnsafeGlobalDynFlags dflags5++  let warns' = map (Warn Cmd.NoReason) (consistency_warnings ++ sh_warns)++  return (dflags5, leftover, warns' ++ warns)++-- | Write an error or warning to the 'LogOutput'.+putLogMsg :: DynFlags -> WarnReason -> Severity -> SrcSpan -> PprStyle+          -> MsgDoc -> IO ()+putLogMsg dflags = log_action dflags dflags++updateWays :: DynFlags -> DynFlags+updateWays dflags+    = let theWays = sort $ nub $ ways dflags+      in dflags {+             ways        = theWays,+             buildTag    = mkBuildTag (filter (not . wayRTSOnly) theWays)+         }++-- | Check (and potentially disable) any extensions that aren't allowed+-- in safe mode.+--+-- The bool is to indicate if we are parsing command line flags (false means+-- file pragma). This allows us to generate better warnings.+safeFlagCheck :: Bool -> DynFlags -> (DynFlags, [Located String])+safeFlagCheck _ dflags | safeLanguageOn dflags = (dflagsUnset, warns)+  where+    -- Handle illegal flags under safe language.+    (dflagsUnset, warns) = foldl' check_method (dflags, []) unsafeFlags++    check_method (df, warns) (str,loc,test,fix)+        | test df   = (fix df, warns ++ safeFailure (loc df) str)+        | otherwise = (df, warns)++    safeFailure loc str+       = [L loc $ str ++ " is not allowed in Safe Haskell; ignoring "+           ++ str]++safeFlagCheck cmdl dflags =+  case (safeInferOn dflags) of+    True | safeFlags -> (dflags', warn)+    True             -> (dflags' { safeInferred = False }, warn)+    False            -> (dflags', warn)++  where+    -- dynflags and warn for when -fpackage-trust by itself with no safe+    -- haskell flag+    (dflags', warn)+      | not (safeHaskellModeEnabled dflags) && not cmdl && packageTrustOn dflags+      = (gopt_unset dflags Opt_PackageTrust, pkgWarnMsg)+      | otherwise = (dflags, [])++    pkgWarnMsg = [L (pkgTrustOnLoc dflags') $+                    "-fpackage-trust ignored;" +++                    " must be specified with a Safe Haskell flag"]++    -- Have we inferred Unsafe? See Note [HscMain . Safe Haskell Inference]+    safeFlags = all (\(_,_,t,_) -> not $ t dflags) unsafeFlagsForInfer+++{- **********************************************************************+%*                                                                      *+                DynFlags specifications+%*                                                                      *+%********************************************************************* -}++-- | All dynamic flags option strings without the deprecated ones.+-- These are the user facing strings for enabling and disabling options.+allNonDeprecatedFlags :: [String]+allNonDeprecatedFlags = allFlagsDeps False++-- | All flags with possibility to filter deprecated ones+allFlagsDeps :: Bool -> [String]+allFlagsDeps keepDeprecated = [ '-':flagName flag+                              | (deprecated, flag) <- flagsAllDeps+                              , keepDeprecated || not (isDeprecated deprecated)]+  where isDeprecated Deprecated = True+        isDeprecated _ = False++{-+ - Below we export user facing symbols for GHC dynamic flags for use with the+ - GHC API.+ -}++-- All dynamic flags present in GHC.+flagsAll :: [Flag (CmdLineP DynFlags)]+flagsAll = map snd flagsAllDeps++-- All dynamic flags present in GHC with deprecation information.+flagsAllDeps :: [(Deprecation, Flag (CmdLineP DynFlags))]+flagsAllDeps =  package_flags_deps ++ dynamic_flags_deps+++-- All dynamic flags, minus package flags, present in GHC.+flagsDynamic :: [Flag (CmdLineP DynFlags)]+flagsDynamic = map snd dynamic_flags_deps++-- ALl package flags present in GHC.+flagsPackage :: [Flag (CmdLineP DynFlags)]+flagsPackage = map snd package_flags_deps++----------------Helpers to make flags and keep deprecation information----------++type FlagMaker m = String -> OptKind m -> Flag m+type DynFlagMaker = FlagMaker (CmdLineP DynFlags)+data Deprecation = NotDeprecated | Deprecated deriving (Eq, Ord)++-- Make a non-deprecated flag+make_ord_flag :: DynFlagMaker -> String -> OptKind (CmdLineP DynFlags)+              -> (Deprecation, Flag (CmdLineP DynFlags))+make_ord_flag fm name kind = (NotDeprecated, fm name kind)++-- Make a deprecated flag+make_dep_flag :: DynFlagMaker -> String -> OptKind (CmdLineP DynFlags) -> String+                 -> (Deprecation, Flag (CmdLineP DynFlags))+make_dep_flag fm name kind message = (Deprecated,+                                      fm name $ add_dep_message kind message)++add_dep_message :: OptKind (CmdLineP DynFlags) -> String+                -> OptKind (CmdLineP DynFlags)+add_dep_message (NoArg f) message = NoArg $ f >> deprecate message+add_dep_message (HasArg f) message = HasArg $ \s -> f s >> deprecate message+add_dep_message (SepArg f) message = SepArg $ \s -> f s >> deprecate message+add_dep_message (Prefix f) message = Prefix $ \s -> f s >> deprecate message+add_dep_message (OptPrefix f) message =+                                  OptPrefix $ \s -> f s >> deprecate message+add_dep_message (OptIntSuffix f) message =+                               OptIntSuffix $ \oi -> f oi >> deprecate message+add_dep_message (IntSuffix f) message =+                                  IntSuffix $ \i -> f i >> deprecate message+add_dep_message (FloatSuffix f) message =+                                FloatSuffix $ \fl -> f fl >> deprecate message+add_dep_message (PassFlag f) message =+                                   PassFlag $ \s -> f s >> deprecate message+add_dep_message (AnySuffix f) message =+                                  AnySuffix $ \s -> f s >> deprecate message++----------------------- The main flags themselves ------------------------------+-- See Note [Updating flag description in the User's Guide]+-- See Note [Supporting CLI completion]+dynamic_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))]+dynamic_flags_deps = [+    make_dep_flag defFlag "n" (NoArg $ return ())+        "The -n flag is deprecated and no longer has any effect"+  , make_ord_flag defFlag "cpp"      (NoArg (setExtensionFlag LangExt.Cpp))+  , make_ord_flag defFlag "F"        (NoArg (setGeneralFlag Opt_Pp))+  , (Deprecated, defFlag "#include"+      (HasArg (\_s ->+         deprecate ("-#include and INCLUDE pragmas are " +++                    "deprecated: They no longer have any effect"))))+  , make_ord_flag defFlag "v"        (OptIntSuffix setVerbosity)++  , make_ord_flag defGhcFlag "j"     (OptIntSuffix+        (\n -> case n of+                 Just n+                     | n > 0     -> upd (\d -> d { parMakeCount = Just n })+                     | otherwise -> addErr "Syntax: -j[n] where n > 0"+                 Nothing -> upd (\d -> d { parMakeCount = Nothing })))+                 -- When the number of parallel builds+                 -- is omitted, it is the same+                 -- as specifing that the number of+                 -- parallel builds is equal to the+                 -- result of getNumProcessors+  , make_ord_flag defFlag "instantiated-with"   (sepArg setUnitIdInsts)+  , make_ord_flag defFlag "this-component-id"   (sepArg setComponentId)++    -- RTS options -------------------------------------------------------------+  , make_ord_flag defFlag "H"           (HasArg (\s -> upd (\d ->+          d { ghcHeapSize = Just $ fromIntegral (decodeSize s)})))++  , make_ord_flag defFlag "Rghc-timing" (NoArg (upd (\d ->+                                               d { enableTimeStats = True })))++    ------- ways ---------------------------------------------------------------+  , make_ord_flag defGhcFlag "prof"           (NoArg (addWay WayProf))+  , make_ord_flag defGhcFlag "eventlog"       (NoArg (addWay WayEventLog))+  , make_dep_flag defGhcFlag "smp"+      (NoArg $ addWay WayThreaded) "Use -threaded instead"+  , make_ord_flag defGhcFlag "debug"          (NoArg (addWay WayDebug))+  , make_ord_flag defGhcFlag "threaded"       (NoArg (addWay WayThreaded))++  , make_ord_flag defGhcFlag "ticky"+      (NoArg (setGeneralFlag Opt_Ticky >> addWay WayDebug))++    -- -ticky enables ticky-ticky code generation, and also implies -debug which+    -- is required to get the RTS ticky support.++        ----- Linker --------------------------------------------------------+  , make_ord_flag defGhcFlag "static"         (NoArg removeWayDyn)+  , make_ord_flag defGhcFlag "dynamic"        (NoArg (addWay WayDyn))+  , make_ord_flag defGhcFlag "rdynamic" $ noArg $+#if defined(linux_HOST_OS)+                              addOptl "-rdynamic"+#elif defined (mingw32_HOST_OS)+                              addOptl "-Wl,--export-all-symbols"+#else+    -- ignored for compat w/ gcc:+                              id+#endif+  , make_ord_flag defGhcFlag "relative-dynlib-paths"+      (NoArg (setGeneralFlag Opt_RelativeDynlibPaths))+  , make_ord_flag defGhcFlag "copy-libs-when-linking"+      (NoArg (setGeneralFlag Opt_SingleLibFolder))+  , make_ord_flag defGhcFlag "pie"            (NoArg (setGeneralFlag Opt_PICExecutable))+  , make_ord_flag defGhcFlag "no-pie"         (NoArg (unSetGeneralFlag Opt_PICExecutable))++        ------- Specific phases  --------------------------------------------+    -- need to appear before -pgmL to be parsed as LLVM flags.+  , make_ord_flag defFlag "pgmlo"+      (hasArg (\f -> alterSettings (\s -> s { sPgm_lo  = (f,[])})))+  , make_ord_flag defFlag "pgmlc"+      (hasArg (\f -> alterSettings (\s -> s { sPgm_lc  = (f,[])})))+  , make_ord_flag defFlag "pgmi"+      (hasArg (\f -> alterSettings (\s -> s { sPgm_i  =  f})))+  , make_ord_flag defFlag "pgmL"+      (hasArg (\f -> alterSettings (\s -> s { sPgm_L   = f})))+  , make_ord_flag defFlag "pgmP"+      (hasArg setPgmP)+  , make_ord_flag defFlag "pgmF"+      (hasArg (\f -> alterSettings (\s -> s { sPgm_F   = f})))+  , make_ord_flag defFlag "pgmc"+      (hasArg (\f -> alterSettings (\s -> s { sPgm_c   = (f,[]),+                                              -- Don't pass -no-pie with -pgmc+                                              -- (see #15319)+                                              sGccSupportsNoPie = False})))+  , make_ord_flag defFlag "pgms"+      (HasArg (\_ -> addWarn "Object splitting was removed in GHC 8.8"))+  , make_ord_flag defFlag "pgma"+      (hasArg (\f -> alterSettings (\s -> s { sPgm_a   = (f,[])})))+  , make_ord_flag defFlag "pgml"+      (hasArg (\f -> alterSettings (\s -> s { sPgm_l   = (f,[])})))+  , make_ord_flag defFlag "pgmdll"+      (hasArg (\f -> alterSettings (\s -> s { sPgm_dll = (f,[])})))+  , make_ord_flag defFlag "pgmwindres"+      (hasArg (\f -> alterSettings (\s -> s { sPgm_windres = f})))+  , make_ord_flag defFlag "pgmlibtool"+      (hasArg (\f -> alterSettings (\s -> s { sPgm_libtool = f})))+  , make_ord_flag defFlag "pgmar"+      (hasArg (\f -> alterSettings (\s -> s { sPgm_ar = f})))+  , make_ord_flag defFlag "pgmranlib"+      (hasArg (\f -> alterSettings (\s -> s { sPgm_ranlib = f})))+++    -- need to appear before -optl/-opta to be parsed as LLVM flags.+  , make_ord_flag defFlag "optlo"+      (hasArg (\f -> alterSettings (\s -> s { sOpt_lo  = f : sOpt_lo s})))+  , make_ord_flag defFlag "optlc"+      (hasArg (\f -> alterSettings (\s -> s { sOpt_lc  = f : sOpt_lc s})))+  , make_ord_flag defFlag "opti"+      (hasArg (\f -> alterSettings (\s -> s { sOpt_i   = f : sOpt_i s})))+  , make_ord_flag defFlag "optL"+      (hasArg (\f -> alterSettings (\s -> s { sOpt_L   = f : sOpt_L s})))+  , make_ord_flag defFlag "optP"+      (hasArg addOptP)+  , make_ord_flag defFlag "optF"+      (hasArg (\f -> alterSettings (\s -> s { sOpt_F   = f : sOpt_F s})))+  , make_ord_flag defFlag "optc"+      (hasArg addOptc)+  , make_ord_flag defFlag "opta"+      (hasArg (\f -> alterSettings (\s -> s { sOpt_a   = f : sOpt_a s})))+  , make_ord_flag defFlag "optl"+      (hasArg addOptl)+  , make_ord_flag defFlag "optwindres"+      (hasArg (\f ->+        alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s})))++  , make_ord_flag defGhcFlag "split-objs"+      (NoArg $ addWarn "ignoring -split-objs")++  , make_ord_flag defGhcFlag "split-sections"+      (noArgM (\dflags -> do+        if platformHasSubsectionsViaSymbols (targetPlatform dflags)+          then do addErr $+                    "-split-sections is not useful on this platform " +++                    "since it always uses subsections via symbols."+                  return dflags+          else return (gopt_set dflags Opt_SplitSections)))++        -------- ghc -M -----------------------------------------------------+  , make_ord_flag defGhcFlag "dep-suffix"              (hasArg addDepSuffix)+  , make_ord_flag defGhcFlag "dep-makefile"            (hasArg setDepMakefile)+  , make_ord_flag defGhcFlag "include-pkg-deps"+        (noArg (setDepIncludePkgDeps True))+  , make_ord_flag defGhcFlag "exclude-module"          (hasArg addDepExcludeMod)++        -------- Linking ----------------------------------------------------+  , make_ord_flag defGhcFlag "no-link"+        (noArg (\d -> d { ghcLink=NoLink }))+  , make_ord_flag defGhcFlag "shared"+        (noArg (\d -> d { ghcLink=LinkDynLib }))+  , make_ord_flag defGhcFlag "staticlib"+        (noArg (\d -> d { ghcLink=LinkStaticLib }))+  , make_ord_flag defGhcFlag "dynload"            (hasArg parseDynLibLoaderMode)+  , make_ord_flag defGhcFlag "dylib-install-name" (hasArg setDylibInstallName)++        ------- Libraries ---------------------------------------------------+  , make_ord_flag defFlag "L"   (Prefix addLibraryPath)+  , make_ord_flag defFlag "l"   (hasArg (addLdInputs . Option . ("-l" ++)))++        ------- Frameworks --------------------------------------------------+        -- -framework-path should really be -F ...+  , make_ord_flag defFlag "framework-path" (HasArg addFrameworkPath)+  , make_ord_flag defFlag "framework"      (hasArg addCmdlineFramework)++        ------- Output Redirection ------------------------------------------+  , make_ord_flag defGhcFlag "odir"              (hasArg setObjectDir)+  , make_ord_flag defGhcFlag "o"                 (sepArg (setOutputFile . Just))+  , make_ord_flag defGhcFlag "dyno"+        (sepArg (setDynOutputFile . Just))+  , make_ord_flag defGhcFlag "ohi"+        (hasArg (setOutputHi . Just ))+  , make_ord_flag defGhcFlag "osuf"              (hasArg setObjectSuf)+  , make_ord_flag defGhcFlag "dynosuf"           (hasArg setDynObjectSuf)+  , make_ord_flag defGhcFlag "hcsuf"             (hasArg setHcSuf)+  , make_ord_flag defGhcFlag "hisuf"             (hasArg setHiSuf)+  , make_ord_flag defGhcFlag "hiesuf"            (hasArg setHieSuf)+  , make_ord_flag defGhcFlag "dynhisuf"          (hasArg setDynHiSuf)+  , make_ord_flag defGhcFlag "hidir"             (hasArg setHiDir)+  , make_ord_flag defGhcFlag "hiedir"            (hasArg setHieDir)+  , make_ord_flag defGhcFlag "tmpdir"            (hasArg setTmpDir)+  , make_ord_flag defGhcFlag "stubdir"           (hasArg setStubDir)+  , make_ord_flag defGhcFlag "dumpdir"           (hasArg setDumpDir)+  , make_ord_flag defGhcFlag "outputdir"         (hasArg setOutputDir)+  , make_ord_flag defGhcFlag "ddump-file-prefix"+        (hasArg (setDumpPrefixForce . Just))++  , make_ord_flag defGhcFlag "dynamic-too"+        (NoArg (setGeneralFlag Opt_BuildDynamicToo))++        ------- Keeping temporary files -------------------------------------+     -- These can be singular (think ghc -c) or plural (think ghc --make)+  , make_ord_flag defGhcFlag "keep-hc-file"+        (NoArg (setGeneralFlag Opt_KeepHcFiles))+  , make_ord_flag defGhcFlag "keep-hc-files"+        (NoArg (setGeneralFlag Opt_KeepHcFiles))+  , make_ord_flag defGhcFlag "keep-hscpp-file"+        (NoArg (setGeneralFlag Opt_KeepHscppFiles))+  , make_ord_flag defGhcFlag "keep-hscpp-files"+        (NoArg (setGeneralFlag Opt_KeepHscppFiles))+  , make_ord_flag defGhcFlag "keep-s-file"+        (NoArg (setGeneralFlag Opt_KeepSFiles))+  , make_ord_flag defGhcFlag "keep-s-files"+        (NoArg (setGeneralFlag Opt_KeepSFiles))+  , make_ord_flag defGhcFlag "keep-llvm-file"+        (NoArg $ setObjTarget HscLlvm >> setGeneralFlag Opt_KeepLlvmFiles)+  , make_ord_flag defGhcFlag "keep-llvm-files"+        (NoArg $ setObjTarget HscLlvm >> setGeneralFlag Opt_KeepLlvmFiles)+     -- This only makes sense as plural+  , make_ord_flag defGhcFlag "keep-tmp-files"+        (NoArg (setGeneralFlag Opt_KeepTmpFiles))+  , make_ord_flag defGhcFlag "keep-hi-file"+        (NoArg (setGeneralFlag Opt_KeepHiFiles))+  , make_ord_flag defGhcFlag "no-keep-hi-file"+        (NoArg (unSetGeneralFlag Opt_KeepHiFiles))+  , make_ord_flag defGhcFlag "keep-hi-files"+        (NoArg (setGeneralFlag Opt_KeepHiFiles))+  , make_ord_flag defGhcFlag "no-keep-hi-files"+        (NoArg (unSetGeneralFlag Opt_KeepHiFiles))+  , make_ord_flag defGhcFlag "keep-o-file"+        (NoArg (setGeneralFlag Opt_KeepOFiles))+  , make_ord_flag defGhcFlag "no-keep-o-file"+        (NoArg (unSetGeneralFlag Opt_KeepOFiles))+  , make_ord_flag defGhcFlag "keep-o-files"+        (NoArg (setGeneralFlag Opt_KeepOFiles))+  , make_ord_flag defGhcFlag "no-keep-o-files"+        (NoArg (unSetGeneralFlag Opt_KeepOFiles))++        ------- Miscellaneous ----------------------------------------------+  , make_ord_flag defGhcFlag "no-auto-link-packages"+        (NoArg (unSetGeneralFlag Opt_AutoLinkPackages))+  , make_ord_flag defGhcFlag "no-hs-main"+        (NoArg (setGeneralFlag Opt_NoHsMain))+  , make_ord_flag defGhcFlag "fno-state-hack"+        (NoArg (setGeneralFlag Opt_G_NoStateHack))+  , make_ord_flag defGhcFlag "fno-opt-coercion"+        (NoArg (setGeneralFlag Opt_G_NoOptCoercion))+  , make_ord_flag defGhcFlag "with-rtsopts"+        (HasArg setRtsOpts)+  , make_ord_flag defGhcFlag "rtsopts"+        (NoArg (setRtsOptsEnabled RtsOptsAll))+  , make_ord_flag defGhcFlag "rtsopts=all"+        (NoArg (setRtsOptsEnabled RtsOptsAll))+  , make_ord_flag defGhcFlag "rtsopts=some"+        (NoArg (setRtsOptsEnabled RtsOptsSafeOnly))+  , make_ord_flag defGhcFlag "rtsopts=none"+        (NoArg (setRtsOptsEnabled RtsOptsNone))+  , make_ord_flag defGhcFlag "rtsopts=ignore"+        (NoArg (setRtsOptsEnabled RtsOptsIgnore))+  , make_ord_flag defGhcFlag "rtsopts=ignoreAll"+        (NoArg (setRtsOptsEnabled RtsOptsIgnoreAll))+  , make_ord_flag defGhcFlag "no-rtsopts"+        (NoArg (setRtsOptsEnabled RtsOptsNone))+  , make_ord_flag defGhcFlag "no-rtsopts-suggestions"+      (noArg (\d -> d {rtsOptsSuggestions = False}))+  , make_ord_flag defGhcFlag "dhex-word-literals"+        (NoArg (setGeneralFlag Opt_HexWordLiterals))++  , make_ord_flag defGhcFlag "ghcversion-file"      (hasArg addGhcVersionFile)+  , make_ord_flag defGhcFlag "main-is"              (SepArg setMainIs)+  , make_ord_flag defGhcFlag "haddock"              (NoArg (setGeneralFlag Opt_Haddock))+  , make_ord_flag defGhcFlag "haddock-opts"         (hasArg addHaddockOpts)+  , make_ord_flag defGhcFlag "hpcdir"               (SepArg setOptHpcDir)+  , make_ord_flag defGhciFlag "ghci-script"         (hasArg addGhciScript)+  , make_ord_flag defGhciFlag "interactive-print"   (hasArg setInteractivePrint)+  , make_ord_flag defGhcFlag "ticky-allocd"+        (NoArg (setGeneralFlag Opt_Ticky_Allocd))+  , make_ord_flag defGhcFlag "ticky-LNE"+        (NoArg (setGeneralFlag Opt_Ticky_LNE))+  , make_ord_flag defGhcFlag "ticky-dyn-thunk"+        (NoArg (setGeneralFlag Opt_Ticky_Dyn_Thunk))+        ------- recompilation checker --------------------------------------+  , make_dep_flag defGhcFlag "recomp"+        (NoArg $ unSetGeneralFlag Opt_ForceRecomp)+             "Use -fno-force-recomp instead"+  , make_dep_flag defGhcFlag "no-recomp"+        (NoArg $ setGeneralFlag Opt_ForceRecomp) "Use -fforce-recomp instead"+  , make_ord_flag defFlag "fmax-errors"+      (intSuffix (\n d -> d { maxErrors = Just (max 1 n) }))+  , make_ord_flag defFlag "fno-max-errors"+      (noArg (\d -> d { maxErrors = Nothing }))+  , make_ord_flag defFlag "freverse-errors"+        (noArg (\d -> d {reverseErrors = True} ))+  , make_ord_flag defFlag "fno-reverse-errors"+        (noArg (\d -> d {reverseErrors = False} ))++        ------ HsCpp opts ---------------------------------------------------+  , make_ord_flag defFlag "D"              (AnySuffix (upd . addOptP))+  , make_ord_flag defFlag "U"              (AnySuffix (upd . addOptP))++        ------- Include/Import Paths ----------------------------------------+  , make_ord_flag defFlag "I"              (Prefix    addIncludePath)+  , make_ord_flag defFlag "i"              (OptPrefix addImportPath)++        ------ Output style options -----------------------------------------+  , make_ord_flag defFlag "dppr-user-length" (intSuffix (\n d ->+                                                       d { pprUserLength = n }))+  , make_ord_flag defFlag "dppr-cols"        (intSuffix (\n d ->+                                                             d { pprCols = n }))+  , make_ord_flag defFlag "fdiagnostics-color=auto"+      (NoArg (upd (\d -> d { useColor = Auto })))+  , make_ord_flag defFlag "fdiagnostics-color=always"+      (NoArg (upd (\d -> d { useColor = Always })))+  , make_ord_flag defFlag "fdiagnostics-color=never"+      (NoArg (upd (\d -> d { useColor = Never })))++  -- Suppress all that is suppressable in core dumps.+  -- Except for uniques, as some simplifier phases introduce new variables that+  -- have otherwise identical names.+  , make_ord_flag defGhcFlag "dsuppress-all"+      (NoArg $ do setGeneralFlag Opt_SuppressCoercions+                  setGeneralFlag Opt_SuppressVarKinds+                  setGeneralFlag Opt_SuppressModulePrefixes+                  setGeneralFlag Opt_SuppressTypeApplications+                  setGeneralFlag Opt_SuppressIdInfo+                  setGeneralFlag Opt_SuppressTicks+                  setGeneralFlag Opt_SuppressStgExts+                  setGeneralFlag Opt_SuppressTypeSignatures+                  setGeneralFlag Opt_SuppressTimestamps)++        ------ Debugging ----------------------------------------------------+  , make_ord_flag defGhcFlag "dstg-stats"+        (NoArg (setGeneralFlag Opt_StgStats))++  , make_ord_flag defGhcFlag "ddump-cmm"+        (setDumpFlag Opt_D_dump_cmm)+  , make_ord_flag defGhcFlag "ddump-cmm-from-stg"+        (setDumpFlag Opt_D_dump_cmm_from_stg)+  , make_ord_flag defGhcFlag "ddump-cmm-raw"+        (setDumpFlag Opt_D_dump_cmm_raw)+  , make_ord_flag defGhcFlag "ddump-cmm-verbose"+        (setDumpFlag Opt_D_dump_cmm_verbose)+  , make_ord_flag defGhcFlag "ddump-cmm-cfg"+        (setDumpFlag Opt_D_dump_cmm_cfg)+  , make_ord_flag defGhcFlag "ddump-cmm-cbe"+        (setDumpFlag Opt_D_dump_cmm_cbe)+  , make_ord_flag defGhcFlag "ddump-cmm-switch"+        (setDumpFlag Opt_D_dump_cmm_switch)+  , make_ord_flag defGhcFlag "ddump-cmm-proc"+        (setDumpFlag Opt_D_dump_cmm_proc)+  , make_ord_flag defGhcFlag "ddump-cmm-sp"+        (setDumpFlag Opt_D_dump_cmm_sp)+  , make_ord_flag defGhcFlag "ddump-cmm-sink"+        (setDumpFlag Opt_D_dump_cmm_sink)+  , make_ord_flag defGhcFlag "ddump-cmm-caf"+        (setDumpFlag Opt_D_dump_cmm_caf)+  , make_ord_flag defGhcFlag "ddump-cmm-procmap"+        (setDumpFlag Opt_D_dump_cmm_procmap)+  , make_ord_flag defGhcFlag "ddump-cmm-split"+        (setDumpFlag Opt_D_dump_cmm_split)+  , make_ord_flag defGhcFlag "ddump-cmm-info"+        (setDumpFlag Opt_D_dump_cmm_info)+  , make_ord_flag defGhcFlag "ddump-cmm-cps"+        (setDumpFlag Opt_D_dump_cmm_cps)+  , make_ord_flag defGhcFlag "ddump-cfg-weights"+        (setDumpFlag Opt_D_dump_cfg_weights)+  , make_ord_flag defGhcFlag "ddump-core-stats"+        (setDumpFlag Opt_D_dump_core_stats)+  , make_ord_flag defGhcFlag "ddump-asm"+        (setDumpFlag Opt_D_dump_asm)+  , make_ord_flag defGhcFlag "ddump-asm-native"+        (setDumpFlag Opt_D_dump_asm_native)+  , make_ord_flag defGhcFlag "ddump-asm-liveness"+        (setDumpFlag Opt_D_dump_asm_liveness)+  , make_ord_flag defGhcFlag "ddump-asm-regalloc"+        (setDumpFlag Opt_D_dump_asm_regalloc)+  , make_ord_flag defGhcFlag "ddump-asm-conflicts"+        (setDumpFlag Opt_D_dump_asm_conflicts)+  , make_ord_flag defGhcFlag "ddump-asm-regalloc-stages"+        (setDumpFlag Opt_D_dump_asm_regalloc_stages)+  , make_ord_flag defGhcFlag "ddump-asm-stats"+        (setDumpFlag Opt_D_dump_asm_stats)+  , make_ord_flag defGhcFlag "ddump-asm-expanded"+        (setDumpFlag Opt_D_dump_asm_expanded)+  , make_ord_flag defGhcFlag "ddump-llvm"+        (NoArg $ setObjTarget HscLlvm >> setDumpFlag' Opt_D_dump_llvm)+  , make_ord_flag defGhcFlag "ddump-deriv"+        (setDumpFlag Opt_D_dump_deriv)+  , make_ord_flag defGhcFlag "ddump-ds"+        (setDumpFlag Opt_D_dump_ds)+  , make_ord_flag defGhcFlag "ddump-ds-preopt"+        (setDumpFlag Opt_D_dump_ds_preopt)+  , make_ord_flag defGhcFlag "ddump-foreign"+        (setDumpFlag Opt_D_dump_foreign)+  , make_ord_flag defGhcFlag "ddump-inlinings"+        (setDumpFlag Opt_D_dump_inlinings)+  , make_ord_flag defGhcFlag "ddump-rule-firings"+        (setDumpFlag Opt_D_dump_rule_firings)+  , make_ord_flag defGhcFlag "ddump-rule-rewrites"+        (setDumpFlag Opt_D_dump_rule_rewrites)+  , make_ord_flag defGhcFlag "ddump-simpl-trace"+        (setDumpFlag Opt_D_dump_simpl_trace)+  , make_ord_flag defGhcFlag "ddump-occur-anal"+        (setDumpFlag Opt_D_dump_occur_anal)+  , make_ord_flag defGhcFlag "ddump-parsed"+        (setDumpFlag Opt_D_dump_parsed)+  , make_ord_flag defGhcFlag "ddump-parsed-ast"+        (setDumpFlag Opt_D_dump_parsed_ast)+  , make_ord_flag defGhcFlag "ddump-rn"+        (setDumpFlag Opt_D_dump_rn)+  , make_ord_flag defGhcFlag "ddump-rn-ast"+        (setDumpFlag Opt_D_dump_rn_ast)+  , make_ord_flag defGhcFlag "ddump-simpl"+        (setDumpFlag Opt_D_dump_simpl)+  , make_ord_flag defGhcFlag "ddump-simpl-iterations"+      (setDumpFlag Opt_D_dump_simpl_iterations)+  , make_ord_flag defGhcFlag "ddump-spec"+        (setDumpFlag Opt_D_dump_spec)+  , make_ord_flag defGhcFlag "ddump-prep"+        (setDumpFlag Opt_D_dump_prep)+  , make_ord_flag defGhcFlag "ddump-stg"+        (setDumpFlag Opt_D_dump_stg)+  , make_ord_flag defGhcFlag "ddump-call-arity"+        (setDumpFlag Opt_D_dump_call_arity)+  , make_ord_flag defGhcFlag "ddump-exitify"+        (setDumpFlag Opt_D_dump_exitify)+  , make_ord_flag defGhcFlag "ddump-stranal"+        (setDumpFlag Opt_D_dump_stranal)+  , make_ord_flag defGhcFlag "ddump-str-signatures"+        (setDumpFlag Opt_D_dump_str_signatures)+  , make_ord_flag defGhcFlag "ddump-tc"+        (setDumpFlag Opt_D_dump_tc)+  , make_ord_flag defGhcFlag "ddump-tc-ast"+        (setDumpFlag Opt_D_dump_tc_ast)+  , make_ord_flag defGhcFlag "ddump-types"+        (setDumpFlag Opt_D_dump_types)+  , make_ord_flag defGhcFlag "ddump-rules"+        (setDumpFlag Opt_D_dump_rules)+  , make_ord_flag defGhcFlag "ddump-cse"+        (setDumpFlag Opt_D_dump_cse)+  , make_ord_flag defGhcFlag "ddump-worker-wrapper"+        (setDumpFlag Opt_D_dump_worker_wrapper)+  , make_ord_flag defGhcFlag "ddump-rn-trace"+        (setDumpFlag Opt_D_dump_rn_trace)+  , make_ord_flag defGhcFlag "ddump-shape"+        (setDumpFlag Opt_D_dump_shape)+  , make_ord_flag defGhcFlag "ddump-if-trace"+        (setDumpFlag Opt_D_dump_if_trace)+  , make_ord_flag defGhcFlag "ddump-cs-trace"+        (setDumpFlag Opt_D_dump_cs_trace)+  , make_ord_flag defGhcFlag "ddump-tc-trace"+        (NoArg (do setDumpFlag' Opt_D_dump_tc_trace+                   setDumpFlag' Opt_D_dump_cs_trace))+  , make_ord_flag defGhcFlag "ddump-ec-trace"+        (setDumpFlag Opt_D_dump_ec_trace)+  , make_ord_flag defGhcFlag "ddump-vt-trace"+        (setDumpFlag Opt_D_dump_vt_trace)+  , make_ord_flag defGhcFlag "ddump-splices"+        (setDumpFlag Opt_D_dump_splices)+  , make_ord_flag defGhcFlag "dth-dec-file"+        (setDumpFlag Opt_D_th_dec_file)++  , make_ord_flag defGhcFlag "ddump-rn-stats"+        (setDumpFlag Opt_D_dump_rn_stats)+  , make_ord_flag defGhcFlag "ddump-opt-cmm"+        (setDumpFlag Opt_D_dump_opt_cmm)+  , make_ord_flag defGhcFlag "ddump-simpl-stats"+        (setDumpFlag Opt_D_dump_simpl_stats)+  , make_ord_flag defGhcFlag "ddump-bcos"+        (setDumpFlag Opt_D_dump_BCOs)+  , make_ord_flag defGhcFlag "dsource-stats"+        (setDumpFlag Opt_D_source_stats)+  , make_ord_flag defGhcFlag "dverbose-core2core"+        (NoArg $ setVerbosity (Just 2) >> setVerboseCore2Core)+  , make_ord_flag defGhcFlag "dverbose-stg2stg"+        (setDumpFlag Opt_D_verbose_stg2stg)+  , make_ord_flag defGhcFlag "ddump-hi"+        (setDumpFlag Opt_D_dump_hi)+  , make_ord_flag defGhcFlag "ddump-minimal-imports"+        (NoArg (setGeneralFlag Opt_D_dump_minimal_imports))+  , make_ord_flag defGhcFlag "ddump-hpc"+        (setDumpFlag Opt_D_dump_ticked) -- back compat+  , make_ord_flag defGhcFlag "ddump-ticked"+        (setDumpFlag Opt_D_dump_ticked)+  , make_ord_flag defGhcFlag "ddump-mod-cycles"+        (setDumpFlag Opt_D_dump_mod_cycles)+  , make_ord_flag defGhcFlag "ddump-mod-map"+        (setDumpFlag Opt_D_dump_mod_map)+  , make_ord_flag defGhcFlag "ddump-timings"+        (setDumpFlag Opt_D_dump_timings)+  , make_ord_flag defGhcFlag "ddump-view-pattern-commoning"+        (setDumpFlag Opt_D_dump_view_pattern_commoning)+  , make_ord_flag defGhcFlag "ddump-to-file"+        (NoArg (setGeneralFlag Opt_DumpToFile))+  , make_ord_flag defGhcFlag "ddump-hi-diffs"+        (setDumpFlag Opt_D_dump_hi_diffs)+  , make_ord_flag defGhcFlag "ddump-rtti"+        (setDumpFlag Opt_D_dump_rtti)+  , make_ord_flag defGhcFlag "dcore-lint"+        (NoArg (setGeneralFlag Opt_DoCoreLinting))+  , make_ord_flag defGhcFlag "dstg-lint"+        (NoArg (setGeneralFlag Opt_DoStgLinting))+  , make_ord_flag defGhcFlag "dcmm-lint"+        (NoArg (setGeneralFlag Opt_DoCmmLinting))+  , make_ord_flag defGhcFlag "dasm-lint"+        (NoArg (setGeneralFlag Opt_DoAsmLinting))+  , make_ord_flag defGhcFlag "dannot-lint"+        (NoArg (setGeneralFlag Opt_DoAnnotationLinting))+  , make_ord_flag defGhcFlag "dshow-passes"+        (NoArg $ forceRecompile >> (setVerbosity $ Just 2))+  , make_ord_flag defGhcFlag "dfaststring-stats"+        (NoArg (setGeneralFlag Opt_D_faststring_stats))+  , make_ord_flag defGhcFlag "dno-llvm-mangler"+        (NoArg (setGeneralFlag Opt_NoLlvmMangler)) -- hidden flag+  , make_ord_flag defGhcFlag "fast-llvm"+        (NoArg (setGeneralFlag Opt_FastLlvm)) -- hidden flag+  , make_ord_flag defGhcFlag "ddump-debug"+        (setDumpFlag Opt_D_dump_debug)+  , make_ord_flag defGhcFlag "ddump-json"+        (noArg (flip dopt_set Opt_D_dump_json . setJsonLogAction ) )+  , make_ord_flag defGhcFlag "dppr-debug"+        (setDumpFlag Opt_D_ppr_debug)+  , make_ord_flag defGhcFlag "ddebug-output"+        (noArg (flip dopt_unset Opt_D_no_debug_output))+  , make_ord_flag defGhcFlag "dno-debug-output"+        (setDumpFlag Opt_D_no_debug_output)++        ------ Machine dependent (-m<blah>) stuff ---------------------------++  , make_ord_flag defGhcFlag "msse"         (noArg (\d ->+                                                  d { sseVersion = Just SSE1 }))+  , make_ord_flag defGhcFlag "msse2"        (noArg (\d ->+                                                  d { sseVersion = Just SSE2 }))+  , make_ord_flag defGhcFlag "msse3"        (noArg (\d ->+                                                  d { sseVersion = Just SSE3 }))+  , make_ord_flag defGhcFlag "msse4"        (noArg (\d ->+                                                  d { sseVersion = Just SSE4 }))+  , make_ord_flag defGhcFlag "msse4.2"      (noArg (\d ->+                                                 d { sseVersion = Just SSE42 }))+  , make_ord_flag defGhcFlag "mbmi"         (noArg (\d ->+                                                 d { bmiVersion = Just BMI1 }))+  , make_ord_flag defGhcFlag "mbmi2"        (noArg (\d ->+                                                 d { bmiVersion = Just BMI2 }))+  , make_ord_flag defGhcFlag "mavx"         (noArg (\d -> d { avx = True }))+  , make_ord_flag defGhcFlag "mavx2"        (noArg (\d -> d { avx2 = True }))+  , make_ord_flag defGhcFlag "mavx512cd"    (noArg (\d ->+                                                         d { avx512cd = True }))+  , make_ord_flag defGhcFlag "mavx512er"    (noArg (\d ->+                                                         d { avx512er = True }))+  , make_ord_flag defGhcFlag "mavx512f"     (noArg (\d -> d { avx512f = True }))+  , make_ord_flag defGhcFlag "mavx512pf"    (noArg (\d ->+                                                         d { avx512pf = True }))++     ------ Warning opts -------------------------------------------------+  , make_ord_flag defFlag "W"       (NoArg (mapM_ setWarningFlag minusWOpts))+  , make_ord_flag defFlag "Werror"+               (NoArg (do { setGeneralFlag Opt_WarnIsError+                          ; mapM_ setFatalWarningFlag minusWeverythingOpts   }))+  , make_ord_flag defFlag "Wwarn"+               (NoArg (do { unSetGeneralFlag Opt_WarnIsError+                          ; mapM_ unSetFatalWarningFlag minusWeverythingOpts }))+                          -- Opt_WarnIsError is still needed to pass -Werror+                          -- to CPP; see runCpp in SysTools+  , make_dep_flag defFlag "Wnot"    (NoArg (upd (\d ->+                                              d {warningFlags = EnumSet.empty})))+                                             "Use -w or -Wno-everything instead"+  , make_ord_flag defFlag "w"       (NoArg (upd (\d ->+                                              d {warningFlags = EnumSet.empty})))++     -- New-style uniform warning sets+     --+     -- Note that -Weverything > -Wall > -Wextra > -Wdefault > -Wno-everything+  , make_ord_flag defFlag "Weverything"    (NoArg (mapM_+                                           setWarningFlag minusWeverythingOpts))+  , make_ord_flag defFlag "Wno-everything"+                           (NoArg (upd (\d -> d {warningFlags = EnumSet.empty})))++  , make_ord_flag defFlag "Wall"           (NoArg (mapM_+                                                  setWarningFlag minusWallOpts))+  , make_ord_flag defFlag "Wno-all"        (NoArg (mapM_+                                                unSetWarningFlag minusWallOpts))++  , make_ord_flag defFlag "Wextra"         (NoArg (mapM_+                                                     setWarningFlag minusWOpts))+  , make_ord_flag defFlag "Wno-extra"      (NoArg (mapM_+                                                   unSetWarningFlag minusWOpts))++  , make_ord_flag defFlag "Wdefault"       (NoArg (mapM_+                                               setWarningFlag standardWarnings))+  , make_ord_flag defFlag "Wno-default"    (NoArg (mapM_+                                             unSetWarningFlag standardWarnings))++  , make_ord_flag defFlag "Wcompat"        (NoArg (mapM_+                                               setWarningFlag minusWcompatOpts))+  , make_ord_flag defFlag "Wno-compat"     (NoArg (mapM_+                                             unSetWarningFlag minusWcompatOpts))++        ------ Plugin flags ------------------------------------------------+  , make_ord_flag defGhcFlag "fplugin-opt" (hasArg addPluginModuleNameOption)+  , make_ord_flag defGhcFlag "fplugin-trustworthy"+      (NoArg (setGeneralFlag Opt_PluginTrustworthy))+  , make_ord_flag defGhcFlag "fplugin"     (hasArg addPluginModuleName)+  , make_ord_flag defGhcFlag "fclear-plugins" (noArg clearPluginModuleNames)+  , make_ord_flag defGhcFlag "ffrontend-opt" (hasArg addFrontendPluginOption)++        ------ Optimisation flags ------------------------------------------+  , make_dep_flag defGhcFlag "Onot"   (noArgM $ setOptLevel 0 )+                                                            "Use -O0 instead"+  , make_ord_flag defGhcFlag "O"      (optIntSuffixM (\mb_n ->+                                                setOptLevel (mb_n `orElse` 1)))+                -- If the number is missing, use 1++  , make_ord_flag defFlag "fbinary-blob-threshold"+      (intSuffix (\n d -> d { binBlobThreshold = fromIntegral n }))++  , make_ord_flag defFlag "fmax-relevant-binds"+      (intSuffix (\n d -> d { maxRelevantBinds = Just n }))+  , make_ord_flag defFlag "fno-max-relevant-binds"+      (noArg (\d -> d { maxRelevantBinds = Nothing }))++  , make_ord_flag defFlag "fmax-valid-hole-fits"+      (intSuffix (\n d -> d { maxValidHoleFits = Just n }))+  , make_ord_flag defFlag "fno-max-valid-hole-fits"+      (noArg (\d -> d { maxValidHoleFits = Nothing }))+  , make_ord_flag defFlag "fmax-refinement-hole-fits"+      (intSuffix (\n d -> d { maxRefHoleFits = Just n }))+  , make_ord_flag defFlag "fno-max-refinement-hole-fits"+      (noArg (\d -> d { maxRefHoleFits = Nothing }))+  , make_ord_flag defFlag "frefinement-level-hole-fits"+      (intSuffix (\n d -> d { refLevelHoleFits = Just n }))+  , make_ord_flag defFlag "fno-refinement-level-hole-fits"+      (noArg (\d -> d { refLevelHoleFits = Nothing }))++  , make_dep_flag defGhcFlag "fllvm-pass-vectors-in-regs"+            (noArg id)+            "vectors registers are now passed in registers by default."+  , make_ord_flag defFlag "fmax-uncovered-patterns"+      (intSuffix (\n d -> d { maxUncoveredPatterns = n }))+  , make_ord_flag defFlag "fsimplifier-phases"+      (intSuffix (\n d -> d { simplPhases = n }))+  , make_ord_flag defFlag "fmax-simplifier-iterations"+      (intSuffix (\n d -> d { maxSimplIterations = n }))+  , make_ord_flag defFlag "fmax-pmcheck-iterations"+      (intSuffix (\n d -> d{ maxPmCheckIterations = n }))+  , make_ord_flag defFlag "fsimpl-tick-factor"+      (intSuffix (\n d -> d { simplTickFactor = n }))+  , make_ord_flag defFlag "fspec-constr-threshold"+      (intSuffix (\n d -> d { specConstrThreshold = Just n }))+  , make_ord_flag defFlag "fno-spec-constr-threshold"+      (noArg (\d -> d { specConstrThreshold = Nothing }))+  , make_ord_flag defFlag "fspec-constr-count"+      (intSuffix (\n d -> d { specConstrCount = Just n }))+  , make_ord_flag defFlag "fno-spec-constr-count"+      (noArg (\d -> d { specConstrCount = Nothing }))+  , make_ord_flag defFlag "fspec-constr-recursive"+      (intSuffix (\n d -> d { specConstrRecursive = n }))+  , make_ord_flag defFlag "fliberate-case-threshold"+      (intSuffix (\n d -> d { liberateCaseThreshold = Just n }))+  , make_ord_flag defFlag "fno-liberate-case-threshold"+      (noArg (\d -> d { liberateCaseThreshold = Nothing }))+  , make_ord_flag defFlag "drule-check"+      (sepArg (\s d -> d { ruleCheck = Just s }))+  , make_ord_flag defFlag "dinline-check"+      (sepArg (\s d -> d { inlineCheck = Just s }))+  , make_ord_flag defFlag "freduction-depth"+      (intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n }))+  , make_ord_flag defFlag "fconstraint-solver-iterations"+      (intSuffix (\n d -> d { solverIterations = treatZeroAsInf n }))+  , (Deprecated, defFlag "fcontext-stack"+      (intSuffixM (\n d ->+       do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead"+          ; return $ d { reductionDepth = treatZeroAsInf n } })))+  , (Deprecated, defFlag "ftype-function-depth"+      (intSuffixM (\n d ->+       do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead"+          ; return $ d { reductionDepth = treatZeroAsInf n } })))+  , make_ord_flag defFlag "fstrictness-before"+      (intSuffix (\n d -> d { strictnessBefore = n : strictnessBefore d }))+  , make_ord_flag defFlag "ffloat-lam-args"+      (intSuffix (\n d -> d { floatLamArgs = Just n }))+  , make_ord_flag defFlag "ffloat-all-lams"+      (noArg (\d -> d { floatLamArgs = Nothing }))+  , make_ord_flag defFlag "fstg-lift-lams-rec-args"+      (intSuffix (\n d -> d { liftLamsRecArgs = Just n }))+  , make_ord_flag defFlag "fstg-lift-lams-rec-args-any"+      (noArg (\d -> d { liftLamsRecArgs = Nothing }))+  , make_ord_flag defFlag "fstg-lift-lams-non-rec-args"+      (intSuffix (\n d -> d { liftLamsRecArgs = Just n }))+  , make_ord_flag defFlag "fstg-lift-lams-non-rec-args-any"+      (noArg (\d -> d { liftLamsRecArgs = Nothing }))+  , make_ord_flag defFlag "fstg-lift-lams-known"+      (noArg (\d -> d { liftLamsKnown = True }))+  , make_ord_flag defFlag "fno-stg-lift-lams-known"+      (noArg (\d -> d { liftLamsKnown = False }))+  , make_ord_flag defFlag "fproc-alignment"+      (intSuffix (\n d -> d { cmmProcAlignment = Just n }))+  , make_ord_flag defFlag "fblock-layout-weights"+        (HasArg (\s ->+            upd (\d -> d { cfgWeightInfo =+                parseCfgWeights s (cfgWeightInfo d)})))+  , make_ord_flag defFlag "fhistory-size"+      (intSuffix (\n d -> d { historySize = n }))+  , make_ord_flag defFlag "funfolding-creation-threshold"+      (intSuffix   (\n d -> d {ufCreationThreshold = n}))+  , make_ord_flag defFlag "funfolding-use-threshold"+      (intSuffix   (\n d -> d {ufUseThreshold = n}))+  , make_ord_flag defFlag "funfolding-fun-discount"+      (intSuffix   (\n d -> d {ufFunAppDiscount = n}))+  , make_ord_flag defFlag "funfolding-dict-discount"+      (intSuffix   (\n d -> d {ufDictDiscount = n}))+  , make_ord_flag defFlag "funfolding-keeness-factor"+      (floatSuffix (\n d -> d {ufKeenessFactor = n}))+  , make_ord_flag defFlag "fmax-worker-args"+      (intSuffix (\n d -> d {maxWorkerArgs = n}))+  , make_ord_flag defGhciFlag "fghci-hist-size"+      (intSuffix (\n d -> d {ghciHistSize = n}))+  , make_ord_flag defGhcFlag "fmax-inline-alloc-size"+      (intSuffix (\n d -> d { maxInlineAllocSize = n }))+  , make_ord_flag defGhcFlag "fmax-inline-memcpy-insns"+      (intSuffix (\n d -> d { maxInlineMemcpyInsns = n }))+  , make_ord_flag defGhcFlag "fmax-inline-memset-insns"+      (intSuffix (\n d -> d { maxInlineMemsetInsns = n }))+  , make_ord_flag defGhcFlag "dinitial-unique"+      (intSuffix (\n d -> d { initialUnique = n }))+  , make_ord_flag defGhcFlag "dunique-increment"+      (intSuffix (\n d -> d { uniqueIncrement = n }))++        ------ Profiling ----------------------------------------------------++        -- OLD profiling flags+  , make_dep_flag defGhcFlag "auto-all"+                    (noArg (\d -> d { profAuto = ProfAutoAll } ))+                    "Use -fprof-auto instead"+  , make_dep_flag defGhcFlag "no-auto-all"+                    (noArg (\d -> d { profAuto = NoProfAuto } ))+                    "Use -fno-prof-auto instead"+  , make_dep_flag defGhcFlag "auto"+                    (noArg (\d -> d { profAuto = ProfAutoExports } ))+                    "Use -fprof-auto-exported instead"+  , make_dep_flag defGhcFlag "no-auto"+            (noArg (\d -> d { profAuto = NoProfAuto } ))+                    "Use -fno-prof-auto instead"+  , make_dep_flag defGhcFlag "caf-all"+            (NoArg (setGeneralFlag Opt_AutoSccsOnIndividualCafs))+                    "Use -fprof-cafs instead"+  , make_dep_flag defGhcFlag "no-caf-all"+            (NoArg (unSetGeneralFlag Opt_AutoSccsOnIndividualCafs))+                    "Use -fno-prof-cafs instead"++        -- NEW profiling flags+  , make_ord_flag defGhcFlag "fprof-auto"+      (noArg (\d -> d { profAuto = ProfAutoAll } ))+  , make_ord_flag defGhcFlag "fprof-auto-top"+      (noArg (\d -> d { profAuto = ProfAutoTop } ))+  , make_ord_flag defGhcFlag "fprof-auto-exported"+      (noArg (\d -> d { profAuto = ProfAutoExports } ))+  , make_ord_flag defGhcFlag "fprof-auto-calls"+      (noArg (\d -> d { profAuto = ProfAutoCalls } ))+  , make_ord_flag defGhcFlag "fno-prof-auto"+      (noArg (\d -> d { profAuto = NoProfAuto } ))++        ------ Compiler flags -----------------------------------------------++  , make_ord_flag defGhcFlag "fasm"             (NoArg (setObjTarget HscAsm))+  , make_ord_flag defGhcFlag "fvia-c"           (NoArg+         (deprecate $ "The -fvia-c flag does nothing; " +++                      "it will be removed in a future GHC release"))+  , make_ord_flag defGhcFlag "fvia-C"           (NoArg+         (deprecate $ "The -fvia-C flag does nothing; " +++                      "it will be removed in a future GHC release"))+  , make_ord_flag defGhcFlag "fllvm"            (NoArg (setObjTarget HscLlvm))++  , make_ord_flag defFlag "fno-code"         (NoArg ((upd $ \d ->+                  d { ghcLink=NoLink }) >> setTarget HscNothing))+  , make_ord_flag defFlag "fbyte-code"       (NoArg (setTarget HscInterpreted))+  , make_ord_flag defFlag "fobject-code"     (NoArg (setTargetWithPlatform+                                                             defaultHscTarget))+  , make_dep_flag defFlag "fglasgow-exts"+      (NoArg enableGlasgowExts) "Use individual extensions instead"+  , make_dep_flag defFlag "fno-glasgow-exts"+      (NoArg disableGlasgowExts) "Use individual extensions instead"+  , make_ord_flag defFlag "Wunused-binds" (NoArg enableUnusedBinds)+  , make_ord_flag defFlag "Wno-unused-binds" (NoArg disableUnusedBinds)+  , make_ord_flag defHiddenFlag "fwarn-unused-binds" (NoArg enableUnusedBinds)+  , make_ord_flag defHiddenFlag "fno-warn-unused-binds" (NoArg+                                                            disableUnusedBinds)++        ------ Safe Haskell flags -------------------------------------------+  , make_ord_flag defFlag "fpackage-trust"   (NoArg setPackageTrust)+  , make_ord_flag defFlag "fno-safe-infer"   (noArg (\d ->+                                                    d { safeInfer = False }))+  , make_ord_flag defFlag "fno-safe-haskell" (NoArg (setSafeHaskell Sf_Ignore))+  , make_ord_flag defGhcFlag "fPIC"          (NoArg (setGeneralFlag Opt_PIC))+  , make_ord_flag defGhcFlag "fno-PIC"       (NoArg (unSetGeneralFlag Opt_PIC))+  , make_ord_flag defGhcFlag "fPIE"          (NoArg (setGeneralFlag Opt_PIC))+  , make_ord_flag defGhcFlag "fno-PIE"       (NoArg (unSetGeneralFlag Opt_PIC))++         ------ Debugging flags ----------------------------------------------+  , make_ord_flag defGhcFlag "g"             (OptIntSuffix setDebugLevel)+ ]+ ++ map (mkFlag turnOn  ""          setGeneralFlag    ) negatableFlagsDeps+ ++ map (mkFlag turnOff "no-"       unSetGeneralFlag  ) negatableFlagsDeps+ ++ map (mkFlag turnOn  "d"         setGeneralFlag    ) dFlagsDeps+ ++ map (mkFlag turnOff "dno-"      unSetGeneralFlag  ) dFlagsDeps+ ++ map (mkFlag turnOn  "f"         setGeneralFlag    ) fFlagsDeps+ ++ map (mkFlag turnOff "fno-"      unSetGeneralFlag  ) fFlagsDeps+ ++ map (mkFlag turnOn  "W"         setWarningFlag    ) wWarningFlagsDeps+ ++ map (mkFlag turnOff "Wno-"      unSetWarningFlag  ) wWarningFlagsDeps+ ++ map (mkFlag turnOn  "Werror="   setWErrorFlag )     wWarningFlagsDeps+ ++ map (mkFlag turnOn  "Wwarn="     unSetFatalWarningFlag )+                                                        wWarningFlagsDeps+ ++ map (mkFlag turnOn  "Wno-error=" unSetFatalWarningFlag )+                                                        wWarningFlagsDeps+ ++ map (mkFlag turnOn  "fwarn-"    setWarningFlag   . hideFlag)+    wWarningFlagsDeps+ ++ map (mkFlag turnOff "fno-warn-" unSetWarningFlag . hideFlag)+    wWarningFlagsDeps+ ++ [ (NotDeprecated, unrecognisedWarning "W"),+      (Deprecated,    unrecognisedWarning "fwarn-"),+      (Deprecated,    unrecognisedWarning "fno-warn-") ]+ ++ [ make_ord_flag defFlag "Werror=compat"+        (NoArg (mapM_ setWErrorFlag minusWcompatOpts))+    , make_ord_flag defFlag "Wno-error=compat"+        (NoArg (mapM_ unSetFatalWarningFlag minusWcompatOpts))+    , make_ord_flag defFlag "Wwarn=compat"+        (NoArg (mapM_ unSetFatalWarningFlag minusWcompatOpts)) ]+ ++ map (mkFlag turnOn  "f"         setExtensionFlag  ) fLangFlagsDeps+ ++ map (mkFlag turnOff "fno-"      unSetExtensionFlag) fLangFlagsDeps+ ++ map (mkFlag turnOn  "X"         setExtensionFlag  ) xFlagsDeps+ ++ map (mkFlag turnOff "XNo"       unSetExtensionFlag) xFlagsDeps+ ++ map (mkFlag turnOn  "X"         setLanguage       ) languageFlagsDeps+ ++ map (mkFlag turnOn  "X"         setSafeHaskell    ) safeHaskellFlagsDeps+ ++ [ make_dep_flag defFlag "XGenerics"+        (NoArg $ return ())+                  ("it does nothing; look into -XDefaultSignatures " +++                   "and -XDeriveGeneric for generic programming support.")+    , make_dep_flag defFlag "XNoGenerics"+        (NoArg $ return ())+               ("it does nothing; look into -XDefaultSignatures and " +++                  "-XDeriveGeneric for generic programming support.") ]++-- | This is where we handle unrecognised warning flags. We only issue a warning+-- if -Wunrecognised-warning-flags is set. See #11429 for context.+unrecognisedWarning :: String -> Flag (CmdLineP DynFlags)+unrecognisedWarning prefix = defHiddenFlag prefix (Prefix action)+  where+    action :: String -> EwM (CmdLineP DynFlags) ()+    action flag = do+      f <- wopt Opt_WarnUnrecognisedWarningFlags <$> liftEwM getCmdLineState+      when f $ addFlagWarn Cmd.ReasonUnrecognisedFlag $+        "unrecognised warning flag: -" ++ prefix ++ flag++-- See Note [Supporting CLI completion]+package_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))]+package_flags_deps = [+        ------- Packages ----------------------------------------------------+    make_ord_flag defFlag "package-db"+      (HasArg (addPkgConfRef . PkgConfFile))+  , make_ord_flag defFlag "clear-package-db"      (NoArg clearPkgConf)+  , make_ord_flag defFlag "no-global-package-db"  (NoArg removeGlobalPkgConf)+  , make_ord_flag defFlag "no-user-package-db"    (NoArg removeUserPkgConf)+  , make_ord_flag defFlag "global-package-db"+      (NoArg (addPkgConfRef GlobalPkgConf))+  , make_ord_flag defFlag "user-package-db"+      (NoArg (addPkgConfRef UserPkgConf))+    -- backwards compat with GHC<=7.4 :+  , make_dep_flag defFlag "package-conf"+      (HasArg $ addPkgConfRef . PkgConfFile) "Use -package-db instead"+  , make_dep_flag defFlag "no-user-package-conf"+      (NoArg removeUserPkgConf)              "Use -no-user-package-db instead"+  , make_ord_flag defGhcFlag "package-name"       (HasArg $ \name -> do+                                      upd (setUnitId name))+                                      -- TODO: Since we JUST deprecated+                                      -- -this-package-key, let's keep this+                                      -- undeprecated for another cycle.+                                      -- Deprecate this eventually.+                                      -- deprecate "Use -this-unit-id instead")+  , make_dep_flag defGhcFlag "this-package-key"   (HasArg $ upd . setUnitId)+                                                  "Use -this-unit-id instead"+  , make_ord_flag defGhcFlag "this-unit-id"       (hasArg setUnitId)+  , make_ord_flag defFlag "package"               (HasArg exposePackage)+  , make_ord_flag defFlag "plugin-package-id"     (HasArg exposePluginPackageId)+  , make_ord_flag defFlag "plugin-package"        (HasArg exposePluginPackage)+  , make_ord_flag defFlag "package-id"            (HasArg exposePackageId)+  , make_ord_flag defFlag "hide-package"          (HasArg hidePackage)+  , make_ord_flag defFlag "hide-all-packages"+      (NoArg (setGeneralFlag Opt_HideAllPackages))+  , make_ord_flag defFlag "hide-all-plugin-packages"+      (NoArg (setGeneralFlag Opt_HideAllPluginPackages))+  , make_ord_flag defFlag "package-env"           (HasArg setPackageEnv)+  , make_ord_flag defFlag "ignore-package"        (HasArg ignorePackage)+  , make_dep_flag defFlag "syslib" (HasArg exposePackage) "Use -package instead"+  , make_ord_flag defFlag "distrust-all-packages"+      (NoArg (setGeneralFlag Opt_DistrustAllPackages))+  , make_ord_flag defFlag "trust"                 (HasArg trustPackage)+  , make_ord_flag defFlag "distrust"              (HasArg distrustPackage)+  ]+  where+    setPackageEnv env = upd $ \s -> s { packageEnv = Just env }++-- | Make a list of flags for shell completion.+-- Filter all available flags into two groups, for interactive GHC vs all other.+flagsForCompletion :: Bool -> [String]+flagsForCompletion isInteractive+    = [ '-':flagName flag+      | flag <- flagsAll+      , modeFilter (flagGhcMode flag)+      ]+    where+      modeFilter AllModes = True+      modeFilter OnlyGhci = isInteractive+      modeFilter OnlyGhc = not isInteractive+      modeFilter HiddenFlag = False++type TurnOnFlag = Bool   -- True  <=> we are turning the flag on+                         -- False <=> we are turning the flag off+turnOn  :: TurnOnFlag; turnOn  = True+turnOff :: TurnOnFlag; turnOff = False++data FlagSpec flag+   = FlagSpec+       { flagSpecName :: String   -- ^ Flag in string form+       , flagSpecFlag :: flag     -- ^ Flag in internal form+       , flagSpecAction :: (TurnOnFlag -> DynP ())+           -- ^ Extra action to run when the flag is found+           -- Typically, emit a warning or error+       , flagSpecGhcMode :: GhcFlagMode+           -- ^ In which ghc mode the flag has effect+       }++-- | Define a new flag.+flagSpec :: String -> flag -> (Deprecation, FlagSpec flag)+flagSpec name flag = flagSpec' name flag nop++-- | Define a new flag with an effect.+flagSpec' :: String -> flag -> (TurnOnFlag -> DynP ())+          -> (Deprecation, FlagSpec flag)+flagSpec' name flag act = (NotDeprecated, FlagSpec name flag act AllModes)++-- | Define a new deprecated flag with an effect.+depFlagSpecOp :: String -> flag -> (TurnOnFlag -> DynP ()) -> String+            -> (Deprecation, FlagSpec flag)+depFlagSpecOp name flag act dep =+    (Deprecated, snd (flagSpec' name flag (\f -> act f >> deprecate dep)))++-- | Define a new deprecated flag.+depFlagSpec :: String -> flag -> String+            -> (Deprecation, FlagSpec flag)+depFlagSpec name flag dep = depFlagSpecOp name flag nop dep++-- | Define a new deprecated flag with an effect where the deprecation message+-- depends on the flag value+depFlagSpecOp' :: String+             -> flag+             -> (TurnOnFlag -> DynP ())+             -> (TurnOnFlag -> String)+             -> (Deprecation, FlagSpec flag)+depFlagSpecOp' name flag act dep =+    (Deprecated, FlagSpec name flag (\f -> act f >> (deprecate $ dep f))+                                                                       AllModes)++-- | Define a new deprecated flag where the deprecation message+-- depends on the flag value+depFlagSpec' :: String+             -> flag+             -> (TurnOnFlag -> String)+             -> (Deprecation, FlagSpec flag)+depFlagSpec' name flag dep = depFlagSpecOp' name flag nop dep+++-- | Define a new deprecated flag where the deprecation message+-- is shown depending on the flag value+depFlagSpecCond :: String+                -> flag+                -> (TurnOnFlag -> Bool)+                -> String+                -> (Deprecation, FlagSpec flag)+depFlagSpecCond name flag cond dep =+    (Deprecated, FlagSpec name flag (\f -> when (cond f) $ deprecate dep)+                                                                       AllModes)++-- | Define a new flag for GHCi.+flagGhciSpec :: String -> flag -> (Deprecation, FlagSpec flag)+flagGhciSpec name flag = flagGhciSpec' name flag nop++-- | Define a new flag for GHCi with an effect.+flagGhciSpec' :: String -> flag -> (TurnOnFlag -> DynP ())+              -> (Deprecation, FlagSpec flag)+flagGhciSpec' name flag act = (NotDeprecated, FlagSpec name flag act OnlyGhci)++-- | Define a new flag invisible to CLI completion.+flagHiddenSpec :: String -> flag -> (Deprecation, FlagSpec flag)+flagHiddenSpec name flag = flagHiddenSpec' name flag nop++-- | Define a new flag invisible to CLI completion with an effect.+flagHiddenSpec' :: String -> flag -> (TurnOnFlag -> DynP ())+                -> (Deprecation, FlagSpec flag)+flagHiddenSpec' name flag act = (NotDeprecated, FlagSpec name flag act+                                                                     HiddenFlag)++-- | Hide a 'FlagSpec' from being displayed in @--show-options@.+--+-- This is for example useful for flags that are obsolete, but should not+-- (yet) be deprecated for compatibility reasons.+hideFlag :: (Deprecation, FlagSpec a) -> (Deprecation, FlagSpec a)+hideFlag (dep, fs) = (dep, fs { flagSpecGhcMode = HiddenFlag })++mkFlag :: TurnOnFlag            -- ^ True <=> it should be turned on+       -> String                -- ^ The flag prefix+       -> (flag -> DynP ())     -- ^ What to do when the flag is found+       -> (Deprecation, FlagSpec flag)  -- ^ Specification of+                                        -- this particular flag+       -> (Deprecation, Flag (CmdLineP DynFlags))+mkFlag turn_on flagPrefix f (dep, (FlagSpec name flag extra_action mode))+    = (dep,+       Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turn_on)) mode)++deprecatedForExtension :: String -> TurnOnFlag -> String+deprecatedForExtension lang turn_on+    = "use -X" ++ flag +++      " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead"+    where+      flag | turn_on   = lang+           | otherwise = "No" ++ lang++useInstead :: String -> String -> TurnOnFlag -> String+useInstead prefix flag turn_on+  = "Use " ++ prefix ++ no ++ flag ++ " instead"+  where+    no = if turn_on then "" else "no-"++nop :: TurnOnFlag -> DynP ()+nop _ = return ()++-- | Find the 'FlagSpec' for a 'WarningFlag'.+flagSpecOf :: WarningFlag -> Maybe (FlagSpec WarningFlag)+flagSpecOf flag = listToMaybe $ filter check wWarningFlags+  where+    check fs = flagSpecFlag fs == flag++-- | These @-W\<blah\>@ flags can all be reversed with @-Wno-\<blah\>@+wWarningFlags :: [FlagSpec WarningFlag]+wWarningFlags = map snd (sortBy (comparing fst) wWarningFlagsDeps)++wWarningFlagsDeps :: [(Deprecation, FlagSpec WarningFlag)]+wWarningFlagsDeps = [+-- See Note [Updating flag description in the User's Guide]+-- See Note [Supporting CLI completion]+-- Please keep the list of flags below sorted alphabetically+  flagSpec "alternative-layout-rule-transitional"+                                      Opt_WarnAlternativeLayoutRuleTransitional,+  depFlagSpec "auto-orphans"             Opt_WarnAutoOrphans+    "it has no effect",+  flagSpec "cpp-undef"                   Opt_WarnCPPUndef,+  flagSpec "unbanged-strict-patterns"    Opt_WarnUnbangedStrictPatterns,+  flagSpec "deferred-type-errors"        Opt_WarnDeferredTypeErrors,+  flagSpec "deferred-out-of-scope-variables"+                                         Opt_WarnDeferredOutOfScopeVariables,+  flagSpec "deprecations"                Opt_WarnWarningsDeprecations,+  flagSpec "deprecated-flags"            Opt_WarnDeprecatedFlags,+  flagSpec "deriving-typeable"           Opt_WarnDerivingTypeable,+  flagSpec "dodgy-exports"               Opt_WarnDodgyExports,+  flagSpec "dodgy-foreign-imports"       Opt_WarnDodgyForeignImports,+  flagSpec "dodgy-imports"               Opt_WarnDodgyImports,+  flagSpec "empty-enumerations"          Opt_WarnEmptyEnumerations,+  depFlagSpec "duplicate-constraints"    Opt_WarnDuplicateConstraints+    "it is subsumed by -Wredundant-constraints",+  flagSpec "redundant-constraints"       Opt_WarnRedundantConstraints,+  flagSpec "duplicate-exports"           Opt_WarnDuplicateExports,+  flagSpec "hi-shadowing"                Opt_WarnHiShadows,+  flagSpec "inaccessible-code"           Opt_WarnInaccessibleCode,+  flagSpec "implicit-prelude"            Opt_WarnImplicitPrelude,+  depFlagSpec "implicit-kind-vars"       Opt_WarnImplicitKindVars+    "it is now an error",+  flagSpec "incomplete-patterns"         Opt_WarnIncompletePatterns,+  flagSpec "incomplete-record-updates"   Opt_WarnIncompletePatternsRecUpd,+  flagSpec "incomplete-uni-patterns"     Opt_WarnIncompleteUniPatterns,+  flagSpec "inline-rule-shadowing"       Opt_WarnInlineRuleShadowing,+  flagSpec "identities"                  Opt_WarnIdentities,+  flagSpec "missing-fields"              Opt_WarnMissingFields,+  flagSpec "missing-import-lists"        Opt_WarnMissingImportList,+  flagSpec "missing-export-lists"        Opt_WarnMissingExportList,+  depFlagSpec "missing-local-sigs"       Opt_WarnMissingLocalSignatures+    "it is replaced by -Wmissing-local-signatures",+  flagSpec "missing-local-signatures"    Opt_WarnMissingLocalSignatures,+  flagSpec "missing-methods"             Opt_WarnMissingMethods,+  flagSpec "missing-monadfail-instances" Opt_WarnMissingMonadFailInstances,+  flagSpec "semigroup"                   Opt_WarnSemigroup,+  flagSpec "missing-signatures"          Opt_WarnMissingSignatures,+  depFlagSpec "missing-exported-sigs"    Opt_WarnMissingExportedSignatures+    "it is replaced by -Wmissing-exported-signatures",+  flagSpec "missing-exported-signatures" Opt_WarnMissingExportedSignatures,+  flagSpec "monomorphism-restriction"    Opt_WarnMonomorphism,+  flagSpec "name-shadowing"              Opt_WarnNameShadowing,+  flagSpec "noncanonical-monad-instances"+                                         Opt_WarnNonCanonicalMonadInstances,+  depFlagSpec "noncanonical-monadfail-instances"+                                         Opt_WarnNonCanonicalMonadInstances+    "fail is no longer a method of Monad",+  flagSpec "noncanonical-monoid-instances"+                                         Opt_WarnNonCanonicalMonoidInstances,+  flagSpec "orphans"                     Opt_WarnOrphans,+  flagSpec "overflowed-literals"         Opt_WarnOverflowedLiterals,+  flagSpec "overlapping-patterns"        Opt_WarnOverlappingPatterns,+  flagSpec "missed-specialisations"      Opt_WarnMissedSpecs,+  flagSpec "missed-specializations"      Opt_WarnMissedSpecs,+  flagSpec "all-missed-specialisations"  Opt_WarnAllMissedSpecs,+  flagSpec "all-missed-specializations"  Opt_WarnAllMissedSpecs,+  flagSpec' "safe"                       Opt_WarnSafe setWarnSafe,+  flagSpec "trustworthy-safe"            Opt_WarnTrustworthySafe,+  flagSpec "tabs"                        Opt_WarnTabs,+  flagSpec "type-defaults"               Opt_WarnTypeDefaults,+  flagSpec "typed-holes"                 Opt_WarnTypedHoles,+  flagSpec "partial-type-signatures"     Opt_WarnPartialTypeSignatures,+  flagSpec "unrecognised-pragmas"        Opt_WarnUnrecognisedPragmas,+  flagSpec' "unsafe"                     Opt_WarnUnsafe setWarnUnsafe,+  flagSpec "unsupported-calling-conventions"+                                         Opt_WarnUnsupportedCallingConventions,+  flagSpec "unsupported-llvm-version"    Opt_WarnUnsupportedLlvmVersion,+  flagSpec "missed-extra-shared-lib"     Opt_WarnMissedExtraSharedLib,+  flagSpec "unticked-promoted-constructors"+                                         Opt_WarnUntickedPromotedConstructors,+  flagSpec "unused-do-bind"              Opt_WarnUnusedDoBind,+  flagSpec "unused-foralls"              Opt_WarnUnusedForalls,+  flagSpec "unused-imports"              Opt_WarnUnusedImports,+  flagSpec "unused-local-binds"          Opt_WarnUnusedLocalBinds,+  flagSpec "unused-matches"              Opt_WarnUnusedMatches,+  flagSpec "unused-pattern-binds"        Opt_WarnUnusedPatternBinds,+  flagSpec "unused-top-binds"            Opt_WarnUnusedTopBinds,+  flagSpec "unused-type-patterns"        Opt_WarnUnusedTypePatterns,+  flagSpec "unused-record-wildcards"     Opt_WarnUnusedRecordWildcards,+  flagSpec "redundant-record-wildcards"  Opt_WarnRedundantRecordWildcards,+  flagSpec "warnings-deprecations"       Opt_WarnWarningsDeprecations,+  flagSpec "wrong-do-bind"               Opt_WarnWrongDoBind,+  flagSpec "missing-pattern-synonym-signatures"+                                    Opt_WarnMissingPatternSynonymSignatures,+  flagSpec "missing-deriving-strategies" Opt_WarnMissingDerivingStrategies,+  flagSpec "simplifiable-class-constraints" Opt_WarnSimplifiableClassConstraints,+  flagSpec "missing-home-modules"        Opt_WarnMissingHomeModules,+  flagSpec "unrecognised-warning-flags"  Opt_WarnUnrecognisedWarningFlags,+  flagSpec "star-binder"                 Opt_WarnStarBinder,+  flagSpec "star-is-type"                Opt_WarnStarIsType,+  flagSpec "missing-space-after-bang"    Opt_WarnSpaceAfterBang,+  flagSpec "partial-fields"              Opt_WarnPartialFields ]++-- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@+negatableFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]+negatableFlagsDeps = [+  flagGhciSpec "ignore-dot-ghci"         Opt_IgnoreDotGhci ]++-- | These @-d\<blah\>@ flags can all be reversed with @-dno-\<blah\>@+dFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]+dFlagsDeps = [+-- See Note [Updating flag description in the User's Guide]+-- See Note [Supporting CLI completion]+-- Please keep the list of flags below sorted alphabetically+  flagSpec "ppr-case-as-let"            Opt_PprCaseAsLet,+  depFlagSpec' "ppr-ticks"              Opt_PprShowTicks+     (\turn_on -> useInstead "-d" "suppress-ticks" (not turn_on)),+  flagSpec "suppress-ticks"             Opt_SuppressTicks,+  depFlagSpec' "suppress-stg-free-vars" Opt_SuppressStgExts+     (useInstead "-d" "suppress-stg-exts"),+  flagSpec "suppress-stg-exts"          Opt_SuppressStgExts,+  flagSpec "suppress-coercions"         Opt_SuppressCoercions,+  flagSpec "suppress-idinfo"            Opt_SuppressIdInfo,+  flagSpec "suppress-unfoldings"        Opt_SuppressUnfoldings,+  flagSpec "suppress-module-prefixes"   Opt_SuppressModulePrefixes,+  flagSpec "suppress-timestamps"        Opt_SuppressTimestamps,+  flagSpec "suppress-type-applications" Opt_SuppressTypeApplications,+  flagSpec "suppress-type-signatures"   Opt_SuppressTypeSignatures,+  flagSpec "suppress-uniques"           Opt_SuppressUniques,+  flagSpec "suppress-var-kinds"         Opt_SuppressVarKinds+  ]++-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@+fFlags :: [FlagSpec GeneralFlag]+fFlags = map snd fFlagsDeps++fFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]+fFlagsDeps = [+-- See Note [Updating flag description in the User's Guide]+-- See Note [Supporting CLI completion]+-- Please keep the list of flags below sorted alphabetically+  flagSpec "asm-shortcutting"                 Opt_AsmShortcutting,+  flagGhciSpec "break-on-error"               Opt_BreakOnError,+  flagGhciSpec "break-on-exception"           Opt_BreakOnException,+  flagSpec "building-cabal-package"           Opt_BuildingCabalPackage,+  flagSpec "call-arity"                       Opt_CallArity,+  flagSpec "exitification"                    Opt_Exitification,+  flagSpec "case-merge"                       Opt_CaseMerge,+  flagSpec "case-folding"                     Opt_CaseFolding,+  flagSpec "cmm-elim-common-blocks"           Opt_CmmElimCommonBlocks,+  flagSpec "cmm-sink"                         Opt_CmmSink,+  flagSpec "cse"                              Opt_CSE,+  flagSpec "stg-cse"                          Opt_StgCSE,+  flagSpec "stg-lift-lams"                    Opt_StgLiftLams,+  flagSpec "cpr-anal"                         Opt_CprAnal,+  flagSpec "defer-diagnostics"                Opt_DeferDiagnostics,+  flagSpec "defer-type-errors"                Opt_DeferTypeErrors,+  flagSpec "defer-typed-holes"                Opt_DeferTypedHoles,+  flagSpec "defer-out-of-scope-variables"     Opt_DeferOutOfScopeVariables,+  flagSpec "diagnostics-show-caret"           Opt_DiagnosticsShowCaret,+  flagSpec "dicts-cheap"                      Opt_DictsCheap,+  flagSpec "dicts-strict"                     Opt_DictsStrict,+  flagSpec "dmd-tx-dict-sel"                  Opt_DmdTxDictSel,+  flagSpec "do-eta-reduction"                 Opt_DoEtaReduction,+  flagSpec "do-lambda-eta-expansion"          Opt_DoLambdaEtaExpansion,+  flagSpec "eager-blackholing"                Opt_EagerBlackHoling,+  flagSpec "embed-manifest"                   Opt_EmbedManifest,+  flagSpec "enable-rewrite-rules"             Opt_EnableRewriteRules,+  flagSpec "error-spans"                      Opt_ErrorSpans,+  flagSpec "excess-precision"                 Opt_ExcessPrecision,+  flagSpec "expose-all-unfoldings"            Opt_ExposeAllUnfoldings,+  flagSpec "external-dynamic-refs"            Opt_ExternalDynamicRefs,+  flagSpec "external-interpreter"             Opt_ExternalInterpreter,+  flagSpec "flat-cache"                       Opt_FlatCache,+  flagSpec "float-in"                         Opt_FloatIn,+  flagSpec "force-recomp"                     Opt_ForceRecomp,+  flagSpec "ignore-optim-changes"             Opt_IgnoreOptimChanges,+  flagSpec "ignore-hpc-changes"               Opt_IgnoreHpcChanges,+  flagSpec "full-laziness"                    Opt_FullLaziness,+  flagSpec "fun-to-thunk"                     Opt_FunToThunk,+  flagSpec "gen-manifest"                     Opt_GenManifest,+  flagSpec "ghci-history"                     Opt_GhciHistory,+  flagSpec "ghci-leak-check"                  Opt_GhciLeakCheck,+  flagSpec "validate-ide-info"                Opt_ValidateHie,+  flagGhciSpec "local-ghci-history"           Opt_LocalGhciHistory,+  flagGhciSpec "no-it"                        Opt_NoIt,+  flagSpec "ghci-sandbox"                     Opt_GhciSandbox,+  flagSpec "helpful-errors"                   Opt_HelpfulErrors,+  flagSpec "hpc"                              Opt_Hpc,+  flagSpec "ignore-asserts"                   Opt_IgnoreAsserts,+  flagSpec "ignore-interface-pragmas"         Opt_IgnoreInterfacePragmas,+  flagGhciSpec "implicit-import-qualified"    Opt_ImplicitImportQualified,+  flagSpec "irrefutable-tuples"               Opt_IrrefutableTuples,+  flagSpec "kill-absence"                     Opt_KillAbsence,+  flagSpec "kill-one-shot"                    Opt_KillOneShot,+  flagSpec "late-dmd-anal"                    Opt_LateDmdAnal,+  flagSpec "late-specialise"                  Opt_LateSpecialise,+  flagSpec "liberate-case"                    Opt_LiberateCase,+  flagHiddenSpec "llvm-tbaa"                  Opt_LlvmTBAA,+  flagHiddenSpec "llvm-fill-undef-with-garbage" Opt_LlvmFillUndefWithGarbage,+  flagSpec "loopification"                    Opt_Loopification,+  flagSpec "block-layout-cfg"                 Opt_CfgBlocklayout,+  flagSpec "block-layout-weightless"          Opt_WeightlessBlocklayout,+  flagSpec "omit-interface-pragmas"           Opt_OmitInterfacePragmas,+  flagSpec "omit-yields"                      Opt_OmitYields,+  flagSpec "optimal-applicative-do"           Opt_OptimalApplicativeDo,+  flagSpec "pedantic-bottoms"                 Opt_PedanticBottoms,+  flagSpec "pre-inlining"                     Opt_SimplPreInlining,+  flagGhciSpec "print-bind-contents"          Opt_PrintBindContents,+  flagGhciSpec "print-bind-result"            Opt_PrintBindResult,+  flagGhciSpec "print-evld-with-show"         Opt_PrintEvldWithShow,+  flagSpec "print-explicit-foralls"           Opt_PrintExplicitForalls,+  flagSpec "print-explicit-kinds"             Opt_PrintExplicitKinds,+  flagSpec "print-explicit-coercions"         Opt_PrintExplicitCoercions,+  flagSpec "print-explicit-runtime-reps"      Opt_PrintExplicitRuntimeReps,+  flagSpec "print-equality-relations"         Opt_PrintEqualityRelations,+  flagSpec "print-unicode-syntax"             Opt_PrintUnicodeSyntax,+  flagSpec "print-expanded-synonyms"          Opt_PrintExpandedSynonyms,+  flagSpec "print-potential-instances"        Opt_PrintPotentialInstances,+  flagSpec "print-typechecker-elaboration"    Opt_PrintTypecheckerElaboration,+  flagSpec "prof-cafs"                        Opt_AutoSccsOnIndividualCafs,+  flagSpec "prof-count-entries"               Opt_ProfCountEntries,+  flagSpec "regs-graph"                       Opt_RegsGraph,+  flagSpec "regs-iterative"                   Opt_RegsIterative,+  depFlagSpec' "rewrite-rules"                Opt_EnableRewriteRules+   (useInstead "-f" "enable-rewrite-rules"),+  flagSpec "shared-implib"                    Opt_SharedImplib,+  flagSpec "spec-constr"                      Opt_SpecConstr,+  flagSpec "spec-constr-keen"                 Opt_SpecConstrKeen,+  flagSpec "specialise"                       Opt_Specialise,+  flagSpec "specialize"                       Opt_Specialise,+  flagSpec "specialise-aggressively"          Opt_SpecialiseAggressively,+  flagSpec "specialize-aggressively"          Opt_SpecialiseAggressively,+  flagSpec "cross-module-specialise"          Opt_CrossModuleSpecialise,+  flagSpec "cross-module-specialize"          Opt_CrossModuleSpecialise,+  flagSpec "static-argument-transformation"   Opt_StaticArgumentTransformation,+  flagSpec "strictness"                       Opt_Strictness,+  flagSpec "use-rpaths"                       Opt_RPath,+  flagSpec "write-interface"                  Opt_WriteInterface,+  flagSpec "write-ide-info"                   Opt_WriteHie,+  flagSpec "unbox-small-strict-fields"        Opt_UnboxSmallStrictFields,+  flagSpec "unbox-strict-fields"              Opt_UnboxStrictFields,+  flagSpec "version-macros"                   Opt_VersionMacros,+  flagSpec "worker-wrapper"                   Opt_WorkerWrapper,+  flagSpec "solve-constant-dicts"             Opt_SolveConstantDicts,+  flagSpec "catch-bottoms"                    Opt_CatchBottoms,+  flagSpec "alignment-sanitisation"           Opt_AlignmentSanitisation,+  flagSpec "num-constant-folding"             Opt_NumConstantFolding,+  flagSpec "show-warning-groups"              Opt_ShowWarnGroups,+  flagSpec "hide-source-paths"                Opt_HideSourcePaths,+  flagSpec "show-loaded-modules"              Opt_ShowLoadedModules,+  flagSpec "whole-archive-hs-libs"            Opt_WholeArchiveHsLibs,+  flagSpec "keep-cafs"                        Opt_KeepCAFs+  ]+  ++ fHoleFlags++-- | These @-f\<blah\>@ flags have to do with the typed-hole error message or+-- the valid hole fits in that message. See Note [Valid hole fits include ...]+-- in the TcHoleErrors module. These flags can all be reversed with+-- @-fno-\<blah\>@+fHoleFlags :: [(Deprecation, FlagSpec GeneralFlag)]+fHoleFlags = [+  flagSpec "show-hole-constraints"            Opt_ShowHoleConstraints,+  depFlagSpec' "show-valid-substitutions"     Opt_ShowValidHoleFits+   (useInstead "-f" "show-valid-hole-fits"),+  flagSpec "show-valid-hole-fits"             Opt_ShowValidHoleFits,+  -- Sorting settings+  flagSpec "sort-valid-hole-fits"             Opt_SortValidHoleFits,+  flagSpec "sort-by-size-hole-fits"           Opt_SortBySizeHoleFits,+  flagSpec "sort-by-subsumption-hole-fits"    Opt_SortBySubsumHoleFits,+  flagSpec "abstract-refinement-hole-fits"    Opt_AbstractRefHoleFits,+  -- Output format settings+  flagSpec "show-hole-matches-of-hole-fits"   Opt_ShowMatchesOfHoleFits,+  flagSpec "show-provenance-of-hole-fits"     Opt_ShowProvOfHoleFits,+  flagSpec "show-type-of-hole-fits"           Opt_ShowTypeOfHoleFits,+  flagSpec "show-type-app-of-hole-fits"       Opt_ShowTypeAppOfHoleFits,+  flagSpec "show-type-app-vars-of-hole-fits"  Opt_ShowTypeAppVarsOfHoleFits,+  flagSpec "show-docs-of-hole-fits"           Opt_ShowDocsOfHoleFits,+  flagSpec "unclutter-valid-hole-fits"        Opt_UnclutterValidHoleFits+  ]++-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@+fLangFlags :: [FlagSpec LangExt.Extension]+fLangFlags = map snd fLangFlagsDeps++fLangFlagsDeps :: [(Deprecation, FlagSpec LangExt.Extension)]+fLangFlagsDeps = [+-- See Note [Updating flag description in the User's Guide]+-- See Note [Supporting CLI completion]+  depFlagSpecOp' "th"                           LangExt.TemplateHaskell+    checkTemplateHaskellOk+    (deprecatedForExtension "TemplateHaskell"),+  depFlagSpec' "fi"                             LangExt.ForeignFunctionInterface+    (deprecatedForExtension "ForeignFunctionInterface"),+  depFlagSpec' "ffi"                            LangExt.ForeignFunctionInterface+    (deprecatedForExtension "ForeignFunctionInterface"),+  depFlagSpec' "arrows"                         LangExt.Arrows+    (deprecatedForExtension "Arrows"),+  depFlagSpec' "implicit-prelude"               LangExt.ImplicitPrelude+    (deprecatedForExtension "ImplicitPrelude"),+  depFlagSpec' "bang-patterns"                  LangExt.BangPatterns+    (deprecatedForExtension "BangPatterns"),+  depFlagSpec' "monomorphism-restriction"       LangExt.MonomorphismRestriction+    (deprecatedForExtension "MonomorphismRestriction"),+  depFlagSpec' "mono-pat-binds"                 LangExt.MonoPatBinds+    (deprecatedForExtension "MonoPatBinds"),+  depFlagSpec' "extended-default-rules"         LangExt.ExtendedDefaultRules+    (deprecatedForExtension "ExtendedDefaultRules"),+  depFlagSpec' "implicit-params"                LangExt.ImplicitParams+    (deprecatedForExtension "ImplicitParams"),+  depFlagSpec' "scoped-type-variables"          LangExt.ScopedTypeVariables+    (deprecatedForExtension "ScopedTypeVariables"),+  depFlagSpec' "allow-overlapping-instances"    LangExt.OverlappingInstances+    (deprecatedForExtension "OverlappingInstances"),+  depFlagSpec' "allow-undecidable-instances"    LangExt.UndecidableInstances+    (deprecatedForExtension "UndecidableInstances"),+  depFlagSpec' "allow-incoherent-instances"     LangExt.IncoherentInstances+    (deprecatedForExtension "IncoherentInstances")+  ]++supportedLanguages :: [String]+supportedLanguages = map (flagSpecName . snd) languageFlagsDeps++supportedLanguageOverlays :: [String]+supportedLanguageOverlays = map (flagSpecName . snd) safeHaskellFlagsDeps++supportedExtensions :: [String]+supportedExtensions = concatMap toFlagSpecNamePair xFlags+  where+    toFlagSpecNamePair flg+#if !defined(GHCI)+      -- IMPORTANT! Make sure that `ghc --supported-extensions` omits+      -- "TemplateHaskell"/"QuasiQuotes" when it's known not to work out of the+      -- box. See also GHC #11102 and #16331 for more details about+      -- the rationale+      | flagSpecFlag flg == LangExt.TemplateHaskell  = [noName]+      | flagSpecFlag flg == LangExt.QuasiQuotes      = [noName]+#endif+      | otherwise = [name, noName]+      where+        noName = "No" ++ name+        name = flagSpecName flg++supportedLanguagesAndExtensions :: [String]+supportedLanguagesAndExtensions =+    supportedLanguages ++ supportedLanguageOverlays ++ supportedExtensions++-- | These -X<blah> flags cannot be reversed with -XNo<blah>+languageFlagsDeps :: [(Deprecation, FlagSpec Language)]+languageFlagsDeps = [+  flagSpec "Haskell98"   Haskell98,+  flagSpec "Haskell2010" Haskell2010+  ]++-- | These -X<blah> flags cannot be reversed with -XNo<blah>+-- They are used to place hard requirements on what GHC Haskell language+-- features can be used.+safeHaskellFlagsDeps :: [(Deprecation, FlagSpec SafeHaskellMode)]+safeHaskellFlagsDeps = [mkF Sf_Unsafe, mkF Sf_Trustworthy, mkF Sf_Safe]+    where mkF flag = flagSpec (show flag) flag++-- | These -X<blah> flags can all be reversed with -XNo<blah>+xFlags :: [FlagSpec LangExt.Extension]+xFlags = map snd xFlagsDeps++xFlagsDeps :: [(Deprecation, FlagSpec LangExt.Extension)]+xFlagsDeps = [+-- See Note [Updating flag description in the User's Guide]+-- See Note [Supporting CLI completion]+-- See Note [Adding a language extension]+-- Please keep the list of flags below sorted alphabetically+  flagSpec "AllowAmbiguousTypes"              LangExt.AllowAmbiguousTypes,+  flagSpec "AlternativeLayoutRule"            LangExt.AlternativeLayoutRule,+  flagSpec "AlternativeLayoutRuleTransitional"+                                              LangExt.AlternativeLayoutRuleTransitional,+  flagSpec "Arrows"                           LangExt.Arrows,+  depFlagSpecCond "AutoDeriveTypeable"        LangExt.AutoDeriveTypeable+    id+         ("Typeable instances are created automatically " +++                     "for all types since GHC 8.2."),+  flagSpec "BangPatterns"                     LangExt.BangPatterns,+  flagSpec "BinaryLiterals"                   LangExt.BinaryLiterals,+  flagSpec "CApiFFI"                          LangExt.CApiFFI,+  flagSpec "CPP"                              LangExt.Cpp,+  flagSpec "ConstrainedClassMethods"          LangExt.ConstrainedClassMethods,+  flagSpec "ConstraintKinds"                  LangExt.ConstraintKinds,+  flagSpec "DataKinds"                        LangExt.DataKinds,+  depFlagSpecCond "DatatypeContexts"          LangExt.DatatypeContexts+    id+         ("It was widely considered a misfeature, " +++                     "and has been removed from the Haskell language."),+  flagSpec "DefaultSignatures"                LangExt.DefaultSignatures,+  flagSpec "DeriveAnyClass"                   LangExt.DeriveAnyClass,+  flagSpec "DeriveDataTypeable"               LangExt.DeriveDataTypeable,+  flagSpec "DeriveFoldable"                   LangExt.DeriveFoldable,+  flagSpec "DeriveFunctor"                    LangExt.DeriveFunctor,+  flagSpec "DeriveGeneric"                    LangExt.DeriveGeneric,+  flagSpec "DeriveLift"                       LangExt.DeriveLift,+  flagSpec "DeriveTraversable"                LangExt.DeriveTraversable,+  flagSpec "DerivingStrategies"               LangExt.DerivingStrategies,+  flagSpec "DerivingVia"                      LangExt.DerivingVia,+  flagSpec "DisambiguateRecordFields"         LangExt.DisambiguateRecordFields,+  flagSpec "DoAndIfThenElse"                  LangExt.DoAndIfThenElse,+  flagSpec "BlockArguments"                   LangExt.BlockArguments,+  depFlagSpec' "DoRec"                        LangExt.RecursiveDo+    (deprecatedForExtension "RecursiveDo"),+  flagSpec "DuplicateRecordFields"            LangExt.DuplicateRecordFields,+  flagSpec "EmptyCase"                        LangExt.EmptyCase,+  flagSpec "EmptyDataDecls"                   LangExt.EmptyDataDecls,+  flagSpec "EmptyDataDeriving"                LangExt.EmptyDataDeriving,+  flagSpec "ExistentialQuantification"        LangExt.ExistentialQuantification,+  flagSpec "ExplicitForAll"                   LangExt.ExplicitForAll,+  flagSpec "ExplicitNamespaces"               LangExt.ExplicitNamespaces,+  flagSpec "ExtendedDefaultRules"             LangExt.ExtendedDefaultRules,+  flagSpec "FlexibleContexts"                 LangExt.FlexibleContexts,+  flagSpec "FlexibleInstances"                LangExt.FlexibleInstances,+  flagSpec "ForeignFunctionInterface"         LangExt.ForeignFunctionInterface,+  flagSpec "FunctionalDependencies"           LangExt.FunctionalDependencies,+  flagSpec "GADTSyntax"                       LangExt.GADTSyntax,+  flagSpec "GADTs"                            LangExt.GADTs,+  flagSpec "GHCForeignImportPrim"             LangExt.GHCForeignImportPrim,+  flagSpec' "GeneralizedNewtypeDeriving"      LangExt.GeneralizedNewtypeDeriving+                                              setGenDeriving,+  flagSpec' "GeneralisedNewtypeDeriving"      LangExt.GeneralizedNewtypeDeriving+                                              setGenDeriving,+  flagSpec "ImplicitParams"                   LangExt.ImplicitParams,+  flagSpec "ImplicitPrelude"                  LangExt.ImplicitPrelude,+  flagSpec "ImpredicativeTypes"               LangExt.ImpredicativeTypes,+  flagSpec' "IncoherentInstances"             LangExt.IncoherentInstances+                                              setIncoherentInsts,+  flagSpec "TypeFamilyDependencies"           LangExt.TypeFamilyDependencies,+  flagSpec "InstanceSigs"                     LangExt.InstanceSigs,+  flagSpec "ApplicativeDo"                    LangExt.ApplicativeDo,+  flagSpec "InterruptibleFFI"                 LangExt.InterruptibleFFI,+  flagSpec "JavaScriptFFI"                    LangExt.JavaScriptFFI,+  flagSpec "KindSignatures"                   LangExt.KindSignatures,+  flagSpec "LambdaCase"                       LangExt.LambdaCase,+  flagSpec "LiberalTypeSynonyms"              LangExt.LiberalTypeSynonyms,+  flagSpec "MagicHash"                        LangExt.MagicHash,+  flagSpec "MonadComprehensions"              LangExt.MonadComprehensions,+  depFlagSpec "MonadFailDesugaring"           LangExt.MonadFailDesugaring+    "MonadFailDesugaring is now the default behavior",+  flagSpec "MonoLocalBinds"                   LangExt.MonoLocalBinds,+  depFlagSpecCond "MonoPatBinds"              LangExt.MonoPatBinds+    id+         "Experimental feature now removed; has no effect",+  flagSpec "MonomorphismRestriction"          LangExt.MonomorphismRestriction,+  flagSpec "MultiParamTypeClasses"            LangExt.MultiParamTypeClasses,+  flagSpec "MultiWayIf"                       LangExt.MultiWayIf,+  flagSpec "NumericUnderscores"               LangExt.NumericUnderscores,+  flagSpec "NPlusKPatterns"                   LangExt.NPlusKPatterns,+  flagSpec "NamedFieldPuns"                   LangExt.RecordPuns,+  flagSpec "NamedWildCards"                   LangExt.NamedWildCards,+  flagSpec "NegativeLiterals"                 LangExt.NegativeLiterals,+  flagSpec "HexFloatLiterals"                 LangExt.HexFloatLiterals,+  flagSpec "NondecreasingIndentation"         LangExt.NondecreasingIndentation,+  depFlagSpec' "NullaryTypeClasses"           LangExt.NullaryTypeClasses+    (deprecatedForExtension "MultiParamTypeClasses"),+  flagSpec "NumDecimals"                      LangExt.NumDecimals,+  depFlagSpecOp "OverlappingInstances"        LangExt.OverlappingInstances+    setOverlappingInsts+    "instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS",+  flagSpec "OverloadedLabels"                 LangExt.OverloadedLabels,+  flagSpec "OverloadedLists"                  LangExt.OverloadedLists,+  flagSpec "OverloadedStrings"                LangExt.OverloadedStrings,+  flagSpec "PackageImports"                   LangExt.PackageImports,+  flagSpec "ParallelArrays"                   LangExt.ParallelArrays,+  flagSpec "ParallelListComp"                 LangExt.ParallelListComp,+  flagSpec "PartialTypeSignatures"            LangExt.PartialTypeSignatures,+  flagSpec "PatternGuards"                    LangExt.PatternGuards,+  depFlagSpec' "PatternSignatures"            LangExt.ScopedTypeVariables+    (deprecatedForExtension "ScopedTypeVariables"),+  flagSpec "PatternSynonyms"                  LangExt.PatternSynonyms,+  flagSpec "PolyKinds"                        LangExt.PolyKinds,+  flagSpec "PolymorphicComponents"            LangExt.RankNTypes,+  flagSpec "QuantifiedConstraints"            LangExt.QuantifiedConstraints,+  flagSpec "PostfixOperators"                 LangExt.PostfixOperators,+  flagSpec "QuasiQuotes"                      LangExt.QuasiQuotes,+  flagSpec "Rank2Types"                       LangExt.RankNTypes,+  flagSpec "RankNTypes"                       LangExt.RankNTypes,+  flagSpec "RebindableSyntax"                 LangExt.RebindableSyntax,+  depFlagSpec' "RecordPuns"                   LangExt.RecordPuns+    (deprecatedForExtension "NamedFieldPuns"),+  flagSpec "RecordWildCards"                  LangExt.RecordWildCards,+  flagSpec "RecursiveDo"                      LangExt.RecursiveDo,+  flagSpec "RelaxedLayout"                    LangExt.RelaxedLayout,+  depFlagSpecCond "RelaxedPolyRec"            LangExt.RelaxedPolyRec+    not+         "You can't turn off RelaxedPolyRec any more",+  flagSpec "RoleAnnotations"                  LangExt.RoleAnnotations,+  flagSpec "ScopedTypeVariables"              LangExt.ScopedTypeVariables,+  flagSpec "StandaloneDeriving"               LangExt.StandaloneDeriving,+  flagSpec "StarIsType"                       LangExt.StarIsType,+  flagSpec "StaticPointers"                   LangExt.StaticPointers,+  flagSpec "Strict"                           LangExt.Strict,+  flagSpec "StrictData"                       LangExt.StrictData,+  flagSpec' "TemplateHaskell"                 LangExt.TemplateHaskell+                                              checkTemplateHaskellOk,+  flagSpec "TemplateHaskellQuotes"            LangExt.TemplateHaskellQuotes,+  flagSpec "TraditionalRecordSyntax"          LangExt.TraditionalRecordSyntax,+  flagSpec "TransformListComp"                LangExt.TransformListComp,+  flagSpec "TupleSections"                    LangExt.TupleSections,+  flagSpec "TypeApplications"                 LangExt.TypeApplications,+  flagSpec "TypeInType"                       LangExt.TypeInType,+  flagSpec "TypeFamilies"                     LangExt.TypeFamilies,+  flagSpec "TypeOperators"                    LangExt.TypeOperators,+  flagSpec "TypeSynonymInstances"             LangExt.TypeSynonymInstances,+  flagSpec "UnboxedTuples"                    LangExt.UnboxedTuples,+  flagSpec "UnboxedSums"                      LangExt.UnboxedSums,+  flagSpec "UndecidableInstances"             LangExt.UndecidableInstances,+  flagSpec "UndecidableSuperClasses"          LangExt.UndecidableSuperClasses,+  flagSpec "UnicodeSyntax"                    LangExt.UnicodeSyntax,+  flagSpec "UnliftedFFITypes"                 LangExt.UnliftedFFITypes,+  flagSpec "ViewPatterns"                     LangExt.ViewPatterns+  ]++defaultFlags :: Settings -> [GeneralFlag]+defaultFlags settings+-- See Note [Updating flag description in the User's Guide]+  = [ Opt_AutoLinkPackages,+      Opt_DiagnosticsShowCaret,+      Opt_EmbedManifest,+      Opt_FlatCache,+      Opt_GenManifest,+      Opt_GhciHistory,+      Opt_GhciSandbox,+      Opt_HelpfulErrors,+      Opt_KeepHiFiles,+      Opt_KeepOFiles,+      Opt_OmitYields,+      Opt_PrintBindContents,+      Opt_ProfCountEntries,+      Opt_RPath,+      Opt_SharedImplib,+      Opt_SimplPreInlining,+      Opt_VersionMacros+    ]++    ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]+             -- The default -O0 options++    ++ default_PIC platform++    ++ concatMap (wayGeneralFlags platform) (defaultWays settings)+    ++ validHoleFitDefaults++    where platform = sTargetPlatform settings++-- | These are the default settings for the display and sorting of valid hole+--  fits in typed-hole error messages. See Note [Valid hole fits include ...]+ -- in the TcHoleErrors module.+validHoleFitDefaults :: [GeneralFlag]+validHoleFitDefaults+  =  [ Opt_ShowTypeAppOfHoleFits+     , Opt_ShowTypeOfHoleFits+     , Opt_ShowProvOfHoleFits+     , Opt_ShowMatchesOfHoleFits+     , Opt_ShowValidHoleFits+     , Opt_SortValidHoleFits+     , Opt_SortBySizeHoleFits+     , Opt_ShowHoleConstraints ]+++validHoleFitsImpliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]+validHoleFitsImpliedGFlags+  = [ (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)+    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppVarsOfHoleFits)+    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowDocsOfHoleFits)+    , (Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)+    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits) ]++default_PIC :: Platform -> [GeneralFlag]+default_PIC platform =+  case (platformOS platform, platformArch platform) of+    (OSDarwin, ArchX86_64) -> [Opt_PIC]+    (OSOpenBSD, ArchX86_64) -> [Opt_PIC] -- Due to PIE support in+                                         -- OpenBSD since 5.3 release+                                         -- (1 May 2013) we need to+                                         -- always generate PIC. See+                                         -- #10597 for more+                                         -- information.+    _                      -> []++-- General flags that are switched on/off when other general flags are switched+-- on+impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]+impliedGFlags = [(Opt_DeferTypeErrors, turnOn, Opt_DeferTypedHoles)+                ,(Opt_DeferTypeErrors, turnOn, Opt_DeferOutOfScopeVariables)+                ,(Opt_Strictness, turnOn, Opt_WorkerWrapper)+                ] ++ validHoleFitsImpliedGFlags++-- General flags that are switched on/off when other general flags are switched+-- off+impliedOffGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]+impliedOffGFlags = [(Opt_Strictness, turnOff, Opt_WorkerWrapper)]++impliedXFlags :: [(LangExt.Extension, TurnOnFlag, LangExt.Extension)]+impliedXFlags+-- See Note [Updating flag description in the User's Guide]+  = [ (LangExt.RankNTypes,                turnOn, LangExt.ExplicitForAll)+    , (LangExt.QuantifiedConstraints,     turnOn, LangExt.ExplicitForAll)+    , (LangExt.ScopedTypeVariables,       turnOn, LangExt.ExplicitForAll)+    , (LangExt.LiberalTypeSynonyms,       turnOn, LangExt.ExplicitForAll)+    , (LangExt.ExistentialQuantification, turnOn, LangExt.ExplicitForAll)+    , (LangExt.FlexibleInstances,         turnOn, LangExt.TypeSynonymInstances)+    , (LangExt.FunctionalDependencies,    turnOn, LangExt.MultiParamTypeClasses)+    , (LangExt.MultiParamTypeClasses,     turnOn, LangExt.ConstrainedClassMethods)  -- c.f. #7854+    , (LangExt.TypeFamilyDependencies,    turnOn, LangExt.TypeFamilies)++    , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude)      -- NB: turn off!++    , (LangExt.DerivingVia, turnOn, LangExt.DerivingStrategies)++    , (LangExt.GADTs,            turnOn, LangExt.GADTSyntax)+    , (LangExt.GADTs,            turnOn, LangExt.MonoLocalBinds)+    , (LangExt.TypeFamilies,     turnOn, LangExt.MonoLocalBinds)++    , (LangExt.TypeFamilies,     turnOn, LangExt.KindSignatures)  -- Type families use kind signatures+    , (LangExt.PolyKinds,        turnOn, LangExt.KindSignatures)  -- Ditto polymorphic kinds++    -- TypeInType is now just a synonym for a couple of other extensions.+    , (LangExt.TypeInType,       turnOn, LangExt.DataKinds)+    , (LangExt.TypeInType,       turnOn, LangExt.PolyKinds)+    , (LangExt.TypeInType,       turnOn, LangExt.KindSignatures)++    -- AutoDeriveTypeable is not very useful without DeriveDataTypeable+    , (LangExt.AutoDeriveTypeable, turnOn, LangExt.DeriveDataTypeable)++    -- We turn this on so that we can export associated type+    -- type synonyms in subordinates (e.g. MyClass(type AssocType))+    , (LangExt.TypeFamilies,     turnOn, LangExt.ExplicitNamespaces)+    , (LangExt.TypeOperators, turnOn, LangExt.ExplicitNamespaces)++    , (LangExt.ImpredicativeTypes,  turnOn, LangExt.RankNTypes)++        -- Record wild-cards implies field disambiguation+        -- Otherwise if you write (C {..}) you may well get+        -- stuff like " 'a' not in scope ", which is a bit silly+        -- if the compiler has just filled in field 'a' of constructor 'C'+    , (LangExt.RecordWildCards,     turnOn, LangExt.DisambiguateRecordFields)++    , (LangExt.ParallelArrays, turnOn, LangExt.ParallelListComp)++    , (LangExt.JavaScriptFFI, turnOn, LangExt.InterruptibleFFI)++    , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFunctor)+    , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFoldable)++    -- Duplicate record fields require field disambiguation+    , (LangExt.DuplicateRecordFields, turnOn, LangExt.DisambiguateRecordFields)++    , (LangExt.TemplateHaskell, turnOn, LangExt.TemplateHaskellQuotes)+    , (LangExt.Strict, turnOn, LangExt.StrictData)+  ]++-- Note [When is StarIsType enabled]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- The StarIsType extension determines whether to treat '*' as a regular type+-- operator or as a synonym for 'Data.Kind.Type'. Many existing pre-TypeInType+-- programs expect '*' to be synonymous with 'Type', so by default StarIsType is+-- enabled.+--+-- Programs that use TypeOperators might expect to repurpose '*' for+-- multiplication or another binary operation, but making TypeOperators imply+-- NoStarIsType caused too much breakage on Hackage.+--++-- Note [Documenting optimisation flags]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- If you change the list of flags enabled for particular optimisation levels+-- please remember to update the User's Guide. The relevant file is:+--+--   docs/users_guide/using-optimisation.rst+--+-- Make sure to note whether a flag is implied by -O0, -O or -O2.++optLevelFlags :: [([Int], GeneralFlag)]+optLevelFlags -- see Note [Documenting optimisation flags]+  = [ ([0,1,2], Opt_DoLambdaEtaExpansion)+    , ([0,1,2], Opt_DoEtaReduction)       -- See Note [Eta-reduction in -O0]+    , ([0,1,2], Opt_DmdTxDictSel)+    , ([0,1,2], Opt_LlvmTBAA)++    , ([0],     Opt_IgnoreInterfacePragmas)+    , ([0],     Opt_OmitInterfacePragmas)++    , ([1,2],   Opt_CallArity)+    , ([1,2],   Opt_Exitification)+    , ([1,2],   Opt_CaseMerge)+    , ([1,2],   Opt_CaseFolding)+    , ([1,2],   Opt_CmmElimCommonBlocks)+    , ([2],     Opt_AsmShortcutting)+    , ([1,2],   Opt_CmmSink)+    , ([1,2],   Opt_CSE)+    , ([1,2],   Opt_StgCSE)+    , ([2],     Opt_StgLiftLams)+    , ([1,2],   Opt_EnableRewriteRules)  -- Off for -O0; see Note [Scoping for Builtin rules]+                                         --              in PrelRules+    , ([1,2],   Opt_FloatIn)+    , ([1,2],   Opt_FullLaziness)+    , ([1,2],   Opt_IgnoreAsserts)+    , ([1,2],   Opt_Loopification)+    , ([1,2],   Opt_CfgBlocklayout)      -- Experimental++    , ([1,2],   Opt_Specialise)+    , ([1,2],   Opt_CrossModuleSpecialise)+    , ([1,2],   Opt_Strictness)+    , ([1,2],   Opt_UnboxSmallStrictFields)+    , ([1,2],   Opt_CprAnal)+    , ([1,2],   Opt_WorkerWrapper)+    , ([1,2],   Opt_SolveConstantDicts)+    , ([1,2],   Opt_NumConstantFolding)++    , ([2],     Opt_LiberateCase)+    , ([2],     Opt_SpecConstr)+--  , ([2],     Opt_RegsGraph)+--   RegsGraph suffers performance regression. See #7679+--  , ([2],     Opt_StaticArgumentTransformation)+--   Static Argument Transformation needs investigation. See #9374+    ]++{- Note [Eta-reduction in -O0]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+#11562 showed an example which tripped an ASSERT in CoreToStg; a+function was marked as MayHaveCafRefs when in fact it obviously+didn't.  Reason was:+ * Eta reduction wasn't happening in the simplifier, but it was+   happening in CorePrep, on+        $fBla = MkDict (/\a. K a)+ * Result: rhsIsStatic told TidyPgm that $fBla might have CAF refs+   but the eta-reduced version (MkDict K) obviously doesn't+Simple solution: just let the simplifier do eta-reduction even in -O0.+After all, CorePrep does it unconditionally!  Not a big deal, but+removes an assertion failure. -}+++-- -----------------------------------------------------------------------------+-- Standard sets of warning options++-- Note [Documenting warning flags]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- If you change the list of warning enabled by default+-- please remember to update the User's Guide. The relevant file is:+--+--  docs/users_guide/using-warnings.rst++-- | Warning groups.+--+-- As all warnings are in the Weverything set, it is ignored when+-- displaying to the user which group a warning is in.+warningGroups :: [(String, [WarningFlag])]+warningGroups =+    [ ("compat",       minusWcompatOpts)+    , ("unused-binds", unusedBindsFlags)+    , ("default",      standardWarnings)+    , ("extra",        minusWOpts)+    , ("all",          minusWallOpts)+    , ("everything",   minusWeverythingOpts)+    ]++-- | Warning group hierarchies, where there is an explicit inclusion+-- relation.+--+-- Each inner list is a hierarchy of warning groups, ordered from+-- smallest to largest, where each group is a superset of the one+-- before it.+--+-- Separating this from 'warningGroups' allows for multiple+-- hierarchies with no inherent relation to be defined.+--+-- The special-case Weverything group is not included.+warningHierarchies :: [[String]]+warningHierarchies = hierarchies ++ map (:[]) rest+  where+    hierarchies = [["default", "extra", "all"]]+    rest = filter (`notElem` "everything" : concat hierarchies) $+           map fst warningGroups++-- | Find the smallest group in every hierarchy which a warning+-- belongs to, excluding Weverything.+smallestGroups :: WarningFlag -> [String]+smallestGroups flag = mapMaybe go warningHierarchies where+    -- Because each hierarchy is arranged from smallest to largest,+    -- the first group we find in a hierarchy which contains the flag+    -- is the smallest.+    go (group:rest) = fromMaybe (go rest) $ do+        flags <- lookup group warningGroups+        guard (flag `elem` flags)+        pure (Just group)+    go [] = Nothing++-- | Warnings enabled unless specified otherwise+standardWarnings :: [WarningFlag]+standardWarnings -- see Note [Documenting warning flags]+    = [ Opt_WarnOverlappingPatterns,+        Opt_WarnWarningsDeprecations,+        Opt_WarnDeprecatedFlags,+        Opt_WarnDeferredTypeErrors,+        Opt_WarnTypedHoles,+        Opt_WarnDeferredOutOfScopeVariables,+        Opt_WarnPartialTypeSignatures,+        Opt_WarnUnrecognisedPragmas,+        Opt_WarnDuplicateExports,+        Opt_WarnOverflowedLiterals,+        Opt_WarnEmptyEnumerations,+        Opt_WarnMissingFields,+        Opt_WarnMissingMethods,+        Opt_WarnWrongDoBind,+        Opt_WarnUnsupportedCallingConventions,+        Opt_WarnDodgyForeignImports,+        Opt_WarnInlineRuleShadowing,+        Opt_WarnAlternativeLayoutRuleTransitional,+        Opt_WarnUnsupportedLlvmVersion,+        Opt_WarnMissedExtraSharedLib,+        Opt_WarnTabs,+        Opt_WarnUnrecognisedWarningFlags,+        Opt_WarnSimplifiableClassConstraints,+        Opt_WarnStarBinder,+        Opt_WarnInaccessibleCode,+        Opt_WarnSpaceAfterBang+      ]++-- | Things you get with -W+minusWOpts :: [WarningFlag]+minusWOpts+    = standardWarnings +++      [ Opt_WarnUnusedTopBinds,+        Opt_WarnUnusedLocalBinds,+        Opt_WarnUnusedPatternBinds,+        Opt_WarnUnusedMatches,+        Opt_WarnUnusedForalls,+        Opt_WarnUnusedImports,+        Opt_WarnIncompletePatterns,+        Opt_WarnDodgyExports,+        Opt_WarnDodgyImports,+        Opt_WarnUnbangedStrictPatterns+      ]++-- | Things you get with -Wall+minusWallOpts :: [WarningFlag]+minusWallOpts+    = minusWOpts +++      [ Opt_WarnTypeDefaults,+        Opt_WarnNameShadowing,+        Opt_WarnMissingSignatures,+        Opt_WarnHiShadows,+        Opt_WarnOrphans,+        Opt_WarnUnusedDoBind,+        Opt_WarnTrustworthySafe,+        Opt_WarnUntickedPromotedConstructors,+        Opt_WarnMissingPatternSynonymSignatures,+        Opt_WarnUnusedRecordWildcards,+        Opt_WarnRedundantRecordWildcards+      ]++-- | Things you get with -Weverything, i.e. *all* known warnings flags+minusWeverythingOpts :: [WarningFlag]+minusWeverythingOpts = [ toEnum 0 .. ]++-- | Things you get with -Wcompat.+--+-- This is intended to group together warnings that will be enabled by default+-- at some point in the future, so that library authors eager to make their+-- code future compatible to fix issues before they even generate warnings.+minusWcompatOpts :: [WarningFlag]+minusWcompatOpts+    = [ Opt_WarnMissingMonadFailInstances+      , Opt_WarnSemigroup+      , Opt_WarnNonCanonicalMonoidInstances+      , Opt_WarnStarIsType+      ]++enableUnusedBinds :: DynP ()+enableUnusedBinds = mapM_ setWarningFlag unusedBindsFlags++disableUnusedBinds :: DynP ()+disableUnusedBinds = mapM_ unSetWarningFlag unusedBindsFlags++-- Things you get with -Wunused-binds+unusedBindsFlags :: [WarningFlag]+unusedBindsFlags = [ Opt_WarnUnusedTopBinds+                   , Opt_WarnUnusedLocalBinds+                   , Opt_WarnUnusedPatternBinds+                   ]++enableGlasgowExts :: DynP ()+enableGlasgowExts = do setGeneralFlag Opt_PrintExplicitForalls+                       mapM_ setExtensionFlag glasgowExtsFlags++disableGlasgowExts :: DynP ()+disableGlasgowExts = do unSetGeneralFlag Opt_PrintExplicitForalls+                        mapM_ unSetExtensionFlag glasgowExtsFlags++-- Please keep what_glasgow_exts_does.rst up to date with this list+glasgowExtsFlags :: [LangExt.Extension]+glasgowExtsFlags = [+             LangExt.ConstrainedClassMethods+           , LangExt.DeriveDataTypeable+           , LangExt.DeriveFoldable+           , LangExt.DeriveFunctor+           , LangExt.DeriveGeneric+           , LangExt.DeriveTraversable+           , LangExt.EmptyDataDecls+           , LangExt.ExistentialQuantification+           , LangExt.ExplicitNamespaces+           , LangExt.FlexibleContexts+           , LangExt.FlexibleInstances+           , LangExt.ForeignFunctionInterface+           , LangExt.FunctionalDependencies+           , LangExt.GeneralizedNewtypeDeriving+           , LangExt.ImplicitParams+           , LangExt.KindSignatures+           , LangExt.LiberalTypeSynonyms+           , LangExt.MagicHash+           , LangExt.MultiParamTypeClasses+           , LangExt.ParallelListComp+           , LangExt.PatternGuards+           , LangExt.PostfixOperators+           , LangExt.RankNTypes+           , LangExt.RecursiveDo+           , LangExt.ScopedTypeVariables+           , LangExt.StandaloneDeriving+           , LangExt.TypeOperators+           , LangExt.TypeSynonymInstances+           , LangExt.UnboxedTuples+           , LangExt.UnicodeSyntax+           , LangExt.UnliftedFFITypes ]++foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt++-- | Was the runtime system built with profiling enabled?+rtsIsProfiled :: Bool+rtsIsProfiled = unsafeDupablePerformIO rtsIsProfiledIO /= 0++-- Consult the RTS to find whether GHC itself has been built with+-- dynamic linking.  This can't be statically known at compile-time,+-- because we build both the static and dynamic versions together with+-- -dynamic-too.+foreign import ccall unsafe "rts_isDynamic" rtsIsDynamicIO :: IO CInt++dynamicGhc :: Bool+dynamicGhc = unsafeDupablePerformIO rtsIsDynamicIO /= 0++setWarnSafe :: Bool -> DynP ()+setWarnSafe True  = getCurLoc >>= \l -> upd (\d -> d { warnSafeOnLoc = l })+setWarnSafe False = return ()++setWarnUnsafe :: Bool -> DynP ()+setWarnUnsafe True  = getCurLoc >>= \l -> upd (\d -> d { warnUnsafeOnLoc = l })+setWarnUnsafe False = return ()++setPackageTrust :: DynP ()+setPackageTrust = do+    setGeneralFlag Opt_PackageTrust+    l <- getCurLoc+    upd $ \d -> d { pkgTrustOnLoc = l }++setGenDeriving :: TurnOnFlag -> DynP ()+setGenDeriving True  = getCurLoc >>= \l -> upd (\d -> d { newDerivOnLoc = l })+setGenDeriving False = return ()++setOverlappingInsts :: TurnOnFlag -> DynP ()+setOverlappingInsts False = return ()+setOverlappingInsts True = do+  l <- getCurLoc+  upd (\d -> d { overlapInstLoc = l })++setIncoherentInsts :: TurnOnFlag -> DynP ()+setIncoherentInsts False = return ()+setIncoherentInsts True = do+  l <- getCurLoc+  upd (\d -> d { incoherentOnLoc = l })++checkTemplateHaskellOk :: TurnOnFlag -> DynP ()+checkTemplateHaskellOk _turn_on+  = getCurLoc >>= \l -> upd (\d -> d { thOnLoc = l })++{- **********************************************************************+%*                                                                      *+                DynFlags constructors+%*                                                                      *+%********************************************************************* -}++type DynP = EwM (CmdLineP DynFlags)++upd :: (DynFlags -> DynFlags) -> DynP ()+upd f = liftEwM (do dflags <- getCmdLineState+                    putCmdLineState $! f dflags)++updM :: (DynFlags -> DynP DynFlags) -> DynP ()+updM f = do dflags <- liftEwM getCmdLineState+            dflags' <- f dflags+            liftEwM $ putCmdLineState $! dflags'++--------------- Constructor functions for OptKind -----------------+noArg :: (DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)+noArg fn = NoArg (upd fn)++noArgM :: (DynFlags -> DynP DynFlags) -> OptKind (CmdLineP DynFlags)+noArgM fn = NoArg (updM fn)++hasArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)+hasArg fn = HasArg (upd . fn)++sepArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)+sepArg fn = SepArg (upd . fn)++intSuffix :: (Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)+intSuffix fn = IntSuffix (\n -> upd (fn n))++intSuffixM :: (Int -> DynFlags -> DynP DynFlags) -> OptKind (CmdLineP DynFlags)+intSuffixM fn = IntSuffix (\n -> updM (fn n))++floatSuffix :: (Float -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)+floatSuffix fn = FloatSuffix (\n -> upd (fn n))++optIntSuffixM :: (Maybe Int -> DynFlags -> DynP DynFlags)+              -> OptKind (CmdLineP DynFlags)+optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi))++setDumpFlag :: DumpFlag -> OptKind (CmdLineP DynFlags)+setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)++--------------------------+addWay :: Way -> DynP ()+addWay w = upd (addWay' w)++addWay' :: Way -> DynFlags -> DynFlags+addWay' w dflags0 = let platform = targetPlatform dflags0+                        dflags1 = dflags0 { ways = w : ways dflags0 }+                        dflags2 = foldr setGeneralFlag' dflags1+                                        (wayGeneralFlags platform w)+                        dflags3 = foldr unSetGeneralFlag' dflags2+                                        (wayUnsetGeneralFlags platform w)+                    in dflags3++removeWayDyn :: DynP ()+removeWayDyn = upd (\dfs -> dfs { ways = filter (WayDyn /=) (ways dfs) })++--------------------------+setGeneralFlag, unSetGeneralFlag :: GeneralFlag -> DynP ()+setGeneralFlag   f = upd (setGeneralFlag' f)+unSetGeneralFlag f = upd (unSetGeneralFlag' f)++setGeneralFlag' :: GeneralFlag -> DynFlags -> DynFlags+setGeneralFlag' f dflags = foldr ($) (gopt_set dflags f) deps+  where+    deps = [ if turn_on then setGeneralFlag'   d+                        else unSetGeneralFlag' d+           | (f', turn_on, d) <- impliedGFlags, f' == f ]+        -- When you set f, set the ones it implies+        -- NB: use setGeneralFlag recursively, in case the implied flags+        --     implies further flags++unSetGeneralFlag' :: GeneralFlag -> DynFlags -> DynFlags+unSetGeneralFlag' f dflags = foldr ($) (gopt_unset dflags f) deps+  where+    deps = [ if turn_on then setGeneralFlag' d+                        else unSetGeneralFlag' d+           | (f', turn_on, d) <- impliedOffGFlags, f' == f ]+   -- In general, when you un-set f, we don't un-set the things it implies.+   -- There are however some exceptions, e.g., -fno-strictness implies+   -- -fno-worker-wrapper.+   --+   -- NB: use unSetGeneralFlag' recursively, in case the implied off flags+   --     imply further flags.++--------------------------+setWarningFlag, unSetWarningFlag :: WarningFlag -> DynP ()+setWarningFlag   f = upd (\dfs -> wopt_set dfs f)+unSetWarningFlag f = upd (\dfs -> wopt_unset dfs f)++setFatalWarningFlag, unSetFatalWarningFlag :: WarningFlag -> DynP ()+setFatalWarningFlag   f = upd (\dfs -> wopt_set_fatal dfs f)+unSetFatalWarningFlag f = upd (\dfs -> wopt_unset_fatal dfs f)++setWErrorFlag :: WarningFlag -> DynP ()+setWErrorFlag flag =+  do { setWarningFlag flag+     ; setFatalWarningFlag flag }++--------------------------+setExtensionFlag, unSetExtensionFlag :: LangExt.Extension -> DynP ()+setExtensionFlag f = upd (setExtensionFlag' f)+unSetExtensionFlag f = upd (unSetExtensionFlag' f)++setExtensionFlag', unSetExtensionFlag' :: LangExt.Extension -> DynFlags -> DynFlags+setExtensionFlag' f dflags = foldr ($) (xopt_set dflags f) deps+  where+    deps = [ if turn_on then setExtensionFlag'   d+                        else unSetExtensionFlag' d+           | (f', turn_on, d) <- impliedXFlags, f' == f ]+        -- When you set f, set the ones it implies+        -- NB: use setExtensionFlag recursively, in case the implied flags+        --     implies further flags++unSetExtensionFlag' f dflags = xopt_unset dflags f+   -- When you un-set f, however, we don't un-set the things it implies+   --      (except for -fno-glasgow-exts, which is treated specially)++--------------------------+alterSettings :: (Settings -> Settings) -> DynFlags -> DynFlags+alterSettings f dflags = dflags { settings = f (settings dflags) }++--------------------------+setDumpFlag' :: DumpFlag -> DynP ()+setDumpFlag' dump_flag+  = do upd (\dfs -> dopt_set dfs dump_flag)+       when want_recomp forceRecompile+    where -- Certain dumpy-things are really interested in what's going+          -- on during recompilation checking, so in those cases we+          -- don't want to turn it off.+          want_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,+                                             Opt_D_dump_hi_diffs,+                                             Opt_D_no_debug_output]++forceRecompile :: DynP ()+-- Whenver we -ddump, force recompilation (by switching off the+-- recompilation checker), else you don't see the dump! However,+-- don't switch it off in --make mode, else *everything* gets+-- recompiled which probably isn't what you want+forceRecompile = do dfs <- liftEwM getCmdLineState+                    when (force_recomp dfs) (setGeneralFlag Opt_ForceRecomp)+        where+          force_recomp dfs = isOneShot (ghcMode dfs)+++setVerboseCore2Core :: DynP ()+setVerboseCore2Core = setDumpFlag' Opt_D_verbose_core2core++setVerbosity :: Maybe Int -> DynP ()+setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })++setDebugLevel :: Maybe Int -> DynP ()+setDebugLevel mb_n = upd (\dfs -> dfs{ debugLevel = mb_n `orElse` 2 })++data PkgConfRef+  = GlobalPkgConf+  | UserPkgConf+  | PkgConfFile FilePath+  deriving Eq++addPkgConfRef :: PkgConfRef -> DynP ()+addPkgConfRef p = upd $ \s ->+  s { packageDBFlags = PackageDB p : packageDBFlags s }++removeUserPkgConf :: DynP ()+removeUserPkgConf = upd $ \s ->+  s { packageDBFlags = NoUserPackageDB : packageDBFlags s }++removeGlobalPkgConf :: DynP ()+removeGlobalPkgConf = upd $ \s ->+ s { packageDBFlags = NoGlobalPackageDB : packageDBFlags s }++clearPkgConf :: DynP ()+clearPkgConf = upd $ \s ->+  s { packageDBFlags = ClearPackageDBs : packageDBFlags s }++parsePackageFlag :: String                 -- the flag+                 -> ReadP PackageArg       -- type of argument+                 -> String                 -- string to parse+                 -> PackageFlag+parsePackageFlag flag arg_parse str+ = case filter ((=="").snd) (readP_to_S parse str) of+    [(r, "")] -> r+    _ -> throwGhcException $ CmdLineError ("Can't parse package flag: " ++ str)+  where doc = flag ++ " " ++ str+        parse = do+            pkg_arg <- tok arg_parse+            let mk_expose = ExposePackage doc pkg_arg+            ( do _ <- tok $ string "with"+                 fmap (mk_expose . ModRenaming True) parseRns+             <++ fmap (mk_expose . ModRenaming False) parseRns+             <++ return (mk_expose (ModRenaming True [])))+        parseRns = do _ <- tok $ R.char '('+                      rns <- tok $ sepBy parseItem (tok $ R.char ',')+                      _ <- tok $ R.char ')'+                      return rns+        parseItem = do+            orig <- tok $ parseModuleName+            (do _ <- tok $ string "as"+                new <- tok $ parseModuleName+                return (orig, new)+              ++++             return (orig, orig))+        tok m = m >>= \x -> skipSpaces >> return x++exposePackage, exposePackageId, hidePackage,+        exposePluginPackage, exposePluginPackageId,+        ignorePackage,+        trustPackage, distrustPackage :: String -> DynP ()+exposePackage p = upd (exposePackage' p)+exposePackageId p =+  upd (\s -> s{ packageFlags =+    parsePackageFlag "-package-id" parseUnitIdArg p : packageFlags s })+exposePluginPackage p =+  upd (\s -> s{ pluginPackageFlags =+    parsePackageFlag "-plugin-package" parsePackageArg p : pluginPackageFlags s })+exposePluginPackageId p =+  upd (\s -> s{ pluginPackageFlags =+    parsePackageFlag "-plugin-package-id" parseUnitIdArg p : pluginPackageFlags s })+hidePackage p =+  upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })+ignorePackage p =+  upd (\s -> s{ ignorePackageFlags = IgnorePackage p : ignorePackageFlags s })++trustPackage p = exposePackage p >> -- both trust and distrust also expose a package+  upd (\s -> s{ trustFlags = TrustPackage p : trustFlags s })+distrustPackage p = exposePackage p >>+  upd (\s -> s{ trustFlags = DistrustPackage p : trustFlags s })++exposePackage' :: String -> DynFlags -> DynFlags+exposePackage' p dflags+    = dflags { packageFlags =+            parsePackageFlag "-package" parsePackageArg p : packageFlags dflags }++parsePackageArg :: ReadP PackageArg+parsePackageArg =+    fmap PackageArg (munch1 (\c -> isAlphaNum c || c `elem` ":-_."))++parseUnitIdArg :: ReadP PackageArg+parseUnitIdArg =+    fmap UnitIdArg parseUnitId++setUnitId :: String -> DynFlags -> DynFlags+setUnitId p d = d { thisInstalledUnitId = stringToInstalledUnitId p }++-- | Given a 'ModuleName' of a signature in the home library, find+-- out how it is instantiated.  E.g., the canonical form of+-- A in @p[A=q[]:A]@ is @q[]:A@.+canonicalizeHomeModule :: DynFlags -> ModuleName -> Module+canonicalizeHomeModule dflags mod_name =+    case lookup mod_name (thisUnitIdInsts dflags) of+        Nothing  -> mkModule (thisPackage dflags) mod_name+        Just mod -> mod++canonicalizeModuleIfHome :: DynFlags -> Module -> Module+canonicalizeModuleIfHome dflags mod+    = if thisPackage dflags == moduleUnitId mod+                      then canonicalizeHomeModule dflags (moduleName mod)+                      else mod+++-- -----------------------------------------------------------------------------+-- | Find the package environment (if one exists)+--+-- We interpret the package environment as a set of package flags; to be+-- specific, if we find a package environment file like+--+-- > clear-package-db+-- > global-package-db+-- > package-db blah/package.conf.d+-- > package-id id1+-- > package-id id2+--+-- we interpret this as+--+-- > [ -hide-all-packages+-- > , -clear-package-db+-- > , -global-package-db+-- > , -package-db blah/package.conf.d+-- > , -package-id id1+-- > , -package-id id2+-- > ]+--+-- There's also an older syntax alias for package-id, which is just an+-- unadorned package id+--+-- > id1+-- > id2+--+interpretPackageEnv :: DynFlags -> IO DynFlags+interpretPackageEnv dflags = do+    mPkgEnv <- runMaybeT $ msum $ [+                   getCmdLineArg >>= \env -> msum [+                       probeNullEnv env+                     , probeEnvFile env+                     , probeEnvName env+                     , cmdLineError env+                     ]+                 , getEnvVar >>= \env -> msum [+                       probeNullEnv env+                     , probeEnvFile env+                     , probeEnvName env+                     , envError     env+                     ]+                 , notIfHideAllPackages >> msum [+                       findLocalEnvFile >>= probeEnvFile+                     , probeEnvName defaultEnvName+                     ]+                 ]+    case mPkgEnv of+      Nothing ->+        -- No environment found. Leave DynFlags unchanged.+        return dflags+      Just "-" -> do+        -- Explicitly disabled environment file. Leave DynFlags unchanged.+        return dflags+      Just envfile -> do+        content <- readFile envfile+        putLogMsg dflags NoReason SevInfo noSrcSpan+             (defaultUserStyle dflags)+             (text ("Loaded package environment from " ++ envfile))+        let setFlags :: DynP ()+            setFlags = do+              setGeneralFlag Opt_HideAllPackages+              parseEnvFile envfile content++            (_, dflags') = runCmdLine (runEwM setFlags) dflags++        return dflags'+  where+    -- Loading environments (by name or by location)++    namedEnvPath :: String -> MaybeT IO FilePath+    namedEnvPath name = do+     appdir <- versionedAppDir dflags+     return $ appdir </> "environments" </> name++    probeEnvName :: String -> MaybeT IO FilePath+    probeEnvName name = probeEnvFile =<< namedEnvPath name++    probeEnvFile :: FilePath -> MaybeT IO FilePath+    probeEnvFile path = do+      guard =<< liftMaybeT (doesFileExist path)+      return path++    probeNullEnv :: FilePath -> MaybeT IO FilePath+    probeNullEnv "-" = return "-"+    probeNullEnv _   = mzero++    parseEnvFile :: FilePath -> String -> DynP ()+    parseEnvFile envfile = mapM_ parseEntry . lines+      where+        parseEntry str = case words str of+          ("package-db": _)     -> addPkgConfRef (PkgConfFile (envdir </> db))+            -- relative package dbs are interpreted relative to the env file+            where envdir = takeDirectory envfile+                  db     = drop 11 str+          ["clear-package-db"]  -> clearPkgConf+          ["global-package-db"] -> addPkgConfRef GlobalPkgConf+          ["user-package-db"]   -> addPkgConfRef UserPkgConf+          ["package-id", pkgid] -> exposePackageId pkgid+          (('-':'-':_):_)       -> return () -- comments+          -- and the original syntax introduced in 7.10:+          [pkgid]               -> exposePackageId pkgid+          []                    -> return ()+          _                     -> throwGhcException $ CmdLineError $+                                        "Can't parse environment file entry: "+                                     ++ envfile ++ ": " ++ str++    -- Various ways to define which environment to use++    getCmdLineArg :: MaybeT IO String+    getCmdLineArg = MaybeT $ return $ packageEnv dflags++    getEnvVar :: MaybeT IO String+    getEnvVar = do+      mvar <- liftMaybeT $ try $ getEnv "GHC_ENVIRONMENT"+      case mvar of+        Right var -> return var+        Left err  -> if isDoesNotExistError err then mzero+                                                else liftMaybeT $ throwIO err++    notIfHideAllPackages :: MaybeT IO ()+    notIfHideAllPackages =+      guard (not (gopt Opt_HideAllPackages dflags))++    defaultEnvName :: String+    defaultEnvName = "default"++    -- e.g. .ghc.environment.x86_64-linux-7.6.3+    localEnvFileName :: FilePath+    localEnvFileName = ".ghc.environment" <.> versionedFilePath dflags++    -- Search for an env file, starting in the current dir and looking upwards.+    -- Fail if we get to the users home dir or the filesystem root. That is,+    -- we don't look for an env file in the user's home dir. The user-wide+    -- env lives in ghc's versionedAppDir/environments/default+    findLocalEnvFile :: MaybeT IO FilePath+    findLocalEnvFile = do+        curdir  <- liftMaybeT getCurrentDirectory+        homedir <- tryMaybeT getHomeDirectory+        let probe dir | isDrive dir || dir == homedir+                      = mzero+            probe dir = do+              let file = dir </> localEnvFileName+              exists <- liftMaybeT (doesFileExist file)+              if exists+                then return file+                else probe (takeDirectory dir)+        probe curdir++    -- Error reporting++    cmdLineError :: String -> MaybeT IO a+    cmdLineError env = liftMaybeT . throwGhcExceptionIO . CmdLineError $+      "Package environment " ++ show env ++ " not found"++    envError :: String -> MaybeT IO a+    envError env = liftMaybeT . throwGhcExceptionIO . CmdLineError $+         "Package environment "+      ++ show env+      ++ " (specified in GHC_ENVIRONMENT) not found"+++-- If we're linking a binary, then only targets that produce object+-- code are allowed (requests for other target types are ignored).+setTarget :: HscTarget -> DynP ()+setTarget l = setTargetWithPlatform (const l)++setTargetWithPlatform :: (Platform -> HscTarget) -> DynP ()+setTargetWithPlatform f = upd set+  where+   set dfs = let l = f (targetPlatform dfs)+             in if ghcLink dfs /= LinkBinary || isObjectTarget l+                then dfs{ hscTarget = l }+                else dfs++-- Changes the target only if we're compiling object code.  This is+-- used by -fasm and -fllvm, which switch from one to the other, but+-- not from bytecode to object-code.  The idea is that -fasm/-fllvm+-- can be safely used in an OPTIONS_GHC pragma.+setObjTarget :: HscTarget -> DynP ()+setObjTarget l = updM set+  where+   set dflags+     | isObjectTarget (hscTarget dflags)+       = return $ dflags { hscTarget = l }+     | otherwise = return dflags++setOptLevel :: Int -> DynFlags -> DynP DynFlags+setOptLevel n dflags = return (updOptLevel n dflags)++checkOptLevel :: Int -> DynFlags -> Either String DynFlags+checkOptLevel n dflags+   | hscTarget dflags == HscInterpreted && n > 0+     = Left "-O conflicts with --interactive; -O ignored."+   | otherwise+     = Right dflags++setMainIs :: String -> DynP ()+setMainIs arg+  | not (null main_fn) && isLower (head main_fn)+     -- The arg looked like "Foo.Bar.baz"+  = upd $ \d -> d { mainFunIs = Just main_fn,+                   mainModIs = mkModule mainUnitId (mkModuleName main_mod) }++  | isUpper (head arg)  -- The arg looked like "Foo" or "Foo.Bar"+  = upd $ \d -> d { mainModIs = mkModule mainUnitId (mkModuleName arg) }++  | otherwise                   -- The arg looked like "baz"+  = upd $ \d -> d { mainFunIs = Just arg }+  where+    (main_mod, main_fn) = splitLongestPrefix arg (== '.')++addLdInputs :: Option -> DynFlags -> DynFlags+addLdInputs p dflags = dflags{ldInputs = ldInputs dflags ++ [p]}++-----------------------------------------------------------------------------+-- Paths & Libraries++addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> DynP ()++-- -i on its own deletes the import paths+addImportPath "" = upd (\s -> s{importPaths = []})+addImportPath p  = upd (\s -> s{importPaths = importPaths s ++ splitPathList p})++addLibraryPath p =+  upd (\s -> s{libraryPaths = libraryPaths s ++ splitPathList p})++addIncludePath p =+  upd (\s -> s{includePaths =+                  addGlobalInclude (includePaths s) (splitPathList p)})++addFrameworkPath p =+  upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})++#if !defined(mingw32_TARGET_OS)+split_marker :: Char+split_marker = ':'   -- not configurable (ToDo)+#endif++splitPathList :: String -> [String]+splitPathList s = filter notNull (splitUp s)+                -- empty paths are ignored: there might be a trailing+                -- ':' in the initial list, for example.  Empty paths can+                -- cause confusion when they are translated into -I options+                -- for passing to gcc.+  where+#if !defined(mingw32_TARGET_OS)+    splitUp xs = split split_marker xs+#else+     -- Windows: 'hybrid' support for DOS-style paths in directory lists.+     --+     -- That is, if "foo:bar:baz" is used, this interpreted as+     -- consisting of three entries, 'foo', 'bar', 'baz'.+     -- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted+     -- as 3 elts, "c:/foo", "c:\\foo", "x:/bar"+     --+     -- Notice that no attempt is made to fully replace the 'standard'+     -- split marker ':' with the Windows / DOS one, ';'. The reason being+     -- that this will cause too much breakage for users & ':' will+     -- work fine even with DOS paths, if you're not insisting on being silly.+     -- So, use either.+    splitUp []             = []+    splitUp (x:':':div:xs) | div `elem` dir_markers+                           = ((x:':':div:p): splitUp rs)+                           where+                              (p,rs) = findNextPath xs+          -- we used to check for existence of the path here, but that+          -- required the IO monad to be threaded through the command-line+          -- parser which is quite inconvenient.  The+    splitUp xs = cons p (splitUp rs)+               where+                 (p,rs) = findNextPath xs++                 cons "" xs = xs+                 cons x  xs = x:xs++    -- will be called either when we've consumed nought or the+    -- "<Drive>:/" part of a DOS path, so splitting is just a Q of+    -- finding the next split marker.+    findNextPath xs =+        case break (`elem` split_markers) xs of+           (p, _:ds) -> (p, ds)+           (p, xs)   -> (p, xs)++    split_markers :: [Char]+    split_markers = [':', ';']++    dir_markers :: [Char]+    dir_markers = ['/', '\\']+#endif++-- -----------------------------------------------------------------------------+-- tmpDir, where we store temporary files.++setTmpDir :: FilePath -> DynFlags -> DynFlags+setTmpDir dir = alterSettings (\s -> s { sTmpDir = normalise dir })+  -- we used to fix /cygdrive/c/.. on Windows, but this doesn't+  -- seem necessary now --SDM 7/2/2008++-----------------------------------------------------------------------------+-- RTS opts++setRtsOpts :: String -> DynP ()+setRtsOpts arg  = upd $ \ d -> d {rtsOpts = Just arg}++setRtsOptsEnabled :: RtsOptsEnabled -> DynP ()+setRtsOptsEnabled arg  = upd $ \ d -> d {rtsOptsEnabled = arg}++-----------------------------------------------------------------------------+-- Hpc stuff++setOptHpcDir :: String -> DynP ()+setOptHpcDir arg  = upd $ \ d -> d {hpcDir = arg}++-----------------------------------------------------------------------------+-- Via-C compilation stuff++-- There are some options that we need to pass to gcc when compiling+-- Haskell code via C, but are only supported by recent versions of+-- gcc.  The configure script decides which of these options we need,+-- and puts them in the "settings" file in $topdir. The advantage of+-- having these in a separate file is that the file can be created at+-- install-time depending on the available gcc version, and even+-- re-generated later if gcc is upgraded.+--+-- The options below are not dependent on the version of gcc, only the+-- platform.++picCCOpts :: DynFlags -> [String]+picCCOpts dflags = pieOpts ++ picOpts+  where+    picOpts =+      case platformOS (targetPlatform dflags) of+      OSDarwin+          -- Apple prefers to do things the other way round.+          -- PIC is on by default.+          -- -mdynamic-no-pic:+          --     Turn off PIC code generation.+          -- -fno-common:+          --     Don't generate "common" symbols - these are unwanted+          --     in dynamic libraries.++       | gopt Opt_PIC dflags -> ["-fno-common", "-U__PIC__", "-D__PIC__"]+       | otherwise           -> ["-mdynamic-no-pic"]+      OSMinGW32 -- no -fPIC for Windows+       | gopt Opt_PIC dflags -> ["-U__PIC__", "-D__PIC__"]+       | otherwise           -> []+      _+      -- we need -fPIC for C files when we are compiling with -dynamic,+      -- otherwise things like stub.c files don't get compiled+      -- correctly.  They need to reference data in the Haskell+      -- objects, but can't without -fPIC.  See+      -- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/position-independent-code+       | gopt Opt_PIC dflags || WayDyn `elem` ways dflags ->+          ["-fPIC", "-U__PIC__", "-D__PIC__"]+      -- gcc may be configured to have PIC on by default, let's be+      -- explicit here, see #15847+       | otherwise -> ["-fno-PIC"]++    pieOpts+      | gopt Opt_PICExecutable dflags       = ["-pie"]+        -- See Note [No PIE when linking]+      | sGccSupportsNoPie (settings dflags) = ["-no-pie"]+      | otherwise                           = []+++{-+Note [No PIE while linking]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+As of 2016 some Linux distributions (e.g. Debian) have started enabling -pie by+default in their gcc builds. This is incompatible with -r as it implies that we+are producing an executable. Consequently, we must manually pass -no-pie to gcc+when joining object files or linking dynamic libraries. Unless, of course, the+user has explicitly requested a PIE executable with -pie. See #12759.+-}++picPOpts :: DynFlags -> [String]+picPOpts dflags+ | gopt Opt_PIC dflags = ["-U__PIC__", "-D__PIC__"]+ | otherwise           = []++-- -----------------------------------------------------------------------------+-- Compiler Info++compilerInfo :: DynFlags -> [(String, String)]+compilerInfo dflags+    = -- We always make "Project name" be first to keep parsing in+      -- other languages simple, i.e. when looking for other fields,+      -- you don't have to worry whether there is a leading '[' or not+      ("Project name",                 cProjectName)+      -- Next come the settings, so anything else can be overridden+      -- in the settings file (as "lookup" uses the first match for the+      -- key)+    : map (fmap $ expandDirectories (topDir dflags) (toolDir dflags))+          (rawSettings dflags)+   ++ [("Project version",             projectVersion dflags),+       ("Project Git commit id",       cProjectGitCommitId),+       ("Booter version",              cBooterVersion),+       ("Stage",                       cStage),+       ("Build platform",              cBuildPlatformString),+       ("Host platform",               cHostPlatformString),+       ("Target platform",             cTargetPlatformString),+       ("Have interpreter",            cGhcWithInterpreter),+       ("Object splitting supported",  showBool False),+       ("Have native code generator",  cGhcWithNativeCodeGen),+       ("Support SMP",                 cGhcWithSMP),+       ("Tables next to code",         cGhcEnableTablesNextToCode),+       ("RTS ways",                    cGhcRTSWays),+       ("RTS expects libdw",           showBool cGhcRtsWithLibdw),+       -- Whether or not we support @-dynamic-too@+       ("Support dynamic-too",         showBool $ not isWindows),+       -- Whether or not we support the @-j@ flag with @--make@.+       ("Support parallel --make",     "YES"),+       -- Whether or not we support "Foo from foo-0.1-XXX:Foo" syntax in+       -- installed package info.+       ("Support reexported-modules",  "YES"),+       -- Whether or not we support extended @-package foo (Foo)@ syntax.+       ("Support thinning and renaming package flags", "YES"),+       -- Whether or not we support Backpack.+       ("Support Backpack", "YES"),+       -- If true, we require that the 'id' field in installed package info+       -- match what is passed to the @-this-unit-id@ flag for modules+       -- built in it+       ("Requires unified installed package IDs", "YES"),+       -- Whether or not we support the @-this-package-key@ flag.  Prefer+       -- "Uses unit IDs" over it.+       ("Uses package keys",           "YES"),+       -- Whether or not we support the @-this-unit-id@ flag+       ("Uses unit IDs",               "YES"),+       -- Whether or not GHC compiles libraries as dynamic by default+       ("Dynamic by default",          showBool $ dYNAMIC_BY_DEFAULT dflags),+       -- Whether or not GHC was compiled using -dynamic+       ("GHC Dynamic",                 showBool dynamicGhc),+       -- Whether or not GHC was compiled using -prof+       ("GHC Profiled",                showBool rtsIsProfiled),+       ("Leading underscore",          cLeadingUnderscore),+       ("Debug on",                    show debugIsOn),+       ("LibDir",                      topDir dflags),+       -- The path of the global package database used by GHC+       ("Global Package DB",           systemPackageConfig dflags)+      ]+  where+    showBool True  = "YES"+    showBool False = "NO"+    isWindows = platformOS (targetPlatform dflags) == OSMinGW32+    expandDirectories :: FilePath -> Maybe FilePath -> String -> String+    expandDirectories topd mtoold = expandToolDir mtoold . expandTopDir topd++-- Produced by deriveConstants+#include "GHCConstantsHaskellWrappers.hs"++bLOCK_SIZE_W :: DynFlags -> Int+bLOCK_SIZE_W dflags = bLOCK_SIZE dflags `quot` wORD_SIZE dflags++wORD_SIZE_IN_BITS :: DynFlags -> Int+wORD_SIZE_IN_BITS dflags = wORD_SIZE dflags * 8++tAG_MASK :: DynFlags -> Int+tAG_MASK dflags = (1 `shiftL` tAG_BITS dflags) - 1++mAX_PTR_TAG :: DynFlags -> Int+mAX_PTR_TAG = tAG_MASK++-- Might be worth caching these in targetPlatform?+tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: DynFlags -> Integer+tARGET_MIN_INT dflags+    = case platformWordSize (targetPlatform dflags) of+      4 -> toInteger (minBound :: Int32)+      8 -> toInteger (minBound :: Int64)+      w -> panic ("tARGET_MIN_INT: Unknown platformWordSize: " ++ show w)+tARGET_MAX_INT dflags+    = case platformWordSize (targetPlatform dflags) of+      4 -> toInteger (maxBound :: Int32)+      8 -> toInteger (maxBound :: Int64)+      w -> panic ("tARGET_MAX_INT: Unknown platformWordSize: " ++ show w)+tARGET_MAX_WORD dflags+    = case platformWordSize (targetPlatform dflags) of+      4 -> toInteger (maxBound :: Word32)+      8 -> toInteger (maxBound :: Word64)+      w -> panic ("tARGET_MAX_WORD: Unknown platformWordSize: " ++ show w)+++{- -----------------------------------------------------------------------------+Note [DynFlags consistency]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~++There are a number of number of DynFlags configurations which either+do not make sense or lead to unimplemented or buggy codepaths in the+compiler. makeDynFlagsConsistent is responsible for verifying the validity+of a set of DynFlags, fixing any issues, and reporting them back to the+caller.++GHCi and -O+---------------++When using optimization, the compiler can introduce several things+(such as unboxed tuples) into the intermediate code, which GHCi later+chokes on since the bytecode interpreter can't handle this (and while+this is arguably a bug these aren't handled, there are no plans to fix+it.)++While the driver pipeline always checks for this particular erroneous+combination when parsing flags, we also need to check when we update+the flags; this is because API clients may parse flags but update the+DynFlags afterwords, before finally running code inside a session (see+T10052 and #10052).+-}++-- | Resolve any internal inconsistencies in a set of 'DynFlags'.+-- Returns the consistent 'DynFlags' as well as a list of warnings+-- to report to the user.+makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Located String])+-- Whenever makeDynFlagsConsistent does anything, it starts over, to+-- ensure that a later change doesn't invalidate an earlier check.+-- Be careful not to introduce potential loops!+makeDynFlagsConsistent dflags+ -- Disable -dynamic-too on Windows (#8228, #7134, #5987)+ | os == OSMinGW32 && gopt Opt_BuildDynamicToo dflags+    = let dflags' = gopt_unset dflags Opt_BuildDynamicToo+          warn    = "-dynamic-too is not supported on Windows"+      in loop dflags' warn+ | hscTarget dflags == HscC &&+   not (platformUnregisterised (targetPlatform dflags))+    = if cGhcWithNativeCodeGen == "YES"+      then let dflags' = dflags { hscTarget = HscAsm }+               warn = "Compiler not unregisterised, so using native code generator rather than compiling via C"+           in loop dflags' warn+      else let dflags' = dflags { hscTarget = HscLlvm }+               warn = "Compiler not unregisterised, so using LLVM rather than compiling via C"+           in loop dflags' warn+ | gopt Opt_Hpc dflags && hscTarget dflags == HscInterpreted+    = let dflags' = gopt_unset dflags Opt_Hpc+          warn = "Hpc can't be used with byte-code interpreter. Ignoring -fhpc."+      in loop dflags' warn+ | hscTarget dflags `elem` [HscAsm, HscLlvm] &&+   platformUnregisterised (targetPlatform dflags)+    = loop (dflags { hscTarget = HscC })+           "Compiler unregisterised, so compiling via C"+ | hscTarget dflags == HscAsm &&+   cGhcWithNativeCodeGen /= "YES"+      = let dflags' = dflags { hscTarget = HscLlvm }+            warn = "No native code generator, so using LLVM"+        in loop dflags' warn+ | not (osElfTarget os) && gopt Opt_PIE dflags+    = loop (gopt_unset dflags Opt_PIE)+           "Position-independent only supported on ELF platforms"+ | os == OSDarwin &&+   arch == ArchX86_64 &&+   not (gopt Opt_PIC dflags)+    = loop (gopt_set dflags Opt_PIC)+           "Enabling -fPIC as it is always on for this platform"+ | Left err <- checkOptLevel (optLevel dflags) dflags+    = loop (updOptLevel 0 dflags) err++ | LinkInMemory <- ghcLink dflags+ , not (gopt Opt_ExternalInterpreter dflags)+ , rtsIsProfiled+ , isObjectTarget (hscTarget dflags)+ , WayProf `notElem` ways dflags+    = loop dflags{ways = WayProf : ways dflags}+         "Enabling -prof, because -fobject-code is enabled and GHCi is profiled"++ | otherwise = (dflags, [])+    where loc = mkGeneralSrcSpan (fsLit "when making flags consistent")+          loop updated_dflags warning+              = case makeDynFlagsConsistent updated_dflags of+                (dflags', ws) -> (dflags', L loc warning : ws)+          platform = targetPlatform dflags+          arch = platformArch platform+          os   = platformOS   platform+++--------------------------------------------------------------------------+-- Do not use unsafeGlobalDynFlags!+--+-- unsafeGlobalDynFlags is a hack, necessary because we need to be able+-- to show SDocs when tracing, but we don't always have DynFlags+-- available.+--+-- Do not use it if you can help it. You may get the wrong value, or this+-- panic!++-- | This is the value that 'unsafeGlobalDynFlags' takes before it is+-- initialized.+defaultGlobalDynFlags :: DynFlags+defaultGlobalDynFlags =+    (defaultDynFlags settings (llvmTargets, llvmPasses)) { verbosity = 2 }+  where+    settings = panic "v_unsafeGlobalDynFlags: settings not initialised"+    llvmTargets = panic "v_unsafeGlobalDynFlags: llvmTargets not initialised"+    llvmPasses = panic "v_unsafeGlobalDynFlags: llvmPasses not initialised"++#if STAGE < 2+GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags)+#else+SHARED_GLOBAL_VAR( v_unsafeGlobalDynFlags+                 , getOrSetLibHSghcGlobalDynFlags+                 , "getOrSetLibHSghcGlobalDynFlags"+                 , defaultGlobalDynFlags+                 , DynFlags )+#endif++unsafeGlobalDynFlags :: DynFlags+unsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags++setUnsafeGlobalDynFlags :: DynFlags -> IO ()+setUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags++-- -----------------------------------------------------------------------------+-- SSE and AVX++-- TODO: Instead of using a separate predicate (i.e. isSse2Enabled) to+-- check if SSE is enabled, we might have x86-64 imply the -msse2+-- flag.++data SseVersion = SSE1+                | SSE2+                | SSE3+                | SSE4+                | SSE42+                deriving (Eq, Ord)++isSseEnabled :: DynFlags -> Bool+isSseEnabled dflags = case platformArch (targetPlatform dflags) of+    ArchX86_64 -> True+    ArchX86    -> sseVersion dflags >= Just SSE1+    _          -> False++isSse2Enabled :: DynFlags -> Bool+isSse2Enabled dflags = case platformArch (targetPlatform dflags) of+    ArchX86_64 -> -- SSE2 is fixed on for x86_64.  It would be+                  -- possible to make it optional, but we'd need to+                  -- fix at least the foreign call code where the+                  -- calling convention specifies the use of xmm regs,+                  -- and possibly other places.+                  True+    ArchX86    -> sseVersion dflags >= Just SSE2+    _          -> False++isSse4_2Enabled :: DynFlags -> Bool+isSse4_2Enabled dflags = sseVersion dflags >= Just SSE42++isAvxEnabled :: DynFlags -> Bool+isAvxEnabled dflags = avx dflags || avx2 dflags || avx512f dflags++isAvx2Enabled :: DynFlags -> Bool+isAvx2Enabled dflags = avx2 dflags || avx512f dflags++isAvx512cdEnabled :: DynFlags -> Bool+isAvx512cdEnabled dflags = avx512cd dflags++isAvx512erEnabled :: DynFlags -> Bool+isAvx512erEnabled dflags = avx512er dflags++isAvx512fEnabled :: DynFlags -> Bool+isAvx512fEnabled dflags = avx512f dflags++isAvx512pfEnabled :: DynFlags -> Bool+isAvx512pfEnabled dflags = avx512pf dflags++-- -----------------------------------------------------------------------------+-- BMI2++data BmiVersion = BMI1+                | BMI2+                deriving (Eq, Ord)++isBmiEnabled :: DynFlags -> Bool+isBmiEnabled dflags = case platformArch (targetPlatform dflags) of+    ArchX86_64 -> bmiVersion dflags >= Just BMI1+    ArchX86    -> bmiVersion dflags >= Just BMI1+    _          -> False++isBmi2Enabled :: DynFlags -> Bool+isBmi2Enabled dflags = case platformArch (targetPlatform dflags) of+    ArchX86_64 -> bmiVersion dflags >= Just BMI2+    ArchX86    -> bmiVersion dflags >= Just BMI2+    _          -> False++-- -----------------------------------------------------------------------------+-- Linker/compiler information++-- LinkerInfo contains any extra options needed by the system linker.+data LinkerInfo+  = GnuLD    [Option]+  | GnuGold  [Option]+  | LlvmLLD  [Option]+  | DarwinLD [Option]+  | SolarisLD [Option]+  | AixLD    [Option]+  | UnknownLD+  deriving Eq++-- CompilerInfo tells us which C compiler we're using+data CompilerInfo+   = GCC+   | Clang+   | AppleClang+   | AppleClang51+   | UnknownCC+   deriving Eq++-- -----------------------------------------------------------------------------+-- RTS hooks++-- Convert sizes like "3.5M" into integers+decodeSize :: String -> Integer+decodeSize str+  | c == ""      = truncate n+  | c == "K" || c == "k" = truncate (n * 1000)+  | c == "M" || c == "m" = truncate (n * 1000 * 1000)+  | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)+  | otherwise            = throwGhcException (CmdLineError ("can't decode size: " ++ str))+  where (m, c) = span pred str+        n      = readRational m+        pred c = isDigit c || c == '.'++foreign import ccall unsafe "setHeapSize"       setHeapSize       :: Int -> IO ()+foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()++-- -----------------------------------------------------------------------------+-- Types for managing temporary files.+--+-- these are here because FilesToClean is used in DynFlags++-- | A collection of files that must be deleted before ghc exits.+-- The current collection+-- is stored in an IORef in DynFlags, 'filesToClean'.+data FilesToClean = FilesToClean {+  ftcGhcSession :: !(Set FilePath),+  -- ^ Files that will be deleted at the end of runGhc(T)+  ftcCurrentModule :: !(Set FilePath)+  -- ^ Files that will be deleted the next time+  -- 'FileCleanup.cleanCurrentModuleTempFiles' is called, or otherwise at the+  -- end of the session.+  }++-- | An empty FilesToClean+emptyFilesToClean :: FilesToClean+emptyFilesToClean = FilesToClean Set.empty Set.empty
+ compiler/main/DynFlags.hs-boot view
@@ -0,0 +1,20 @@+module DynFlags where++import GhcPrelude+import Platform++data DynFlags+data DumpFlag+data GeneralFlag++targetPlatform           :: DynFlags -> Platform+pprUserLength            :: DynFlags -> Int+pprCols                  :: DynFlags -> Int+unsafeGlobalDynFlags     :: DynFlags+useUnicode               :: DynFlags -> Bool+useUnicodeSyntax         :: DynFlags -> Bool+useStarIsType            :: DynFlags -> Bool+shouldUseColor           :: DynFlags -> Bool+shouldUseHexWordLiterals :: DynFlags -> Bool+hasPprDebug              :: DynFlags -> Bool+hasNoDebugOutput         :: DynFlags -> Bool
+ compiler/main/ErrUtils.hs view
@@ -0,0 +1,747 @@+{-+(c) The AQUA Project, Glasgow University, 1994-1998++\section[ErrsUtils]{Utilities for error reporting}+-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RecordWildCards #-}++module ErrUtils (+        -- * Basic types+        Validity(..), andValid, allValid, isValid, getInvalids, orValid,+        Severity(..),++        -- * Messages+        ErrMsg, errMsgDoc, errMsgSeverity, errMsgReason,+        ErrDoc, errDoc, errDocImportant, errDocContext, errDocSupplementary,+        WarnMsg, MsgDoc,+        Messages, ErrorMessages, WarningMessages,+        unionMessages,+        errMsgSpan, errMsgContext,+        errorsFound, isEmptyMessages,+        isWarnMsgFatal,+        warningsToMessages,++        -- ** Formatting+        pprMessageBag, pprErrMsgBagWithLoc,+        pprLocErrMsg, printBagOfErrors,+        formatErrDoc,++        -- ** Construction+        emptyMessages, mkLocMessage, mkLocMessageAnn, makeIntoWarning,+        mkErrMsg, mkPlainErrMsg, mkErrDoc, mkLongErrMsg, mkWarnMsg,+        mkPlainWarnMsg,+        mkLongWarnMsg,++        -- * Utilities+        doIfSet, doIfSet_dyn,+        getCaretDiagnostic,++        -- * Dump files+        dumpIfSet, dumpIfSet_dyn, dumpIfSet_dyn_printer,+        mkDumpDoc, dumpSDoc, dumpSDocForUser,+        dumpSDocWithStyle,++        -- * Issuing messages during compilation+        putMsg, printInfoForUser, printOutputForUser,+        logInfo, logOutput,+        errorMsg, warningMsg,+        fatalErrorMsg, fatalErrorMsg'',+        compilationProgressMsg,+        showPass, withTiming,+        debugTraceMsg,+        ghcExit,+        prettyPrintGhcErrors,+        traceCmd+    ) where++#include "HsVersions.h"++import GhcPrelude++import Bag+import Exception+import Outputable+import Panic+import qualified PprColour as Col+import SrcLoc+import DynFlags+import FastString (unpackFS)+import StringBuffer (atLine, hGetStringBuffer, len, lexemeToString)+import Json++import System.Directory+import System.Exit      ( ExitCode(..), exitWith )+import System.FilePath  ( takeDirectory, (</>) )+import Data.List+import qualified Data.Set as Set+import Data.IORef+import Data.Maybe       ( fromMaybe )+import Data.Ord+import Data.Time+import Control.Monad+import Control.Monad.IO.Class+import System.IO+import System.IO.Error  ( catchIOError )+import GHC.Conc         ( getAllocationCounter )+import System.CPUTime++-------------------------+type MsgDoc  = SDoc++-------------------------+data Validity+  = IsValid            -- ^ Everything is fine+  | NotValid MsgDoc    -- ^ A problem, and some indication of why++isValid :: Validity -> Bool+isValid IsValid       = True+isValid (NotValid {}) = False++andValid :: Validity -> Validity -> Validity+andValid IsValid v = v+andValid v _       = v++-- | If they aren't all valid, return the first+allValid :: [Validity] -> Validity+allValid []       = IsValid+allValid (v : vs) = v `andValid` allValid vs++getInvalids :: [Validity] -> [MsgDoc]+getInvalids vs = [d | NotValid d <- vs]++orValid :: Validity -> Validity -> Validity+orValid IsValid _ = IsValid+orValid _       v = v++-- -----------------------------------------------------------------------------+-- Basic error messages: just render a message with a source location.++type Messages        = (WarningMessages, ErrorMessages)+type WarningMessages = Bag WarnMsg+type ErrorMessages   = Bag ErrMsg++unionMessages :: Messages -> Messages -> Messages+unionMessages (warns1, errs1) (warns2, errs2) =+  (warns1 `unionBags` warns2, errs1 `unionBags` errs2)++data ErrMsg = ErrMsg {+        errMsgSpan        :: SrcSpan,+        errMsgContext     :: PrintUnqualified,+        errMsgDoc         :: ErrDoc,+        -- | This has the same text as errDocImportant . errMsgDoc.+        errMsgShortString :: String,+        errMsgSeverity    :: Severity,+        errMsgReason      :: WarnReason+        }+        -- The SrcSpan is used for sorting errors into line-number order+++-- | Categorise error msgs by their importance.  This is so each section can+-- be rendered visually distinct.  See Note [Error report] for where these come+-- from.+data ErrDoc = ErrDoc {+        -- | Primary error msg.+        errDocImportant     :: [MsgDoc],+        -- | Context e.g. \"In the second argument of ...\".+        errDocContext       :: [MsgDoc],+        -- | Supplementary information, e.g. \"Relevant bindings include ...\".+        errDocSupplementary :: [MsgDoc]+        }++errDoc :: [MsgDoc] -> [MsgDoc] -> [MsgDoc] -> ErrDoc+errDoc = ErrDoc++type WarnMsg = ErrMsg++data Severity+  = SevOutput+  | SevFatal+  | SevInteractive++  | SevDump+    -- ^ Log message intended for compiler developers+    -- No file/line/column stuff++  | SevInfo+    -- ^ Log messages intended for end users.+    -- No file/line/column stuff.++  | SevWarning+  | SevError+    -- ^ SevWarning and SevError are used for warnings and errors+    --   o The message has a file/line/column heading,+    --     plus "warning:" or "error:",+    --     added by mkLocMessags+    --   o Output is intended for end users+  deriving Show+++instance ToJson Severity where+  json s = JSString (show s)+++instance Show ErrMsg where+    show em = errMsgShortString em++pprMessageBag :: Bag MsgDoc -> SDoc+pprMessageBag msgs = vcat (punctuate blankLine (bagToList msgs))++-- | Make an unannotated error message with location info.+mkLocMessage :: Severity -> SrcSpan -> MsgDoc -> MsgDoc+mkLocMessage = mkLocMessageAnn Nothing++-- | Make a possibly annotated error message with location info.+mkLocMessageAnn+  :: Maybe String                       -- ^ optional annotation+  -> Severity                           -- ^ severity+  -> SrcSpan                            -- ^ location+  -> MsgDoc                             -- ^ message+  -> MsgDoc+  -- Always print the location, even if it is unhelpful.  Error messages+  -- are supposed to be in a standard format, and one without a location+  -- would look strange.  Better to say explicitly "<no location info>".+mkLocMessageAnn ann severity locn msg+    = sdocWithDynFlags $ \dflags ->+      let locn' = if gopt Opt_ErrorSpans dflags+                  then ppr locn+                  else ppr (srcSpanStart locn)++          sevColour = getSeverityColour severity (colScheme dflags)++          -- Add optional information+          optAnn = case ann of+            Nothing -> text ""+            Just i  -> text " [" <> coloured sevColour (text i) <> text "]"++          -- Add prefixes, like    Foo.hs:34: warning:+          --                           <the warning message>+          header = locn' <> colon <+>+                   coloured sevColour sevText <> optAnn++      in coloured (Col.sMessage (colScheme dflags))+                  (hang (coloured (Col.sHeader (colScheme dflags)) header) 4+                        msg)++  where+    sevText =+      case severity of+        SevWarning -> text "warning:"+        SevError   -> text "error:"+        SevFatal   -> text "fatal:"+        _          -> empty++getSeverityColour :: Severity -> Col.Scheme -> Col.PprColour+getSeverityColour SevWarning = Col.sWarning+getSeverityColour SevError   = Col.sError+getSeverityColour SevFatal   = Col.sFatal+getSeverityColour _          = const mempty++getCaretDiagnostic :: Severity -> SrcSpan -> IO MsgDoc+getCaretDiagnostic _ (UnhelpfulSpan _) = pure empty+getCaretDiagnostic severity (RealSrcSpan span) = do+  caretDiagnostic <$> getSrcLine (srcSpanFile span) row++  where+    getSrcLine fn i =+      getLine i (unpackFS fn)+        `catchIOError` \_ ->+          pure Nothing++    getLine i fn = do+      -- StringBuffer has advantages over readFile:+      -- (a) no lazy IO, otherwise IO exceptions may occur in pure code+      -- (b) always UTF-8, rather than some system-dependent encoding+      --     (Haskell source code must be UTF-8 anyway)+      content <- hGetStringBuffer fn+      case atLine i content of+        Just at_line -> pure $+          case lines (fix <$> lexemeToString at_line (len at_line)) of+            srcLine : _ -> Just srcLine+            _           -> Nothing+        _ -> pure Nothing++    -- allow user to visibly see that their code is incorrectly encoded+    -- (StringBuffer.nextChar uses \0 to represent undecodable characters)+    fix '\0' = '\xfffd'+    fix c    = c++    row = srcSpanStartLine span+    rowStr = show row+    multiline = row /= srcSpanEndLine span++    caretDiagnostic Nothing = empty+    caretDiagnostic (Just srcLineWithNewline) =+      sdocWithDynFlags $ \ dflags ->+      let sevColour = getSeverityColour severity (colScheme dflags)+          marginColour = Col.sMargin (colScheme dflags)+      in+      coloured marginColour (text marginSpace) <>+      text ("\n") <>+      coloured marginColour (text marginRow) <>+      text (" " ++ srcLinePre) <>+      coloured sevColour (text srcLineSpan) <>+      text (srcLinePost ++ "\n") <>+      coloured marginColour (text marginSpace) <>+      coloured sevColour (text (" " ++ caretLine))++      where++        -- expand tabs in a device-independent manner #13664+        expandTabs tabWidth i s =+          case s of+            ""        -> ""+            '\t' : cs -> replicate effectiveWidth ' ' +++                         expandTabs tabWidth (i + effectiveWidth) cs+            c    : cs -> c : expandTabs tabWidth (i + 1) cs+          where effectiveWidth = tabWidth - i `mod` tabWidth++        srcLine = filter (/= '\n') (expandTabs 8 0 srcLineWithNewline)++        start = srcSpanStartCol span - 1+        end | multiline = length srcLine+            | otherwise = srcSpanEndCol span - 1+        width = max 1 (end - start)++        marginWidth = length rowStr+        marginSpace = replicate marginWidth ' ' ++ " |"+        marginRow   = rowStr ++ " |"++        (srcLinePre,  srcLineRest) = splitAt start srcLine+        (srcLineSpan, srcLinePost) = splitAt width srcLineRest++        caretEllipsis | multiline = "..."+                      | otherwise = ""+        caretLine = replicate start ' ' ++ replicate width '^' ++ caretEllipsis++makeIntoWarning :: WarnReason -> ErrMsg -> ErrMsg+makeIntoWarning reason err = err+    { errMsgSeverity = SevWarning+    , errMsgReason = reason }++-- -----------------------------------------------------------------------------+-- Collecting up messages for later ordering and printing.++mk_err_msg :: DynFlags -> Severity -> SrcSpan -> PrintUnqualified -> ErrDoc -> ErrMsg+mk_err_msg dflags sev locn print_unqual doc+ = ErrMsg { errMsgSpan = locn+          , errMsgContext = print_unqual+          , errMsgDoc = doc+          , errMsgShortString = showSDoc dflags (vcat (errDocImportant doc))+          , errMsgSeverity = sev+          , errMsgReason = NoReason }++mkErrDoc :: DynFlags -> SrcSpan -> PrintUnqualified -> ErrDoc -> ErrMsg+mkErrDoc dflags = mk_err_msg dflags SevError++mkLongErrMsg, mkLongWarnMsg   :: DynFlags -> SrcSpan -> PrintUnqualified -> MsgDoc -> MsgDoc -> ErrMsg+-- ^ A long (multi-line) error message+mkErrMsg, mkWarnMsg           :: DynFlags -> SrcSpan -> PrintUnqualified -> MsgDoc            -> ErrMsg+-- ^ A short (one-line) error message+mkPlainErrMsg, mkPlainWarnMsg :: DynFlags -> SrcSpan ->                     MsgDoc            -> ErrMsg+-- ^ Variant that doesn't care about qualified/unqualified names++mkLongErrMsg   dflags locn unqual msg extra = mk_err_msg dflags SevError   locn unqual        (ErrDoc [msg] [] [extra])+mkErrMsg       dflags locn unqual msg       = mk_err_msg dflags SevError   locn unqual        (ErrDoc [msg] [] [])+mkPlainErrMsg  dflags locn        msg       = mk_err_msg dflags SevError   locn alwaysQualify (ErrDoc [msg] [] [])+mkLongWarnMsg  dflags locn unqual msg extra = mk_err_msg dflags SevWarning locn unqual        (ErrDoc [msg] [] [extra])+mkWarnMsg      dflags locn unqual msg       = mk_err_msg dflags SevWarning locn unqual        (ErrDoc [msg] [] [])+mkPlainWarnMsg dflags locn        msg       = mk_err_msg dflags SevWarning locn alwaysQualify (ErrDoc [msg] [] [])++----------------+emptyMessages :: Messages+emptyMessages = (emptyBag, emptyBag)++isEmptyMessages :: Messages -> Bool+isEmptyMessages (warns, errs) = isEmptyBag warns && isEmptyBag errs++errorsFound :: DynFlags -> Messages -> Bool+errorsFound _dflags (_warns, errs) = not (isEmptyBag errs)++warningsToMessages :: DynFlags -> WarningMessages -> Messages+warningsToMessages dflags =+  partitionBagWith $ \warn ->+    case isWarnMsgFatal dflags warn of+      Nothing -> Left warn+      Just err_reason ->+        Right warn{ errMsgSeverity = SevError+                  , errMsgReason = ErrReason err_reason }++printBagOfErrors :: DynFlags -> Bag ErrMsg -> IO ()+printBagOfErrors dflags bag_of_errors+  = sequence_ [ let style = mkErrStyle dflags unqual+                in putLogMsg dflags reason sev s style (formatErrDoc dflags doc)+              | ErrMsg { errMsgSpan      = s,+                         errMsgDoc       = doc,+                         errMsgSeverity  = sev,+                         errMsgReason    = reason,+                         errMsgContext   = unqual } <- sortMsgBag (Just dflags)+                                                                  bag_of_errors ]++formatErrDoc :: DynFlags -> ErrDoc -> SDoc+formatErrDoc dflags (ErrDoc important context supplementary)+  = case msgs of+        [msg] -> vcat msg+        _ -> vcat $ map starred msgs+    where+    msgs = filter (not . null) $ map (filter (not . Outputable.isEmpty dflags))+        [important, context, supplementary]+    starred = (bullet<+>) . vcat++pprErrMsgBagWithLoc :: Bag ErrMsg -> [SDoc]+pprErrMsgBagWithLoc bag = [ pprLocErrMsg item | item <- sortMsgBag Nothing bag ]++pprLocErrMsg :: ErrMsg -> SDoc+pprLocErrMsg (ErrMsg { errMsgSpan      = s+                     , errMsgDoc       = doc+                     , errMsgSeverity  = sev+                     , errMsgContext   = unqual })+  = sdocWithDynFlags $ \dflags ->+    withPprStyle (mkErrStyle dflags unqual) $+    mkLocMessage sev s (formatErrDoc dflags doc)++sortMsgBag :: Maybe DynFlags -> Bag ErrMsg -> [ErrMsg]+sortMsgBag dflags = maybeLimit . sortBy (maybeFlip cmp) . bagToList+  where maybeFlip :: (a -> a -> b) -> (a -> a -> b)+        maybeFlip+          | fromMaybe False (fmap reverseErrors dflags) = flip+          | otherwise                                   = id+        cmp = comparing errMsgSpan+        maybeLimit = case join (fmap maxErrors dflags) of+          Nothing        -> id+          Just err_limit -> take err_limit++ghcExit :: DynFlags -> Int -> IO ()+ghcExit dflags val+  | val == 0  = exitWith ExitSuccess+  | otherwise = do errorMsg dflags (text "\nCompilation had errors\n\n")+                   exitWith (ExitFailure val)++doIfSet :: Bool -> IO () -> IO ()+doIfSet flag action | flag      = action+                    | otherwise = return ()++doIfSet_dyn :: DynFlags -> GeneralFlag -> IO () -> IO()+doIfSet_dyn dflags flag action | gopt flag dflags = action+                               | otherwise        = return ()++-- -----------------------------------------------------------------------------+-- Dumping++dumpIfSet :: DynFlags -> Bool -> String -> SDoc -> IO ()+dumpIfSet dflags flag hdr doc+  | not flag   = return ()+  | otherwise  = putLogMsg  dflags+                            NoReason+                            SevDump+                            noSrcSpan+                            (defaultDumpStyle dflags)+                            (mkDumpDoc hdr doc)++-- | a wrapper around 'dumpSDoc'.+-- First check whether the dump flag is set+-- Do nothing if it is unset+dumpIfSet_dyn :: DynFlags -> DumpFlag -> String -> SDoc -> IO ()+dumpIfSet_dyn dflags flag hdr doc+  = when (dopt flag dflags) $ dumpSDoc dflags alwaysQualify flag hdr doc++-- | a wrapper around 'dumpSDoc'.+-- First check whether the dump flag is set+-- Do nothing if it is unset+--+-- Unlike 'dumpIfSet_dyn',+-- has a printer argument but no header argument+dumpIfSet_dyn_printer :: PrintUnqualified+                      -> DynFlags -> DumpFlag -> SDoc -> IO ()+dumpIfSet_dyn_printer printer dflags flag doc+  = when (dopt flag dflags) $ dumpSDoc dflags printer flag "" doc++mkDumpDoc :: String -> SDoc -> SDoc+mkDumpDoc hdr doc+   = vcat [blankLine,+           line <+> text hdr <+> line,+           doc,+           blankLine]+     where+        line = text (replicate 20 '=')++-- | Run an action with the handle of a 'DumpFlag' if we are outputting to a+-- file, otherwise 'Nothing'.+withDumpFileHandle :: DynFlags -> DumpFlag -> (Maybe Handle -> IO ()) -> IO ()+withDumpFileHandle dflags flag action = do+    let mFile = chooseDumpFile dflags flag+    case mFile of+      Just fileName -> do+        let gdref = generatedDumps dflags+        gd <- readIORef gdref+        let append = Set.member fileName gd+            mode = if append then AppendMode else WriteMode+        unless append $+            writeIORef gdref (Set.insert fileName gd)+        createDirectoryIfMissing True (takeDirectory fileName)+        withFile fileName mode $ \handle -> do+            -- We do not want the dump file to be affected by+            -- environment variables, but instead to always use+            -- UTF8. See:+            -- https://gitlab.haskell.org/ghc/ghc/issues/10762+            hSetEncoding handle utf8++            action (Just handle)+      Nothing -> action Nothing+++dumpSDoc, dumpSDocForUser+  :: DynFlags -> PrintUnqualified -> DumpFlag -> String -> SDoc -> IO ()++-- | A wrapper around 'dumpSDocWithStyle' which uses 'PprDump' style.+dumpSDoc dflags print_unqual+  = dumpSDocWithStyle dump_style dflags+  where dump_style = mkDumpStyle dflags print_unqual++-- | A wrapper around 'dumpSDocWithStyle' which uses 'PprUser' style.+dumpSDocForUser dflags print_unqual+  = dumpSDocWithStyle user_style dflags+  where user_style = mkUserStyle dflags print_unqual AllTheWay++-- | Write out a dump.+-- If --dump-to-file is set then this goes to a file.+-- otherwise emit to stdout.+--+-- When @hdr@ is empty, we print in a more compact format (no separators and+-- blank lines)+--+-- The 'DumpFlag' is used only to choose the filename to use if @--dump-to-file@+-- is used; it is not used to decide whether to dump the output+dumpSDocWithStyle :: PprStyle -> DynFlags -> DumpFlag -> String -> SDoc -> IO ()+dumpSDocWithStyle sty dflags flag hdr doc =+    withDumpFileHandle dflags flag writeDump+  where+    -- write dump to file+    writeDump (Just handle) = do+        doc' <- if null hdr+                then return doc+                else do t <- getCurrentTime+                        let timeStamp = if (gopt Opt_SuppressTimestamps dflags)+                                          then empty+                                          else text (show t)+                        let d = timeStamp+                                $$ blankLine+                                $$ doc+                        return $ mkDumpDoc hdr d+        defaultLogActionHPrintDoc dflags handle doc' sty++    -- write the dump to stdout+    writeDump Nothing = do+        let (doc', severity)+              | null hdr  = (doc, SevOutput)+              | otherwise = (mkDumpDoc hdr doc, SevDump)+        putLogMsg dflags NoReason severity noSrcSpan sty doc'+++-- | Choose where to put a dump file based on DynFlags+--+chooseDumpFile :: DynFlags -> DumpFlag -> Maybe FilePath+chooseDumpFile dflags flag++        | gopt Opt_DumpToFile dflags || flag == Opt_D_th_dec_file+        , Just prefix <- getPrefix+        = Just $ setDir (prefix ++ (beautifyDumpName flag))++        | otherwise+        = Nothing++        where getPrefix+                 -- dump file location is being forced+                 --      by the --ddump-file-prefix flag.+               | Just prefix <- dumpPrefixForce dflags+                  = Just prefix+                 -- dump file location chosen by DriverPipeline.runPipeline+               | Just prefix <- dumpPrefix dflags+                  = Just prefix+                 -- we haven't got a place to put a dump file.+               | otherwise+                  = Nothing+              setDir f = case dumpDir dflags of+                         Just d  -> d </> f+                         Nothing ->       f++-- | Build a nice file name from name of a 'DumpFlag' constructor+beautifyDumpName :: DumpFlag -> String+beautifyDumpName Opt_D_th_dec_file = "th.hs"+beautifyDumpName flag+ = let str = show flag+       suff = case stripPrefix "Opt_D_" str of+              Just x -> x+              Nothing -> panic ("Bad flag name: " ++ str)+       dash = map (\c -> if c == '_' then '-' else c) suff+   in dash+++-- -----------------------------------------------------------------------------+-- Outputting messages from the compiler++-- We want all messages to go through one place, so that we can+-- redirect them if necessary.  For example, when GHC is used as a+-- library we might want to catch all messages that GHC tries to+-- output and do something else with them.++ifVerbose :: DynFlags -> Int -> IO () -> IO ()+ifVerbose dflags val act+  | verbosity dflags >= val = act+  | otherwise               = return ()++errorMsg :: DynFlags -> MsgDoc -> IO ()+errorMsg dflags msg+   = putLogMsg dflags NoReason SevError noSrcSpan (defaultErrStyle dflags) msg++warningMsg :: DynFlags -> MsgDoc -> IO ()+warningMsg dflags msg+   = putLogMsg dflags NoReason SevWarning noSrcSpan (defaultErrStyle dflags) msg++fatalErrorMsg :: DynFlags -> MsgDoc -> IO ()+fatalErrorMsg dflags msg =+    putLogMsg dflags NoReason SevFatal noSrcSpan (defaultErrStyle dflags) msg++fatalErrorMsg'' :: FatalMessager -> String -> IO ()+fatalErrorMsg'' fm msg = fm msg++compilationProgressMsg :: DynFlags -> String -> IO ()+compilationProgressMsg dflags msg+  = ifVerbose dflags 1 $+    logOutput dflags (defaultUserStyle dflags) (text msg)++showPass :: DynFlags -> String -> IO ()+showPass dflags what+  = ifVerbose dflags 2 $+    logInfo dflags (defaultUserStyle dflags) (text "***" <+> text what <> colon)++-- | Time a compilation phase.+--+-- When timings are enabled (e.g. with the @-v2@ flag), the allocations+-- and CPU time used by the phase will be reported to stderr. Consider+-- a typical usage: @withTiming getDynFlags (text "simplify") force pass@.+-- When timings are enabled the following costs are included in the+-- produced accounting,+--+--  - The cost of executing @pass@ to a result @r@ in WHNF+--  - The cost of evaluating @force r@ to WHNF (e.g. @()@)+--+-- The choice of the @force@ function depends upon the amount of forcing+-- desired; the goal here is to ensure that the cost of evaluating the result+-- is, to the greatest extent possible, included in the accounting provided by+-- 'withTiming'. Often the pass already sufficiently forces its result during+-- construction; in this case @const ()@ is a reasonable choice.+-- In other cases, it is necessary to evaluate the result to normal form, in+-- which case something like @Control.DeepSeq.rnf@ is appropriate.+--+-- To avoid adversely affecting compiler performance when timings are not+-- requested, the result is only forced when timings are enabled.+withTiming :: MonadIO m+           => m DynFlags  -- ^ A means of getting a 'DynFlags' (often+                          -- 'getDynFlags' will work here)+           -> SDoc        -- ^ The name of the phase+           -> (a -> ())   -- ^ A function to force the result+                          -- (often either @const ()@ or 'rnf')+           -> m a         -- ^ The body of the phase to be timed+           -> m a+withTiming getDFlags what force_result action+  = do dflags <- getDFlags+       if verbosity dflags >= 2 || dopt Opt_D_dump_timings dflags+          then do liftIO $ logInfo dflags (defaultUserStyle dflags)+                         $ text "***" <+> what <> colon+                  alloc0 <- liftIO getAllocationCounter+                  start <- liftIO getCPUTime+                  !r <- action+                  () <- pure $ force_result r+                  end <- liftIO getCPUTime+                  alloc1 <- liftIO getAllocationCounter+                  -- recall that allocation counter counts down+                  let alloc = alloc0 - alloc1+                      time = realToFrac (end - start) * 1e-9++                  when (verbosity dflags >= 2)+                      $ liftIO $ logInfo dflags (defaultUserStyle dflags)+                          (text "!!!" <+> what <> colon <+> text "finished in"+                           <+> doublePrec 2 time+                           <+> text "milliseconds"+                           <> comma+                           <+> text "allocated"+                           <+> doublePrec 3 (realToFrac alloc / 1024 / 1024)+                           <+> text "megabytes")++                  liftIO $ dumpIfSet_dyn dflags Opt_D_dump_timings ""+                      $ text $ showSDocOneLine dflags+                      $ hsep [ what <> colon+                             , text "alloc=" <> ppr alloc+                             , text "time=" <> doublePrec 3 time+                             ]+                  pure r+           else action++debugTraceMsg :: DynFlags -> Int -> MsgDoc -> IO ()+debugTraceMsg dflags val msg = ifVerbose dflags val $+                               logInfo dflags (defaultDumpStyle dflags) msg+putMsg :: DynFlags -> MsgDoc -> IO ()+putMsg dflags msg = logInfo dflags (defaultUserStyle dflags) msg++printInfoForUser :: DynFlags -> PrintUnqualified -> MsgDoc -> IO ()+printInfoForUser dflags print_unqual msg+  = logInfo dflags (mkUserStyle dflags print_unqual AllTheWay) msg++printOutputForUser :: DynFlags -> PrintUnqualified -> MsgDoc -> IO ()+printOutputForUser dflags print_unqual msg+  = logOutput dflags (mkUserStyle dflags print_unqual AllTheWay) msg++logInfo :: DynFlags -> PprStyle -> MsgDoc -> IO ()+logInfo dflags sty msg+  = putLogMsg dflags NoReason SevInfo noSrcSpan sty msg++logOutput :: DynFlags -> PprStyle -> MsgDoc -> IO ()+-- ^ Like 'logInfo' but with 'SevOutput' rather then 'SevInfo'+logOutput dflags sty msg+  = putLogMsg dflags NoReason SevOutput noSrcSpan sty msg++prettyPrintGhcErrors :: ExceptionMonad m => DynFlags -> m a -> m a+prettyPrintGhcErrors dflags+    = ghandle $ \e -> case e of+                      PprPanic str doc ->+                          pprDebugAndThen dflags panic (text str) doc+                      PprSorry str doc ->+                          pprDebugAndThen dflags sorry (text str) doc+                      PprProgramError str doc ->+                          pprDebugAndThen dflags pgmError (text str) doc+                      _ ->+                          liftIO $ throwIO e++-- | Checks if given 'WarnMsg' is a fatal warning.+isWarnMsgFatal :: DynFlags -> WarnMsg -> Maybe (Maybe WarningFlag)+isWarnMsgFatal dflags ErrMsg{errMsgReason = Reason wflag}+  = if wopt_fatal wflag dflags+      then Just (Just wflag)+      else Nothing+isWarnMsgFatal dflags _+  = if gopt Opt_WarnIsError dflags+      then Just Nothing+      else Nothing++traceCmd :: DynFlags -> String -> String -> IO a -> IO a+-- trace the command (at two levels of verbosity)+traceCmd dflags phase_name cmd_line action+ = do   { let verb = verbosity dflags+        ; showPass dflags phase_name+        ; debugTraceMsg dflags 3 (text cmd_line)+        ; case flushErr dflags of+              FlushErr io -> io++           -- And run it!+        ; action `catchIO` handle_exn verb+        }+  where+    handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n')+                              ; debugTraceMsg dflags 2+                                (text "Failed:"+                                 <+> text cmd_line+                                 <+> text (show exn))+                              ; throwGhcExceptionIO (ProgramError (show exn))}
+ compiler/main/ErrUtils.hs-boot view
@@ -0,0 +1,26 @@+module ErrUtils where++import GhcPrelude+import Outputable (SDoc, PrintUnqualified )+import SrcLoc (SrcSpan)+import Json+import {-# SOURCE #-} DynFlags ( DynFlags, DumpFlag )++data Severity+  = SevOutput+  | SevFatal+  | SevInteractive+  | SevDump+  | SevInfo+  | SevWarning+  | SevError+++type MsgDoc = SDoc++mkLocMessage :: Severity -> SrcSpan -> MsgDoc -> MsgDoc+mkLocMessageAnn :: Maybe String -> Severity -> SrcSpan -> MsgDoc -> MsgDoc+getCaretDiagnostic :: Severity -> SrcSpan -> IO MsgDoc+dumpSDoc :: DynFlags -> PrintUnqualified -> DumpFlag -> String -> SDoc -> IO ()++instance ToJson Severity
+ compiler/main/FileCleanup.hs view
@@ -0,0 +1,314 @@+{-# LANGUAGE CPP #-}+module FileCleanup+  ( TempFileLifetime(..)+  , cleanTempDirs, cleanTempFiles, cleanCurrentModuleTempFiles+  , addFilesToClean, changeTempFilesLifetime+  , newTempName, newTempLibName, newTempDir+  , withSystemTempDirectory, withTempDirectory+  ) where++import GhcPrelude++import DynFlags+import ErrUtils+import Outputable+import Util+import Exception+import DriverPhases++import Control.Monad+import Data.List+import qualified Data.Set as Set+import qualified Data.Map as Map+import Data.IORef+import System.Directory+import System.FilePath+import System.IO.Error++#if !defined(mingw32_HOST_OS)+import qualified System.Posix.Internals+#endif++-- | Used when a temp file is created. This determines which component Set of+-- FilesToClean will get the temp file+data TempFileLifetime+  = TFL_CurrentModule+  -- ^ A file with lifetime TFL_CurrentModule will be cleaned up at the+  -- end of upweep_mod+  | TFL_GhcSession+  -- ^ A file with lifetime TFL_GhcSession will be cleaned up at the end of+  -- runGhc(T)+  deriving (Show)++cleanTempDirs :: DynFlags -> IO ()+cleanTempDirs dflags+   = unless (gopt Opt_KeepTmpFiles dflags)+   $ mask_+   $ do let ref = dirsToClean dflags+        ds <- atomicModifyIORef' ref $ \ds -> (Map.empty, ds)+        removeTmpDirs dflags (Map.elems ds)++-- | Delete all files in @filesToClean dflags@.+cleanTempFiles :: DynFlags -> IO ()+cleanTempFiles dflags+   = unless (gopt Opt_KeepTmpFiles dflags)+   $ mask_+   $ do let ref = filesToClean dflags+        to_delete <- atomicModifyIORef' ref $+            \FilesToClean+                { ftcCurrentModule = cm_files+                , ftcGhcSession = gs_files+                } -> ( emptyFilesToClean+                     , Set.toList cm_files ++ Set.toList gs_files)+        removeTmpFiles dflags to_delete++-- | Delete all files in @filesToClean dflags@. That have lifetime+-- TFL_CurrentModule.+-- If a file must be cleaned eventually, but must survive a+-- cleanCurrentModuleTempFiles, ensure it has lifetime TFL_GhcSession.+cleanCurrentModuleTempFiles :: DynFlags -> IO ()+cleanCurrentModuleTempFiles dflags+   = unless (gopt Opt_KeepTmpFiles dflags)+   $ mask_+   $ do let ref = filesToClean dflags+        to_delete <- atomicModifyIORef' ref $+            \ftc@FilesToClean{ftcCurrentModule = cm_files} ->+                (ftc {ftcCurrentModule = Set.empty}, Set.toList cm_files)+        removeTmpFiles dflags to_delete++-- | Ensure that new_files are cleaned on the next call of+-- 'cleanTempFiles' or 'cleanCurrentModuleTempFiles', depending on lifetime.+-- If any of new_files are already tracked, they will have their lifetime+-- updated.+addFilesToClean :: DynFlags -> TempFileLifetime -> [FilePath] -> IO ()+addFilesToClean dflags lifetime new_files = modifyIORef' (filesToClean dflags) $+  \FilesToClean+    { ftcCurrentModule = cm_files+    , ftcGhcSession = gs_files+    } -> case lifetime of+      TFL_CurrentModule -> FilesToClean+        { ftcCurrentModule = cm_files `Set.union` new_files_set+        , ftcGhcSession = gs_files `Set.difference` new_files_set+        }+      TFL_GhcSession -> FilesToClean+        { ftcCurrentModule = cm_files `Set.difference` new_files_set+        , ftcGhcSession = gs_files `Set.union` new_files_set+        }+  where+    new_files_set = Set.fromList new_files++-- | Update the lifetime of files already being tracked. If any files are+-- not being tracked they will be discarded.+changeTempFilesLifetime :: DynFlags -> TempFileLifetime -> [FilePath] -> IO ()+changeTempFilesLifetime dflags lifetime files = do+  FilesToClean+    { ftcCurrentModule = cm_files+    , ftcGhcSession = gs_files+    } <- readIORef (filesToClean dflags)+  let old_set = case lifetime of+        TFL_CurrentModule -> gs_files+        TFL_GhcSession -> cm_files+      existing_files = [f | f <- files, f `Set.member` old_set]+  addFilesToClean dflags lifetime existing_files++-- Return a unique numeric temp file suffix+newTempSuffix :: DynFlags -> IO Int+newTempSuffix dflags =+  atomicModifyIORef' (nextTempSuffix dflags) $ \n -> (n+1,n)++-- Find a temporary name that doesn't already exist.+newTempName :: DynFlags -> TempFileLifetime -> Suffix -> IO FilePath+newTempName dflags lifetime extn+  = do d <- getTempDir dflags+       findTempName (d </> "ghc_") -- See Note [Deterministic base name]+  where+    findTempName :: FilePath -> IO FilePath+    findTempName prefix+      = do n <- newTempSuffix dflags+           let filename = prefix ++ show n <.> extn+           b <- doesFileExist filename+           if b then findTempName prefix+                else do -- clean it up later+                        addFilesToClean dflags lifetime [filename]+                        return filename++newTempDir :: DynFlags -> IO FilePath+newTempDir dflags+  = do d <- getTempDir dflags+       findTempDir (d </> "ghc_")+  where+    findTempDir :: FilePath -> IO FilePath+    findTempDir prefix+      = do n <- newTempSuffix dflags+           let filename = prefix ++ show n+           b <- doesDirectoryExist filename+           if b then findTempDir prefix+                else do createDirectory filename+                        -- see mkTempDir below; this is wrong: -> consIORef (dirsToClean dflags) filename+                        return filename++newTempLibName :: DynFlags -> TempFileLifetime -> Suffix+  -> IO (FilePath, FilePath, String)+newTempLibName dflags lifetime extn+  = do d <- getTempDir dflags+       findTempName d ("ghc_")+  where+    findTempName :: FilePath -> String -> IO (FilePath, FilePath, String)+    findTempName dir prefix+      = do n <- newTempSuffix dflags -- See Note [Deterministic base name]+           let libname = prefix ++ show n+               filename = dir </> "lib" ++ libname <.> extn+           b <- doesFileExist filename+           if b then findTempName dir prefix+                else do -- clean it up later+                        addFilesToClean dflags lifetime [filename]+                        return (filename, dir, libname)+++-- Return our temporary directory within tmp_dir, creating one if we+-- don't have one yet.+getTempDir :: DynFlags -> IO FilePath+getTempDir dflags = do+    mapping <- readIORef dir_ref+    case Map.lookup tmp_dir mapping of+        Nothing -> do+            pid <- getProcessID+            let prefix = tmp_dir </> "ghc" ++ show pid ++ "_"+            mask_ $ mkTempDir prefix+        Just dir -> return dir+  where+    tmp_dir = tmpDir dflags+    dir_ref = dirsToClean dflags++    mkTempDir :: FilePath -> IO FilePath+    mkTempDir prefix = do+        n <- newTempSuffix dflags+        let our_dir = prefix ++ show n++        -- 1. Speculatively create our new directory.+        createDirectory our_dir++        -- 2. Update the dirsToClean mapping unless an entry already exists+        -- (i.e. unless another thread beat us to it).+        their_dir <- atomicModifyIORef' dir_ref $ \mapping ->+            case Map.lookup tmp_dir mapping of+                Just dir -> (mapping, Just dir)+                Nothing  -> (Map.insert tmp_dir our_dir mapping, Nothing)++        -- 3. If there was an existing entry, return it and delete the+        -- directory we created.  Otherwise return the directory we created.+        case their_dir of+            Nothing  -> do+                debugTraceMsg dflags 2 $+                    text "Created temporary directory:" <+> text our_dir+                return our_dir+            Just dir -> do+                removeDirectory our_dir+                return dir+      `catchIO` \e -> if isAlreadyExistsError e+                      then mkTempDir prefix else ioError e++{- Note [Deterministic base name]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++The filename of temporary files, especially the basename of C files, can end+up in the output in some form, e.g. as part of linker debug information. In the+interest of bit-wise exactly reproducible compilation (#4012), the basename of+the temporary file no longer contains random information (it used to contain+the process id).++This is ok, as the temporary directory used contains the pid (see getTempDir).+-}+removeTmpDirs :: DynFlags -> [FilePath] -> IO ()+removeTmpDirs dflags ds+  = traceCmd dflags "Deleting temp dirs"+             ("Deleting: " ++ unwords ds)+             (mapM_ (removeWith dflags removeDirectory) ds)++removeTmpFiles :: DynFlags -> [FilePath] -> IO ()+removeTmpFiles dflags fs+  = warnNon $+    traceCmd dflags "Deleting temp files"+             ("Deleting: " ++ unwords deletees)+             (mapM_ (removeWith dflags removeFile) deletees)+  where+     -- Flat out refuse to delete files that are likely to be source input+     -- files (is there a worse bug than having a compiler delete your source+     -- files?)+     --+     -- Deleting source files is a sign of a bug elsewhere, so prominently flag+     -- the condition.+    warnNon act+     | null non_deletees = act+     | otherwise         = do+        putMsg dflags (text "WARNING - NOT deleting source files:"+                       <+> hsep (map text non_deletees))+        act++    (non_deletees, deletees) = partition isHaskellUserSrcFilename fs++removeWith :: DynFlags -> (FilePath -> IO ()) -> FilePath -> IO ()+removeWith dflags remover f = remover f `catchIO`+  (\e ->+   let msg = if isDoesNotExistError e+             then text "Warning: deleting non-existent" <+> text f+             else text "Warning: exception raised when deleting"+                                            <+> text f <> colon+               $$ text (show e)+   in debugTraceMsg dflags 2 msg+  )++#if defined(mingw32_HOST_OS)+-- relies on Int == Int32 on Windows+foreign import ccall unsafe "_getpid" getProcessID :: IO Int+#else+getProcessID :: IO Int+getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral+#endif++-- The following three functions are from the `temporary` package.++-- | Create and use a temporary directory in the system standard temporary+-- directory.+--+-- Behaves exactly the same as 'withTempDirectory', except that the parent+-- temporary directory will be that returned by 'getTemporaryDirectory'.+withSystemTempDirectory :: String   -- ^ Directory name template. See 'openTempFile'.+                        -> (FilePath -> IO a) -- ^ Callback that can use the directory+                        -> IO a+withSystemTempDirectory template action =+  getTemporaryDirectory >>= \tmpDir -> withTempDirectory tmpDir template action+++-- | Create and use a temporary directory.+--+-- Creates a new temporary directory inside the given directory, making use+-- of the template. The temp directory is deleted after use. For example:+--+-- > withTempDirectory "src" "sdist." $ \tmpDir -> do ...+--+-- The @tmpDir@ will be a new subdirectory of the given directory, e.g.+-- @src/sdist.342@.+withTempDirectory :: FilePath -- ^ Temp directory to create the directory in+                  -> String   -- ^ Directory name template. See 'openTempFile'.+                  -> (FilePath -> IO a) -- ^ Callback that can use the directory+                  -> IO a+withTempDirectory targetDir template =+  Exception.bracket+    (createTempDirectory targetDir template)+    (ignoringIOErrors . removeDirectoryRecursive)++ignoringIOErrors :: IO () -> IO ()+ignoringIOErrors ioe = ioe `catch` (\e -> const (return ()) (e :: IOError))+++createTempDirectory :: FilePath -> String -> IO FilePath+createTempDirectory dir template = do+  pid <- getProcessID+  findTempName pid+  where findTempName x = do+            let path = dir </> template ++ show x+            createDirectory path+            return path+          `catchIO` \e -> if isAlreadyExistsError e+                          then findTempName (x+1) else ioError e
+ compiler/main/GhcMonad.hs view
@@ -0,0 +1,209 @@+{-# LANGUAGE CPP, RankNTypes #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}+-- -----------------------------------------------------------------------------+--+-- (c) The University of Glasgow, 2010+--+-- The Session type and related functionality+--+-- -----------------------------------------------------------------------------++module GhcMonad (+        -- * 'Ghc' monad stuff+        GhcMonad(..),+        Ghc(..),+        GhcT(..), liftGhcT,+        reflectGhc, reifyGhc,+        getSessionDynFlags,+        liftIO,+        Session(..), withSession, modifySession, withTempSession,++        -- ** Warnings+        logWarnings, printException,+        WarnErrLogger, defaultWarnErrLogger+  ) where++import GhcPrelude++import MonadUtils+import HscTypes+import DynFlags+import Exception+import ErrUtils++import Control.Monad+import Data.IORef++-- -----------------------------------------------------------------------------+-- | A monad that has all the features needed by GHC API calls.+--+-- In short, a GHC monad+--+--   - allows embedding of IO actions,+--+--   - can log warnings,+--+--   - allows handling of (extensible) exceptions, and+--+--   - maintains a current session.+--+-- If you do not use 'Ghc' or 'GhcT', make sure to call 'GHC.initGhcMonad'+-- before any call to the GHC API functions can occur.+--+class (Functor m, MonadIO m, ExceptionMonad m, HasDynFlags m) => GhcMonad m where+  getSession :: m HscEnv+  setSession :: HscEnv -> m ()++-- | Call the argument with the current session.+withSession :: GhcMonad m => (HscEnv -> m a) -> m a+withSession f = getSession >>= f++-- | Grabs the DynFlags from the Session+getSessionDynFlags :: GhcMonad m => m DynFlags+getSessionDynFlags = withSession (return . hsc_dflags)++-- | Set the current session to the result of applying the current session to+-- the argument.+modifySession :: GhcMonad m => (HscEnv -> HscEnv) -> m ()+modifySession f = do h <- getSession+                     setSession $! f h++withSavedSession :: GhcMonad m => m a -> m a+withSavedSession m = do+  saved_session <- getSession+  m `gfinally` setSession saved_session++-- | Call an action with a temporarily modified Session.+withTempSession :: GhcMonad m => (HscEnv -> HscEnv) -> m a -> m a+withTempSession f m =+  withSavedSession $ modifySession f >> m++-- -----------------------------------------------------------------------------+-- | A monad that allows logging of warnings.++logWarnings :: GhcMonad m => WarningMessages -> m ()+logWarnings warns = do+  dflags <- getSessionDynFlags+  liftIO $ printOrThrowWarnings dflags warns++-- -----------------------------------------------------------------------------+-- | A minimal implementation of a 'GhcMonad'.  If you need a custom monad,+-- e.g., to maintain additional state consider wrapping this monad or using+-- 'GhcT'.+newtype Ghc a = Ghc { unGhc :: Session -> IO a }++-- | The Session is a handle to the complete state of a compilation+-- session.  A compilation session consists of a set of modules+-- constituting the current program or library, the context for+-- interactive evaluation, and various caches.+data Session = Session !(IORef HscEnv)++instance Functor Ghc where+  fmap f m = Ghc $ \s -> f `fmap` unGhc m s++instance Applicative Ghc where+  pure a = Ghc $ \_ -> return a+  g <*> m = do f <- g; a <- m; return (f a)++instance Monad Ghc where+  m >>= g  = Ghc $ \s -> do a <- unGhc m s; unGhc (g a) s++instance MonadIO Ghc where+  liftIO ioA = Ghc $ \_ -> ioA++instance MonadFix Ghc where+  mfix f = Ghc $ \s -> mfix (\x -> unGhc (f x) s)++instance ExceptionMonad Ghc where+  gcatch act handle =+      Ghc $ \s -> unGhc act s `gcatch` \e -> unGhc (handle e) s+  gmask f =+      Ghc $ \s -> gmask $ \io_restore ->+                             let+                                g_restore (Ghc m) = Ghc $ \s -> io_restore (m s)+                             in+                                unGhc (f g_restore) s++instance HasDynFlags Ghc where+  getDynFlags = getSessionDynFlags++instance GhcMonad Ghc where+  getSession = Ghc $ \(Session r) -> readIORef r+  setSession s' = Ghc $ \(Session r) -> writeIORef r s'++-- | Reflect a computation in the 'Ghc' monad into the 'IO' monad.+--+-- You can use this to call functions returning an action in the 'Ghc' monad+-- inside an 'IO' action.  This is needed for some (too restrictive) callback+-- arguments of some library functions:+--+-- > libFunc :: String -> (Int -> IO a) -> IO a+-- > ghcFunc :: Int -> Ghc a+-- >+-- > ghcFuncUsingLibFunc :: String -> Ghc a -> Ghc a+-- > ghcFuncUsingLibFunc str =+-- >   reifyGhc $ \s ->+-- >     libFunc $ \i -> do+-- >       reflectGhc (ghcFunc i) s+--+reflectGhc :: Ghc a -> Session -> IO a+reflectGhc m = unGhc m++-- > Dual to 'reflectGhc'.  See its documentation.+reifyGhc :: (Session -> IO a) -> Ghc a+reifyGhc act = Ghc $ act++-- -----------------------------------------------------------------------------+-- | A monad transformer to add GHC specific features to another monad.+--+-- Note that the wrapped monad must support IO and handling of exceptions.+newtype GhcT m a = GhcT { unGhcT :: Session -> m a }++liftGhcT :: m a -> GhcT m a+liftGhcT m = GhcT $ \_ -> m++instance Functor m => Functor (GhcT m) where+  fmap f m = GhcT $ \s -> f `fmap` unGhcT m s++instance Applicative m => Applicative (GhcT m) where+  pure x  = GhcT $ \_ -> pure x+  g <*> m = GhcT $ \s -> unGhcT g s <*> unGhcT m s++instance Monad m => Monad (GhcT m) where+  m >>= k  = GhcT $ \s -> do a <- unGhcT m s; unGhcT (k a) s++instance MonadIO m => MonadIO (GhcT m) where+  liftIO ioA = GhcT $ \_ -> liftIO ioA++instance ExceptionMonad m => ExceptionMonad (GhcT m) where+  gcatch act handle =+      GhcT $ \s -> unGhcT act s `gcatch` \e -> unGhcT (handle e) s+  gmask f =+      GhcT $ \s -> gmask $ \io_restore ->+                           let+                              g_restore (GhcT m) = GhcT $ \s -> io_restore (m s)+                           in+                              unGhcT (f g_restore) s++instance MonadIO m => HasDynFlags (GhcT m) where+  getDynFlags = GhcT $ \(Session r) -> liftM hsc_dflags (liftIO $ readIORef r)++instance ExceptionMonad m => GhcMonad (GhcT m) where+  getSession = GhcT $ \(Session r) -> liftIO $ readIORef r+  setSession s' = GhcT $ \(Session r) -> liftIO $ writeIORef r s'+++-- | Print the error message and all warnings.  Useful inside exception+--   handlers.  Clears warnings after printing.+printException :: GhcMonad m => SourceError -> m ()+printException err = do+  dflags <- getSessionDynFlags+  liftIO $ printBagOfErrors dflags (srcErrorMessages err)++-- | A function called to log warnings and errors.+type WarnErrLogger = forall m. GhcMonad m => Maybe SourceError -> m ()++defaultWarnErrLogger :: WarnErrLogger+defaultWarnErrLogger Nothing  = return ()+defaultWarnErrLogger (Just e) = printException e+
+ compiler/main/Hooks.hs view
@@ -0,0 +1,104 @@+-- \section[Hooks]{Low level API hooks}++-- NB: this module is SOURCE-imported by DynFlags, and should primarily+--     refer to *types*, rather than *code*++{-# LANGUAGE CPP #-}+module Hooks ( Hooks+             , emptyHooks+             , lookupHook+             , getHooked+               -- the hooks:+             , dsForeignsHook+             , tcForeignImportsHook+             , tcForeignExportsHook+             , hscFrontendHook+             , hscCompileCoreExprHook+             , ghcPrimIfaceHook+             , runPhaseHook+             , runMetaHook+             , linkHook+             , runRnSpliceHook+             , getValueSafelyHook+             , createIservProcessHook+             ) where++import GhcPrelude++import DynFlags+import PipelineMonad+import HscTypes+import HsDecls+import HsBinds+import HsExpr+import OrdList+import TcRnTypes+import Bag+import RdrName+import Name+import Id+import CoreSyn+import GHCi.RemoteTypes+import SrcLoc+import Type+import System.Process+import BasicTypes+import HsExtension++import Data.Maybe++{-+************************************************************************+*                                                                      *+\subsection{Hooks}+*                                                                      *+************************************************************************+-}++-- | Hooks can be used by GHC API clients to replace parts of+--   the compiler pipeline. If a hook is not installed, GHC+--   uses the default built-in behaviour++emptyHooks :: Hooks+emptyHooks = Hooks+  { dsForeignsHook         = Nothing+  , tcForeignImportsHook   = Nothing+  , tcForeignExportsHook   = Nothing+  , hscFrontendHook        = Nothing+  , hscCompileCoreExprHook = Nothing+  , ghcPrimIfaceHook       = Nothing+  , runPhaseHook           = Nothing+  , runMetaHook            = Nothing+  , linkHook               = Nothing+  , runRnSpliceHook        = Nothing+  , getValueSafelyHook     = Nothing+  , createIservProcessHook = Nothing+  }++data Hooks = Hooks+  { dsForeignsHook         :: Maybe ([LForeignDecl GhcTc]+                           -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))+  , tcForeignImportsHook   :: Maybe ([LForeignDecl GhcRn]+                          -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt))+  , tcForeignExportsHook   :: Maybe ([LForeignDecl GhcRn]+            -> TcM (LHsBinds GhcTcId, [LForeignDecl GhcTcId], Bag GlobalRdrElt))+  , hscFrontendHook        :: Maybe (ModSummary -> Hsc FrontendResult)+  , hscCompileCoreExprHook ::+               Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue)+  , ghcPrimIfaceHook       :: Maybe ModIface+  , runPhaseHook           :: Maybe (PhasePlus -> FilePath -> DynFlags+                                         -> CompPipeline (PhasePlus, FilePath))+  , runMetaHook            :: Maybe (MetaHook TcM)+  , linkHook               :: Maybe (GhcLink -> DynFlags -> Bool+                                         -> HomePackageTable -> IO SuccessFlag)+  , runRnSpliceHook        :: Maybe (HsSplice GhcRn -> RnM (HsSplice GhcRn))+  , getValueSafelyHook     :: Maybe (HscEnv -> Name -> Type+                                                          -> IO (Maybe HValue))+  , createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle)+  }++getHooked :: (Functor f, HasDynFlags f) => (Hooks -> Maybe a) -> a -> f a+getHooked hook def = fmap (lookupHook hook def) getDynFlags++lookupHook :: (Hooks -> Maybe a) -> a -> DynFlags -> a+lookupHook hook def = fromMaybe def . hook . hooks
+ compiler/main/Hooks.hs-boot view
@@ -0,0 +1,7 @@+module Hooks where++import GhcPrelude ()++data Hooks++emptyHooks :: Hooks
+ compiler/main/HscTypes.hs view
@@ -0,0 +1,3138 @@+{-+(c) The University of Glasgow, 2006++\section[HscTypes]{Types for the per-module compiler}+-}++{-# LANGUAGE CPP, ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++-- | Types for the per-module compiler+module HscTypes (+        -- * compilation state+        HscEnv(..), hscEPS,+        FinderCache, FindResult(..), InstalledFindResult(..),+        Target(..), TargetId(..), pprTarget, pprTargetId,+        HscStatus(..),+        IServ(..),++        -- * ModuleGraph+        ModuleGraph, emptyMG, mkModuleGraph, extendMG, mapMG,+        mgModSummaries, mgElemModule, mgLookupModule,+        needsTemplateHaskellOrQQ, mgBootModules,++        -- * Hsc monad+        Hsc(..), runHsc, mkInteractiveHscEnv, runInteractiveHsc,++        -- * Information about modules+        ModDetails(..), emptyModDetails,+        ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,+        ImportedMods, ImportedBy(..), importedByUser, ImportedModsVal(..), SptEntry(..),+        ForeignSrcLang(..),++        ModSummary(..), ms_imps, ms_installed_mod, ms_mod_name, showModMsg, isBootSummary,+        msHsFilePath, msHiFilePath, msObjFilePath,+        SourceModified(..), isTemplateHaskellOrQQNonBoot,++        -- * Information about the module being compiled+        -- (re-exported from DriverPhases)+        HscSource(..), isHsBootOrSig, isHsigFile, hscSourceString,+++        -- * State relating to modules in this package+        HomePackageTable, HomeModInfo(..), emptyHomePackageTable,+        lookupHpt, eltsHpt, filterHpt, allHpt, mapHpt, delFromHpt,+        addToHpt, addListToHpt, lookupHptDirectly, listToHpt,+        hptCompleteSigs,+        hptInstances, hptRules, pprHPT,++        -- * State relating to known packages+        ExternalPackageState(..), EpsStats(..), addEpsInStats,+        PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,+        lookupIfaceByModule, emptyModIface, lookupHptByModule,++        PackageInstEnv, PackageFamInstEnv, PackageRuleBase,+        PackageCompleteMatchMap,++        mkSOName, mkHsSOName, soExt,++        -- * Metaprogramming+        MetaRequest(..),+        MetaResult, -- data constructors not exported to ensure correct response type+        metaRequestE, metaRequestP, metaRequestT, metaRequestD, metaRequestAW,+        MetaHook,++        -- * Annotations+        prepareAnnotations,++        -- * Interactive context+        InteractiveContext(..), emptyInteractiveContext,+        icPrintUnqual, icInScopeTTs, icExtendGblRdrEnv,+        extendInteractiveContext, extendInteractiveContextWithIds,+        substInteractiveContext,+        setInteractivePrintName, icInteractiveModule,+        InteractiveImport(..), setInteractivePackage,+        mkPrintUnqualified, pprModulePrefix,+        mkQualPackage, mkQualModule, pkgQual,++        -- * Interfaces+        ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,+        emptyIfaceWarnCache, mi_boot, mi_fix,+        mi_semantic_module,+        mi_free_holes,+        renameFreeHoles,++        -- * Fixity+        FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,++        -- * TyThings and type environments+        TyThing(..),  tyThingAvailInfo,+        tyThingTyCon, tyThingDataCon, tyThingConLike,+        tyThingId, tyThingCoAxiom, tyThingParent_maybe, tyThingsTyCoVars,+        implicitTyThings, implicitTyConThings, implicitClassThings,+        isImplicitTyThing,++        TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,+        typeEnvFromEntities, mkTypeEnvWithImplicits,+        extendTypeEnv, extendTypeEnvList,+        extendTypeEnvWithIds, plusTypeEnv,+        lookupTypeEnv,+        typeEnvElts, typeEnvTyCons, typeEnvIds, typeEnvPatSyns,+        typeEnvDataCons, typeEnvCoAxioms, typeEnvClasses,++        -- * MonadThings+        MonadThings(..),++        -- * Information on imports and exports+        WhetherHasOrphans, IsBootInterface, Usage(..),+        Dependencies(..), noDependencies,+        updNameCache,+        IfaceExport,++        -- * Warnings+        Warnings(..), WarningTxt(..), plusWarns,++        -- * Linker stuff+        Linkable(..), isObjectLinkable, linkableObjs,+        Unlinked(..), CompiledByteCode,+        isObject, nameOfObject, isInterpretable, byteCodeOfObject,++        -- * Program coverage+        HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,++        -- * Breakpoints+        ModBreaks (..), emptyModBreaks,++        -- * Safe Haskell information+        IfaceTrustInfo, getSafeMode, setSafeMode, noIfaceTrustInfo,+        trustInfoToNum, numToTrustInfo, IsSafeImport,++        -- * result of the parser+        HsParsedModule(..),++        -- * Compilation errors and warnings+        SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,+        throwOneError, throwErrors, handleSourceError,+        handleFlagWarnings, printOrThrowWarnings,++        -- * COMPLETE signature+        CompleteMatch(..), CompleteMatchMap,+        mkCompleteMatchMap, extendCompleteMatchMap+    ) where++#include "HsVersions.h"++import GhcPrelude++import ByteCodeTypes+import InteractiveEvalTypes ( Resume )+import GHCi.Message         ( Pipe )+import GHCi.RemoteTypes+import GHC.ForeignSrcLang++import UniqFM+import HsSyn+import RdrName+import Avail+import Module+import InstEnv          ( InstEnv, ClsInst, identicalClsInstHead )+import FamInstEnv+import CoreSyn          ( CoreProgram, RuleBase, CoreRule )+import Name+import NameEnv+import VarSet+import Var+import Id+import IdInfo           ( IdDetails(..), RecSelParent(..))+import Type++import ApiAnnotation    ( ApiAnns )+import Annotations      ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv )+import Class+import TyCon+import CoAxiom+import ConLike+import DataCon+import PatSyn+import PrelNames        ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule )+import TysWiredIn+import Packages hiding  ( Version(..) )+import CmdLineParser+import DynFlags+import DriverPhases     ( Phase, HscSource(..), hscSourceString+                        , isHsBootOrSig, isHsigFile )+import BasicTypes+import IfaceSyn+import Maybes+import Outputable+import SrcLoc+import Unique+import UniqDFM+import FastString+import StringBuffer     ( StringBuffer )+import Fingerprint+import MonadUtils+import Bag+import Binary+import ErrUtils+import NameCache+import Platform+import Util+import UniqDSet+import GHC.Serialized   ( Serialized )+import qualified GHC.LanguageExtensions as LangExt++import Foreign+import Control.Monad    ( guard, liftM, ap )+import Data.IORef+import Data.Time+import Exception+import System.FilePath+import Control.Concurrent+import System.Process   ( ProcessHandle )++-- -----------------------------------------------------------------------------+-- Compilation state+-- -----------------------------------------------------------------------------++-- | Status of a compilation to hard-code+data HscStatus+    = HscNotGeneratingCode+    | HscUpToDate+    | HscUpdateBoot+    | HscUpdateSig+    | HscRecomp CgGuts ModSummary++-- -----------------------------------------------------------------------------+-- The Hsc monad: Passing an environment and warning state++newtype Hsc a = Hsc (HscEnv -> WarningMessages -> IO (a, WarningMessages))++instance Functor Hsc where+    fmap = liftM++instance Applicative Hsc where+    pure a = Hsc $ \_ w -> return (a, w)+    (<*>) = ap++instance Monad Hsc where+    Hsc m >>= k = Hsc $ \e w -> do (a, w1) <- m e w+                                   case k a of+                                       Hsc k' -> k' e w1++instance MonadIO Hsc where+    liftIO io = Hsc $ \_ w -> do a <- io; return (a, w)++instance HasDynFlags Hsc where+    getDynFlags = Hsc $ \e w -> return (hsc_dflags e, w)++runHsc :: HscEnv -> Hsc a -> IO a+runHsc hsc_env (Hsc hsc) = do+    (a, w) <- hsc hsc_env emptyBag+    printOrThrowWarnings (hsc_dflags hsc_env) w+    return a++mkInteractiveHscEnv :: HscEnv -> HscEnv+mkInteractiveHscEnv hsc_env = hsc_env{ hsc_dflags = interactive_dflags }+  where+    interactive_dflags = ic_dflags (hsc_IC hsc_env)++runInteractiveHsc :: HscEnv -> Hsc a -> IO a+-- A variant of runHsc that switches in the DynFlags from the+-- InteractiveContext before running the Hsc computation.+runInteractiveHsc hsc_env = runHsc (mkInteractiveHscEnv hsc_env)++-- -----------------------------------------------------------------------------+-- Source Errors++-- When the compiler (HscMain) discovers errors, it throws an+-- exception in the IO monad.++mkSrcErr :: ErrorMessages -> SourceError+mkSrcErr = SourceError++srcErrorMessages :: SourceError -> ErrorMessages+srcErrorMessages (SourceError msgs) = msgs++mkApiErr :: DynFlags -> SDoc -> GhcApiError+mkApiErr dflags msg = GhcApiError (showSDoc dflags msg)++throwErrors :: MonadIO io => ErrorMessages -> io a+throwErrors = liftIO . throwIO . mkSrcErr++throwOneError :: MonadIO io => ErrMsg -> io a+throwOneError = throwErrors . unitBag++-- | A source error is an error that is caused by one or more errors in the+-- source code.  A 'SourceError' is thrown by many functions in the+-- compilation pipeline.  Inside GHC these errors are merely printed via+-- 'log_action', but API clients may treat them differently, for example,+-- insert them into a list box.  If you want the default behaviour, use the+-- idiom:+--+-- > handleSourceError printExceptionAndWarnings $ do+-- >   ... api calls that may fail ...+--+-- The 'SourceError's error messages can be accessed via 'srcErrorMessages'.+-- This list may be empty if the compiler failed due to @-Werror@+-- ('Opt_WarnIsError').+--+-- See 'printExceptionAndWarnings' for more information on what to take care+-- of when writing a custom error handler.+newtype SourceError = SourceError ErrorMessages++instance Show SourceError where+  show (SourceError msgs) = unlines . map show . bagToList $ msgs++instance Exception SourceError++-- | Perform the given action and call the exception handler if the action+-- throws a 'SourceError'.  See 'SourceError' for more information.+handleSourceError :: (ExceptionMonad m) =>+                     (SourceError -> m a) -- ^ exception handler+                  -> m a -- ^ action to perform+                  -> m a+handleSourceError handler act =+  gcatch act (\(e :: SourceError) -> handler e)++-- | An error thrown if the GHC API is used in an incorrect fashion.+newtype GhcApiError = GhcApiError String++instance Show GhcApiError where+  show (GhcApiError msg) = msg++instance Exception GhcApiError++-- | Given a bag of warnings, turn them into an exception if+-- -Werror is enabled, or print them out otherwise.+printOrThrowWarnings :: DynFlags -> Bag WarnMsg -> IO ()+printOrThrowWarnings dflags warns = do+  let (make_error, warns') =+        mapAccumBagL+          (\make_err warn ->+            case isWarnMsgFatal dflags warn of+              Nothing ->+                (make_err, warn)+              Just err_reason ->+                (True, warn{ errMsgSeverity = SevError+                           , errMsgReason = ErrReason err_reason+                           }))+          False warns+  if make_error+    then throwIO (mkSrcErr warns')+    else printBagOfErrors dflags warns++handleFlagWarnings :: DynFlags -> [Warn] -> IO ()+handleFlagWarnings dflags warns = do+  let warns' = filter (shouldPrintWarning dflags . warnReason)  warns++      -- It would be nicer if warns :: [Located MsgDoc], but that+      -- has circular import problems.+      bag = listToBag [ mkPlainWarnMsg dflags loc (text warn)+                      | Warn _ (dL->L loc warn) <- warns' ]++  printOrThrowWarnings dflags bag++-- Given a warn reason, check to see if it's associated -W opt is enabled+shouldPrintWarning :: DynFlags -> CmdLineParser.WarnReason -> Bool+shouldPrintWarning dflags ReasonDeprecatedFlag+  = wopt Opt_WarnDeprecatedFlags dflags+shouldPrintWarning dflags ReasonUnrecognisedFlag+  = wopt Opt_WarnUnrecognisedWarningFlags dflags+shouldPrintWarning _ _+  = True++{-+************************************************************************+*                                                                      *+\subsection{HscEnv}+*                                                                      *+************************************************************************+-}++-- | HscEnv is like 'Session', except that some of the fields are immutable.+-- An HscEnv is used to compile a single module from plain Haskell source+-- code (after preprocessing) to either C, assembly or C--.  Things like+-- the module graph don't change during a single compilation.+--+-- Historical note: \"hsc\" used to be the name of the compiler binary,+-- when there was a separate driver and compiler.  To compile a single+-- module, the driver would invoke hsc on the source code... so nowadays+-- we think of hsc as the layer of the compiler that deals with compiling+-- a single module.+data HscEnv+  = HscEnv {+        hsc_dflags :: DynFlags,+                -- ^ The dynamic flag settings++        hsc_targets :: [Target],+                -- ^ The targets (or roots) of the current session++        hsc_mod_graph :: ModuleGraph,+                -- ^ The module graph of the current session++        hsc_IC :: InteractiveContext,+                -- ^ The context for evaluating interactive statements++        hsc_HPT    :: HomePackageTable,+                -- ^ The home package table describes already-compiled+                -- home-package modules, /excluding/ the module we+                -- are compiling right now.+                -- (In one-shot mode the current module is the only+                -- home-package module, so hsc_HPT is empty.  All other+                -- modules count as \"external-package\" modules.+                -- However, even in GHCi mode, hi-boot interfaces are+                -- demand-loaded into the external-package table.)+                --+                -- 'hsc_HPT' is not mutable because we only demand-load+                -- external packages; the home package is eagerly+                -- loaded, module by module, by the compilation manager.+                --+                -- The HPT may contain modules compiled earlier by @--make@+                -- but not actually below the current module in the dependency+                -- graph.+                --+                -- (This changes a previous invariant: changed Jan 05.)++        hsc_EPS :: {-# UNPACK #-} !(IORef ExternalPackageState),+                -- ^ Information about the currently loaded external packages.+                -- This is mutable because packages will be demand-loaded during+                -- a compilation run as required.++        hsc_NC  :: {-# UNPACK #-} !(IORef NameCache),+                -- ^ As with 'hsc_EPS', this is side-effected by compiling to+                -- reflect sucking in interface files.  They cache the state of+                -- external interface files, in effect.++        hsc_FC   :: {-# UNPACK #-} !(IORef FinderCache),+                -- ^ The cached result of performing finding in the file system++        hsc_type_env_var :: Maybe (Module, IORef TypeEnv)+                -- ^ Used for one-shot compilation only, to initialise+                -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for+                -- 'TcRnTypes.TcGblEnv'.  See also Note [hsc_type_env_var hack]++        , hsc_iserv :: MVar (Maybe IServ)+                -- ^ interactive server process.  Created the first+                -- time it is needed.+ }++-- Note [hsc_type_env_var hack]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- hsc_type_env_var is used to initialize tcg_type_env_var, and+-- eventually it is the mutable variable that is queried from+-- if_rec_types to get a TypeEnv.  So, clearly, it's something+-- related to knot-tying (see Note [Tying the knot]).+-- hsc_type_env_var is used in two places: initTcRn (where+-- it initializes tcg_type_env_var) and initIfaceCheck+-- (where it initializes if_rec_types).+--+-- But why do we need a way to feed a mutable variable in?  Why+-- can't we just initialize tcg_type_env_var when we start+-- typechecking?  The problem is we need to knot-tie the+-- EPS, and we may start adding things to the EPS before type+-- checking starts.+--+-- Here is a concrete example. Suppose we are running+-- "ghc -c A.hs", and we have this file system state:+--+--  A.hs-boot   A.hi-boot **up to date**+--  B.hs        B.hi      **up to date**+--  A.hs        A.hi      **stale**+--+-- The first thing we do is run checkOldIface on A.hi.+-- checkOldIface will call loadInterface on B.hi so it can+-- get its hands on the fingerprints, to find out if A.hi+-- needs recompilation.  But loadInterface also populates+-- the EPS!  And so if compilation turns out to be necessary,+-- as it is in this case, the thunks we put into the EPS for+-- B.hi need to have the correct if_rec_types mutable variable+-- to query.+--+-- If the mutable variable is only allocated WHEN we start+-- typechecking, then that's too late: we can't get the+-- information to the thunks.  So we need to pre-commit+-- to a type variable in 'hscIncrementalCompile' BEFORE we+-- check the old interface.+--+-- This is all a massive hack because arguably checkOldIface+-- should not populate the EPS. But that's a refactor for+-- another day.+++data IServ = IServ+  { iservPipe :: Pipe+  , iservProcess :: ProcessHandle+  , iservLookupSymbolCache :: IORef (UniqFM (Ptr ()))+  , iservPendingFrees :: [HValueRef]+  }++-- | Retrieve the ExternalPackageState cache.+hscEPS :: HscEnv -> IO ExternalPackageState+hscEPS hsc_env = readIORef (hsc_EPS hsc_env)++-- | A compilation target.+--+-- A target may be supplied with the actual text of the+-- module.  If so, use this instead of the file contents (this+-- is for use in an IDE where the file hasn't been saved by+-- the user yet).+data Target+  = Target {+      targetId           :: TargetId, -- ^ module or filename+      targetAllowObjCode :: Bool,     -- ^ object code allowed?+      targetContents     :: Maybe (StringBuffer,UTCTime)+                                        -- ^ in-memory text buffer?+    }++data TargetId+  = TargetModule ModuleName+        -- ^ A module name: search for the file+  | TargetFile FilePath (Maybe Phase)+        -- ^ A filename: preprocess & parse it to find the module name.+        -- If specified, the Phase indicates how to compile this file+        -- (which phase to start from).  Nothing indicates the starting phase+        -- should be determined from the suffix of the filename.+  deriving Eq++pprTarget :: Target -> SDoc+pprTarget (Target id obj _) =+    (if obj then char '*' else empty) <> pprTargetId id++instance Outputable Target where+    ppr = pprTarget++pprTargetId :: TargetId -> SDoc+pprTargetId (TargetModule m) = ppr m+pprTargetId (TargetFile f _) = text f++instance Outputable TargetId where+    ppr = pprTargetId++{-+************************************************************************+*                                                                      *+\subsection{Package and Module Tables}+*                                                                      *+************************************************************************+-}++-- | Helps us find information about modules in the home package+type HomePackageTable  = DModuleNameEnv HomeModInfo+        -- Domain = modules in the home package that have been fully compiled+        -- "home" unit id cached here for convenience++-- | Helps us find information about modules in the imported packages+type PackageIfaceTable = ModuleEnv ModIface+        -- Domain = modules in the imported packages++-- | Constructs an empty HomePackageTable+emptyHomePackageTable :: HomePackageTable+emptyHomePackageTable  = emptyUDFM++-- | Constructs an empty PackageIfaceTable+emptyPackageIfaceTable :: PackageIfaceTable+emptyPackageIfaceTable = emptyModuleEnv++pprHPT :: HomePackageTable -> SDoc+-- A bit arbitrary for now+pprHPT hpt = pprUDFM hpt $ \hms ->+    vcat [ hang (ppr (mi_module (hm_iface hm)))+              2 (ppr (md_types (hm_details hm)))+         | hm <- hms ]++lookupHpt :: HomePackageTable -> ModuleName -> Maybe HomeModInfo+lookupHpt = lookupUDFM++lookupHptDirectly :: HomePackageTable -> Unique -> Maybe HomeModInfo+lookupHptDirectly = lookupUDFM_Directly++eltsHpt :: HomePackageTable -> [HomeModInfo]+eltsHpt = eltsUDFM++filterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable+filterHpt = filterUDFM++allHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool+allHpt = allUDFM++mapHpt :: (HomeModInfo -> HomeModInfo) -> HomePackageTable -> HomePackageTable+mapHpt = mapUDFM++delFromHpt :: HomePackageTable -> ModuleName -> HomePackageTable+delFromHpt = delFromUDFM++addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable+addToHpt = addToUDFM++addListToHpt+  :: HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable+addListToHpt = addListToUDFM++listToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable+listToHpt = listToUDFM++lookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo+-- The HPT is indexed by ModuleName, not Module,+-- we must check for a hit on the right Module+lookupHptByModule hpt mod+  = case lookupHpt hpt (moduleName mod) of+      Just hm | mi_module (hm_iface hm) == mod -> Just hm+      _otherwise                               -> Nothing++-- | Information about modules in the package being compiled+data HomeModInfo+  = HomeModInfo {+      hm_iface    :: !ModIface,+        -- ^ The basic loaded interface file: every loaded module has one of+        -- these, even if it is imported from another package+      hm_details  :: !ModDetails,+        -- ^ Extra information that has been created from the 'ModIface' for+        -- the module, typically during typechecking+      hm_linkable :: !(Maybe Linkable)+        -- ^ The actual artifact we would like to link to access things in+        -- this module.+        --+        -- 'hm_linkable' might be Nothing:+        --+        --   1. If this is an .hs-boot module+        --+        --   2. Temporarily during compilation if we pruned away+        --      the old linkable because it was out of date.+        --+        -- After a complete compilation ('GHC.load'), all 'hm_linkable' fields+        -- in the 'HomePackageTable' will be @Just@.+        --+        -- When re-linking a module ('HscMain.HscNoRecomp'), we construct the+        -- 'HomeModInfo' by building a new 'ModDetails' from the old+        -- 'ModIface' (only).+    }++-- | Find the 'ModIface' for a 'Module', searching in both the loaded home+-- and external package module information+lookupIfaceByModule+        :: DynFlags+        -> HomePackageTable+        -> PackageIfaceTable+        -> Module+        -> Maybe ModIface+lookupIfaceByModule _dflags hpt pit mod+  = case lookupHptByModule hpt mod of+       Just hm -> Just (hm_iface hm)+       Nothing -> lookupModuleEnv pit mod++-- If the module does come from the home package, why do we look in the PIT as well?+-- (a) In OneShot mode, even home-package modules accumulate in the PIT+-- (b) Even in Batch (--make) mode, there is *one* case where a home-package+--     module is in the PIT, namely GHC.Prim when compiling the base package.+-- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package+-- of its own, but it doesn't seem worth the bother.++hptCompleteSigs :: HscEnv -> [CompleteMatch]+hptCompleteSigs = hptAllThings  (md_complete_sigs . hm_details)++-- | Find all the instance declarations (of classes and families) from+-- the Home Package Table filtered by the provided predicate function.+-- Used in @tcRnImports@, to select the instances that are in the+-- transitive closure of imports from the currently compiled module.+hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])+hptInstances hsc_env want_this_module+  = let (insts, famInsts) = unzip $ flip hptAllThings hsc_env $ \mod_info -> do+                guard (want_this_module (moduleName (mi_module (hm_iface mod_info))))+                let details = hm_details mod_info+                return (md_insts details, md_fam_insts details)+    in (concat insts, concat famInsts)++-- | Get rules from modules "below" this one (in the dependency sense)+hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule]+hptRules = hptSomeThingsBelowUs (md_rules . hm_details) False+++-- | Get annotations from modules "below" this one (in the dependency sense)+hptAnns :: HscEnv -> Maybe [(ModuleName, IsBootInterface)] -> [Annotation]+hptAnns hsc_env (Just deps) = hptSomeThingsBelowUs (md_anns . hm_details) False hsc_env deps+hptAnns hsc_env Nothing = hptAllThings (md_anns . hm_details) hsc_env++hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]+hptAllThings extract hsc_env = concatMap extract (eltsHpt (hsc_HPT hsc_env))++-- | Get things from modules "below" this one (in the dependency sense)+-- C.f Inst.hptInstances+hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [(ModuleName, IsBootInterface)] -> [a]+hptSomeThingsBelowUs extract include_hi_boot hsc_env deps+  | isOneShot (ghcMode (hsc_dflags hsc_env)) = []++  | otherwise+  = let hpt = hsc_HPT hsc_env+    in+    [ thing+    |   -- Find each non-hi-boot module below me+      (mod, is_boot_mod) <- deps+    , include_hi_boot || not is_boot_mod++        -- unsavoury: when compiling the base package with --make, we+        -- sometimes try to look up RULES etc for GHC.Prim. GHC.Prim won't+        -- be in the HPT, because we never compile it; it's in the EPT+        -- instead. ToDo: clean up, and remove this slightly bogus filter:+    , mod /= moduleName gHC_PRIM++        -- Look it up in the HPT+    , let things = case lookupHpt hpt mod of+                    Just info -> extract info+                    Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg []+          msg = vcat [text "missing module" <+> ppr mod,+                      text "Probable cause: out-of-date interface files"]+                        -- This really shouldn't happen, but see #962++        -- And get its dfuns+    , thing <- things ]+++{-+************************************************************************+*                                                                      *+\subsection{Metaprogramming}+*                                                                      *+************************************************************************+-}++-- | The supported metaprogramming result types+data MetaRequest+  = MetaE  (LHsExpr GhcPs   -> MetaResult)+  | MetaP  (LPat GhcPs      -> MetaResult)+  | MetaT  (LHsType GhcPs   -> MetaResult)+  | MetaD  ([LHsDecl GhcPs] -> MetaResult)+  | MetaAW (Serialized     -> MetaResult)++-- | data constructors not exported to ensure correct result type+data MetaResult+  = MetaResE  { unMetaResE  :: LHsExpr GhcPs   }+  | MetaResP  { unMetaResP  :: LPat GhcPs      }+  | MetaResT  { unMetaResT  :: LHsType GhcPs   }+  | MetaResD  { unMetaResD  :: [LHsDecl GhcPs] }+  | MetaResAW { unMetaResAW :: Serialized        }++type MetaHook f = MetaRequest -> LHsExpr GhcTc -> f MetaResult++metaRequestE :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LHsExpr GhcPs)+metaRequestE h = fmap unMetaResE . h (MetaE MetaResE)++metaRequestP :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LPat GhcPs)+metaRequestP h = fmap unMetaResP . h (MetaP MetaResP)++metaRequestT :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LHsType GhcPs)+metaRequestT h = fmap unMetaResT . h (MetaT MetaResT)++metaRequestD :: Functor f => MetaHook f -> LHsExpr GhcTc -> f [LHsDecl GhcPs]+metaRequestD h = fmap unMetaResD . h (MetaD MetaResD)++metaRequestAW :: Functor f => MetaHook f -> LHsExpr GhcTc -> f Serialized+metaRequestAW h = fmap unMetaResAW . h (MetaAW MetaResAW)++{-+************************************************************************+*                                                                      *+\subsection{Dealing with Annotations}+*                                                                      *+************************************************************************+-}++-- | Deal with gathering annotations in from all possible places+--   and combining them into a single 'AnnEnv'+prepareAnnotations :: HscEnv -> Maybe ModGuts -> IO AnnEnv+prepareAnnotations hsc_env mb_guts = do+    eps <- hscEPS hsc_env+    let -- Extract annotations from the module being compiled if supplied one+        mb_this_module_anns = fmap (mkAnnEnv . mg_anns) mb_guts+        -- Extract dependencies of the module if we are supplied one,+        -- otherwise load annotations from all home package table+        -- entries regardless of dependency ordering.+        home_pkg_anns  = (mkAnnEnv . hptAnns hsc_env) $ fmap (dep_mods . mg_deps) mb_guts+        other_pkg_anns = eps_ann_env eps+        ann_env        = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns,+                                                         Just home_pkg_anns,+                                                         Just other_pkg_anns]+    return ann_env++{-+************************************************************************+*                                                                      *+\subsection{The Finder cache}+*                                                                      *+************************************************************************+-}++-- | The 'FinderCache' maps modules to the result of+-- searching for that module. It records the results of searching for+-- modules along the search path. On @:load@, we flush the entire+-- contents of this cache.+--+type FinderCache = InstalledModuleEnv InstalledFindResult++data InstalledFindResult+  = InstalledFound ModLocation InstalledModule+  | InstalledNoPackage InstalledUnitId+  | InstalledNotFound [FilePath] (Maybe InstalledUnitId)++-- | The result of searching for an imported module.+--+-- NB: FindResult manages both user source-import lookups+-- (which can result in 'Module') as well as direct imports+-- for interfaces (which always result in 'InstalledModule').+data FindResult+  = Found ModLocation Module+        -- ^ The module was found+  | NoPackage UnitId+        -- ^ The requested package was not found+  | FoundMultiple [(Module, ModuleOrigin)]+        -- ^ _Error_: both in multiple packages++        -- | Not found+  | NotFound+      { fr_paths       :: [FilePath]       -- Places where I looked++      , fr_pkg         :: Maybe UnitId  -- Just p => module is in this package's+                                           --           manifest, but couldn't find+                                           --           the .hi file++      , fr_mods_hidden :: [UnitId]      -- Module is in these packages,+                                           --   but the *module* is hidden++      , fr_pkgs_hidden :: [UnitId]      -- Module is in these packages,+                                           --   but the *package* is hidden++        -- Modules are in these packages, but it is unusable+      , fr_unusables   :: [(UnitId, UnusablePackageReason)]++      , fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules+      }++{-+************************************************************************+*                                                                      *+\subsection{Symbol tables and Module details}+*                                                                      *+************************************************************************+-}++-- | A 'ModIface' plus a 'ModDetails' summarises everything we know+-- about a compiled module.  The 'ModIface' is the stuff *before* linking,+-- and can be written out to an interface file. The 'ModDetails is after+-- linking and can be completely recovered from just the 'ModIface'.+--+-- When we read an interface file, we also construct a 'ModIface' from it,+-- except that we explicitly make the 'mi_decls' and a few other fields empty;+-- as when reading we consolidate the declarations etc. into a number of indexed+-- maps and environments in the 'ExternalPackageState'.+data ModIface+  = ModIface {+        mi_module     :: !Module,             -- ^ Name of the module we are for+        mi_sig_of     :: !(Maybe Module),     -- ^ Are we a sig of another mod?+        mi_iface_hash :: !Fingerprint,        -- ^ Hash of the whole interface+        mi_mod_hash   :: !Fingerprint,        -- ^ Hash of the ABI only+        mi_flag_hash  :: !Fingerprint,        -- ^ Hash of the important flags+                                              -- used when compiling the module,+                                              -- excluding optimisation flags+        mi_opt_hash   :: !Fingerprint,        -- ^ Hash of optimisation flags+        mi_hpc_hash   :: !Fingerprint,        -- ^ Hash of hpc flags+        mi_plugin_hash :: !Fingerprint,       -- ^ Hash of plugins++        mi_orphan     :: !WhetherHasOrphans,  -- ^ Whether this module has orphans+        mi_finsts     :: !WhetherHasFamInst,+                -- ^ Whether this module has family instances.+                -- See Note [The type family instance consistency story].+        mi_hsc_src    :: !HscSource,          -- ^ Boot? Signature?++        mi_deps     :: Dependencies,+                -- ^ The dependencies of the module.  This is+                -- consulted for directly-imported modules, but not+                -- for anything else (hence lazy)++        mi_usages   :: [Usage],+                -- ^ Usages; kept sorted so that it's easy to decide+                -- whether to write a new iface file (changing usages+                -- doesn't affect the hash of this module)+                -- NOT STRICT!  we read this field lazily from the interface file+                -- It is *only* consulted by the recompilation checker++        mi_exports  :: ![IfaceExport],+                -- ^ Exports+                -- Kept sorted by (mod,occ), to make version comparisons easier+                -- Records the modules that are the declaration points for things+                -- exported by this module, and the 'OccName's of those things++        mi_exp_hash :: !Fingerprint,+                -- ^ Hash of export list++        mi_used_th  :: !Bool,+                -- ^ Module required TH splices when it was compiled.+                -- This disables recompilation avoidance (see #481).++        mi_fixities :: [(OccName,Fixity)],+                -- ^ Fixities+                -- NOT STRICT!  we read this field lazily from the interface file++        mi_warns    :: Warnings,+                -- ^ Warnings+                -- NOT STRICT!  we read this field lazily from the interface file++        mi_anns     :: [IfaceAnnotation],+                -- ^ Annotations+                -- NOT STRICT!  we read this field lazily from the interface file+++        mi_decls    :: [(Fingerprint,IfaceDecl)],+                -- ^ Type, class and variable declarations+                -- The hash of an Id changes if its fixity or deprecations change+                --      (as well as its type of course)+                -- Ditto data constructors, class operations, except that+                -- the hash of the parent class/tycon changes++        mi_globals  :: !(Maybe GlobalRdrEnv),+                -- ^ Binds all the things defined at the top level in+                -- the /original source/ code for this module. which+                -- is NOT the same as mi_exports, nor mi_decls (which+                -- may contains declarations for things not actually+                -- defined by the user).  Used for GHCi and for inspecting+                -- the contents of modules via the GHC API only.+                --+                -- (We need the source file to figure out the+                -- top-level environment, if we didn't compile this module+                -- from source then this field contains @Nothing@).+                --+                -- Strictly speaking this field should live in the+                -- 'HomeModInfo', but that leads to more plumbing.++                -- Instance declarations and rules+        mi_insts       :: [IfaceClsInst],     -- ^ Sorted class instance+        mi_fam_insts   :: [IfaceFamInst],  -- ^ Sorted family instances+        mi_rules       :: [IfaceRule],     -- ^ Sorted rules+        mi_orphan_hash :: !Fingerprint,    -- ^ Hash for orphan rules, class and family+                                           -- instances combined++                -- Cached environments for easy lookup+                -- These are computed (lazily) from other fields+                -- and are not put into the interface file+        mi_warn_fn   :: OccName -> Maybe WarningTxt,+                -- ^ Cached lookup for 'mi_warns'+        mi_fix_fn    :: OccName -> Maybe Fixity,+                -- ^ Cached lookup for 'mi_fixities'+        mi_hash_fn   :: OccName -> Maybe (OccName, Fingerprint),+                -- ^ Cached lookup for 'mi_decls'.+                -- The @Nothing@ in 'mi_hash_fn' means that the thing+                -- isn't in decls. It's useful to know that when+                -- seeing if we are up to date wrt. the old interface.+                -- The 'OccName' is the parent of the name, if it has one.++        mi_hpc       :: !AnyHpcUsage,+                -- ^ True if this program uses Hpc at any point in the program.++        mi_trust     :: !IfaceTrustInfo,+                -- ^ Safe Haskell Trust information for this module.++        mi_trust_pkg :: !Bool,+                -- ^ Do we require the package this module resides in be trusted+                -- to trust this module? This is used for the situation where a+                -- module is Safe (so doesn't require the package be trusted+                -- itself) but imports some trustworthy modules from its own+                -- package (which does require its own package be trusted).+                -- See Note [RnNames . Trust Own Package]+        mi_complete_sigs :: [IfaceCompleteMatch],++        mi_doc_hdr :: Maybe HsDocString,+                -- ^ Module header.++        mi_decl_docs :: DeclDocMap,+                -- ^ Docs on declarations.++        mi_arg_docs :: ArgDocMap+                -- ^ Docs on arguments.+     }++-- | Old-style accessor for whether or not the ModIface came from an hs-boot+-- file.+mi_boot :: ModIface -> Bool+mi_boot iface = mi_hsc_src iface == HsBootFile++-- | Lookups up a (possibly cached) fixity from a 'ModIface'. If one cannot be+-- found, 'defaultFixity' is returned instead.+mi_fix :: ModIface -> OccName -> Fixity+mi_fix iface name = mi_fix_fn iface name `orElse` defaultFixity++-- | The semantic module for this interface; e.g., if it's a interface+-- for a signature, if 'mi_module' is @p[A=<A>]:A@, 'mi_semantic_module'+-- will be @<A>@.+mi_semantic_module :: ModIface -> Module+mi_semantic_module iface = case mi_sig_of iface of+                            Nothing -> mi_module iface+                            Just mod -> mod++-- | The "precise" free holes, e.g., the signatures that this+-- 'ModIface' depends on.+mi_free_holes :: ModIface -> UniqDSet ModuleName+mi_free_holes iface =+  case splitModuleInsts (mi_module iface) of+    (_, Just indef)+        -- A mini-hack: we rely on the fact that 'renameFreeHoles'+        -- drops things that aren't holes.+        -> renameFreeHoles (mkUniqDSet cands) (indefUnitIdInsts (indefModuleUnitId indef))+    _   -> emptyUniqDSet+  where+    cands = map fst (dep_mods (mi_deps iface))++-- | Given a set of free holes, and a unit identifier, rename+-- the free holes according to the instantiation of the unit+-- identifier.  For example, if we have A and B free, and+-- our unit identity is @p[A=<C>,B=impl:B]@, the renamed free+-- holes are just C.+renameFreeHoles :: UniqDSet ModuleName -> [(ModuleName, Module)] -> UniqDSet ModuleName+renameFreeHoles fhs insts =+    unionManyUniqDSets (map lookup_impl (uniqDSetToList fhs))+  where+    hmap = listToUFM insts+    lookup_impl mod_name+        | Just mod <- lookupUFM hmap mod_name = moduleFreeHoles mod+        -- It wasn't actually a hole+        | otherwise                           = emptyUniqDSet++instance Binary ModIface where+   put_ bh (ModIface {+                 mi_module    = mod,+                 mi_sig_of    = sig_of,+                 mi_hsc_src   = hsc_src,+                 mi_iface_hash= iface_hash,+                 mi_mod_hash  = mod_hash,+                 mi_flag_hash = flag_hash,+                 mi_opt_hash  = opt_hash,+                 mi_hpc_hash  = hpc_hash,+                 mi_plugin_hash = plugin_hash,+                 mi_orphan    = orphan,+                 mi_finsts    = hasFamInsts,+                 mi_deps      = deps,+                 mi_usages    = usages,+                 mi_exports   = exports,+                 mi_exp_hash  = exp_hash,+                 mi_used_th   = used_th,+                 mi_fixities  = fixities,+                 mi_warns     = warns,+                 mi_anns      = anns,+                 mi_decls     = decls,+                 mi_insts     = insts,+                 mi_fam_insts = fam_insts,+                 mi_rules     = rules,+                 mi_orphan_hash = orphan_hash,+                 mi_hpc       = hpc_info,+                 mi_trust     = trust,+                 mi_trust_pkg = trust_pkg,+                 mi_complete_sigs = complete_sigs,+                 mi_doc_hdr   = doc_hdr,+                 mi_decl_docs = decl_docs,+                 mi_arg_docs  = arg_docs }) = do+        put_ bh mod+        put_ bh sig_of+        put_ bh hsc_src+        put_ bh iface_hash+        put_ bh mod_hash+        put_ bh flag_hash+        put_ bh opt_hash+        put_ bh hpc_hash+        put_ bh plugin_hash+        put_ bh orphan+        put_ bh hasFamInsts+        lazyPut bh deps+        lazyPut bh usages+        put_ bh exports+        put_ bh exp_hash+        put_ bh used_th+        put_ bh fixities+        lazyPut bh warns+        lazyPut bh anns+        put_ bh decls+        put_ bh insts+        put_ bh fam_insts+        lazyPut bh rules+        put_ bh orphan_hash+        put_ bh hpc_info+        put_ bh trust+        put_ bh trust_pkg+        put_ bh complete_sigs+        lazyPut bh doc_hdr+        lazyPut bh decl_docs+        lazyPut bh arg_docs++   get bh = do+        mod         <- get bh+        sig_of      <- get bh+        hsc_src     <- get bh+        iface_hash  <- get bh+        mod_hash    <- get bh+        flag_hash   <- get bh+        opt_hash    <- get bh+        hpc_hash    <- get bh+        plugin_hash <- get bh+        orphan      <- get bh+        hasFamInsts <- get bh+        deps        <- lazyGet bh+        usages      <- {-# SCC "bin_usages" #-} lazyGet bh+        exports     <- {-# SCC "bin_exports" #-} get bh+        exp_hash    <- get bh+        used_th     <- get bh+        fixities    <- {-# SCC "bin_fixities" #-} get bh+        warns       <- {-# SCC "bin_warns" #-} lazyGet bh+        anns        <- {-# SCC "bin_anns" #-} lazyGet bh+        decls       <- {-# SCC "bin_tycldecls" #-} get bh+        insts       <- {-# SCC "bin_insts" #-} get bh+        fam_insts   <- {-# SCC "bin_fam_insts" #-} get bh+        rules       <- {-# SCC "bin_rules" #-} lazyGet bh+        orphan_hash <- get bh+        hpc_info    <- get bh+        trust       <- get bh+        trust_pkg   <- get bh+        complete_sigs <- get bh+        doc_hdr     <- lazyGet bh+        decl_docs   <- lazyGet bh+        arg_docs    <- lazyGet bh+        return (ModIface {+                 mi_module      = mod,+                 mi_sig_of      = sig_of,+                 mi_hsc_src     = hsc_src,+                 mi_iface_hash  = iface_hash,+                 mi_mod_hash    = mod_hash,+                 mi_flag_hash   = flag_hash,+                 mi_opt_hash    = opt_hash,+                 mi_hpc_hash    = hpc_hash,+                 mi_plugin_hash = plugin_hash,+                 mi_orphan      = orphan,+                 mi_finsts      = hasFamInsts,+                 mi_deps        = deps,+                 mi_usages      = usages,+                 mi_exports     = exports,+                 mi_exp_hash    = exp_hash,+                 mi_used_th     = used_th,+                 mi_anns        = anns,+                 mi_fixities    = fixities,+                 mi_warns       = warns,+                 mi_decls       = decls,+                 mi_globals     = Nothing,+                 mi_insts       = insts,+                 mi_fam_insts   = fam_insts,+                 mi_rules       = rules,+                 mi_orphan_hash = orphan_hash,+                 mi_hpc         = hpc_info,+                 mi_trust       = trust,+                 mi_trust_pkg   = trust_pkg,+                        -- And build the cached values+                 mi_warn_fn     = mkIfaceWarnCache warns,+                 mi_fix_fn      = mkIfaceFixCache fixities,+                 mi_hash_fn     = mkIfaceHashCache decls,+                 mi_complete_sigs = complete_sigs,+                 mi_doc_hdr     = doc_hdr,+                 mi_decl_docs   = decl_docs,+                 mi_arg_docs    = arg_docs })++-- | The original names declared of a certain module that are exported+type IfaceExport = AvailInfo++-- | Constructs an empty ModIface+emptyModIface :: Module -> ModIface+emptyModIface mod+  = ModIface { mi_module      = mod,+               mi_sig_of      = Nothing,+               mi_iface_hash  = fingerprint0,+               mi_mod_hash    = fingerprint0,+               mi_flag_hash   = fingerprint0,+               mi_opt_hash    = fingerprint0,+               mi_hpc_hash    = fingerprint0,+               mi_plugin_hash = fingerprint0,+               mi_orphan      = False,+               mi_finsts      = False,+               mi_hsc_src     = HsSrcFile,+               mi_deps        = noDependencies,+               mi_usages      = [],+               mi_exports     = [],+               mi_exp_hash    = fingerprint0,+               mi_used_th     = False,+               mi_fixities    = [],+               mi_warns       = NoWarnings,+               mi_anns        = [],+               mi_insts       = [],+               mi_fam_insts   = [],+               mi_rules       = [],+               mi_decls       = [],+               mi_globals     = Nothing,+               mi_orphan_hash = fingerprint0,+               mi_warn_fn     = emptyIfaceWarnCache,+               mi_fix_fn      = emptyIfaceFixCache,+               mi_hash_fn     = emptyIfaceHashCache,+               mi_hpc         = False,+               mi_trust       = noIfaceTrustInfo,+               mi_trust_pkg   = False,+               mi_complete_sigs = [],+               mi_doc_hdr     = Nothing,+               mi_decl_docs   = emptyDeclDocMap,+               mi_arg_docs    = emptyArgDocMap }+++-- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface'+mkIfaceHashCache :: [(Fingerprint,IfaceDecl)]+                 -> (OccName -> Maybe (OccName, Fingerprint))+mkIfaceHashCache pairs+  = \occ -> lookupOccEnv env occ+  where+    env = foldl' add_decl emptyOccEnv pairs+    add_decl env0 (v,d) = foldl' add env0 (ifaceDeclFingerprints v d)+      where+        add env0 (occ,hash) = extendOccEnv env0 occ (occ,hash)++emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint)+emptyIfaceHashCache _occ = Nothing+++-- | The 'ModDetails' is essentially a cache for information in the 'ModIface'+-- for home modules only. Information relating to packages will be loaded into+-- global environments in 'ExternalPackageState'.+data ModDetails+  = ModDetails {+        -- The next two fields are created by the typechecker+        md_exports   :: [AvailInfo],+        md_types     :: !TypeEnv,       -- ^ Local type environment for this particular module+                                        -- Includes Ids, TyCons, PatSyns+        md_insts     :: ![ClsInst],     -- ^ 'DFunId's for the instances in this module+        md_fam_insts :: ![FamInst],+        md_rules     :: ![CoreRule],    -- ^ Domain may include 'Id's from other modules+        md_anns      :: ![Annotation],  -- ^ Annotations present in this module: currently+                                        -- they only annotate things also declared in this module+        md_complete_sigs :: [CompleteMatch]+          -- ^ Complete match pragmas for this module+     }++-- | Constructs an empty ModDetails+emptyModDetails :: ModDetails+emptyModDetails+  = ModDetails { md_types     = emptyTypeEnv,+                 md_exports   = [],+                 md_insts     = [],+                 md_rules     = [],+                 md_fam_insts = [],+                 md_anns      = [],+                 md_complete_sigs = [] }++-- | Records the modules directly imported by a module for extracting e.g.+-- usage information, and also to give better error message+type ImportedMods = ModuleEnv [ImportedBy]++-- | If a module was "imported" by the user, we associate it with+-- more detailed usage information 'ImportedModsVal'; a module+-- imported by the system only gets used for usage information.+data ImportedBy+    = ImportedByUser ImportedModsVal+    | ImportedBySystem++importedByUser :: [ImportedBy] -> [ImportedModsVal]+importedByUser (ImportedByUser imv : bys) = imv : importedByUser bys+importedByUser (ImportedBySystem   : bys) =       importedByUser bys+importedByUser [] = []++data ImportedModsVal+ = ImportedModsVal {+        imv_name :: ModuleName,          -- ^ The name the module is imported with+        imv_span :: SrcSpan,             -- ^ the source span of the whole import+        imv_is_safe :: IsSafeImport,     -- ^ whether this is a safe import+        imv_is_hiding :: Bool,           -- ^ whether this is an "hiding" import+        imv_all_exports :: !GlobalRdrEnv, -- ^ all the things the module could provide+          -- NB. BangPattern here: otherwise this leaks. (#15111)+        imv_qualified :: Bool            -- ^ whether this is a qualified import+        }++-- | A ModGuts is carried through the compiler, accumulating stuff as it goes+-- There is only one ModGuts at any time, the one for the module+-- being compiled right now.  Once it is compiled, a 'ModIface' and+-- 'ModDetails' are extracted and the ModGuts is discarded.+data ModGuts+  = ModGuts {+        mg_module    :: !Module,         -- ^ Module being compiled+        mg_hsc_src   :: HscSource,       -- ^ Whether it's an hs-boot module+        mg_loc       :: SrcSpan,         -- ^ For error messages from inner passes+        mg_exports   :: ![AvailInfo],    -- ^ What it exports+        mg_deps      :: !Dependencies,   -- ^ What it depends on, directly or+                                         -- otherwise+        mg_usages    :: ![Usage],        -- ^ What was used?  Used for interfaces.++        mg_used_th   :: !Bool,           -- ^ Did we run a TH splice?+        mg_rdr_env   :: !GlobalRdrEnv,   -- ^ Top-level lexical environment++        -- These fields all describe the things **declared in this module**+        mg_fix_env   :: !FixityEnv,      -- ^ Fixities declared in this module.+                                         -- Used for creating interface files.+        mg_tcs       :: ![TyCon],        -- ^ TyCons declared in this module+                                         -- (includes TyCons for classes)+        mg_insts     :: ![ClsInst],      -- ^ Class instances declared in this module+        mg_fam_insts :: ![FamInst],+                                         -- ^ Family instances declared in this module+        mg_patsyns   :: ![PatSyn],       -- ^ Pattern synonyms declared in this module+        mg_rules     :: ![CoreRule],     -- ^ Before the core pipeline starts, contains+                                         -- See Note [Overall plumbing for rules] in Rules.hs+        mg_binds     :: !CoreProgram,    -- ^ Bindings for this module+        mg_foreign   :: !ForeignStubs,   -- ^ Foreign exports declared in this module+        mg_foreign_files :: ![(ForeignSrcLang, FilePath)],+        -- ^ Files to be compiled with the C compiler+        mg_warns     :: !Warnings,       -- ^ Warnings declared in the module+        mg_anns      :: [Annotation],    -- ^ Annotations declared in this module+        mg_complete_sigs :: [CompleteMatch], -- ^ Complete Matches+        mg_hpc_info  :: !HpcInfo,        -- ^ Coverage tick boxes in the module+        mg_modBreaks :: !(Maybe ModBreaks), -- ^ Breakpoints for the module++                        -- The next two fields are unusual, because they give instance+                        -- environments for *all* modules in the home package, including+                        -- this module, rather than for *just* this module.+                        -- Reason: when looking up an instance we don't want to have to+                        --         look at each module in the home package in turn+        mg_inst_env     :: InstEnv,             -- ^ Class instance environment for+                                                -- /home-package/ modules (including this+                                                -- one); c.f. 'tcg_inst_env'+        mg_fam_inst_env :: FamInstEnv,          -- ^ Type-family instance environment for+                                                -- /home-package/ modules (including this+                                                -- one); c.f. 'tcg_fam_inst_env'++        mg_safe_haskell :: SafeHaskellMode,     -- ^ Safe Haskell mode+        mg_trust_pkg    :: Bool,                -- ^ Do we need to trust our+                                                -- own package for Safe Haskell?+                                                -- See Note [RnNames . Trust Own Package]++        mg_doc_hdr       :: !(Maybe HsDocString), -- ^ Module header.+        mg_decl_docs     :: !DeclDocMap,     -- ^ Docs on declarations.+        mg_arg_docs      :: !ArgDocMap       -- ^ Docs on arguments.+    }++-- The ModGuts takes on several slightly different forms:+--+-- After simplification, the following fields change slightly:+--      mg_rules        Orphan rules only (local ones now attached to binds)+--      mg_binds        With rules attached++---------------------------------------------------------+-- The Tidy pass forks the information about this module:+--      * one lot goes to interface file generation (ModIface)+--        and later compilations (ModDetails)+--      * the other lot goes to code generation (CgGuts)++-- | A restricted form of 'ModGuts' for code generation purposes+data CgGuts+  = CgGuts {+        cg_module    :: !Module,+                -- ^ Module being compiled++        cg_tycons    :: [TyCon],+                -- ^ Algebraic data types (including ones that started+                -- life as classes); generate constructors and info+                -- tables. Includes newtypes, just for the benefit of+                -- External Core++        cg_binds     :: CoreProgram,+                -- ^ The tidied main bindings, including+                -- previously-implicit bindings for record and class+                -- selectors, and data constructor wrappers.  But *not*+                -- data constructor workers; reason: we regard them+                -- as part of the code-gen of tycons++        cg_foreign   :: !ForeignStubs,   -- ^ Foreign export stubs+        cg_foreign_files :: ![(ForeignSrcLang, FilePath)],+        cg_dep_pkgs  :: ![InstalledUnitId], -- ^ Dependent packages, used to+                                            -- generate #includes for C code gen+        cg_hpc_info  :: !HpcInfo,           -- ^ Program coverage tick box information+        cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints+        cg_spt_entries :: [SptEntry]+                -- ^ Static pointer table entries for static forms defined in+                -- the module.+                -- See Note [Grand plan for static forms] in StaticPtrTable+    }++-----------------------------------+-- | Foreign export stubs+data ForeignStubs+  = NoStubs+      -- ^ We don't have any stubs+  | ForeignStubs SDoc SDoc+      -- ^ There are some stubs. Parameters:+      --+      --  1) Header file prototypes for+      --     "foreign exported" functions+      --+      --  2) C stubs to use when calling+      --     "foreign exported" functions++appendStubC :: ForeignStubs -> SDoc -> ForeignStubs+appendStubC NoStubs            c_code = ForeignStubs empty c_code+appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code)++-- | An entry to be inserted into a module's static pointer table.+-- See Note [Grand plan for static forms] in StaticPtrTable.+data SptEntry = SptEntry Id Fingerprint++instance Outputable SptEntry where+  ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr++{-+************************************************************************+*                                                                      *+                The interactive context+*                                                                      *+************************************************************************++Note [The interactive package]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Type, class, and value declarations at the command prompt are treated+as if they were defined in modules+   interactive:Ghci1+   interactive:Ghci2+   ...etc...+with each bunch of declarations using a new module, all sharing a+common package 'interactive' (see Module.interactiveUnitId, and+PrelNames.mkInteractiveModule).++This scheme deals well with shadowing.  For example:++   ghci> data T = A+   ghci> data T = B+   ghci> :i A+   data Ghci1.T = A  -- Defined at <interactive>:2:10++Here we must display info about constructor A, but its type T has been+shadowed by the second declaration.  But it has a respectable+qualified name (Ghci1.T), and its source location says where it was+defined.++So the main invariant continues to hold, that in any session an+original name M.T only refers to one unique thing.  (In a previous+iteration both the T's above were called :Interactive.T, albeit with+different uniques, which gave rise to all sorts of trouble.)++The details are a bit tricky though:++ * The field ic_mod_index counts which Ghci module we've got up to.+   It is incremented when extending ic_tythings++ * ic_tythings contains only things from the 'interactive' package.++ * Module from the 'interactive' package (Ghci1, Ghci2 etc) never go+   in the Home Package Table (HPT).  When you say :load, that's when we+   extend the HPT.++ * The 'thisPackage' field of DynFlags is *not* set to 'interactive'.+   It stays as 'main' (or whatever -this-unit-id says), and is the+   package to which :load'ed modules are added to.++ * So how do we arrange that declarations at the command prompt get to+   be in the 'interactive' package?  Simply by setting the tcg_mod+   field of the TcGblEnv to "interactive:Ghci1".  This is done by the+   call to initTc in initTcInteractive, which in turn get the module+   from it 'icInteractiveModule' field of the interactive context.++   The 'thisPackage' field stays as 'main' (or whatever -this-unit-id says.++ * The main trickiness is that the type environment (tcg_type_env) and+   fixity envt (tcg_fix_env), now contain entities from all the+   interactive-package modules (Ghci1, Ghci2, ...) together, rather+   than just a single module as is usually the case.  So you can't use+   "nameIsLocalOrFrom" to decide whether to look in the TcGblEnv vs+   the HPT/PTE.  This is a change, but not a problem provided you+   know.++* However, the tcg_binds, tcg_sigs, tcg_insts, tcg_fam_insts, etc fields+  of the TcGblEnv, which collect "things defined in this module", all+  refer to stuff define in a single GHCi command, *not* all the commands+  so far.++  In contrast, tcg_inst_env, tcg_fam_inst_env, have instances from+  all GhciN modules, which makes sense -- they are all "home package"+  modules.+++Note [Interactively-bound Ids in GHCi]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The Ids bound by previous Stmts in GHCi are currently+        a) GlobalIds, with+        b) An External Name, like Ghci4.foo+           See Note [The interactive package] above+        c) A tidied type++ (a) They must be GlobalIds (not LocalIds) otherwise when we come to+     compile an expression using these ids later, the byte code+     generator will consider the occurrences to be free rather than+     global.++ (b) Having an External Name is important because of Note+     [GlobalRdrEnv shadowing] in RdrName++ (c) Their types are tidied. This is important, because :info may ask+     to look at them, and :info expects the things it looks up to have+     tidy types++Where do interactively-bound Ids come from?++  - GHCi REPL Stmts   e.g.+         ghci> let foo x = x+1+    These start with an Internal Name because a Stmt is a local+    construct, so the renamer naturally builds an Internal name for+    each of its binders.  Then in tcRnStmt they are externalised via+    TcRnDriver.externaliseAndTidyId, so they get Names like Ghic4.foo.++  - Ids bound by the debugger etc have Names constructed by+    IfaceEnv.newInteractiveBinder; at the call sites it is followed by+    mkVanillaGlobal or mkVanillaGlobalWithInfo.  So again, they are+    all Global, External.++  - TyCons, Classes, and Ids bound by other top-level declarations in+    GHCi (eg foreign import, record selectors) also get External+    Names, with Ghci9 (or 8, or 7, etc) as the module name.+++Note [ic_tythings]+~~~~~~~~~~~~~~~~~~+The ic_tythings field contains+  * The TyThings declared by the user at the command prompt+    (eg Ids, TyCons, Classes)++  * The user-visible Ids that arise from such things, which+    *don't* come from 'implicitTyThings', notably:+       - record selectors+       - class ops+    The implicitTyThings are readily obtained from the TyThings+    but record selectors etc are not++It does *not* contain+  * DFunIds (they can be gotten from ic_instances)+  * CoAxioms (ditto)++See also Note [Interactively-bound Ids in GHCi]++Note [Override identical instances in GHCi]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If you declare a new instance in GHCi that is identical to a previous one,+we simply override the previous one; we don't regard it as overlapping.+e.g.    Prelude> data T = A | B+        Prelude> instance Eq T where ...+        Prelude> instance Eq T where ...   -- This one overrides++It's exactly the same for type-family instances.  See #7102+-}++-- | Interactive context, recording information about the state of the+-- context in which statements are executed in a GHCi session.+data InteractiveContext+  = InteractiveContext {+         ic_dflags     :: DynFlags,+             -- ^ The 'DynFlags' used to evaluate interative expressions+             -- and statements.++         ic_mod_index :: Int,+             -- ^ Each GHCi stmt or declaration brings some new things into+             -- scope. We give them names like interactive:Ghci9.T,+             -- where the ic_index is the '9'.  The ic_mod_index is+             -- incremented whenever we add something to ic_tythings+             -- See Note [The interactive package]++         ic_imports :: [InteractiveImport],+             -- ^ The GHCi top-level scope (ic_rn_gbl_env) is extended with+             -- these imports+             --+             -- This field is only stored here so that the client+             -- can retrieve it with GHC.getContext. GHC itself doesn't+             -- use it, but does reset it to empty sometimes (such+             -- as before a GHC.load). The context is set with GHC.setContext.++         ic_tythings   :: [TyThing],+             -- ^ TyThings defined by the user, in reverse order of+             -- definition (ie most recent at the front)+             -- See Note [ic_tythings]++         ic_rn_gbl_env :: GlobalRdrEnv,+             -- ^ The cached 'GlobalRdrEnv', built by+             -- 'InteractiveEval.setContext' and updated regularly+             -- It contains everything in scope at the command line,+             -- including everything in ic_tythings++         ic_instances  :: ([ClsInst], [FamInst]),+             -- ^ All instances and family instances created during+             -- this session.  These are grabbed en masse after each+             -- update to be sure that proper overlapping is retained.+             -- That is, rather than re-check the overlapping each+             -- time we update the context, we just take the results+             -- from the instance code that already does that.++         ic_fix_env :: FixityEnv,+            -- ^ Fixities declared in let statements++         ic_default :: Maybe [Type],+             -- ^ The current default types, set by a 'default' declaration++          ic_resume :: [Resume],+             -- ^ The stack of breakpoint contexts++         ic_monad      :: Name,+             -- ^ The monad that GHCi is executing in++         ic_int_print  :: Name,+             -- ^ The function that is used for printing results+             -- of expressions in ghci and -e mode.++         ic_cwd :: Maybe FilePath+             -- virtual CWD of the program+    }++data InteractiveImport+  = IIDecl (ImportDecl GhcPs)+      -- ^ Bring the exports of a particular module+      -- (filtered by an import decl) into scope++  | IIModule ModuleName+      -- ^ Bring into scope the entire top-level envt of+      -- of this module, including the things imported+      -- into it.+++-- | Constructs an empty InteractiveContext.+emptyInteractiveContext :: DynFlags -> InteractiveContext+emptyInteractiveContext dflags+  = InteractiveContext {+       ic_dflags     = dflags,+       ic_imports    = [],+       ic_rn_gbl_env = emptyGlobalRdrEnv,+       ic_mod_index  = 1,+       ic_tythings   = [],+       ic_instances  = ([],[]),+       ic_fix_env    = emptyNameEnv,+       ic_monad      = ioTyConName,  -- IO monad by default+       ic_int_print  = printName,    -- System.IO.print by default+       ic_default    = Nothing,+       ic_resume     = [],+       ic_cwd        = Nothing }++icInteractiveModule :: InteractiveContext -> Module+icInteractiveModule (InteractiveContext { ic_mod_index = index })+  = mkInteractiveModule index++-- | This function returns the list of visible TyThings (useful for+-- e.g. showBindings)+icInScopeTTs :: InteractiveContext -> [TyThing]+icInScopeTTs = ic_tythings++-- | Get the PrintUnqualified function based on the flags and this InteractiveContext+icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified+icPrintUnqual dflags InteractiveContext{ ic_rn_gbl_env = grenv } =+    mkPrintUnqualified dflags grenv++-- | extendInteractiveContext is called with new TyThings recently defined to update the+-- InteractiveContext to include them.  Ids are easily removed when shadowed,+-- but Classes and TyCons are not.  Some work could be done to determine+-- whether they are entirely shadowed, but as you could still have references+-- to them (e.g. instances for classes or values of the type for TyCons), it's+-- not clear whether removing them is even the appropriate behavior.+extendInteractiveContext :: InteractiveContext+                         -> [TyThing]+                         -> [ClsInst] -> [FamInst]+                         -> Maybe [Type]+                         -> FixityEnv+                         -> InteractiveContext+extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults fix_env+  = ictxt { ic_mod_index  = ic_mod_index ictxt + 1+                            -- Always bump this; even instances should create+                            -- a new mod_index (#9426)+          , ic_tythings   = new_tythings ++ old_tythings+          , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings+          , ic_instances  = ( new_cls_insts ++ old_cls_insts+                            , new_fam_insts ++ fam_insts )+                            -- we don't shadow old family instances (#7102),+                            -- so don't need to remove them here+          , ic_default    = defaults+          , ic_fix_env    = fix_env  -- See Note [Fixity declarations in GHCi]+          }+  where+    new_ids = [id | AnId id <- new_tythings]+    old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)++    -- Discard old instances that have been fully overridden+    -- See Note [Override identical instances in GHCi]+    (cls_insts, fam_insts) = ic_instances ictxt+    old_cls_insts = filterOut (\i -> any (identicalClsInstHead i) new_cls_insts) cls_insts++extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveContext+-- Just a specialised version+extendInteractiveContextWithIds ictxt new_ids+  | null new_ids = ictxt+  | otherwise    = ictxt { ic_mod_index  = ic_mod_index ictxt + 1+                         , ic_tythings   = new_tythings ++ old_tythings+                         , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings }+  where+    new_tythings = map AnId new_ids+    old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)++shadowed_by :: [Id] -> TyThing -> Bool+shadowed_by ids = shadowed+  where+    shadowed id = getOccName id `elemOccSet` new_occs+    new_occs = mkOccSet (map getOccName ids)++setInteractivePackage :: HscEnv -> HscEnv+-- Set the 'thisPackage' DynFlag to 'interactive'+setInteractivePackage hsc_env+   = hsc_env { hsc_dflags = (hsc_dflags hsc_env)+                { thisInstalledUnitId = toInstalledUnitId interactiveUnitId } }++setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext+setInteractivePrintName ic n = ic{ic_int_print = n}++    -- ToDo: should not add Ids to the gbl env here++-- | Add TyThings to the GlobalRdrEnv, earlier ones in the list shadowing+-- later ones, and shadowing existing entries in the GlobalRdrEnv.+icExtendGblRdrEnv :: GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv+icExtendGblRdrEnv env tythings+  = foldr add env tythings  -- Foldr makes things in the front of+                            -- the list shadow things at the back+  where+    -- One at a time, to ensure each shadows the previous ones+    add thing env+       | is_sub_bndr thing+       = env+       | otherwise+       = foldl' extendGlobalRdrEnv env1 (concatMap localGREsFromAvail avail)+       where+          env1  = shadowNames env (concatMap availNames avail)+          avail = tyThingAvailInfo thing++    -- Ugh! The new_tythings may include record selectors, since they+    -- are not implicit-ids, and must appear in the TypeEnv.  But they+    -- will also be brought into scope by the corresponding (ATyCon+    -- tc).  And we want the latter, because that has the correct+    -- parent (#10520)+    is_sub_bndr (AnId f) = case idDetails f of+                             RecSelId {}  -> True+                             ClassOpId {} -> True+                             _            -> False+    is_sub_bndr _ = False++substInteractiveContext :: InteractiveContext -> TCvSubst -> InteractiveContext+substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst+  | isEmptyTCvSubst subst = ictxt+  | otherwise             = ictxt { ic_tythings = map subst_ty tts }+  where+    subst_ty (AnId id)+      = AnId $ id `setIdType` substTyAddInScope subst (idType id)+      -- Variables in the interactive context *can* mention free type variables+      -- because of the runtime debugger. Otherwise you'd expect all+      -- variables bound in the interactive context to be closed.+    subst_ty tt+      = tt++instance Outputable InteractiveImport where+  ppr (IIModule m) = char '*' <> ppr m+  ppr (IIDecl d)   = ppr d++{-+************************************************************************+*                                                                      *+        Building a PrintUnqualified+*                                                                      *+************************************************************************++Note [Printing original names]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Deciding how to print names is pretty tricky.  We are given a name+P:M.T, where P is the package name, M is the defining module, and T is+the occurrence name, and we have to decide in which form to display+the name given a GlobalRdrEnv describing the current scope.++Ideally we want to display the name in the form in which it is in+scope.  However, the name might not be in scope at all, and that's+where it gets tricky.  Here are the cases:++ 1. T uniquely maps to  P:M.T      --->  "T"      NameUnqual+ 2. There is an X for which X.T+       uniquely maps to  P:M.T     --->  "X.T"    NameQual X+ 3. There is no binding for "M.T"  --->  "M.T"    NameNotInScope1+ 4. Otherwise                      --->  "P:M.T"  NameNotInScope2++(3) and (4) apply when the entity P:M.T is not in the GlobalRdrEnv at+all. In these cases we still want to refer to the name as "M.T", *but*+"M.T" might mean something else in the current scope (e.g. if there's+an "import X as M"), so to avoid confusion we avoid using "M.T" if+there's already a binding for it.  Instead we write P:M.T.++There's one further subtlety: in case (3), what if there are two+things around, P1:M.T and P2:M.T?  Then we don't want to print both of+them as M.T!  However only one of the modules P1:M and P2:M can be+exposed (say P2), so we use M.T for that, and P1:M.T for the other one.+This is handled by the qual_mod component of PrintUnqualified, inside+the (ppr mod) of case (3), in Name.pprModulePrefix++Note [Printing unit ids]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In the old days, original names were tied to PackageIds, which directly+corresponded to the entities that users wrote in Cabal files, and were perfectly+suitable for printing when we need to disambiguate packages.  However, with+UnitId, the situation can be different: if the key is instantiated with+some holes, we should try to give the user some more useful information.+-}++-- | Creates some functions that work out the best ways to format+-- names for the user according to a set of heuristics.+mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified+mkPrintUnqualified dflags env = QueryQualify qual_name+                                             (mkQualModule dflags)+                                             (mkQualPackage dflags)+  where+  qual_name mod occ+        | [gre] <- unqual_gres+        , right_name gre+        = NameUnqual   -- If there's a unique entity that's in scope+                       -- unqualified with 'occ' AND that entity is+                       -- the right one, then we can use the unqualified name++        | [] <- unqual_gres+        , any is_name forceUnqualNames+        , not (isDerivedOccName occ)+        = NameUnqual   -- Don't qualify names that come from modules+                       -- that come with GHC, often appear in error messages,+                       -- but aren't typically in scope. Doing this does not+                       -- cause ambiguity, and it reduces the amount of+                       -- qualification in error messages thus improving+                       -- readability.+                       --+                       -- A motivating example is 'Constraint'. It's often not+                       -- in scope, but printing GHC.Prim.Constraint seems+                       -- overkill.++        | [gre] <- qual_gres+        = NameQual (greQualModName gre)++        | null qual_gres+        = if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env)+          then NameNotInScope1+          else NameNotInScope2++        | otherwise+        = NameNotInScope1   -- Can happen if 'f' is bound twice in the module+                            -- Eg  f = True; g = 0; f = False+      where+        is_name :: Name -> Bool+        is_name name = ASSERT2( isExternalName name, ppr name )+                       nameModule name == mod && nameOccName name == occ++        forceUnqualNames :: [Name]+        forceUnqualNames =+          map tyConName [ constraintKindTyCon, heqTyCon, coercibleTyCon ]+          ++ [ eqTyConName ]++        right_name gre = nameModule_maybe (gre_name gre) == Just mod++        unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env+        qual_gres   = filter right_name (lookupGlobalRdrEnv env occ)++    -- we can mention a module P:M without the P: qualifier iff+    -- "import M" would resolve unambiguously to P:M.  (if P is the+    -- current package we can just assume it is unqualified).++-- | Creates a function for formatting modules based on two heuristics:+-- (1) if the module is the current module, don't qualify, and (2) if there+-- is only one exposed package which exports this module, don't qualify.+mkQualModule :: DynFlags -> QueryQualifyModule+mkQualModule dflags mod+     | moduleUnitId mod == thisPackage dflags = False++     | [(_, pkgconfig)] <- lookup,+       packageConfigId pkgconfig == moduleUnitId mod+        -- this says: we are given a module P:M, is there just one exposed package+        -- that exposes a module M, and is it package P?+     = False++     | otherwise = True+     where lookup = lookupModuleInAllPackages dflags (moduleName mod)++-- | Creates a function for formatting packages based on two heuristics:+-- (1) don't qualify if the package in question is "main", and (2) only qualify+-- with a unit id if the package ID would be ambiguous.+mkQualPackage :: DynFlags -> QueryQualifyPackage+mkQualPackage dflags pkg_key+     | pkg_key == mainUnitId || pkg_key == interactiveUnitId+        -- Skip the lookup if it's main, since it won't be in the package+        -- database!+     = False+     | Just pkgid <- mb_pkgid+     , searchPackageId dflags pkgid `lengthIs` 1+        -- this says: we are given a package pkg-0.1@MMM, are there only one+        -- exposed packages whose package ID is pkg-0.1?+     = False+     | otherwise+     = True+     where mb_pkgid = fmap sourcePackageId (lookupPackage dflags pkg_key)++-- | A function which only qualifies package names if necessary; but+-- qualifies all other identifiers.+pkgQual :: DynFlags -> PrintUnqualified+pkgQual dflags = alwaysQualify {+        queryQualifyPackage = mkQualPackage dflags+    }++{-+************************************************************************+*                                                                      *+                Implicit TyThings+*                                                                      *+************************************************************************++Note [Implicit TyThings]+~~~~~~~~~~~~~~~~~~~~~~~~+  DEFINITION: An "implicit" TyThing is one that does not have its own+  IfaceDecl in an interface file.  Instead, its binding in the type+  environment is created as part of typechecking the IfaceDecl for+  some other thing.++Examples:+  * All DataCons are implicit, because they are generated from the+    IfaceDecl for the data/newtype.  Ditto class methods.++  * Record selectors are *not* implicit, because they get their own+    free-standing IfaceDecl.++  * Associated data/type families are implicit because they are+    included in the IfaceDecl of the parent class.  (NB: the+    IfaceClass decl happens to use IfaceDecl recursively for the+    associated types, but that's irrelevant here.)++  * Dictionary function Ids are not implicit.++  * Axioms for newtypes are implicit (same as above), but axioms+    for data/type family instances are *not* implicit (like DFunIds).+-}++-- | Determine the 'TyThing's brought into scope by another 'TyThing'+-- /other/ than itself. For example, Id's don't have any implicit TyThings+-- as they just bring themselves into scope, but classes bring their+-- dictionary datatype, type constructor and some selector functions into+-- scope, just for a start!++-- N.B. the set of TyThings returned here *must* match the set of+-- names returned by LoadIface.ifaceDeclImplicitBndrs, in the sense that+-- TyThing.getOccName should define a bijection between the two lists.+-- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])+-- The order of the list does not matter.+implicitTyThings :: TyThing -> [TyThing]+implicitTyThings (AnId _)       = []+implicitTyThings (ACoAxiom _cc) = []+implicitTyThings (ATyCon tc)    = implicitTyConThings tc+implicitTyThings (AConLike cl)  = implicitConLikeThings cl++implicitConLikeThings :: ConLike -> [TyThing]+implicitConLikeThings (RealDataCon dc)+  = dataConImplicitTyThings dc++implicitConLikeThings (PatSynCon {})+  = []  -- Pattern synonyms have no implicit Ids; the wrapper and matcher+        -- are not "implicit"; they are simply new top-level bindings,+        -- and they have their own declaration in an interface file+        -- Unless a record pat syn when there are implicit selectors+        -- They are still not included here as `implicitConLikeThings` is+        -- used by `tcTyClsDecls` whilst pattern synonyms are typed checked+        -- by `tcTopValBinds`.++implicitClassThings :: Class -> [TyThing]+implicitClassThings cl+  = -- Does not include default methods, because those Ids may have+    --    their own pragmas, unfoldings etc, not derived from the Class object++    -- associated types+    --    No recursive call for the classATs, because they+    --    are only the family decls; they have no implicit things+    map ATyCon (classATs cl) ++++    -- superclass and operation selectors+    map AnId (classAllSelIds cl)++implicitTyConThings :: TyCon -> [TyThing]+implicitTyConThings tc+  = class_stuff +++      -- fields (names of selectors)++      -- (possibly) implicit newtype axioms+      -- or type family axioms+    implicitCoTyCon tc ++++      -- for each data constructor in order,+      --   the constructor, worker, and (possibly) wrapper+    [ thing | dc    <- tyConDataCons tc+            , thing <- AConLike (RealDataCon dc) : dataConImplicitTyThings dc ]+      -- NB. record selectors are *not* implicit, they have fully-fledged+      -- bindings that pass through the compilation pipeline as normal.+  where+    class_stuff = case tyConClass_maybe tc of+        Nothing -> []+        Just cl -> implicitClassThings cl++-- For newtypes and closed type families (only) add the implicit coercion tycon+implicitCoTyCon :: TyCon -> [TyThing]+implicitCoTyCon tc+  | Just co <- newTyConCo_maybe tc = [ACoAxiom $ toBranchedAxiom co]+  | Just co <- isClosedSynFamilyTyConWithAxiom_maybe tc+                                   = [ACoAxiom co]+  | otherwise                      = []++-- | Returns @True@ if there should be no interface-file declaration+-- for this thing on its own: either it is built-in, or it is part+-- of some other declaration, or it is generated implicitly by some+-- other declaration.+isImplicitTyThing :: TyThing -> Bool+isImplicitTyThing (AConLike cl) = case cl of+                                    RealDataCon {} -> True+                                    PatSynCon {}   -> False+isImplicitTyThing (AnId id)     = isImplicitId id+isImplicitTyThing (ATyCon tc)   = isImplicitTyCon tc+isImplicitTyThing (ACoAxiom ax) = isImplicitCoAxiom ax++-- | tyThingParent_maybe x returns (Just p)+-- when pprTyThingInContext should print a declaration for p+-- (albeit with some "..." in it) when asked to show x+-- It returns the *immediate* parent.  So a datacon returns its tycon+-- but the tycon could be the associated type of a class, so it in turn+-- might have a parent.+tyThingParent_maybe :: TyThing -> Maybe TyThing+tyThingParent_maybe (AConLike cl) = case cl of+    RealDataCon dc  -> Just (ATyCon (dataConTyCon dc))+    PatSynCon{}     -> Nothing+tyThingParent_maybe (ATyCon tc)   = case tyConAssoc_maybe tc of+                                      Just tc -> Just (ATyCon tc)+                                      Nothing -> Nothing+tyThingParent_maybe (AnId id)     = case idDetails id of+                                      RecSelId { sel_tycon = RecSelData tc } ->+                                          Just (ATyCon tc)+                                      ClassOpId cls               ->+                                          Just (ATyCon (classTyCon cls))+                                      _other                      -> Nothing+tyThingParent_maybe _other = Nothing++tyThingsTyCoVars :: [TyThing] -> TyCoVarSet+tyThingsTyCoVars tts =+    unionVarSets $ map ttToVarSet tts+    where+        ttToVarSet (AnId id)     = tyCoVarsOfType $ idType id+        ttToVarSet (AConLike cl) = case cl of+            RealDataCon dc  -> tyCoVarsOfType $ dataConRepType dc+            PatSynCon{}     -> emptyVarSet+        ttToVarSet (ATyCon tc)+          = case tyConClass_maybe tc of+              Just cls -> (mkVarSet . fst . classTvsFds) cls+              Nothing  -> tyCoVarsOfType $ tyConKind tc+        ttToVarSet (ACoAxiom _)  = emptyVarSet++-- | The Names that a TyThing should bring into scope.  Used to build+-- the GlobalRdrEnv for the InteractiveContext.+tyThingAvailInfo :: TyThing -> [AvailInfo]+tyThingAvailInfo (ATyCon t)+   = case tyConClass_maybe t of+        Just c  -> [AvailTC n (n : map getName (classMethods c)+                                 ++ map getName (classATs c))+                             [] ]+             where n = getName c+        Nothing -> [AvailTC n (n : map getName dcs) flds]+             where n    = getName t+                   dcs  = tyConDataCons t+                   flds = tyConFieldLabels t+tyThingAvailInfo (AConLike (PatSynCon p))+  = map avail ((getName p) : map flSelector (patSynFieldLabels p))+tyThingAvailInfo t+   = [avail (getName t)]++{-+************************************************************************+*                                                                      *+                TypeEnv+*                                                                      *+************************************************************************+-}++-- | A map from 'Name's to 'TyThing's, constructed by typechecking+-- local declarations or interface files+type TypeEnv = NameEnv TyThing++emptyTypeEnv    :: TypeEnv+typeEnvElts     :: TypeEnv -> [TyThing]+typeEnvTyCons   :: TypeEnv -> [TyCon]+typeEnvCoAxioms :: TypeEnv -> [CoAxiom Branched]+typeEnvIds      :: TypeEnv -> [Id]+typeEnvPatSyns  :: TypeEnv -> [PatSyn]+typeEnvDataCons :: TypeEnv -> [DataCon]+typeEnvClasses  :: TypeEnv -> [Class]+lookupTypeEnv   :: TypeEnv -> Name -> Maybe TyThing++emptyTypeEnv        = emptyNameEnv+typeEnvElts     env = nameEnvElts env+typeEnvTyCons   env = [tc | ATyCon tc   <- typeEnvElts env]+typeEnvCoAxioms env = [ax | ACoAxiom ax <- typeEnvElts env]+typeEnvIds      env = [id | AnId id     <- typeEnvElts env]+typeEnvPatSyns  env = [ps | AConLike (PatSynCon ps) <- typeEnvElts env]+typeEnvDataCons env = [dc | AConLike (RealDataCon dc) <- typeEnvElts env]+typeEnvClasses  env = [cl | tc <- typeEnvTyCons env,+                            Just cl <- [tyConClass_maybe tc]]++mkTypeEnv :: [TyThing] -> TypeEnv+mkTypeEnv things = extendTypeEnvList emptyTypeEnv things++mkTypeEnvWithImplicits :: [TyThing] -> TypeEnv+mkTypeEnvWithImplicits things =+  mkTypeEnv things+    `plusNameEnv`+  mkTypeEnv (concatMap implicitTyThings things)++typeEnvFromEntities :: [Id] -> [TyCon] -> [FamInst] -> TypeEnv+typeEnvFromEntities ids tcs famInsts =+  mkTypeEnv (   map AnId ids+             ++ map ATyCon all_tcs+             ++ concatMap implicitTyConThings all_tcs+             ++ map (ACoAxiom . toBranchedAxiom . famInstAxiom) famInsts+            )+ where+  all_tcs = tcs ++ famInstsRepTyCons famInsts++lookupTypeEnv = lookupNameEnv++-- Extend the type environment+extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv+extendTypeEnv env thing = extendNameEnv env (getName thing) thing++extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv+extendTypeEnvList env things = foldl' extendTypeEnv env things++extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv+extendTypeEnvWithIds env ids+  = extendNameEnvList env [(getName id, AnId id) | id <- ids]++plusTypeEnv :: TypeEnv -> TypeEnv -> TypeEnv+plusTypeEnv env1 env2 = plusNameEnv env1 env2++-- | Find the 'TyThing' for the given 'Name' by using all the resources+-- at our disposal: the compiled modules in the 'HomePackageTable' and the+-- compiled modules in other packages that live in 'PackageTypeEnv'. Note+-- that this does NOT look up the 'TyThing' in the module being compiled: you+-- have to do that yourself, if desired+lookupType :: DynFlags+           -> HomePackageTable+           -> PackageTypeEnv+           -> Name+           -> Maybe TyThing++lookupType dflags hpt pte name+  | isOneShot (ghcMode dflags)  -- in one-shot, we don't use the HPT+  = lookupNameEnv pte name+  | otherwise+  = case lookupHptByModule hpt mod of+       Just hm -> lookupNameEnv (md_types (hm_details hm)) name+       Nothing -> lookupNameEnv pte name+  where+    mod = ASSERT2( isExternalName name, ppr name )+          if isHoleName name+            then mkModule (thisPackage dflags) (moduleName (nameModule name))+            else nameModule name++-- | As 'lookupType', but with a marginally easier-to-use interface+-- if you have a 'HscEnv'+lookupTypeHscEnv :: HscEnv -> Name -> IO (Maybe TyThing)+lookupTypeHscEnv hsc_env name = do+    eps <- readIORef (hsc_EPS hsc_env)+    return $! lookupType dflags hpt (eps_PTE eps) name+  where+    dflags = hsc_dflags hsc_env+    hpt = hsc_HPT hsc_env++-- | Get the 'TyCon' from a 'TyThing' if it is a type constructor thing. Panics otherwise+tyThingTyCon :: TyThing -> TyCon+tyThingTyCon (ATyCon tc) = tc+tyThingTyCon other       = pprPanic "tyThingTyCon" (ppr other)++-- | Get the 'CoAxiom' from a 'TyThing' if it is a coercion axiom thing. Panics otherwise+tyThingCoAxiom :: TyThing -> CoAxiom Branched+tyThingCoAxiom (ACoAxiom ax) = ax+tyThingCoAxiom other         = pprPanic "tyThingCoAxiom" (ppr other)++-- | Get the 'DataCon' from a 'TyThing' if it is a data constructor thing. Panics otherwise+tyThingDataCon :: TyThing -> DataCon+tyThingDataCon (AConLike (RealDataCon dc)) = dc+tyThingDataCon other                       = pprPanic "tyThingDataCon" (ppr other)++-- | Get the 'ConLike' from a 'TyThing' if it is a data constructor thing.+-- Panics otherwise+tyThingConLike :: TyThing -> ConLike+tyThingConLike (AConLike dc) = dc+tyThingConLike other         = pprPanic "tyThingConLike" (ppr other)++-- | Get the 'Id' from a 'TyThing' if it is a id *or* data constructor thing. Panics otherwise+tyThingId :: TyThing -> Id+tyThingId (AnId id)                   = id+tyThingId (AConLike (RealDataCon dc)) = dataConWrapId dc+tyThingId other                       = pprPanic "tyThingId" (ppr other)++{-+************************************************************************+*                                                                      *+\subsection{MonadThings and friends}+*                                                                      *+************************************************************************+-}++-- | Class that abstracts out the common ability of the monads in GHC+-- to lookup a 'TyThing' in the monadic environment by 'Name'. Provides+-- a number of related convenience functions for accessing particular+-- kinds of 'TyThing'+class Monad m => MonadThings m where+        lookupThing :: Name -> m TyThing++        lookupId :: Name -> m Id+        lookupId = liftM tyThingId . lookupThing++        lookupDataCon :: Name -> m DataCon+        lookupDataCon = liftM tyThingDataCon . lookupThing++        lookupTyCon :: Name -> m TyCon+        lookupTyCon = liftM tyThingTyCon . lookupThing++{-+************************************************************************+*                                                                      *+\subsection{Auxiliary types}+*                                                                      *+************************************************************************++These types are defined here because they are mentioned in ModDetails,+but they are mostly elaborated elsewhere+-}++------------------ Warnings -------------------------+-- | Warning information for a module+data Warnings+  = NoWarnings                          -- ^ Nothing deprecated+  | WarnAll WarningTxt                  -- ^ Whole module deprecated+  | WarnSome [(OccName,WarningTxt)]     -- ^ Some specific things deprecated++     -- Only an OccName is needed because+     --    (1) a deprecation always applies to a binding+     --        defined in the module in which the deprecation appears.+     --    (2) deprecations are only reported outside the defining module.+     --        this is important because, otherwise, if we saw something like+     --+     --        {-# DEPRECATED f "" #-}+     --        f = ...+     --        h = f+     --        g = let f = undefined in f+     --+     --        we'd need more information than an OccName to know to say something+     --        about the use of f in h but not the use of the locally bound f in g+     --+     --        however, because we only report about deprecations from the outside,+     --        and a module can only export one value called f,+     --        an OccName suffices.+     --+     --        this is in contrast with fixity declarations, where we need to map+     --        a Name to its fixity declaration.+  deriving( Eq )++instance Binary Warnings where+    put_ bh NoWarnings     = putByte bh 0+    put_ bh (WarnAll t) = do+            putByte bh 1+            put_ bh t+    put_ bh (WarnSome ts) = do+            putByte bh 2+            put_ bh ts++    get bh = do+            h <- getByte bh+            case h of+              0 -> return NoWarnings+              1 -> do aa <- get bh+                      return (WarnAll aa)+              _ -> do aa <- get bh+                      return (WarnSome aa)++-- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface'+mkIfaceWarnCache :: Warnings -> OccName -> Maybe WarningTxt+mkIfaceWarnCache NoWarnings  = \_ -> Nothing+mkIfaceWarnCache (WarnAll t) = \_ -> Just t+mkIfaceWarnCache (WarnSome pairs) = lookupOccEnv (mkOccEnv pairs)++emptyIfaceWarnCache :: OccName -> Maybe WarningTxt+emptyIfaceWarnCache _ = Nothing++plusWarns :: Warnings -> Warnings -> Warnings+plusWarns d NoWarnings = d+plusWarns NoWarnings d = d+plusWarns _ (WarnAll t) = WarnAll t+plusWarns (WarnAll t) _ = WarnAll t+plusWarns (WarnSome v1) (WarnSome v2) = WarnSome (v1 ++ v2)++-- | Creates cached lookup for the 'mi_fix_fn' field of 'ModIface'+mkIfaceFixCache :: [(OccName, Fixity)] -> OccName -> Maybe Fixity+mkIfaceFixCache pairs+  = \n -> lookupOccEnv env n+  where+   env = mkOccEnv pairs++emptyIfaceFixCache :: OccName -> Maybe Fixity+emptyIfaceFixCache _ = Nothing++-- | Fixity environment mapping names to their fixities+type FixityEnv = NameEnv FixItem++-- | Fixity information for an 'Name'. We keep the OccName in the range+-- so that we can generate an interface from it+data FixItem = FixItem OccName Fixity++instance Outputable FixItem where+  ppr (FixItem occ fix) = ppr fix <+> ppr occ++emptyFixityEnv :: FixityEnv+emptyFixityEnv = emptyNameEnv++lookupFixity :: FixityEnv -> Name -> Fixity+lookupFixity env n = case lookupNameEnv env n of+                        Just (FixItem _ fix) -> fix+                        Nothing         -> defaultFixity++{-+************************************************************************+*                                                                      *+\subsection{WhatsImported}+*                                                                      *+************************************************************************+-}++-- | Records whether a module has orphans. An \"orphan\" is one of:+--+-- * An instance declaration in a module other than the definition+--   module for one of the type constructors or classes in the instance head+--+-- * A transformation rule in a module other than the one defining+--   the function in the head of the rule+--+type WhetherHasOrphans   = Bool++-- | Does this module define family instances?+type WhetherHasFamInst = Bool++-- | Did this module originate from a *-boot file?+type IsBootInterface = Bool++-- | Dependency information about ALL modules and packages below this one+-- in the import hierarchy.+--+-- Invariant: the dependencies of a module @M@ never includes @M@.+--+-- Invariant: none of the lists contain duplicates.+data Dependencies+  = Deps { dep_mods   :: [(ModuleName, IsBootInterface)]+                        -- ^ All home-package modules transitively below this one+                        -- I.e. modules that this one imports, or that are in the+                        --      dep_mods of those directly-imported modules++         , dep_pkgs   :: [(InstalledUnitId, Bool)]+                        -- ^ All packages transitively below this module+                        -- I.e. packages to which this module's direct imports belong,+                        --      or that are in the dep_pkgs of those modules+                        -- The bool indicates if the package is required to be+                        -- trusted when the module is imported as a safe import+                        -- (Safe Haskell). See Note [RnNames . Tracking Trust Transitively]++         , dep_orphs  :: [Module]+                        -- ^ Transitive closure of orphan modules (whether+                        -- home or external pkg).+                        --+                        -- (Possible optimization: don't include family+                        -- instance orphans as they are anyway included in+                        -- 'dep_finsts'.  But then be careful about code+                        -- which relies on dep_orphs having the complete list!)+                        -- This does NOT include us, unlike 'imp_orphs'.++         , dep_finsts :: [Module]+                        -- ^ Transitive closure of depended upon modules which+                        -- contain family instances (whether home or external).+                        -- This is used by 'checkFamInstConsistency'.  This+                        -- does NOT include us, unlike 'imp_finsts'. See Note+                        -- [The type family instance consistency story].++         , dep_plgins :: [ModuleName]+                        -- ^ All the plugins used while compiling this module.+         }+  deriving( Eq )+        -- Equality used only for old/new comparison in MkIface.addFingerprints+        -- See 'TcRnTypes.ImportAvails' for details on dependencies.++instance Binary Dependencies where+    put_ bh deps = do put_ bh (dep_mods deps)+                      put_ bh (dep_pkgs deps)+                      put_ bh (dep_orphs deps)+                      put_ bh (dep_finsts deps)+                      put_ bh (dep_plgins deps)++    get bh = do ms <- get bh+                ps <- get bh+                os <- get bh+                fis <- get bh+                pl <- get bh+                return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,+                               dep_finsts = fis, dep_plgins = pl })++noDependencies :: Dependencies+noDependencies = Deps [] [] [] [] []++-- | Records modules for which changes may force recompilation of this module+-- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance+--+-- This differs from Dependencies.  A module X may be in the dep_mods of this+-- module (via an import chain) but if we don't use anything from X it won't+-- appear in our Usage+data Usage+  -- | Module from another package+  = UsagePackageModule {+        usg_mod      :: Module,+           -- ^ External package module depended on+        usg_mod_hash :: Fingerprint,+            -- ^ Cached module fingerprint+        usg_safe :: IsSafeImport+            -- ^ Was this module imported as a safe import+    }+  -- | Module from the current package+  | UsageHomeModule {+        usg_mod_name :: ModuleName,+            -- ^ Name of the module+        usg_mod_hash :: Fingerprint,+            -- ^ Cached module fingerprint+        usg_entities :: [(OccName,Fingerprint)],+            -- ^ Entities we depend on, sorted by occurrence name and fingerprinted.+            -- NB: usages are for parent names only, e.g. type constructors+            -- but not the associated data constructors.+        usg_exports  :: Maybe Fingerprint,+            -- ^ Fingerprint for the export list of this module,+            -- if we directly imported it (and hence we depend on its export list)+        usg_safe :: IsSafeImport+            -- ^ Was this module imported as a safe import+    }                                           -- ^ Module from the current package+  -- | A file upon which the module depends, e.g. a CPP #include, or using TH's+  -- 'addDependentFile'+  | UsageFile {+        usg_file_path  :: FilePath,+        -- ^ External file dependency. From a CPP #include or TH+        -- addDependentFile. Should be absolute.+        usg_file_hash  :: Fingerprint+        -- ^ 'Fingerprint' of the file contents.++        -- Note: We don't consider things like modification timestamps+        -- here, because there's no reason to recompile if the actual+        -- contents don't change.  This previously lead to odd+        -- recompilation behaviors; see #8114+  }+  -- | A requirement which was merged into this one.+  | UsageMergedRequirement {+        usg_mod :: Module,+        usg_mod_hash :: Fingerprint+  }+    deriving( Eq )+        -- The export list field is (Just v) if we depend on the export list:+        --      i.e. we imported the module directly, whether or not we+        --           enumerated the things we imported, or just imported+        --           everything+        -- We need to recompile if M's exports change, because+        -- if the import was    import M,       we might now have a name clash+        --                                      in the importing module.+        -- if the import was    import M(x)     M might no longer export x+        -- The only way we don't depend on the export list is if we have+        --                      import M()+        -- And of course, for modules that aren't imported directly we don't+        -- depend on their export lists++instance Binary Usage where+    put_ bh usg@UsagePackageModule{} = do+        putByte bh 0+        put_ bh (usg_mod usg)+        put_ bh (usg_mod_hash usg)+        put_ bh (usg_safe     usg)++    put_ bh usg@UsageHomeModule{} = do+        putByte bh 1+        put_ bh (usg_mod_name usg)+        put_ bh (usg_mod_hash usg)+        put_ bh (usg_exports  usg)+        put_ bh (usg_entities usg)+        put_ bh (usg_safe     usg)++    put_ bh usg@UsageFile{} = do+        putByte bh 2+        put_ bh (usg_file_path usg)+        put_ bh (usg_file_hash usg)++    put_ bh usg@UsageMergedRequirement{} = do+        putByte bh 3+        put_ bh (usg_mod      usg)+        put_ bh (usg_mod_hash usg)++    get bh = do+        h <- getByte bh+        case h of+          0 -> do+            nm    <- get bh+            mod   <- get bh+            safe  <- get bh+            return UsagePackageModule { usg_mod = nm, usg_mod_hash = mod, usg_safe = safe }+          1 -> do+            nm    <- get bh+            mod   <- get bh+            exps  <- get bh+            ents  <- get bh+            safe  <- get bh+            return UsageHomeModule { usg_mod_name = nm, usg_mod_hash = mod,+                     usg_exports = exps, usg_entities = ents, usg_safe = safe }+          2 -> do+            fp   <- get bh+            hash <- get bh+            return UsageFile { usg_file_path = fp, usg_file_hash = hash }+          3 -> do+            mod <- get bh+            hash <- get bh+            return UsageMergedRequirement { usg_mod = mod, usg_mod_hash = hash }+          i -> error ("Binary.get(Usage): " ++ show i)++{-+************************************************************************+*                                                                      *+                The External Package State+*                                                                      *+************************************************************************+-}++type PackageTypeEnv          = TypeEnv+type PackageRuleBase         = RuleBase+type PackageInstEnv          = InstEnv+type PackageFamInstEnv       = FamInstEnv+type PackageAnnEnv           = AnnEnv+type PackageCompleteMatchMap = CompleteMatchMap++-- | Information about other packages that we have slurped in by reading+-- their interface files+data ExternalPackageState+  = EPS {+        eps_is_boot :: !(ModuleNameEnv (ModuleName, IsBootInterface)),+                -- ^ In OneShot mode (only), home-package modules+                -- accumulate in the external package state, and are+                -- sucked in lazily.  For these home-pkg modules+                -- (only) we need to record which are boot modules.+                -- We set this field after loading all the+                -- explicitly-imported interfaces, but before doing+                -- anything else+                --+                -- The 'ModuleName' part is not necessary, but it's useful for+                -- debug prints, and it's convenient because this field comes+                -- direct from 'TcRnTypes.imp_dep_mods'++        eps_PIT :: !PackageIfaceTable,+                -- ^ The 'ModIface's for modules in external packages+                -- whose interfaces we have opened.+                -- The declarations in these interface files are held in the+                -- 'eps_decls', 'eps_inst_env', 'eps_fam_inst_env' and 'eps_rules'+                -- fields of this record, not in the 'mi_decls' fields of the+                -- interface we have sucked in.+                --+                -- What /is/ in the PIT is:+                --+                -- * The Module+                --+                -- * Fingerprint info+                --+                -- * Its exports+                --+                -- * Fixities+                --+                -- * Deprecations and warnings++        eps_free_holes :: InstalledModuleEnv (UniqDSet ModuleName),+                -- ^ Cache for 'mi_free_holes'.  Ordinarily, we can rely on+                -- the 'eps_PIT' for this information, EXCEPT that when+                -- we do dependency analysis, we need to look at the+                -- 'Dependencies' of our imports to determine what their+                -- precise free holes are ('moduleFreeHolesPrecise').  We+                -- don't want to repeatedly reread in the interface+                -- for every import, so cache it here.  When the PIT+                -- gets filled in we can drop these entries.++        eps_PTE :: !PackageTypeEnv,+                -- ^ Result of typechecking all the external package+                -- interface files we have sucked in. The domain of+                -- the mapping is external-package modules++        eps_inst_env     :: !PackageInstEnv,   -- ^ The total 'InstEnv' accumulated+                                               -- from all the external-package modules+        eps_fam_inst_env :: !PackageFamInstEnv,-- ^ The total 'FamInstEnv' accumulated+                                               -- from all the external-package modules+        eps_rule_base    :: !PackageRuleBase,  -- ^ The total 'RuleEnv' accumulated+                                               -- from all the external-package modules+        eps_ann_env      :: !PackageAnnEnv,    -- ^ The total 'AnnEnv' accumulated+                                               -- from all the external-package modules+        eps_complete_matches :: !PackageCompleteMatchMap,+                                  -- ^ The total 'CompleteMatchMap' accumulated+                                  -- from all the external-package modules++        eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- ^ The family instances accumulated from external+                                                         -- packages, keyed off the module that declared them++        eps_stats :: !EpsStats                 -- ^ Stastics about what was loaded from external packages+  }++-- | Accumulated statistics about what we are putting into the 'ExternalPackageState'.+-- \"In\" means stuff that is just /read/ from interface files,+-- \"Out\" means actually sucked in and type-checked+data EpsStats = EpsStats { n_ifaces_in+                         , n_decls_in, n_decls_out+                         , n_rules_in, n_rules_out+                         , n_insts_in, n_insts_out :: !Int }++addEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats+-- ^ Add stats for one newly-read interface+addEpsInStats stats n_decls n_insts n_rules+  = stats { n_ifaces_in = n_ifaces_in stats + 1+          , n_decls_in  = n_decls_in stats + n_decls+          , n_insts_in  = n_insts_in stats + n_insts+          , n_rules_in  = n_rules_in stats + n_rules }++{-+Names in a NameCache are always stored as a Global, and have the SrcLoc+of their binding locations.++Actually that's not quite right.  When we first encounter the original+name, we might not be at its binding site (e.g. we are reading an+interface file); so we give it 'noSrcLoc' then.  Later, when we find+its binding site, we fix it up.+-}++updNameCache :: IORef NameCache+             -> (NameCache -> (NameCache, c))  -- The updating function+             -> IO c+updNameCache ncRef upd_fn+  = atomicModifyIORef' ncRef upd_fn++mkSOName :: Platform -> FilePath -> FilePath+mkSOName platform root+    = case platformOS platform of+      OSMinGW32 ->           root  <.> soExt platform+      _         -> ("lib" ++ root) <.> soExt platform++mkHsSOName :: Platform -> FilePath -> FilePath+mkHsSOName platform root = ("lib" ++ root) <.> soExt platform++soExt :: Platform -> FilePath+soExt platform+    = case platformOS platform of+      OSDarwin  -> "dylib"+      OSMinGW32 -> "dll"+      _         -> "so"++{-+************************************************************************+*                                                                      *+                The module graph and ModSummary type+        A ModSummary is a node in the compilation manager's+        dependency graph, and it's also passed to hscMain+*                                                                      *+************************************************************************+-}++-- | A ModuleGraph contains all the nodes from the home package (only).+-- There will be a node for each source module, plus a node for each hi-boot+-- module.+--+-- The graph is not necessarily stored in topologically-sorted order.  Use+-- 'GHC.topSortModuleGraph' and 'Digraph.flattenSCC' to achieve this.+data ModuleGraph = ModuleGraph+  { mg_mss :: [ModSummary]+  , mg_non_boot :: ModuleEnv ModSummary+    -- a map of all non-boot ModSummaries keyed by Modules+  , mg_boot :: ModuleSet+    -- a set of boot Modules+  , mg_needs_th_or_qq :: !Bool+    -- does any of the modules in mg_mss require TemplateHaskell or+    -- QuasiQuotes?+  }++-- | Determines whether a set of modules requires Template Haskell or+-- Quasi Quotes+--+-- Note that if the session's 'DynFlags' enabled Template Haskell when+-- 'depanal' was called, then each module in the returned module graph will+-- have Template Haskell enabled whether it is actually needed or not.+needsTemplateHaskellOrQQ :: ModuleGraph -> Bool+needsTemplateHaskellOrQQ mg = mg_needs_th_or_qq mg++-- | Map a function 'f' over all the 'ModSummaries'.+-- To preserve invariants 'f' can't change the isBoot status.+mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph+mapMG f mg@ModuleGraph{..} = mg+  { mg_mss = map f mg_mss+  , mg_non_boot = mapModuleEnv f mg_non_boot+  }++mgBootModules :: ModuleGraph -> ModuleSet+mgBootModules ModuleGraph{..} = mg_boot++mgModSummaries :: ModuleGraph -> [ModSummary]+mgModSummaries = mg_mss++mgElemModule :: ModuleGraph -> Module -> Bool+mgElemModule ModuleGraph{..} m = elemModuleEnv m mg_non_boot++-- | Look up a ModSummary in the ModuleGraph+mgLookupModule :: ModuleGraph -> Module -> Maybe ModSummary+mgLookupModule ModuleGraph{..} m = lookupModuleEnv mg_non_boot m++emptyMG :: ModuleGraph+emptyMG = ModuleGraph [] emptyModuleEnv emptyModuleSet False++isTemplateHaskellOrQQNonBoot :: ModSummary -> Bool+isTemplateHaskellOrQQNonBoot ms =+  (xopt LangExt.TemplateHaskell (ms_hspp_opts ms)+    || xopt LangExt.QuasiQuotes (ms_hspp_opts ms)) &&+  not (isBootSummary ms)++-- | Add a ModSummary to ModuleGraph. Assumes that the new ModSummary is+-- not an element of the ModuleGraph.+extendMG :: ModuleGraph -> ModSummary -> ModuleGraph+extendMG ModuleGraph{..} ms = ModuleGraph+  { mg_mss = ms:mg_mss+  , mg_non_boot = if isBootSummary ms+      then mg_non_boot+      else extendModuleEnv mg_non_boot (ms_mod ms) ms+  , mg_boot = if isBootSummary ms+      then extendModuleSet mg_boot (ms_mod ms)+      else mg_boot+  , mg_needs_th_or_qq = mg_needs_th_or_qq || isTemplateHaskellOrQQNonBoot ms+  }++mkModuleGraph :: [ModSummary] -> ModuleGraph+mkModuleGraph = foldr (flip extendMG) emptyMG++-- | A single node in a 'ModuleGraph'. The nodes of the module graph+-- are one of:+--+-- * A regular Haskell source module+-- * A hi-boot source module+--+data ModSummary+   = ModSummary {+        ms_mod          :: Module,+          -- ^ Identity of the module+        ms_hsc_src      :: HscSource,+          -- ^ The module source either plain Haskell or hs-boot+        ms_location     :: ModLocation,+          -- ^ Location of the various files belonging to the module+        ms_hs_date      :: UTCTime,+          -- ^ Timestamp of source file+        ms_obj_date     :: Maybe UTCTime,+          -- ^ Timestamp of object, if we have one+        ms_iface_date   :: Maybe UTCTime,+          -- ^ Timestamp of hi file, if we *only* are typechecking (it is+          -- 'Nothing' otherwise.+          -- See Note [Recompilation checking in -fno-code mode] and #9243+        ms_hie_date   :: Maybe UTCTime,+          -- ^ Timestamp of hie file, if we have one+        ms_srcimps      :: [(Maybe FastString, Located ModuleName)],+          -- ^ Source imports of the module+        ms_textual_imps :: [(Maybe FastString, Located ModuleName)],+          -- ^ Non-source imports of the module from the module *text*+        ms_parsed_mod   :: Maybe HsParsedModule,+          -- ^ The parsed, nonrenamed source, if we have it.  This is also+          -- used to support "inline module syntax" in Backpack files.+        ms_hspp_file    :: FilePath,+          -- ^ Filename of preprocessed source file+        ms_hspp_opts    :: DynFlags,+          -- ^ Cached flags from @OPTIONS@, @INCLUDE@ and @LANGUAGE@+          -- pragmas in the modules source code+        ms_hspp_buf     :: Maybe StringBuffer+          -- ^ The actual preprocessed source, if we have it+     }++ms_installed_mod :: ModSummary -> InstalledModule+ms_installed_mod = fst . splitModuleInsts . ms_mod++ms_mod_name :: ModSummary -> ModuleName+ms_mod_name = moduleName . ms_mod++ms_imps :: ModSummary -> [(Maybe FastString, Located ModuleName)]+ms_imps ms =+  ms_textual_imps ms +++  map mk_additional_import (dynFlagDependencies (ms_hspp_opts ms))+  where+    mk_additional_import mod_nm = (Nothing, noLoc mod_nm)++-- The ModLocation contains both the original source filename and the+-- filename of the cleaned-up source file after all preprocessing has been+-- done.  The point is that the summariser will have to cpp/unlit/whatever+-- all files anyway, and there's no point in doing this twice -- just+-- park the result in a temp file, put the name of it in the location,+-- and let @compile@ read from that file on the way back up.++-- The ModLocation is stable over successive up-sweeps in GHCi, wheres+-- the ms_hs_date and imports can, of course, change++msHsFilePath, msHiFilePath, msObjFilePath :: ModSummary -> FilePath+msHsFilePath  ms = expectJust "msHsFilePath" (ml_hs_file  (ms_location ms))+msHiFilePath  ms = ml_hi_file  (ms_location ms)+msObjFilePath ms = ml_obj_file (ms_location ms)++-- | Did this 'ModSummary' originate from a hs-boot file?+isBootSummary :: ModSummary -> Bool+isBootSummary ms = ms_hsc_src ms == HsBootFile++instance Outputable ModSummary where+   ppr ms+      = sep [text "ModSummary {",+             nest 3 (sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),+                          text "ms_mod =" <+> ppr (ms_mod ms)+                                <> text (hscSourceString (ms_hsc_src ms)) <> comma,+                          text "ms_textual_imps =" <+> ppr (ms_textual_imps ms),+                          text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),+             char '}'+            ]++showModMsg :: DynFlags -> HscTarget -> Bool -> ModSummary -> String+showModMsg dflags target recomp mod_summary = showSDoc dflags $+   if gopt Opt_HideSourcePaths dflags+      then text mod_str+      else hsep+         [ text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' ')+         , char '('+         , text (op $ msHsFilePath mod_summary) <> char ','+         , case target of+              HscInterpreted | recomp -> text "interpreted"+              HscNothing              -> text "nothing"+              _                       -> text (op $ msObjFilePath mod_summary)+         , char ')'+         ]+  where+    op      = normalise+    mod     = moduleName (ms_mod mod_summary)+    mod_str = showPpr dflags mod ++ hscSourceString (ms_hsc_src mod_summary)++{-+************************************************************************+*                                                                      *+\subsection{Recompilation}+*                                                                      *+************************************************************************+-}++-- | Indicates whether a given module's source has been modified since it+-- was last compiled.+data SourceModified+  = SourceModified+       -- ^ the source has been modified+  | SourceUnmodified+       -- ^ the source has not been modified.  Compilation may or may+       -- not be necessary, depending on whether any dependencies have+       -- changed since we last compiled.+  | SourceUnmodifiedAndStable+       -- ^ the source has not been modified, and furthermore all of+       -- its (transitive) dependencies are up to date; it definitely+       -- does not need to be recompiled.  This is important for two+       -- reasons: (a) we can omit the version check in checkOldIface,+       -- and (b) if the module used TH splices we don't need to force+       -- recompilation.++{-+************************************************************************+*                                                                      *+\subsection{Hpc Support}+*                                                                      *+************************************************************************+-}++-- | Information about a modules use of Haskell Program Coverage+data HpcInfo+  = HpcInfo+     { hpcInfoTickCount :: Int+     , hpcInfoHash      :: Int+     }+  | NoHpcInfo+     { hpcUsed          :: AnyHpcUsage  -- ^ Is hpc used anywhere on the module \*tree\*?+     }++-- | This is used to signal if one of my imports used HPC instrumentation+-- even if there is no module-local HPC usage+type AnyHpcUsage = Bool++emptyHpcInfo :: AnyHpcUsage -> HpcInfo+emptyHpcInfo = NoHpcInfo++-- | Find out if HPC is used by this module or any of the modules+-- it depends upon+isHpcUsed :: HpcInfo -> AnyHpcUsage+isHpcUsed (HpcInfo {})                   = True+isHpcUsed (NoHpcInfo { hpcUsed = used }) = used++{-+************************************************************************+*                                                                      *+\subsection{Safe Haskell Support}+*                                                                      *+************************************************************************++This stuff here is related to supporting the Safe Haskell extension,+primarily about storing under what trust type a module has been compiled.+-}++-- | Is an import a safe import?+type IsSafeImport = Bool++-- | Safe Haskell information for 'ModIface'+-- Simply a wrapper around SafeHaskellMode to sepperate iface and flags+newtype IfaceTrustInfo = TrustInfo SafeHaskellMode++getSafeMode :: IfaceTrustInfo -> SafeHaskellMode+getSafeMode (TrustInfo x) = x++setSafeMode :: SafeHaskellMode -> IfaceTrustInfo+setSafeMode = TrustInfo++noIfaceTrustInfo :: IfaceTrustInfo+noIfaceTrustInfo = setSafeMode Sf_None++trustInfoToNum :: IfaceTrustInfo -> Word8+trustInfoToNum it+  = case getSafeMode it of+            Sf_None         -> 0+            Sf_Unsafe       -> 1+            Sf_Trustworthy  -> 2+            Sf_Safe         -> 3+            Sf_Ignore       -> 0++numToTrustInfo :: Word8 -> IfaceTrustInfo+numToTrustInfo 0 = setSafeMode Sf_None+numToTrustInfo 1 = setSafeMode Sf_Unsafe+numToTrustInfo 2 = setSafeMode Sf_Trustworthy+numToTrustInfo 3 = setSafeMode Sf_Safe+numToTrustInfo 4 = setSafeMode Sf_Safe -- retained for backwards compat, used+                                       -- to be Sf_SafeInfered but we no longer+                                       -- differentiate.+numToTrustInfo n = error $ "numToTrustInfo: bad input number! (" ++ show n ++ ")"++instance Outputable IfaceTrustInfo where+    ppr (TrustInfo Sf_None)          = text "none"+    ppr (TrustInfo Sf_Ignore)        = text "none"+    ppr (TrustInfo Sf_Unsafe)        = text "unsafe"+    ppr (TrustInfo Sf_Trustworthy)   = text "trustworthy"+    ppr (TrustInfo Sf_Safe)          = text "safe"++instance Binary IfaceTrustInfo where+    put_ bh iftrust = putByte bh $ trustInfoToNum iftrust+    get bh = getByte bh >>= (return . numToTrustInfo)++{-+************************************************************************+*                                                                      *+\subsection{Parser result}+*                                                                      *+************************************************************************+-}++data HsParsedModule = HsParsedModule {+    hpm_module    :: Located (HsModule GhcPs),+    hpm_src_files :: [FilePath],+       -- ^ extra source files (e.g. from #includes).  The lexer collects+       -- these from '# <file> <line>' pragmas, which the C preprocessor+       -- leaves behind.  These files and their timestamps are stored in+       -- the .hi file, so that we can force recompilation if any of+       -- them change (#3589)+    hpm_annotations :: ApiAnns+    -- See note [Api annotations] in ApiAnnotation.hs+  }++{-+************************************************************************+*                                                                      *+\subsection{Linkable stuff}+*                                                                      *+************************************************************************++This stuff is in here, rather than (say) in Linker.hs, because the Linker.hs+stuff is the *dynamic* linker, and isn't present in a stage-1 compiler+-}++-- | Information we can use to dynamically link modules into the compiler+data Linkable = LM {+  linkableTime     :: UTCTime,          -- ^ Time at which this linkable was built+                                        -- (i.e. when the bytecodes were produced,+                                        --       or the mod date on the files)+  linkableModule   :: Module,           -- ^ The linkable module itself+  linkableUnlinked :: [Unlinked]+    -- ^ Those files and chunks of code we have yet to link.+    --+    -- INVARIANT: A valid linkable always has at least one 'Unlinked' item.+    -- If this list is empty, the Linkable represents a fake linkable, which+    -- is generated in HscNothing mode to avoid recompiling modules.+    --+    -- ToDo: Do items get removed from this list when they get linked?+ }++isObjectLinkable :: Linkable -> Bool+isObjectLinkable l = not (null unlinked) && all isObject unlinked+  where unlinked = linkableUnlinked l+        -- A linkable with no Unlinked's is treated as a BCO.  We can+        -- generate a linkable with no Unlinked's as a result of+        -- compiling a module in HscNothing mode, and this choice+        -- happens to work well with checkStability in module GHC.++linkableObjs :: Linkable -> [FilePath]+linkableObjs l = [ f | DotO f <- linkableUnlinked l ]++instance Outputable Linkable where+   ppr (LM when_made mod unlinkeds)+      = (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod)+        $$ nest 3 (ppr unlinkeds)++-------------------------------------------++-- | Objects which have yet to be linked by the compiler+data Unlinked+   = DotO FilePath      -- ^ An object file (.o)+   | DotA FilePath      -- ^ Static archive file (.a)+   | DotDLL FilePath    -- ^ Dynamically linked library file (.so, .dll, .dylib)+   | BCOs CompiledByteCode+          [SptEntry]    -- ^ A byte-code object, lives only in memory. Also+                        -- carries some static pointer table entries which+                        -- should be loaded along with the BCOs.+                        -- See Note [Grant plan for static forms] in+                        -- StaticPtrTable.++instance Outputable Unlinked where+   ppr (DotO path)   = text "DotO" <+> text path+   ppr (DotA path)   = text "DotA" <+> text path+   ppr (DotDLL path) = text "DotDLL" <+> text path+   ppr (BCOs bcos spt) = text "BCOs" <+> ppr bcos <+> ppr spt++-- | Is this an actual file on disk we can link in somehow?+isObject :: Unlinked -> Bool+isObject (DotO _)   = True+isObject (DotA _)   = True+isObject (DotDLL _) = True+isObject _          = False++-- | Is this a bytecode linkable with no file on disk?+isInterpretable :: Unlinked -> Bool+isInterpretable = not . isObject++-- | Retrieve the filename of the linkable if possible. Panic if it is a byte-code object+nameOfObject :: Unlinked -> FilePath+nameOfObject (DotO fn)   = fn+nameOfObject (DotA fn)   = fn+nameOfObject (DotDLL fn) = fn+nameOfObject other       = pprPanic "nameOfObject" (ppr other)++-- | Retrieve the compiled byte-code if possible. Panic if it is a file-based linkable+byteCodeOfObject :: Unlinked -> CompiledByteCode+byteCodeOfObject (BCOs bc _) = bc+byteCodeOfObject other       = pprPanic "byteCodeOfObject" (ppr other)+++-------------------------------------------++-- | A list of conlikes which represents a complete pattern match.+-- These arise from @COMPLETE@ signatures.++-- See Note [Implementation of COMPLETE signatures]+data CompleteMatch = CompleteMatch {+                            completeMatchConLikes :: [Name]+                            -- ^ The ConLikes that form a covering family+                            -- (e.g. Nothing, Just)+                          , completeMatchTyCon :: Name+                            -- ^ The TyCon that they cover (e.g. Maybe)+                          }++instance Outputable CompleteMatch where+  ppr (CompleteMatch cl ty) = text "CompleteMatch:" <+> ppr cl+                                                    <+> dcolon <+> ppr ty++-- | A map keyed by the 'completeMatchTyCon'.++-- See Note [Implementation of COMPLETE signatures]+type CompleteMatchMap = UniqFM [CompleteMatch]++mkCompleteMatchMap :: [CompleteMatch] -> CompleteMatchMap+mkCompleteMatchMap = extendCompleteMatchMap emptyUFM++extendCompleteMatchMap :: CompleteMatchMap -> [CompleteMatch]+                       -> CompleteMatchMap+extendCompleteMatchMap = foldl' insertMatch+  where+    insertMatch :: CompleteMatchMap -> CompleteMatch -> CompleteMatchMap+    insertMatch ufm c@(CompleteMatch _ t) = addToUFM_C (++) ufm t [c]++{-+Note [Implementation of COMPLETE signatures]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A COMPLETE signature represents a set of conlikes (i.e., constructors or+pattern synonyms) such that if they are all pattern-matched against in a+function, it gives rise to a total function. An example is:++  newtype Boolean = Boolean Int+  pattern F, T :: Boolean+  pattern F = Boolean 0+  pattern T = Boolean 1+  {-# COMPLETE F, T #-}++  -- This is a total function+  booleanToInt :: Boolean -> Int+  booleanToInt F = 0+  booleanToInt T = 1++COMPLETE sets are represented internally in GHC with the CompleteMatch data+type. For example, {-# COMPLETE F, T #-} would be represented as:++  CompleteMatch { complateMatchConLikes = [F, T]+                , completeMatchTyCon    = Boolean }++Note that GHC was able to infer the completeMatchTyCon (Boolean), but for the+cases in which it's ambiguous, you can also explicitly specify it in the source+language by writing this:++  {-# COMPLETE F, T :: Boolean #-}++For efficiency purposes, GHC collects all of the CompleteMatches that it knows+about into a CompleteMatchMap, which is a map that is keyed by the+completeMatchTyCon. In other words, you could have a multiple COMPLETE sets+for the same TyCon:++  {-# COMPLETE F, T1 :: Boolean #-}+  {-# COMPLETE F, T2 :: Boolean #-}++And looking up the values in the CompleteMatchMap associated with Boolean+would give you [CompleteMatch [F, T1] Boolean, CompleteMatch [F, T2] Boolean].+dsGetCompleteMatches in DsMeta accomplishes this lookup.++Also see Note [Typechecking Complete Matches] in TcBinds for a more detailed+explanation for how GHC ensures that all the conlikes in a COMPLETE set are+consistent.+-}
+ compiler/main/InteractiveEvalTypes.hs view
@@ -0,0 +1,89 @@+-- -----------------------------------------------------------------------------+--+-- (c) The University of Glasgow, 2005-2007+--+-- Running statements interactively+--+-- -----------------------------------------------------------------------------++module InteractiveEvalTypes (+        Resume(..), History(..), ExecResult(..),+        SingleStep(..), isStep, ExecOptions(..),+        BreakInfo(..)+        ) where++import GhcPrelude++import GHCi.RemoteTypes+import GHCi.Message (EvalExpr, ResumeContext)+import Id+import Name+import Module+import RdrName+import Type+import SrcLoc+import Exception++import Data.Word+import GHC.Stack.CCS++data ExecOptions+ = ExecOptions+     { execSingleStep :: SingleStep         -- ^ stepping mode+     , execSourceFile :: String             -- ^ filename (for errors)+     , execLineNumber :: Int                -- ^ line number (for errors)+     , execWrap :: ForeignHValue -> EvalExpr ForeignHValue+     }++data SingleStep+   = RunToCompletion+   | SingleStep+   | RunAndLogSteps++isStep :: SingleStep -> Bool+isStep RunToCompletion = False+isStep _ = True++data ExecResult+  = ExecComplete+       { execResult :: Either SomeException [Name]+       , execAllocation :: Word64+       }+  | ExecBreak+       { breakNames :: [Name]+       , breakInfo :: Maybe BreakInfo+       }++data BreakInfo = BreakInfo+  { breakInfo_module :: Module+  , breakInfo_number :: Int+  }++data Resume = Resume+       { resumeStmt      :: String       -- the original statement+       , resumeContext   :: ForeignRef (ResumeContext [HValueRef])+       , resumeBindings  :: ([TyThing], GlobalRdrEnv)+       , resumeFinalIds  :: [Id]         -- [Id] to bind on completion+       , resumeApStack   :: ForeignHValue -- The object from which we can get+                                        -- value of the free variables.+       , resumeBreakInfo :: Maybe BreakInfo+                                        -- the breakpoint we stopped at+                                        -- (module, index)+                                        -- (Nothing <=> exception)+       , resumeSpan      :: SrcSpan      -- just a copy of the SrcSpan+                                        -- from the ModBreaks,+                                        -- otherwise it's a pain to+                                        -- fetch the ModDetails &+                                        -- ModBreaks to get this.+       , resumeDecl      :: String       -- ditto+       , resumeCCS       :: RemotePtr CostCentreStack+       , resumeHistory   :: [History]+       , resumeHistoryIx :: Int           -- 0 <==> at the top of the history+       }++data History+   = History {+        historyApStack   :: ForeignHValue,+        historyBreakInfo :: BreakInfo,+        historyEnclosingDecls :: [String]  -- declarations enclosing the breakpoint+   }
+ compiler/main/PackageConfig.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE CPP, RecordWildCards, FlexibleInstances, MultiParamTypeClasses #-}++-- |+-- Package configuration information: essentially the interface to Cabal, with+-- some utilities+--+-- (c) The University of Glasgow, 2004+--+module PackageConfig (+        -- $package_naming++        -- * UnitId+        packageConfigId,+        expandedPackageConfigId,+        definitePackageConfigId,+        installedPackageConfigId,++        -- * The PackageConfig type: information about a package+        PackageConfig,+        InstalledPackageInfo(..),+        ComponentId(..),+        SourcePackageId(..),+        PackageName(..),+        Version(..),+        defaultPackageConfig,+        sourcePackageIdString,+        packageNameString,+        pprPackageConfig,+    ) where++#include "HsVersions.h"++import GhcPrelude++import GHC.PackageDb+import Data.Version++import FastString+import Outputable+import Module+import Unique++-- -----------------------------------------------------------------------------+-- Our PackageConfig type is the InstalledPackageInfo from ghc-boot,+-- which is similar to a subset of the InstalledPackageInfo type from Cabal.++type PackageConfig = InstalledPackageInfo+                       ComponentId+                       SourcePackageId+                       PackageName+                       Module.InstalledUnitId+                       Module.UnitId+                       Module.ModuleName+                       Module.Module++-- TODO: there's no need for these to be FastString, as we don't need the uniq+--       feature, but ghc doesn't currently have convenient support for any+--       other compact string types, e.g. plain ByteString or Text.++newtype SourcePackageId    = SourcePackageId    FastString deriving (Eq, Ord)+newtype PackageName        = PackageName        FastString deriving (Eq, Ord)++instance BinaryStringRep SourcePackageId where+  fromStringRep = SourcePackageId . mkFastStringByteString+  toStringRep (SourcePackageId s) = bytesFS s++instance BinaryStringRep PackageName where+  fromStringRep = PackageName . mkFastStringByteString+  toStringRep (PackageName s) = bytesFS s++instance Uniquable SourcePackageId where+  getUnique (SourcePackageId n) = getUnique n++instance Uniquable PackageName where+  getUnique (PackageName n) = getUnique n++instance Outputable SourcePackageId where+  ppr (SourcePackageId str) = ftext str++instance Outputable PackageName where+  ppr (PackageName str) = ftext str++defaultPackageConfig :: PackageConfig+defaultPackageConfig = emptyInstalledPackageInfo++sourcePackageIdString :: PackageConfig -> String+sourcePackageIdString pkg = unpackFS str+  where+    SourcePackageId str = sourcePackageId pkg++packageNameString :: PackageConfig -> String+packageNameString pkg = unpackFS str+  where+    PackageName str = packageName pkg++pprPackageConfig :: PackageConfig -> SDoc+pprPackageConfig InstalledPackageInfo {..} =+    vcat [+      field "name"                 (ppr packageName),+      field "version"              (text (showVersion packageVersion)),+      field "id"                   (ppr unitId),+      field "exposed"              (ppr exposed),+      field "exposed-modules"      (ppr exposedModules),+      field "hidden-modules"       (fsep (map ppr hiddenModules)),+      field "trusted"              (ppr trusted),+      field "import-dirs"          (fsep (map text importDirs)),+      field "library-dirs"         (fsep (map text libraryDirs)),+      field "dynamic-library-dirs" (fsep (map text libraryDynDirs)),+      field "hs-libraries"         (fsep (map text hsLibraries)),+      field "extra-libraries"      (fsep (map text extraLibraries)),+      field "extra-ghci-libraries" (fsep (map text extraGHCiLibraries)),+      field "include-dirs"         (fsep (map text includeDirs)),+      field "includes"             (fsep (map text includes)),+      field "depends"              (fsep (map ppr  depends)),+      field "cc-options"           (fsep (map text ccOptions)),+      field "ld-options"           (fsep (map text ldOptions)),+      field "framework-dirs"       (fsep (map text frameworkDirs)),+      field "frameworks"           (fsep (map text frameworks)),+      field "haddock-interfaces"   (fsep (map text haddockInterfaces)),+      field "haddock-html"         (fsep (map text haddockHTMLs))+    ]+  where+    field name body = text name <> colon <+> nest 4 body++-- -----------------------------------------------------------------------------+-- UnitId (package names, versions and dep hash)++-- $package_naming+-- #package_naming#+-- Mostly the compiler deals in terms of 'UnitId's, which are md5 hashes+-- of a package ID, keys of its dependencies, and Cabal flags. You're expected+-- to pass in the unit id in the @-this-unit-id@ flag. However, for+-- wired-in packages like @base@ & @rts@, we don't necessarily know what the+-- version is, so these are handled specially; see #wired_in_packages#.++-- | Get the GHC 'UnitId' right out of a Cabalish 'PackageConfig'+installedPackageConfigId :: PackageConfig -> InstalledUnitId+installedPackageConfigId = unitId++packageConfigId :: PackageConfig -> UnitId+packageConfigId p =+    if indefinite p+        then newUnitId (componentId p) (instantiatedWith p)+        else DefiniteUnitId (DefUnitId (unitId p))++expandedPackageConfigId :: PackageConfig -> UnitId+expandedPackageConfigId p =+    newUnitId (componentId p) (instantiatedWith p)++definitePackageConfigId :: PackageConfig -> Maybe DefUnitId+definitePackageConfigId p =+    case packageConfigId p of+        DefiniteUnitId def_uid -> Just def_uid+        _ -> Nothing
+ compiler/main/PackageConfig.hs-boot view
@@ -0,0 +1,7 @@+module PackageConfig where+import FastString+import {-# SOURCE #-} Module+import GHC.PackageDb+newtype PackageName = PackageName FastString+newtype SourcePackageId = SourcePackageId FastString+type PackageConfig = InstalledPackageInfo ComponentId SourcePackageId PackageName UnitId ModuleName Module
+ compiler/main/Packages.hs view
@@ -0,0 +1,2193 @@+-- (c) The University of Glasgow, 2006++{-# LANGUAGE CPP, ScopedTypeVariables, BangPatterns, FlexibleContexts #-}++-- | Package manipulation+module Packages (+        module PackageConfig,++        -- * Reading the package config, and processing cmdline args+        PackageState(preloadPackages, explicitPackages, moduleToPkgConfAll, requirementContext),+        PackageConfigMap,+        emptyPackageState,+        initPackages,+        readPackageConfigs,+        getPackageConfRefs,+        resolvePackageConfig,+        readPackageConfig,+        listPackageConfigMap,++        -- * Querying the package config+        lookupPackage,+        lookupPackage',+        lookupInstalledPackage,+        lookupPackageName,+        improveUnitId,+        searchPackageId,+        getPackageDetails,+        getInstalledPackageDetails,+        componentIdString,+        displayInstalledUnitId,+        listVisibleModuleNames,+        lookupModuleInAllPackages,+        lookupModuleWithSuggestions,+        lookupPluginModuleWithSuggestions,+        LookupResult(..),+        ModuleSuggestion(..),+        ModuleOrigin(..),+        UnusablePackageReason(..),+        pprReason,++        -- * Inspecting the set of packages in scope+        getPackageIncludePath,+        getPackageLibraryPath,+        getPackageLinkOpts,+        getPackageExtraCcOpts,+        getPackageFrameworkPath,+        getPackageFrameworks,+        getPackageConfigMap,+        getPreloadPackagesAnd,++        collectArchives,+        collectIncludeDirs, collectLibraryPaths, collectLinkOpts,+        packageHsLibs, getLibs,++        -- * Utils+        unwireUnitId,+        pprFlag,+        pprPackages,+        pprPackagesSimple,+        pprModuleMap,+        isIndefinite,+        isDllName+    )+where++#include "HsVersions.h"++import GhcPrelude++import GHC.PackageDb+import PackageConfig+import DynFlags+import Name             ( Name, nameModule_maybe )+import UniqFM+import UniqDFM+import UniqSet+import Module+import Util+import Panic+import Platform+import Outputable+import Maybes++import System.Environment ( getEnv )+import FastString+import ErrUtils         ( debugTraceMsg, MsgDoc, dumpIfSet_dyn )+import Exception++import System.Directory+import System.FilePath as FilePath+import qualified System.FilePath.Posix as FilePath.Posix+import Control.Monad+import Data.Graph (stronglyConnComp, SCC(..))+import Data.Char ( toUpper )+import Data.List as List+import Data.Map (Map)+import Data.Set (Set)+import Data.Monoid (First(..))+import qualified Data.Semigroup as Semigroup+import qualified Data.Map as Map+import qualified Data.Map.Strict as MapStrict+import qualified Data.Set as Set+import Data.Version++-- ---------------------------------------------------------------------------+-- The Package state++-- | Package state is all stored in 'DynFlags', including the details of+-- all packages, which packages are exposed, and which modules they+-- provide.+--+-- The package state is computed by 'initPackages', and kept in DynFlags.+-- It is influenced by various package flags:+--+--   * @-package <pkg>@ and @-package-id <pkg>@ cause @<pkg>@ to become exposed.+--     If @-hide-all-packages@ was not specified, these commands also cause+--      all other packages with the same name to become hidden.+--+--   * @-hide-package <pkg>@ causes @<pkg>@ to become hidden.+--+--   * (there are a few more flags, check below for their semantics)+--+-- The package state has the following properties.+--+--   * Let @exposedPackages@ be the set of packages thus exposed.+--     Let @depExposedPackages@ be the transitive closure from @exposedPackages@ of+--     their dependencies.+--+--   * When searching for a module from a preload import declaration,+--     only the exposed modules in @exposedPackages@ are valid.+--+--   * When searching for a module from an implicit import, all modules+--     from @depExposedPackages@ are valid.+--+--   * When linking in a compilation manager mode, we link in packages the+--     program depends on (the compiler knows this list by the+--     time it gets to the link step).  Also, we link in all packages+--     which were mentioned with preload @-package@ flags on the command-line,+--     or are a transitive dependency of same, or are \"base\"\/\"rts\".+--     The reason for this is that we might need packages which don't+--     contain any Haskell modules, and therefore won't be discovered+--     by the normal mechanism of dependency tracking.++-- Notes on DLLs+-- ~~~~~~~~~~~~~+-- When compiling module A, which imports module B, we need to+-- know whether B will be in the same DLL as A.+--      If it's in the same DLL, we refer to B_f_closure+--      If it isn't, we refer to _imp__B_f_closure+-- When compiling A, we record in B's Module value whether it's+-- in a different DLL, by setting the DLL flag.++-- | Given a module name, there may be multiple ways it came into scope,+-- possibly simultaneously.  This data type tracks all the possible ways+-- it could have come into scope.  Warning: don't use the record functions,+-- they're partial!+data ModuleOrigin =+    -- | Module is hidden, and thus never will be available for import.+    -- (But maybe the user didn't realize), so we'll still keep track+    -- of these modules.)+    ModHidden+    -- | Module is unavailable because the package is unusable.+  | ModUnusable UnusablePackageReason+    -- | Module is public, and could have come from some places.+  | ModOrigin {+        -- | @Just False@ means that this module is in+        -- someone's @exported-modules@ list, but that package is hidden;+        -- @Just True@ means that it is available; @Nothing@ means neither+        -- applies.+        fromOrigPackage :: Maybe Bool+        -- | Is the module available from a reexport of an exposed package?+        -- There could be multiple.+      , fromExposedReexport :: [PackageConfig]+        -- | Is the module available from a reexport of a hidden package?+      , fromHiddenReexport :: [PackageConfig]+        -- | Did the module export come from a package flag? (ToDo: track+        -- more information.+      , fromPackageFlag :: Bool+      }++instance Outputable ModuleOrigin where+    ppr ModHidden = text "hidden module"+    ppr (ModUnusable _) = text "unusable module"+    ppr (ModOrigin e res rhs f) = sep (punctuate comma (+        (case e of+            Nothing -> []+            Just False -> [text "hidden package"]+            Just True -> [text "exposed package"]) +++        (if null res+            then []+            else [text "reexport by" <+>+                    sep (map (ppr . packageConfigId) res)]) +++        (if null rhs+            then []+            else [text "hidden reexport by" <+>+                    sep (map (ppr . packageConfigId) res)]) +++        (if f then [text "package flag"] else [])+        ))++-- | Smart constructor for a module which is in @exposed-modules@.  Takes+-- as an argument whether or not the defining package is exposed.+fromExposedModules :: Bool -> ModuleOrigin+fromExposedModules e = ModOrigin (Just e) [] [] False++-- | Smart constructor for a module which is in @reexported-modules@.  Takes+-- as an argument whether or not the reexporting package is expsed, and+-- also its 'PackageConfig'.+fromReexportedModules :: Bool -> PackageConfig -> ModuleOrigin+fromReexportedModules True pkg = ModOrigin Nothing [pkg] [] False+fromReexportedModules False pkg = ModOrigin Nothing [] [pkg] False++-- | Smart constructor for a module which was bound by a package flag.+fromFlag :: ModuleOrigin+fromFlag = ModOrigin Nothing [] [] True++instance Semigroup ModuleOrigin where+    ModOrigin e res rhs f <> ModOrigin e' res' rhs' f' =+        ModOrigin (g e e') (res ++ res') (rhs ++ rhs') (f || f')+      where g (Just b) (Just b')+                | b == b'   = Just b+                | otherwise = panic "ModOrigin: package both exposed/hidden"+            g Nothing x = x+            g x Nothing = x+    _x <> _y = panic "ModOrigin: hidden module redefined"++instance Monoid ModuleOrigin where+    mempty = ModOrigin Nothing [] [] False+    mappend = (Semigroup.<>)++-- | Is the name from the import actually visible? (i.e. does it cause+-- ambiguity, or is it only relevant when we're making suggestions?)+originVisible :: ModuleOrigin -> Bool+originVisible ModHidden = False+originVisible (ModUnusable _) = False+originVisible (ModOrigin b res _ f) = b == Just True || not (null res) || f++-- | Are there actually no providers for this module?  This will never occur+-- except when we're filtering based on package imports.+originEmpty :: ModuleOrigin -> Bool+originEmpty (ModOrigin Nothing [] [] False) = True+originEmpty _ = False++-- | 'UniqFM' map from 'InstalledUnitId'+type InstalledUnitIdMap = UniqDFM++-- | 'UniqFM' map from 'UnitId' to 'PackageConfig', plus+-- the transitive closure of preload packages.+data PackageConfigMap = PackageConfigMap {+        unPackageConfigMap :: InstalledUnitIdMap PackageConfig,+        -- | The set of transitively reachable packages according+        -- to the explicitly provided command line arguments.+        -- See Note [UnitId to InstalledUnitId improvement]+        preloadClosure :: UniqSet InstalledUnitId+    }++-- | 'UniqFM' map from 'UnitId' to a 'UnitVisibility'.+type VisibilityMap = Map UnitId UnitVisibility++-- | 'UnitVisibility' records the various aspects of visibility of a particular+-- 'UnitId'.+data UnitVisibility = UnitVisibility+    { uv_expose_all :: Bool+      --  ^ Should all modules in exposed-modules should be dumped into scope?+    , uv_renamings :: [(ModuleName, ModuleName)]+      -- ^ Any custom renamings that should bring extra 'ModuleName's into+      -- scope.+    , uv_package_name :: First FastString+      -- ^ The package name is associated with the 'UnitId'.  This is used+      -- to implement legacy behavior where @-package foo-0.1@ implicitly+      -- hides any packages named @foo@+    , uv_requirements :: Map ModuleName (Set IndefModule)+      -- ^ The signatures which are contributed to the requirements context+      -- from this unit ID.+    , uv_explicit :: Bool+      -- ^ Whether or not this unit was explicitly brought into scope,+      -- as opposed to implicitly via the 'exposed' fields in the+      -- package database (when @-hide-all-packages@ is not passed.)+    }++instance Outputable UnitVisibility where+    ppr (UnitVisibility {+        uv_expose_all = b,+        uv_renamings = rns,+        uv_package_name = First mb_pn,+        uv_requirements = reqs,+        uv_explicit = explicit+    }) = ppr (b, rns, mb_pn, reqs, explicit)++instance Semigroup UnitVisibility where+    uv1 <> uv2+        = UnitVisibility+          { uv_expose_all = uv_expose_all uv1 || uv_expose_all uv2+          , uv_renamings = uv_renamings uv1 ++ uv_renamings uv2+          , uv_package_name = mappend (uv_package_name uv1) (uv_package_name uv2)+          , uv_requirements = Map.unionWith Set.union (uv_requirements uv1) (uv_requirements uv2)+          , uv_explicit = uv_explicit uv1 || uv_explicit uv2+          }++instance Monoid UnitVisibility where+    mempty = UnitVisibility+             { uv_expose_all = False+             , uv_renamings = []+             , uv_package_name = First Nothing+             , uv_requirements = Map.empty+             , uv_explicit = False+             }+    mappend = (Semigroup.<>)++type WiredUnitId = DefUnitId+type PreloadUnitId = InstalledUnitId++-- | Map from 'ModuleName' to 'Module' to all the origins of the bindings+-- in scope.  The 'PackageConf' is not cached, mostly for convenience reasons+-- (since this is the slow path, we'll just look it up again).+type ModuleToPkgConfAll =+    Map ModuleName (Map Module ModuleOrigin)++data PackageState = PackageState {+  -- | A mapping of 'UnitId' to 'PackageConfig'.  This list is adjusted+  -- so that only valid packages are here.  'PackageConfig' reflects+  -- what was stored *on disk*, except for the 'trusted' flag, which+  -- is adjusted at runtime.  (In particular, some packages in this map+  -- may have the 'exposed' flag be 'False'.)+  pkgIdMap              :: PackageConfigMap,++  -- | A mapping of 'PackageName' to 'ComponentId'.  This is used when+  -- users refer to packages in Backpack includes.+  packageNameMap            :: Map PackageName ComponentId,++  -- | A mapping from wired in names to the original names from the+  -- package database.+  unwireMap :: Map WiredUnitId WiredUnitId,++  -- | The packages we're going to link in eagerly.  This list+  -- should be in reverse dependency order; that is, a package+  -- is always mentioned before the packages it depends on.+  preloadPackages      :: [PreloadUnitId],++  -- | Packages which we explicitly depend on (from a command line flag).+  -- We'll use this to generate version macros.+  explicitPackages      :: [UnitId],++  -- | This is a full map from 'ModuleName' to all modules which may possibly+  -- be providing it.  These providers may be hidden (but we'll still want+  -- to report them in error messages), or it may be an ambiguous import.+  moduleToPkgConfAll    :: !ModuleToPkgConfAll,++  -- | A map, like 'moduleToPkgConfAll', but controlling plugin visibility.+  pluginModuleToPkgConfAll    :: !ModuleToPkgConfAll,++  -- | A map saying, for each requirement, what interfaces must be merged+  -- together when we use them.  For example, if our dependencies+  -- are @p[A=<A>]@ and @q[A=<A>,B=r[C=<A>]:B]@, then the interfaces+  -- to merge for A are @p[A=<A>]:A@, @q[A=<A>,B=r[C=<A>]:B]:A@+  -- and @r[C=<A>]:C@.+  --+  -- There's an entry in this map for each hole in our home library.+  requirementContext :: Map ModuleName [IndefModule]+  }++emptyPackageState :: PackageState+emptyPackageState = PackageState {+    pkgIdMap = emptyPackageConfigMap,+    packageNameMap = Map.empty,+    unwireMap = Map.empty,+    preloadPackages = [],+    explicitPackages = [],+    moduleToPkgConfAll = Map.empty,+    pluginModuleToPkgConfAll = Map.empty,+    requirementContext = Map.empty+    }++type InstalledPackageIndex = Map InstalledUnitId PackageConfig++-- | Empty package configuration map+emptyPackageConfigMap :: PackageConfigMap+emptyPackageConfigMap = PackageConfigMap emptyUDFM emptyUniqSet++-- | Find the package we know about with the given unit id, if any+lookupPackage :: DynFlags -> UnitId -> Maybe PackageConfig+lookupPackage dflags = lookupPackage' (isIndefinite dflags) (pkgIdMap (pkgState dflags))++-- | A more specialized interface, which takes a boolean specifying+-- whether or not to look for on-the-fly renamed interfaces, and+-- just a 'PackageConfigMap' rather than a 'DynFlags' (so it can+-- be used while we're initializing 'DynFlags'+lookupPackage' :: Bool -> PackageConfigMap -> UnitId -> Maybe PackageConfig+lookupPackage' False (PackageConfigMap pkg_map _) uid = lookupUDFM pkg_map uid+lookupPackage' True m@(PackageConfigMap pkg_map _) uid =+    case splitUnitIdInsts uid of+        (iuid, Just indef) ->+            fmap (renamePackage m (indefUnitIdInsts indef))+                 (lookupUDFM pkg_map iuid)+        (_, Nothing) -> lookupUDFM pkg_map uid++{-+-- | Find the indefinite package for a given 'ComponentId'.+-- The way this works is just by fiat'ing that every indefinite package's+-- unit key is precisely its component ID; and that they share uniques.+lookupComponentId :: DynFlags -> ComponentId -> Maybe PackageConfig+lookupComponentId dflags (ComponentId cid_fs) = lookupUDFM pkg_map cid_fs+  where+    PackageConfigMap pkg_map = pkgIdMap (pkgState dflags)+-}++-- | Find the package we know about with the given package name (e.g. @foo@), if any+-- (NB: there might be a locally defined unit name which overrides this)+lookupPackageName :: DynFlags -> PackageName -> Maybe ComponentId+lookupPackageName dflags n = Map.lookup n (packageNameMap (pkgState dflags))++-- | Search for packages with a given package ID (e.g. \"foo-0.1\")+searchPackageId :: DynFlags -> SourcePackageId -> [PackageConfig]+searchPackageId dflags pid = filter ((pid ==) . sourcePackageId)+                               (listPackageConfigMap dflags)++-- | Extends the package configuration map with a list of package configs.+extendPackageConfigMap+   :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap+extendPackageConfigMap (PackageConfigMap pkg_map closure) new_pkgs+  = PackageConfigMap (foldl' add pkg_map new_pkgs) closure+    -- We also add the expanded version of the packageConfigId, so that+    -- 'improveUnitId' can find it.+  where add pkg_map p = addToUDFM (addToUDFM pkg_map (expandedPackageConfigId p) p)+                                  (installedPackageConfigId p) p++-- | Looks up the package with the given id in the package state, panicing if it is+-- not found+getPackageDetails :: DynFlags -> UnitId -> PackageConfig+getPackageDetails dflags pid =+    expectJust "getPackageDetails" (lookupPackage dflags pid)++lookupInstalledPackage :: DynFlags -> InstalledUnitId -> Maybe PackageConfig+lookupInstalledPackage dflags uid = lookupInstalledPackage' (pkgIdMap (pkgState dflags)) uid++lookupInstalledPackage' :: PackageConfigMap -> InstalledUnitId -> Maybe PackageConfig+lookupInstalledPackage' (PackageConfigMap db _) uid = lookupUDFM db uid++getInstalledPackageDetails :: DynFlags -> InstalledUnitId -> PackageConfig+getInstalledPackageDetails dflags uid =+    expectJust "getInstalledPackageDetails" $+        lookupInstalledPackage dflags uid++-- | Get a list of entries from the package database.  NB: be careful with+-- this function, although all packages in this map are "visible", this+-- does not imply that the exposed-modules of the package are available+-- (they may have been thinned or renamed).+listPackageConfigMap :: DynFlags -> [PackageConfig]+listPackageConfigMap dflags = eltsUDFM pkg_map+  where+    PackageConfigMap pkg_map _ = pkgIdMap (pkgState dflags)++-- ----------------------------------------------------------------------------+-- Loading the package db files and building up the package state++-- | Call this after 'DynFlags.parseDynFlags'.  It reads the package+-- database files, and sets up various internal tables of package+-- information, according to the package-related flags on the+-- command-line (@-package@, @-hide-package@ etc.)+--+-- Returns a list of packages to link in if we're doing dynamic linking.+-- This list contains the packages that the user explicitly mentioned with+-- @-package@ flags.+--+-- 'initPackages' can be called again subsequently after updating the+-- 'packageFlags' field of the 'DynFlags', and it will update the+-- 'pkgState' in 'DynFlags' and return a list of packages to+-- link in.+initPackages :: DynFlags -> IO (DynFlags, [PreloadUnitId])+initPackages dflags0 = do+  dflags <- interpretPackageEnv dflags0+  pkg_db <-+    case pkgDatabase dflags of+        Nothing -> readPackageConfigs dflags+        Just db -> return $ map (\(p, pkgs)+                                    -> (p, setBatchPackageFlags dflags pkgs)) db+  (pkg_state, preload, insts)+        <- mkPackageState dflags pkg_db []+  return (dflags{ pkgDatabase = Just pkg_db,+                  pkgState = pkg_state,+                  thisUnitIdInsts_ = insts },+          preload)++-- -----------------------------------------------------------------------------+-- Reading the package database(s)++readPackageConfigs :: DynFlags -> IO [(FilePath, [PackageConfig])]+readPackageConfigs dflags = do+  conf_refs <- getPackageConfRefs dflags+  confs     <- liftM catMaybes $ mapM (resolvePackageConfig dflags) conf_refs+  mapM (readPackageConfig dflags) confs+++getPackageConfRefs :: DynFlags -> IO [PkgConfRef]+getPackageConfRefs dflags = do+  let system_conf_refs = [UserPkgConf, GlobalPkgConf]++  e_pkg_path <- tryIO (getEnv $ map toUpper (programName dflags) ++ "_PACKAGE_PATH")+  let base_conf_refs = case e_pkg_path of+        Left _ -> system_conf_refs+        Right path+         | not (null path) && isSearchPathSeparator (last path)+         -> map PkgConfFile (splitSearchPath (init path)) ++ system_conf_refs+         | otherwise+         -> map PkgConfFile (splitSearchPath path)++  -- Apply the package DB-related flags from the command line to get the+  -- final list of package DBs.+  --+  -- Notes on ordering:+  --  * The list of flags is reversed (later ones first)+  --  * We work with the package DB list in "left shadows right" order+  --  * and finally reverse it at the end, to get "right shadows left"+  --+  return $ reverse (foldr doFlag base_conf_refs (packageDBFlags dflags))+ where+  doFlag (PackageDB p) dbs = p : dbs+  doFlag NoUserPackageDB dbs = filter isNotUser dbs+  doFlag NoGlobalPackageDB dbs = filter isNotGlobal dbs+  doFlag ClearPackageDBs _ = []++  isNotUser UserPkgConf = False+  isNotUser _ = True++  isNotGlobal GlobalPkgConf = False+  isNotGlobal _ = True++resolvePackageConfig :: DynFlags -> PkgConfRef -> IO (Maybe FilePath)+resolvePackageConfig dflags GlobalPkgConf = return $ Just (systemPackageConfig dflags)+-- NB: This logic is reimplemented in Cabal, so if you change it,+-- make sure you update Cabal.  (Or, better yet, dump it in the+-- compiler info so Cabal can use the info.)+resolvePackageConfig dflags UserPkgConf = runMaybeT $ do+  dir <- versionedAppDir dflags+  let pkgconf = dir </> "package.conf.d"+  exist <- tryMaybeT $ doesDirectoryExist pkgconf+  if exist then return pkgconf else mzero+resolvePackageConfig _ (PkgConfFile name) = return $ Just name++readPackageConfig :: DynFlags -> FilePath -> IO (FilePath, [PackageConfig])+readPackageConfig dflags conf_file = do+  isdir <- doesDirectoryExist conf_file++  proto_pkg_configs <-+    if isdir+       then readDirStylePackageConfig conf_file+       else do+            isfile <- doesFileExist conf_file+            if isfile+               then do+                 mpkgs <- tryReadOldFileStylePackageConfig+                 case mpkgs of+                   Just pkgs -> return pkgs+                   Nothing   -> throwGhcExceptionIO $ InstallationError $+                      "ghc no longer supports single-file style package " +++                      "databases (" ++ conf_file +++                      ") use 'ghc-pkg init' to create the database with " +++                      "the correct format."+               else throwGhcExceptionIO $ InstallationError $+                      "can't find a package database at " ++ conf_file++  let+      top_dir = topDir dflags+      pkgroot = takeDirectory conf_file+      pkg_configs1 = map (mungePackageConfig top_dir pkgroot)+                         proto_pkg_configs+      pkg_configs2 = setBatchPackageFlags dflags pkg_configs1+  --+  return (conf_file, pkg_configs2)+  where+    readDirStylePackageConfig conf_dir = do+      let filename = conf_dir </> "package.cache"+      cache_exists <- doesFileExist filename+      if cache_exists+        then do+          debugTraceMsg dflags 2 $ text "Using binary package database:"+                                    <+> text filename+          readPackageDbForGhc filename+        else do+          -- If there is no package.cache file, we check if the database is not+          -- empty by inspecting if the directory contains any .conf file. If it+          -- does, something is wrong and we fail. Otherwise we assume that the+          -- database is empty.+          debugTraceMsg dflags 2 $ text "There is no package.cache in"+                               <+> text conf_dir+                                <> text ", checking if the database is empty"+          db_empty <- all (not . isSuffixOf ".conf")+                   <$> getDirectoryContents conf_dir+          if db_empty+            then do+              debugTraceMsg dflags 3 $ text "There are no .conf files in"+                                   <+> text conf_dir <> text ", treating"+                                   <+> text "package database as empty"+              return []+            else do+              throwGhcExceptionIO $ InstallationError $+                "there is no package.cache in " ++ conf_dir +++                " even though package database is not empty"+++    -- Single-file style package dbs have been deprecated for some time, but+    -- it turns out that Cabal was using them in one place. So this is a+    -- workaround to allow older Cabal versions to use this newer ghc.+    -- We check if the file db contains just "[]" and if so, we look for a new+    -- dir-style db in conf_file.d/, ie in a dir next to the given file.+    -- We cannot just replace the file with a new dir style since Cabal still+    -- assumes it's a file and tries to overwrite with 'writeFile'.+    -- ghc-pkg also cooperates with this workaround.+    tryReadOldFileStylePackageConfig = do+      content <- readFile conf_file `catchIO` \_ -> return ""+      if take 2 content == "[]"+        then do+          let conf_dir = conf_file <.> "d"+          direxists <- doesDirectoryExist conf_dir+          if direxists+             then do debugTraceMsg dflags 2 (text "Ignoring old file-style db and trying:" <+> text conf_dir)+                     liftM Just (readDirStylePackageConfig conf_dir)+             else return (Just []) -- ghc-pkg will create it when it's updated+        else return Nothing++setBatchPackageFlags :: DynFlags -> [PackageConfig] -> [PackageConfig]+setBatchPackageFlags dflags pkgs = maybeDistrustAll pkgs+  where+    maybeDistrustAll pkgs'+      | gopt Opt_DistrustAllPackages dflags = map distrust pkgs'+      | otherwise                           = pkgs'++    distrust pkg = pkg{ trusted = False }++mungePackageConfig :: FilePath -> FilePath+                   -> PackageConfig -> PackageConfig+mungePackageConfig top_dir pkgroot =+    mungeDynLibFields+  . mungePackagePaths top_dir pkgroot++mungeDynLibFields :: PackageConfig -> PackageConfig+mungeDynLibFields pkg =+    pkg {+      libraryDynDirs     = libraryDynDirs pkg+                `orIfNull` libraryDirs pkg+    }+  where+    orIfNull [] flags = flags+    orIfNull flags _  = flags++-- TODO: This code is duplicated in utils/ghc-pkg/Main.hs+mungePackagePaths :: FilePath -> FilePath -> PackageConfig -> PackageConfig+-- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec+-- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)+-- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.+-- The "pkgroot" is the directory containing the package database.+--+-- Also perform a similar substitution for the older GHC-specific+-- "$topdir" variable. The "topdir" is the location of the ghc+-- installation (obtained from the -B option).+mungePackagePaths top_dir pkgroot pkg =+    pkg {+      importDirs  = munge_paths (importDirs pkg),+      includeDirs = munge_paths (includeDirs pkg),+      libraryDirs = munge_paths (libraryDirs pkg),+      libraryDynDirs = munge_paths (libraryDynDirs pkg),+      frameworkDirs = munge_paths (frameworkDirs pkg),+      haddockInterfaces = munge_paths (haddockInterfaces pkg),+      haddockHTMLs = munge_urls (haddockHTMLs pkg)+    }+  where+    munge_paths = map munge_path+    munge_urls  = map munge_url++    munge_path p+      | Just p' <- stripVarPrefix "${pkgroot}" p = pkgroot ++ p'+      | Just p' <- stripVarPrefix "$topdir"    p = top_dir ++ p'+      | otherwise                                = p++    munge_url p+      | Just p' <- stripVarPrefix "${pkgrooturl}" p = toUrlPath pkgroot p'+      | Just p' <- stripVarPrefix "$httptopdir"   p = toUrlPath top_dir p'+      | otherwise                                   = p++    toUrlPath r p = "file:///"+                 -- URLs always use posix style '/' separators:+                 ++ FilePath.Posix.joinPath+                        (r : -- We need to drop a leading "/" or "\\"+                             -- if there is one:+                             dropWhile (all isPathSeparator)+                                       (FilePath.splitDirectories p))++    -- We could drop the separator here, and then use </> above. However,+    -- by leaving it in and using ++ we keep the same path separator+    -- rather than letting FilePath change it to use \ as the separator+    stripVarPrefix var path = case stripPrefix var path of+                              Just [] -> Just []+                              Just cs@(c : _) | isPathSeparator c -> Just cs+                              _ -> Nothing+++-- -----------------------------------------------------------------------------+-- Modify our copy of the package database based on trust flags,+-- -trust and -distrust.++applyTrustFlag+   :: DynFlags+   -> PackagePrecedenceIndex+   -> UnusablePackages+   -> [PackageConfig]+   -> TrustFlag+   -> IO [PackageConfig]+applyTrustFlag dflags prec_map unusable pkgs flag =+  case flag of+    -- we trust all matching packages. Maybe should only trust first one?+    -- and leave others the same or set them untrusted+    TrustPackage str ->+       case selectPackages prec_map (PackageArg str) pkgs unusable of+         Left ps       -> trustFlagErr dflags flag ps+         Right (ps,qs) -> return (map trust ps ++ qs)+          where trust p = p {trusted=True}++    DistrustPackage str ->+       case selectPackages prec_map (PackageArg str) pkgs unusable of+         Left ps       -> trustFlagErr dflags flag ps+         Right (ps,qs) -> return (map distrust ps ++ qs)+          where distrust p = p {trusted=False}++-- | A little utility to tell if the 'thisPackage' is indefinite+-- (if it is not, we should never use on-the-fly renaming.)+isIndefinite :: DynFlags -> Bool+isIndefinite dflags = not (unitIdIsDefinite (thisPackage dflags))++applyPackageFlag+   :: DynFlags+   -> PackagePrecedenceIndex+   -> PackageConfigMap+   -> UnusablePackages+   -> Bool -- if False, if you expose a package, it implicitly hides+           -- any previously exposed packages with the same name+   -> [PackageConfig]+   -> VisibilityMap           -- Initially exposed+   -> PackageFlag               -- flag to apply+   -> IO VisibilityMap        -- Now exposed++applyPackageFlag dflags prec_map pkg_db unusable no_hide_others pkgs vm flag =+  case flag of+    ExposePackage _ arg (ModRenaming b rns) ->+       case findPackages prec_map pkg_db arg pkgs unusable of+         Left ps         -> packageFlagErr dflags flag ps+         Right (p:_) -> return vm'+          where+           n = fsPackageName p++           -- If a user says @-unit-id p[A=<A>]@, this imposes+           -- a requirement on us: whatever our signature A is,+           -- it must fulfill all of p[A=<A>]:A's requirements.+           -- This method is responsible for computing what our+           -- inherited requirements are.+           reqs | UnitIdArg orig_uid <- arg = collectHoles orig_uid+                | otherwise                 = Map.empty++           collectHoles uid = case splitUnitIdInsts uid of+                (_, Just indef) ->+                  let local = [ Map.singleton+                                  (moduleName mod)+                                  (Set.singleton $ IndefModule indef mod_name)+                              | (mod_name, mod) <- indefUnitIdInsts indef+                              , isHoleModule mod ]+                      recurse = [ collectHoles (moduleUnitId mod)+                                | (_, mod) <- indefUnitIdInsts indef ]+                  in Map.unionsWith Set.union $ local ++ recurse+                -- Other types of unit identities don't have holes+                (_, Nothing) -> Map.empty+++           uv = UnitVisibility+                { uv_expose_all = b+                , uv_renamings = rns+                , uv_package_name = First (Just n)+                , uv_requirements = reqs+                , uv_explicit = True+                }+           vm' = Map.insertWith mappend (packageConfigId p) uv vm_cleared+           -- In the old days, if you said `ghc -package p-0.1 -package p-0.2`+           -- (or if p-0.1 was registered in the pkgdb as exposed: True),+           -- the second package flag would override the first one and you+           -- would only see p-0.2 in exposed modules.  This is good for+           -- usability.+           --+           -- However, with thinning and renaming (or Backpack), there might be+           -- situations where you legitimately want to see two versions of a+           -- package at the same time, and this behavior would make it+           -- impossible to do so.  So we decided that if you pass+           -- -hide-all-packages, this should turn OFF the overriding behavior+           -- where an exposed package hides all other packages with the same+           -- name.  This should not affect Cabal at all, which only ever+           -- exposes one package at a time.+           --+           -- NB: Why a variable no_hide_others?  We have to apply this logic to+           -- -plugin-package too, and it's more consistent if the switch in+           -- behavior is based off of+           -- -hide-all-packages/-hide-all-plugin-packages depending on what+           -- flag is in question.+           vm_cleared | no_hide_others = vm+                      -- NB: renamings never clear+                      | (_:_) <- rns = vm+                      | otherwise = Map.filterWithKey+                            (\k uv -> k == packageConfigId p+                                   || First (Just n) /= uv_package_name uv) vm+         _ -> panic "applyPackageFlag"++    HidePackage str ->+       case findPackages prec_map pkg_db (PackageArg str) pkgs unusable of+         Left ps  -> packageFlagErr dflags flag ps+         Right ps -> return vm'+          where vm' = foldl' (flip Map.delete) vm (map packageConfigId ps)++-- | Like 'selectPackages', but doesn't return a list of unmatched+-- packages.  Furthermore, any packages it returns are *renamed*+-- if the 'UnitArg' has a renaming associated with it.+findPackages :: PackagePrecedenceIndex+             -> PackageConfigMap -> PackageArg -> [PackageConfig]+             -> UnusablePackages+             -> Either [(PackageConfig, UnusablePackageReason)]+                [PackageConfig]+findPackages prec_map pkg_db arg pkgs unusable+  = let ps = mapMaybe (finder arg) pkgs+    in if null ps+        then Left (mapMaybe (\(x,y) -> finder arg x >>= \x' -> return (x',y))+                            (Map.elems unusable))+        else Right (sortByPreference prec_map ps)+  where+    finder (PackageArg str) p+      = if str == sourcePackageIdString p || str == packageNameString p+          then Just p+          else Nothing+    finder (UnitIdArg uid) p+      = let (iuid, mb_indef) = splitUnitIdInsts uid+        in if iuid == installedPackageConfigId p+              then Just (case mb_indef of+                            Nothing    -> p+                            Just indef -> renamePackage pkg_db (indefUnitIdInsts indef) p)+              else Nothing++selectPackages :: PackagePrecedenceIndex -> PackageArg -> [PackageConfig]+               -> UnusablePackages+               -> Either [(PackageConfig, UnusablePackageReason)]+                  ([PackageConfig], [PackageConfig])+selectPackages prec_map arg pkgs unusable+  = let matches = matching arg+        (ps,rest) = partition matches pkgs+    in if null ps+        then Left (filter (matches.fst) (Map.elems unusable))+        else Right (sortByPreference prec_map ps, rest)++-- | Rename a 'PackageConfig' according to some module instantiation.+renamePackage :: PackageConfigMap -> [(ModuleName, Module)]+              -> PackageConfig -> PackageConfig+renamePackage pkg_map insts conf =+    let hsubst = listToUFM insts+        smod  = renameHoleModule' pkg_map hsubst+        new_insts = map (\(k,v) -> (k,smod v)) (instantiatedWith conf)+    in conf {+        instantiatedWith = new_insts,+        exposedModules = map (\(mod_name, mb_mod) -> (mod_name, fmap smod mb_mod))+                             (exposedModules conf)+    }+++-- A package named on the command line can either include the+-- version, or just the name if it is unambiguous.+matchingStr :: String -> PackageConfig -> Bool+matchingStr str p+        =  str == sourcePackageIdString p+        || str == packageNameString p++matchingId :: InstalledUnitId -> PackageConfig -> Bool+matchingId uid p = uid == installedPackageConfigId p++matching :: PackageArg -> PackageConfig -> Bool+matching (PackageArg str) = matchingStr str+matching (UnitIdArg (DefiniteUnitId (DefUnitId uid)))  = matchingId uid+matching (UnitIdArg _)  = \_ -> False -- TODO: warn in this case++-- | This sorts a list of packages, putting "preferred" packages first.+-- See 'compareByPreference' for the semantics of "preference".+sortByPreference :: PackagePrecedenceIndex -> [PackageConfig] -> [PackageConfig]+sortByPreference prec_map = sortBy (flip (compareByPreference prec_map))++-- | Returns 'GT' if @pkg@ should be preferred over @pkg'@ when picking+-- which should be "active".  Here is the order of preference:+--+--      1. First, prefer the latest version+--      2. If the versions are the same, prefer the package that+--      came in the latest package database.+--+-- Pursuant to #12518, we could change this policy to, for example, remove+-- the version preference, meaning that we would always prefer the packages+-- in later package database.+--+-- Instead, we use that preference based policy only when one of the packages+-- is integer-gmp and the other is integer-simple.+-- This currently only happens when we're looking up which concrete+-- package to use in place of @integer-wired-in@ and that two different+-- package databases supply a different integer library. For more about+-- the fake @integer-wired-in@ package, see Note [The integer library]+-- in the @PrelNames@ module.+compareByPreference+    :: PackagePrecedenceIndex+    -> PackageConfig+    -> PackageConfig+    -> Ordering+compareByPreference prec_map pkg pkg'+  | Just prec  <- Map.lookup (unitId pkg)  prec_map+  , Just prec' <- Map.lookup (unitId pkg') prec_map+  , differentIntegerPkgs pkg pkg'+  = compare prec prec'++  | otherwise+  = case comparing packageVersion pkg pkg' of+        GT -> GT+        EQ | Just prec  <- Map.lookup (unitId pkg)  prec_map+           , Just prec' <- Map.lookup (unitId pkg') prec_map+           -- Prefer the package from the later DB flag (i.e., higher+           -- precedence)+           -> compare prec prec'+           | otherwise+           -> EQ+        LT -> LT++  where isIntegerPkg p = packageNameString p `elem`+          ["integer-simple", "integer-gmp"]+        differentIntegerPkgs p p' =+          isIntegerPkg p && isIntegerPkg p' &&+          (packageName p /= packageName p')++comparing :: Ord a => (t -> a) -> t -> t -> Ordering+comparing f a b = f a `compare` f b++packageFlagErr :: DynFlags+               -> PackageFlag+               -> [(PackageConfig, UnusablePackageReason)]+               -> IO a+packageFlagErr dflags flag reasons+  = packageFlagErr' dflags (pprFlag flag) reasons++trustFlagErr :: DynFlags+             -> TrustFlag+             -> [(PackageConfig, UnusablePackageReason)]+             -> IO a+trustFlagErr dflags flag reasons+  = packageFlagErr' dflags (pprTrustFlag flag) reasons++packageFlagErr' :: DynFlags+               -> SDoc+               -> [(PackageConfig, UnusablePackageReason)]+               -> IO a+packageFlagErr' dflags flag_doc reasons+  = throwGhcExceptionIO (CmdLineError (showSDoc dflags $ err))+  where err = text "cannot satisfy " <> flag_doc <>+                (if null reasons then Outputable.empty else text ": ") $$+              nest 4 (ppr_reasons $$+                      text "(use -v for more information)")+        ppr_reasons = vcat (map ppr_reason reasons)+        ppr_reason (p, reason) =+            pprReason (ppr (unitId p) <+> text "is") reason++pprFlag :: PackageFlag -> SDoc+pprFlag flag = case flag of+    HidePackage p   -> text "-hide-package " <> text p+    ExposePackage doc _ _ -> text doc++pprTrustFlag :: TrustFlag -> SDoc+pprTrustFlag flag = case flag of+    TrustPackage p    -> text "-trust " <> text p+    DistrustPackage p -> text "-distrust " <> text p++-- -----------------------------------------------------------------------------+-- Wired-in packages+--+-- See Note [Wired-in packages] in Module++type WiredInUnitId = String+type WiredPackagesMap = Map WiredUnitId WiredUnitId++wired_in_pkgids :: [WiredInUnitId]+wired_in_pkgids = map unitIdString wiredInUnitIds++findWiredInPackages+   :: DynFlags+   -> PackagePrecedenceIndex+   -> [PackageConfig]           -- database+   -> VisibilityMap             -- info on what packages are visible+                                -- for wired in selection+   -> IO ([PackageConfig],  -- package database updated for wired in+          WiredPackagesMap) -- map from unit id to wired identity++findWiredInPackages dflags prec_map pkgs vis_map = do+  -- Now we must find our wired-in packages, and rename them to+  -- their canonical names (eg. base-1.0 ==> base), as described+  -- in Note [Wired-in packages] in Module+  let+        matches :: PackageConfig -> WiredInUnitId -> Bool+        pc `matches` pid+            -- See Note [The integer library] in PrelNames+            | pid == unitIdString integerUnitId+            = packageNameString pc `elem` ["integer-gmp", "integer-simple"]+        pc `matches` pid = packageNameString pc == pid++        -- find which package corresponds to each wired-in package+        -- delete any other packages with the same name+        -- update the package and any dependencies to point to the new+        -- one.+        --+        -- When choosing which package to map to a wired-in package+        -- name, we try to pick the latest version of exposed packages.+        -- However, if there are no exposed wired in packages available+        -- (e.g. -hide-all-packages was used), we can't bail: we *have*+        -- to assign a package for the wired-in package: so we try again+        -- with hidden packages included to (and pick the latest+        -- version).+        --+        -- You can also override the default choice by using -ignore-package:+        -- this works even when there is no exposed wired in package+        -- available.+        --+        findWiredInPackage :: [PackageConfig] -> WiredInUnitId+                           -> IO (Maybe (WiredInUnitId, PackageConfig))+        findWiredInPackage pkgs wired_pkg =+           let all_ps = [ p | p <- pkgs, p `matches` wired_pkg ]+               all_exposed_ps =+                    [ p | p <- all_ps+                        , Map.member (packageConfigId p) vis_map ] in+           case all_exposed_ps of+            [] -> case all_ps of+                       []   -> notfound+                       many -> pick (head (sortByPreference prec_map many))+            many -> pick (head (sortByPreference prec_map many))+          where+                notfound = do+                          debugTraceMsg dflags 2 $+                            text "wired-in package "+                                 <> text wired_pkg+                                 <> text " not found."+                          return Nothing+                pick :: PackageConfig+                     -> IO (Maybe (WiredInUnitId, PackageConfig))+                pick pkg = do+                        debugTraceMsg dflags 2 $+                            text "wired-in package "+                                 <> text wired_pkg+                                 <> text " mapped to "+                                 <> ppr (unitId pkg)+                        return (Just (wired_pkg, pkg))+++  mb_wired_in_pkgs <- mapM (findWiredInPackage pkgs) wired_in_pkgids+  let+        wired_in_pkgs = catMaybes mb_wired_in_pkgs++        -- this is old: we used to assume that if there were+        -- multiple versions of wired-in packages installed that+        -- they were mutually exclusive.  Now we're assuming that+        -- you have one "main" version of each wired-in package+        -- (the latest version), and the others are backward-compat+        -- wrappers that depend on this one.  e.g. base-4.0 is the+        -- latest, base-3.0 is a compat wrapper depending on base-4.0.+        {-+        deleteOtherWiredInPackages pkgs = filterOut bad pkgs+          where bad p = any (p `matches`) wired_in_pkgids+                      && package p `notElem` map fst wired_in_ids+        -}++        wiredInMap :: Map WiredUnitId WiredUnitId+        wiredInMap = Map.fromList+          [ (key, DefUnitId (stringToInstalledUnitId wiredInUnitId))+          | (wiredInUnitId, pkg) <- wired_in_pkgs+          , Just key <- pure $ definitePackageConfigId pkg+          ]++        updateWiredInDependencies pkgs = map (upd_deps . upd_pkg) pkgs+          where upd_pkg pkg+                  | Just def_uid <- definitePackageConfigId pkg+                  , Just wiredInUnitId <- Map.lookup def_uid wiredInMap+                  = let fs = installedUnitIdFS (unDefUnitId wiredInUnitId)+                    in pkg {+                      unitId = fsToInstalledUnitId fs,+                      componentId = ComponentId fs+                    }+                  | otherwise+                  = pkg+                upd_deps pkg = pkg {+                      -- temporary harmless DefUnitId invariant violation+                      depends = map (unDefUnitId . upd_wired_in wiredInMap . DefUnitId) (depends pkg),+                      exposedModules+                        = map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v))+                              (exposedModules pkg)+                    }+++  return (updateWiredInDependencies pkgs, wiredInMap)++-- Helper functions for rewiring Module and UnitId.  These+-- rewrite UnitIds of modules in wired-in packages to the form known to the+-- compiler, as described in Note [Wired-in packages] in Module.+--+-- For instance, base-4.9.0.0 will be rewritten to just base, to match+-- what appears in PrelNames.++upd_wired_in_mod :: WiredPackagesMap -> Module -> Module+upd_wired_in_mod wiredInMap (Module uid m) = Module (upd_wired_in_uid wiredInMap uid) m++upd_wired_in_uid :: WiredPackagesMap -> UnitId -> UnitId+upd_wired_in_uid wiredInMap (DefiniteUnitId def_uid) =+    DefiniteUnitId (upd_wired_in wiredInMap def_uid)+upd_wired_in_uid wiredInMap (IndefiniteUnitId indef_uid) =+    IndefiniteUnitId $ newIndefUnitId+        (indefUnitIdComponentId indef_uid)+        (map (\(x,y) -> (x,upd_wired_in_mod wiredInMap y)) (indefUnitIdInsts indef_uid))++upd_wired_in :: WiredPackagesMap -> DefUnitId -> DefUnitId+upd_wired_in wiredInMap key+    | Just key' <- Map.lookup key wiredInMap = key'+    | otherwise = key++updateVisibilityMap :: WiredPackagesMap -> VisibilityMap -> VisibilityMap+updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap)+  where f vm (from, to) = case Map.lookup (DefiniteUnitId from) vis_map of+                    Nothing -> vm+                    Just r -> Map.insert (DefiniteUnitId to) r+                                (Map.delete (DefiniteUnitId from) vm)+++-- ----------------------------------------------------------------------------++-- | The reason why a package is unusable.+data UnusablePackageReason+  = -- | We ignored it explicitly using @-ignore-package@.+    IgnoredWithFlag+    -- | This package transitively depends on a package that was never present+    -- in any of the provided databases.+  | BrokenDependencies   [InstalledUnitId]+    -- | This package transitively depends on a package involved in a cycle.+    -- Note that the list of 'InstalledUnitId' reports the direct dependencies+    -- of this package that (transitively) depended on the cycle, and not+    -- the actual cycle itself (which we report separately at high verbosity.)+  | CyclicDependencies   [InstalledUnitId]+    -- | This package transitively depends on a package which was ignored.+  | IgnoredDependencies  [InstalledUnitId]+    -- | This package transitively depends on a package which was+    -- shadowed by an ABI-incompatible package.+  | ShadowedDependencies [InstalledUnitId]++instance Outputable UnusablePackageReason where+    ppr IgnoredWithFlag = text "[ignored with flag]"+    ppr (BrokenDependencies uids)   = brackets (text "broken" <+> ppr uids)+    ppr (CyclicDependencies uids)   = brackets (text "cyclic" <+> ppr uids)+    ppr (IgnoredDependencies uids)  = brackets (text "ignored" <+> ppr uids)+    ppr (ShadowedDependencies uids) = brackets (text "shadowed" <+> ppr uids)++type UnusablePackages = Map InstalledUnitId+                            (PackageConfig, UnusablePackageReason)++pprReason :: SDoc -> UnusablePackageReason -> SDoc+pprReason pref reason = case reason of+  IgnoredWithFlag ->+      pref <+> text "ignored due to an -ignore-package flag"+  BrokenDependencies deps ->+      pref <+> text "unusable due to missing dependencies:" $$+        nest 2 (hsep (map ppr deps))+  CyclicDependencies deps ->+      pref <+> text "unusable due to cyclic dependencies:" $$+        nest 2 (hsep (map ppr deps))+  IgnoredDependencies deps ->+      pref <+> text ("unusable because the -ignore-package flag was used to " +++                     "ignore at least one of its dependencies:") $$+        nest 2 (hsep (map ppr deps))+  ShadowedDependencies deps ->+      pref <+> text "unusable due to shadowed dependencies:" $$+        nest 2 (hsep (map ppr deps))++reportCycles :: DynFlags -> [SCC PackageConfig] -> IO ()+reportCycles dflags sccs = mapM_ report sccs+  where+    report (AcyclicSCC _) = return ()+    report (CyclicSCC vs) =+        debugTraceMsg dflags 2 $+          text "these packages are involved in a cycle:" $$+            nest 2 (hsep (map (ppr . unitId) vs))++reportUnusable :: DynFlags -> UnusablePackages -> IO ()+reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)+  where+    report (ipid, (_, reason)) =+       debugTraceMsg dflags 2 $+         pprReason+           (text "package" <+> ppr ipid <+> text "is") reason++-- ----------------------------------------------------------------------------+--+-- Utilities on the database+--++-- | A reverse dependency index, mapping an 'InstalledUnitId' to+-- the 'InstalledUnitId's which have a dependency on it.+type RevIndex = Map InstalledUnitId [InstalledUnitId]++-- | Compute the reverse dependency index of a package database.+reverseDeps :: InstalledPackageIndex -> RevIndex+reverseDeps db = Map.foldl' go Map.empty db+  where+    go r pkg = foldl' (go' (unitId pkg)) r (depends pkg)+    go' from r to = Map.insertWith (++) to [from] r++-- | Given a list of 'InstalledUnitId's to remove, a database,+-- and a reverse dependency index (as computed by 'reverseDeps'),+-- remove those packages, plus any packages which depend on them.+-- Returns the pruned database, as well as a list of 'PackageConfig's+-- that was removed.+removePackages :: [InstalledUnitId] -> RevIndex+               -> InstalledPackageIndex+               -> (InstalledPackageIndex, [PackageConfig])+removePackages uids index m = go uids (m,[])+  where+    go [] (m,pkgs) = (m,pkgs)+    go (uid:uids) (m,pkgs)+        | Just pkg <- Map.lookup uid m+        = case Map.lookup uid index of+            Nothing    -> go uids (Map.delete uid m, pkg:pkgs)+            Just rdeps -> go (rdeps ++ uids) (Map.delete uid m, pkg:pkgs)+        | otherwise+        = go uids (m,pkgs)++-- | Given a 'PackageConfig' from some 'InstalledPackageIndex',+-- return all entries in 'depends' which correspond to packages+-- that do not exist in the index.+depsNotAvailable :: InstalledPackageIndex+                 -> PackageConfig+                 -> [InstalledUnitId]+depsNotAvailable pkg_map pkg = filter (not . (`Map.member` pkg_map)) (depends pkg)++-- | Given a 'PackageConfig' from some 'InstalledPackageIndex'+-- return all entries in 'abiDepends' which correspond to packages+-- that do not exist, OR have mismatching ABIs.+depsAbiMismatch :: InstalledPackageIndex+                -> PackageConfig+                -> [InstalledUnitId]+depsAbiMismatch pkg_map pkg = map fst . filter (not . abiMatch) $ abiDepends pkg+  where+    abiMatch (dep_uid, abi)+        | Just dep_pkg <- Map.lookup dep_uid pkg_map+        = abiHash dep_pkg == abi+        | otherwise+        = False++-- -----------------------------------------------------------------------------+-- Ignore packages++ignorePackages :: [IgnorePackageFlag] -> [PackageConfig] -> UnusablePackages+ignorePackages flags pkgs = Map.fromList (concatMap doit flags)+  where+  doit (IgnorePackage str) =+     case partition (matchingStr str) pkgs of+         (ps, _) -> [ (unitId p, (p, IgnoredWithFlag))+                    | p <- ps ]+        -- missing package is not an error for -ignore-package,+        -- because a common usage is to -ignore-package P as+        -- a preventative measure just in case P exists.++-- ----------------------------------------------------------------------------+--+-- Merging databases+--++-- | For each package, a mapping from uid -> i indicates that this+-- package was brought into GHC by the ith @-package-db@ flag on+-- the command line.  We use this mapping to make sure we prefer+-- packages that were defined later on the command line, if there+-- is an ambiguity.+type PackagePrecedenceIndex = Map InstalledUnitId Int++-- | Given a list of databases, merge them together, where+-- packages with the same unit id in later databases override+-- earlier ones.  This does NOT check if the resulting database+-- makes sense (that's done by 'validateDatabase').+mergeDatabases :: DynFlags -> [(FilePath, [PackageConfig])]+               -> IO (InstalledPackageIndex, PackagePrecedenceIndex)+mergeDatabases dflags = foldM merge (Map.empty, Map.empty) . zip [1..]+  where+    merge (pkg_map, prec_map) (i, (db_path, db)) = do+      debugTraceMsg dflags 2 $+          text "loading package database" <+> text db_path+      forM_ (Set.toList override_set) $ \pkg ->+          debugTraceMsg dflags 2 $+              text "package" <+> ppr pkg <+>+              text "overrides a previously defined package"+      return (pkg_map', prec_map')+     where+      db_map = mk_pkg_map db+      mk_pkg_map = Map.fromList . map (\p -> (unitId p, p))++      -- The set of UnitIds which appear in both db and pkgs.  These are the+      -- ones that get overridden.  Compute this just to give some+      -- helpful debug messages at -v2+      override_set :: Set InstalledUnitId+      override_set = Set.intersection (Map.keysSet db_map)+                                      (Map.keysSet pkg_map)++      -- Now merge the sets together (NB: in case of duplicate,+      -- first argument preferred)+      pkg_map' :: InstalledPackageIndex+      pkg_map' = Map.union db_map pkg_map++      prec_map' :: PackagePrecedenceIndex+      prec_map' = Map.union (Map.map (const i) db_map) prec_map++-- | Validates a database, removing unusable packages from it+-- (this includes removing packages that the user has explicitly+-- ignored.)  Our general strategy:+--+-- 1. Remove all broken packages (dangling dependencies)+-- 2. Remove all packages that are cyclic+-- 3. Apply ignore flags+-- 4. Remove all packages which have deps with mismatching ABIs+--+validateDatabase :: DynFlags -> InstalledPackageIndex+                 -> (InstalledPackageIndex, UnusablePackages, [SCC PackageConfig])+validateDatabase dflags pkg_map1 =+    (pkg_map5, unusable, sccs)+  where+    ignore_flags = reverse (ignorePackageFlags dflags)++    -- Compute the reverse dependency index+    index = reverseDeps pkg_map1++    -- Helper function+    mk_unusable mk_err dep_matcher m uids =+      Map.fromList [ (unitId pkg, (pkg, mk_err (dep_matcher m pkg)))+                   | pkg <- uids ]++    -- Find broken packages+    directly_broken = filter (not . null . depsNotAvailable pkg_map1)+                             (Map.elems pkg_map1)+    (pkg_map2, broken) = removePackages (map unitId directly_broken) index pkg_map1+    unusable_broken = mk_unusable BrokenDependencies depsNotAvailable pkg_map2 broken++    -- Find recursive packages+    sccs = stronglyConnComp [ (pkg, unitId pkg, depends pkg)+                            | pkg <- Map.elems pkg_map2 ]+    getCyclicSCC (CyclicSCC vs) = map unitId vs+    getCyclicSCC (AcyclicSCC _) = []+    (pkg_map3, cyclic) = removePackages (concatMap getCyclicSCC sccs) index pkg_map2+    unusable_cyclic = mk_unusable CyclicDependencies depsNotAvailable pkg_map3 cyclic++    -- Apply ignore flags+    directly_ignored = ignorePackages ignore_flags (Map.elems pkg_map3)+    (pkg_map4, ignored) = removePackages (Map.keys directly_ignored) index pkg_map3+    unusable_ignored = mk_unusable IgnoredDependencies depsNotAvailable pkg_map4 ignored++    -- Knock out packages whose dependencies don't agree with ABI+    -- (i.e., got invalidated due to shadowing)+    directly_shadowed = filter (not . null . depsAbiMismatch pkg_map4)+                               (Map.elems pkg_map4)+    (pkg_map5, shadowed) = removePackages (map unitId directly_shadowed) index pkg_map4+    unusable_shadowed = mk_unusable ShadowedDependencies depsAbiMismatch pkg_map5 shadowed++    unusable = directly_ignored `Map.union` unusable_ignored+                                `Map.union` unusable_broken+                                `Map.union` unusable_cyclic+                                `Map.union` unusable_shadowed++-- -----------------------------------------------------------------------------+-- When all the command-line options are in, we can process our package+-- settings and populate the package state.++mkPackageState+    :: DynFlags+    -- initial databases, in the order they were specified on+    -- the command line (later databases shadow earlier ones)+    -> [(FilePath, [PackageConfig])]+    -> [PreloadUnitId]              -- preloaded packages+    -> IO (PackageState,+           [PreloadUnitId],         -- new packages to preload+           Maybe [(ModuleName, Module)])++mkPackageState dflags dbs preload0 = do+{-+   Plan.++   There are two main steps for making the package state:++    1. We want to build a single, unified package database based+       on all of the input databases, which upholds the invariant that+       there is only one package per any UnitId and there are no+       dangling dependencies.  We'll do this by merging, and+       then successively filtering out bad dependencies.++       a) Merge all the databases together.+          If an input database defines unit ID that is already in+          the unified database, that package SHADOWS the existing+          package in the current unified database.  Note that+          order is important: packages defined later in the list of+          command line arguments shadow those defined earlier.++       b) Remove all packages with missing dependencies, or+          mutually recursive dependencies.++       b) Remove packages selected by -ignore-package from input database++       c) Remove all packages which depended on packages that are now+          shadowed by an ABI-incompatible package++       d) report (with -v) any packages that were removed by steps 1-3++    2. We want to look at the flags controlling package visibility,+       and build a mapping of what module names are in scope and+       where they live.++       a) on the final, unified database, we apply -trust/-distrust+          flags directly, modifying the database so that the 'trusted'+          field has the correct value.++       b) we use the -package/-hide-package flags to compute a+          visibility map, stating what packages are "exposed" for+          the purposes of computing the module map.+          * if any flag refers to a package which was removed by 1-5, then+            we can give an error message explaining why+          * if -hide-all-packages what not specified, this step also+            hides packages which are superseded by later exposed packages+          * this step is done TWICE if -plugin-package/-hide-all-plugin-packages+            are used++       c) based on the visibility map, we pick wired packages and rewrite+          them to have the expected unitId.++       d) finally, using the visibility map and the package database,+          we build a mapping saying what every in scope module name points to.+-}++  -- This, and the other reverse's that you will see, are due to the face that+  -- packageFlags, pluginPackageFlags, etc. are all specified in *reverse* order+  -- than they are on the command line.+  let other_flags = reverse (packageFlags dflags)+  debugTraceMsg dflags 2 $+      text "package flags" <+> ppr other_flags++  -- Merge databases together, without checking validity+  (pkg_map1, prec_map) <- mergeDatabases dflags dbs++  -- Now that we've merged everything together, prune out unusable+  -- packages.+  let (pkg_map2, unusable, sccs) = validateDatabase dflags pkg_map1++  reportCycles dflags sccs+  reportUnusable dflags unusable++  -- Apply trust flags (these flags apply regardless of whether+  -- or not packages are visible or not)+  pkgs1 <- foldM (applyTrustFlag dflags prec_map unusable)+                 (Map.elems pkg_map2) (reverse (trustFlags dflags))+  let prelim_pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs1++  --+  -- Calculate the initial set of units from package databases, prior to any package flags.+  --+  -- Conceptually, we select the latest versions of all valid (not unusable) *packages*+  -- (not units). This is empty if we have -hide-all-packages.+  --+  -- Then we create an initial visibility map with default visibilities for all+  -- exposed, definite units which belong to the latest valid packages.+  --+  let preferLater unit unit' =+        case compareByPreference prec_map unit unit' of+            GT -> unit+            _  -> unit'+      addIfMorePreferable m unit = addToUDFM_C preferLater m (fsPackageName unit) unit+      -- This is the set of maximally preferable packages. In fact, it is a set of+      -- most preferable *units* keyed by package name, which act as stand-ins in +      -- for "a package in a database". We use units here because we don't have +      -- "a package in a database" as a type currently.+      mostPreferablePackageReps = if gopt Opt_HideAllPackages dflags+                    then emptyUDFM+                    else foldl' addIfMorePreferable emptyUDFM pkgs1+      -- When exposing units, we want to consider all of those in the most preferable+      -- packages. We can implement that by looking for units that are equi-preferable+      -- with the most preferable unit for package. Being equi-preferable means that+      -- they must be in the same database, with the same version, and the same pacakge name.+      --+      -- We must take care to consider all these units and not just the most +      -- preferable one, otherwise we can end up with problems like #16228.+      mostPreferable u =+        case lookupUDFM mostPreferablePackageReps (fsPackageName u) of+          Nothing -> False+          Just u' -> compareByPreference prec_map u u' == EQ+      vis_map1 = foldl' (\vm p ->+                            -- Note: we NEVER expose indefinite packages by+                            -- default, because it's almost assuredly not+                            -- what you want (no mix-in linking has occurred).+                            if exposed p && unitIdIsDefinite (packageConfigId p) && mostPreferable p+                               then Map.insert (packageConfigId p)+                                               UnitVisibility {+                                                 uv_expose_all = True,+                                                 uv_renamings = [],+                                                 uv_package_name = First (Just (fsPackageName p)),+                                                 uv_requirements = Map.empty,+                                                 uv_explicit = False+                                               }+                                               vm+                               else vm)+                         Map.empty pkgs1++  --+  -- Compute a visibility map according to the command-line flags (-package,+  -- -hide-package).  This needs to know about the unusable packages, since if a+  -- user tries to enable an unusable package, we should let them know.+  --+  vis_map2 <- foldM (applyPackageFlag dflags prec_map prelim_pkg_db unusable+                        (gopt Opt_HideAllPackages dflags) pkgs1)+                            vis_map1 other_flags++  --+  -- Sort out which packages are wired in. This has to be done last, since+  -- it modifies the unit ids of wired in packages, but when we process+  -- package arguments we need to key against the old versions.+  --+  (pkgs2, wired_map) <- findWiredInPackages dflags prec_map pkgs1 vis_map2+  let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs2++  -- Update the visibility map, so we treat wired packages as visible.+  let vis_map = updateVisibilityMap wired_map vis_map2++  let hide_plugin_pkgs = gopt Opt_HideAllPluginPackages dflags+  plugin_vis_map <-+    case pluginPackageFlags dflags of+        -- common case; try to share the old vis_map+        [] | not hide_plugin_pkgs -> return vis_map+           | otherwise -> return Map.empty+        _ -> do let plugin_vis_map1+                        | hide_plugin_pkgs = Map.empty+                        -- Use the vis_map PRIOR to wired in,+                        -- because otherwise applyPackageFlag+                        -- won't work.+                        | otherwise = vis_map2+                plugin_vis_map2+                    <- foldM (applyPackageFlag dflags prec_map prelim_pkg_db unusable+                                (gopt Opt_HideAllPluginPackages dflags) pkgs1)+                             plugin_vis_map1+                             (reverse (pluginPackageFlags dflags))+                -- Updating based on wired in packages is mostly+                -- good hygiene, because it won't matter: no wired in+                -- package has a compiler plugin.+                -- TODO: If a wired in package had a compiler plugin,+                -- and you tried to pick different wired in packages+                -- with the plugin flags and the normal flags... what+                -- would happen?  I don't know!  But this doesn't seem+                -- likely to actually happen.+                return (updateVisibilityMap wired_map plugin_vis_map2)++  --+  -- Here we build up a set of the packages mentioned in -package+  -- flags on the command line; these are called the "preload"+  -- packages.  we link these packages in eagerly.  The preload set+  -- should contain at least rts & base, which is why we pretend that+  -- the command line contains -package rts & -package base.+  --+  -- NB: preload IS important even for type-checking, because we+  -- need the correct include path to be set.+  --+  let preload1 = Map.keys (Map.filter uv_explicit vis_map)++  let pkgname_map = foldl' add Map.empty pkgs2+        where add pn_map p+                = Map.insert (packageName p) (componentId p) pn_map++  -- The explicitPackages accurately reflects the set of packages we have turned+  -- on; as such, it also is the only way one can come up with requirements.+  -- The requirement context is directly based off of this: we simply+  -- look for nested unit IDs that are directly fed holes: the requirements+  -- of those units are precisely the ones we need to track+  let explicit_pkgs = Map.keys vis_map+      req_ctx = Map.map (Set.toList)+              $ Map.unionsWith Set.union (map uv_requirements (Map.elems vis_map))+++  let preload2 = preload1++  let+      -- add base & rts to the preload packages+      basicLinkedPackages+       | gopt Opt_AutoLinkPackages dflags+          = filter (flip elemUDFM (unPackageConfigMap pkg_db))+                [baseUnitId, rtsUnitId]+       | otherwise = []+      -- but in any case remove the current package from the set of+      -- preloaded packages so that base/rts does not end up in the+      -- set up preloaded package when we are just building it+      -- (NB: since this is only relevant for base/rts it doesn't matter+      -- that thisUnitIdInsts_ is not wired yet)+      --+      preload3 = nub $ filter (/= thisPackage dflags)+                     $ (basicLinkedPackages ++ preload2)++  -- Close the preload packages with their dependencies+  dep_preload <- closeDeps dflags pkg_db (zip (map toInstalledUnitId preload3) (repeat Nothing))+  let new_dep_preload = filter (`notElem` preload0) dep_preload++  let mod_map1 = mkModuleToPkgConfAll dflags pkg_db vis_map+      mod_map2 = mkUnusableModuleToPkgConfAll unusable+      mod_map = Map.union mod_map1 mod_map2++  dumpIfSet_dyn (dflags { pprCols = 200 }) Opt_D_dump_mod_map "Mod Map"+    (pprModuleMap mod_map)++  -- Force pstate to avoid leaking the dflags0 passed to mkPackageState+  let !pstate = PackageState{+    preloadPackages     = dep_preload,+    explicitPackages    = explicit_pkgs,+    pkgIdMap            = pkg_db,+    moduleToPkgConfAll  = mod_map,+    pluginModuleToPkgConfAll = mkModuleToPkgConfAll dflags pkg_db plugin_vis_map,+    packageNameMap          = pkgname_map,+    unwireMap = Map.fromList [ (v,k) | (k,v) <- Map.toList wired_map ],+    requirementContext = req_ctx+    }+  let new_insts = fmap (map (fmap (upd_wired_in_mod wired_map))) (thisUnitIdInsts_ dflags)+  return (pstate, new_dep_preload, new_insts)++-- | Given a wired-in 'UnitId', "unwire" it into the 'UnitId'+-- that it was recorded as in the package database.+unwireUnitId :: DynFlags -> UnitId -> UnitId+unwireUnitId dflags uid@(DefiniteUnitId def_uid) =+    maybe uid DefiniteUnitId (Map.lookup def_uid (unwireMap (pkgState dflags)))+unwireUnitId _ uid = uid++-- -----------------------------------------------------------------------------+-- | Makes the mapping from module to package info++-- Slight irritation: we proceed by leafing through everything+-- in the installed package database, which makes handling indefinite+-- packages a bit bothersome.++mkModuleToPkgConfAll+  :: DynFlags+  -> PackageConfigMap+  -> VisibilityMap+  -> ModuleToPkgConfAll+mkModuleToPkgConfAll dflags pkg_db vis_map =+    -- What should we fold on?  Both situations are awkward:+    --+    --    * Folding on the visibility map means that we won't create+    --      entries for packages that aren't mentioned in vis_map+    --      (e.g., hidden packages, causing #14717)+    --+    --    * Folding on pkg_db is awkward because if we have an+    --      Backpack instantiation, we need to possibly add a+    --      package from pkg_db multiple times to the actual+    --      ModuleToPkgConfAll.  Also, we don't really want+    --      definite package instantiations to show up in the+    --      list of possibilities.+    --+    -- So what will we do instead?  We'll extend vis_map with+    -- entries for every definite (for non-Backpack) and+    -- indefinite (for Backpack) package, so that we get the+    -- hidden entries we need.+    Map.foldlWithKey extend_modmap emptyMap vis_map_extended+ where+  vis_map_extended = Map.union vis_map {- preferred -} default_vis++  default_vis = Map.fromList+                  [ (packageConfigId pkg, mempty)+                  | pkg <- eltsUDFM (unPackageConfigMap pkg_db)+                  -- Exclude specific instantiations of an indefinite+                  -- package+                  , indefinite pkg || null (instantiatedWith pkg)+                  ]++  emptyMap = Map.empty+  setOrigins m os = fmap (const os) m+  extend_modmap modmap uid+    UnitVisibility { uv_expose_all = b, uv_renamings = rns }+    = addListTo modmap theBindings+   where+    pkg = pkg_lookup uid++    theBindings :: [(ModuleName, Map Module ModuleOrigin)]+    theBindings = newBindings b rns++    newBindings :: Bool+                -> [(ModuleName, ModuleName)]+                -> [(ModuleName, Map Module ModuleOrigin)]+    newBindings e rns  = es e ++ hiddens ++ map rnBinding rns++    rnBinding :: (ModuleName, ModuleName)+              -> (ModuleName, Map Module ModuleOrigin)+    rnBinding (orig, new) = (new, setOrigins origEntry fromFlag)+     where origEntry = case lookupUFM esmap orig of+            Just r -> r+            Nothing -> throwGhcException (CmdLineError (showSDoc dflags+                        (text "package flag: could not find module name" <+>+                            ppr orig <+> text "in package" <+> ppr pk)))++    es :: Bool -> [(ModuleName, Map Module ModuleOrigin)]+    es e = do+     (m, exposedReexport) <- exposed_mods+     let (pk', m', origin') =+          case exposedReexport of+           Nothing -> (pk, m, fromExposedModules e)+           Just (Module pk' m') ->+            let pkg' = pkg_lookup pk'+            in (pk', m', fromReexportedModules e pkg')+     return (m, mkModMap pk' m' origin')++    esmap :: UniqFM (Map Module ModuleOrigin)+    esmap = listToUFM (es False) -- parameter here doesn't matter, orig will+                                 -- be overwritten++    hiddens = [(m, mkModMap pk m ModHidden) | m <- hidden_mods]++    pk = packageConfigId pkg+    pkg_lookup uid = lookupPackage' (isIndefinite dflags) pkg_db uid+                        `orElse` pprPanic "pkg_lookup" (ppr uid)++    exposed_mods = exposedModules pkg+    hidden_mods = hiddenModules pkg++-- | Make a 'ModuleToPkgConfAll' covering a set of unusable packages.+mkUnusableModuleToPkgConfAll :: UnusablePackages -> ModuleToPkgConfAll+mkUnusableModuleToPkgConfAll unusables =+    Map.foldl' extend_modmap Map.empty unusables+ where+    extend_modmap modmap (pkg, reason) = addListTo modmap bindings+      where bindings :: [(ModuleName, Map Module ModuleOrigin)]+            bindings = exposed ++ hidden++            origin = ModUnusable reason+            pkg_id = packageConfigId pkg++            exposed = map get_exposed exposed_mods+            hidden = [(m, mkModMap pkg_id m origin) | m <- hidden_mods]++            get_exposed (mod, Just mod') = (mod, Map.singleton mod' origin)+            get_exposed (mod, _)         = (mod, mkModMap pkg_id mod origin)++            exposed_mods = exposedModules pkg+            hidden_mods = hiddenModules pkg++-- | Add a list of key/value pairs to a nested map.+--+-- The outer map is processed with 'Data.Map.Strict' to prevent memory leaks+-- when reloading modules in GHCi (see #4029). This ensures that each+-- value is forced before installing into the map.+addListTo :: (Monoid a, Ord k1, Ord k2)+          => Map k1 (Map k2 a)+          -> [(k1, Map k2 a)]+          -> Map k1 (Map k2 a)+addListTo = foldl' merge+  where merge m (k, v) = MapStrict.insertWith (Map.unionWith mappend) k v m++-- | Create a singleton module mapping+mkModMap :: UnitId -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin+mkModMap pkg mod = Map.singleton (mkModule pkg mod)++-- -----------------------------------------------------------------------------+-- Extracting information from the packages in scope++-- Many of these functions take a list of packages: in those cases,+-- the list is expected to contain the "dependent packages",+-- i.e. those packages that were found to be depended on by the+-- current module/program.  These can be auto or non-auto packages, it+-- doesn't really matter.  The list is always combined with the list+-- of preload (command-line) packages to determine which packages to+-- use.++-- | Find all the include directories in these and the preload packages+getPackageIncludePath :: DynFlags -> [PreloadUnitId] -> IO [String]+getPackageIncludePath dflags pkgs =+  collectIncludeDirs `fmap` getPreloadPackagesAnd dflags pkgs++collectIncludeDirs :: [PackageConfig] -> [FilePath]+collectIncludeDirs ps = nub (filter notNull (concatMap includeDirs ps))++-- | Find all the library paths in these and the preload packages+getPackageLibraryPath :: DynFlags -> [PreloadUnitId] -> IO [String]+getPackageLibraryPath dflags pkgs =+  collectLibraryPaths dflags `fmap` getPreloadPackagesAnd dflags pkgs++collectLibraryPaths :: DynFlags -> [PackageConfig] -> [FilePath]+collectLibraryPaths dflags = nub . filter notNull+                           . concatMap (libraryDirsForWay dflags)++-- | Find all the link options in these and the preload packages,+-- returning (package hs lib options, extra library options, other flags)+getPackageLinkOpts :: DynFlags -> [PreloadUnitId] -> IO ([String], [String], [String])+getPackageLinkOpts dflags pkgs =+  collectLinkOpts dflags `fmap` getPreloadPackagesAnd dflags pkgs++collectLinkOpts :: DynFlags -> [PackageConfig] -> ([String], [String], [String])+collectLinkOpts dflags ps =+    (+        concatMap (map ("-l" ++) . packageHsLibs dflags) ps,+        concatMap (map ("-l" ++) . extraLibraries) ps,+        concatMap ldOptions ps+    )+collectArchives :: DynFlags -> PackageConfig -> IO [FilePath]+collectArchives dflags pc =+  filterM doesFileExist [ searchPath </> ("lib" ++ lib ++ ".a")+                        | searchPath <- searchPaths+                        , lib <- libs ]+  where searchPaths = nub . filter notNull . libraryDirsForWay dflags $ pc+        libs        = packageHsLibs dflags pc ++ extraLibraries pc++getLibs :: DynFlags -> [PreloadUnitId] -> IO [(String,String)]+getLibs dflags pkgs = do+  ps <- getPreloadPackagesAnd dflags pkgs+  fmap concat . forM ps $ \p -> do+    let candidates = [ (l </> f, f) | l <- collectLibraryPaths dflags [p]+                                    , f <- (\n -> "lib" ++ n ++ ".a") <$> packageHsLibs dflags p ]+    filterM (doesFileExist . fst) candidates++packageHsLibs :: DynFlags -> PackageConfig -> [String]+packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)+  where+        ways0 = ways dflags++        ways1 = filter (/= WayDyn) ways0+        -- the name of a shared library is libHSfoo-ghc<version>.so+        -- we leave out the _dyn, because it is superfluous++        -- debug and profiled RTSs include support for -eventlog+        ways2 | WayDebug `elem` ways1 || WayProf `elem` ways1+              = filter (/= WayEventLog) ways1+              | otherwise+              = ways1++        tag     = mkBuildTag (filter (not . wayRTSOnly) ways2)+        rts_tag = mkBuildTag ways2++        mkDynName x+         | WayDyn `notElem` ways dflags = x+         | "HS" `isPrefixOf` x          =+              x ++ '-':programName dflags ++ projectVersion dflags+           -- For non-Haskell libraries, we use the name "Cfoo". The .a+           -- file is libCfoo.a, and the .so is libfoo.so. That way the+           -- linker knows what we mean for the vanilla (-lCfoo) and dyn+           -- (-lfoo) ways. We therefore need to strip the 'C' off here.+         | Just x' <- stripPrefix "C" x = x'+         | otherwise+            = panic ("Don't understand library name " ++ x)++        -- Add _thr and other rts suffixes to packages named+        -- `rts` or `rts-1.0`. Why both?  Traditionally the rts+        -- package is called `rts` only.  However the tooling+        -- usually expects a package name to have a version.+        -- As such we will gradually move towards the `rts-1.0`+        -- package name, at which point the `rts` package name+        -- will eventually be unused.+        --+        -- This change elevates the need to add custom hooks+        -- and handling specifically for the `rts` package for+        -- example in ghc-cabal.+        addSuffix rts@"HSrts"    = rts       ++ (expandTag rts_tag)+        addSuffix rts@"HSrts-1.0"= rts       ++ (expandTag rts_tag)+        addSuffix other_lib      = other_lib ++ (expandTag tag)++        expandTag t | null t = ""+                    | otherwise = '_':t++-- | Either the 'libraryDirs' or 'libraryDynDirs' as appropriate for the way.+libraryDirsForWay :: DynFlags -> PackageConfig -> [String]+libraryDirsForWay dflags+  | WayDyn `elem` ways dflags = libraryDynDirs+  | otherwise                 = libraryDirs++-- | Find all the C-compiler options in these and the preload packages+getPackageExtraCcOpts :: DynFlags -> [PreloadUnitId] -> IO [String]+getPackageExtraCcOpts dflags pkgs = do+  ps <- getPreloadPackagesAnd dflags pkgs+  return (concatMap ccOptions ps)++-- | Find all the package framework paths in these and the preload packages+getPackageFrameworkPath  :: DynFlags -> [PreloadUnitId] -> IO [String]+getPackageFrameworkPath dflags pkgs = do+  ps <- getPreloadPackagesAnd dflags pkgs+  return (nub (filter notNull (concatMap frameworkDirs ps)))++-- | Find all the package frameworks in these and the preload packages+getPackageFrameworks  :: DynFlags -> [PreloadUnitId] -> IO [String]+getPackageFrameworks dflags pkgs = do+  ps <- getPreloadPackagesAnd dflags pkgs+  return (concatMap frameworks ps)++-- -----------------------------------------------------------------------------+-- Package Utils++-- | Takes a 'ModuleName', and if the module is in any package returns+-- list of modules which take that name.+lookupModuleInAllPackages :: DynFlags+                          -> ModuleName+                          -> [(Module, PackageConfig)]+lookupModuleInAllPackages dflags m+  = case lookupModuleWithSuggestions dflags m Nothing of+      LookupFound a b -> [(a,b)]+      LookupMultiple rs -> map f rs+        where f (m,_) = (m, expectJust "lookupModule" (lookupPackage dflags+                                                         (moduleUnitId m)))+      _ -> []++-- | The result of performing a lookup+data LookupResult =+    -- | Found the module uniquely, nothing else to do+    LookupFound Module PackageConfig+    -- | Multiple modules with the same name in scope+  | LookupMultiple [(Module, ModuleOrigin)]+    -- | No modules found, but there were some hidden ones with+    -- an exact name match.  First is due to package hidden, second+    -- is due to module being hidden+  | LookupHidden [(Module, ModuleOrigin)] [(Module, ModuleOrigin)]+    -- | No modules found, but there were some unusable ones with+    -- an exact name match+  | LookupUnusable [(Module, ModuleOrigin)]+    -- | Nothing found, here are some suggested different names+  | LookupNotFound [ModuleSuggestion] -- suggestions++data ModuleSuggestion = SuggestVisible ModuleName Module ModuleOrigin+                      | SuggestHidden ModuleName Module ModuleOrigin++lookupModuleWithSuggestions :: DynFlags+                            -> ModuleName+                            -> Maybe FastString+                            -> LookupResult+lookupModuleWithSuggestions dflags+  = lookupModuleWithSuggestions' dflags+        (moduleToPkgConfAll (pkgState dflags))++lookupPluginModuleWithSuggestions :: DynFlags+                                  -> ModuleName+                                  -> Maybe FastString+                                  -> LookupResult+lookupPluginModuleWithSuggestions dflags+  = lookupModuleWithSuggestions' dflags+        (pluginModuleToPkgConfAll (pkgState dflags))++lookupModuleWithSuggestions' :: DynFlags+                            -> ModuleToPkgConfAll+                            -> ModuleName+                            -> Maybe FastString+                            -> LookupResult+lookupModuleWithSuggestions' dflags mod_map m mb_pn+  = case Map.lookup m mod_map of+        Nothing -> LookupNotFound suggestions+        Just xs ->+          case foldl' classify ([],[],[], []) (Map.toList xs) of+            ([], [], [], []) -> LookupNotFound suggestions+            (_, _, _, [(m, _)])             -> LookupFound m (mod_pkg m)+            (_, _, _, exposed@(_:_))        -> LookupMultiple exposed+            ([], [], unusable@(_:_), [])    -> LookupUnusable unusable+            (hidden_pkg, hidden_mod, _, []) ->+              LookupHidden hidden_pkg hidden_mod+  where+    classify (hidden_pkg, hidden_mod, unusable, exposed) (m, origin0) =+      let origin = filterOrigin mb_pn (mod_pkg m) origin0+          x = (m, origin)+      in case origin of+          ModHidden+            -> (hidden_pkg, x:hidden_mod, unusable, exposed)+          ModUnusable _+            -> (hidden_pkg, hidden_mod, x:unusable, exposed)+          _ | originEmpty origin+            -> (hidden_pkg,   hidden_mod, unusable, exposed)+            | originVisible origin+            -> (hidden_pkg, hidden_mod, unusable, x:exposed)+            | otherwise+            -> (x:hidden_pkg, hidden_mod, unusable, exposed)++    pkg_lookup p = lookupPackage dflags p `orElse` pprPanic "lookupModuleWithSuggestions" (ppr p <+> ppr m)+    mod_pkg = pkg_lookup . moduleUnitId++    -- Filters out origins which are not associated with the given package+    -- qualifier.  No-op if there is no package qualifier.  Test if this+    -- excluded all origins with 'originEmpty'.+    filterOrigin :: Maybe FastString+                 -> PackageConfig+                 -> ModuleOrigin+                 -> ModuleOrigin+    filterOrigin Nothing _ o = o+    filterOrigin (Just pn) pkg o =+      case o of+          ModHidden -> if go pkg then ModHidden else mempty+          (ModUnusable _) -> if go pkg then o else mempty+          ModOrigin { fromOrigPackage = e, fromExposedReexport = res,+                      fromHiddenReexport = rhs }+            -> ModOrigin {+                  fromOrigPackage = if go pkg then e else Nothing+                , fromExposedReexport = filter go res+                , fromHiddenReexport = filter go rhs+                , fromPackageFlag = False -- always excluded+                }+      where go pkg = pn == fsPackageName pkg++    suggestions+      | gopt Opt_HelpfulErrors dflags =+           fuzzyLookup (moduleNameString m) all_mods+      | otherwise = []++    all_mods :: [(String, ModuleSuggestion)]     -- All modules+    all_mods = sortBy (comparing fst) $+        [ (moduleNameString m, suggestion)+        | (m, e) <- Map.toList (moduleToPkgConfAll (pkgState dflags))+        , suggestion <- map (getSuggestion m) (Map.toList e)+        ]+    getSuggestion name (mod, origin) =+        (if originVisible origin then SuggestVisible else SuggestHidden)+            name mod origin++listVisibleModuleNames :: DynFlags -> [ModuleName]+listVisibleModuleNames dflags =+    map fst (filter visible (Map.toList (moduleToPkgConfAll (pkgState dflags))))+  where visible (_, ms) = any originVisible (Map.elems ms)++-- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of+-- 'PackageConfig's+getPreloadPackagesAnd :: DynFlags -> [PreloadUnitId] -> IO [PackageConfig]+getPreloadPackagesAnd dflags pkgids0 =+  let+      pkgids  = pkgids0 +++                  -- An indefinite package will have insts to HOLE,+                  -- which is not a real package. Don't look it up.+                  -- Fixes #14525+                  if isIndefinite dflags+                    then []+                    else map (toInstalledUnitId . moduleUnitId . snd)+                             (thisUnitIdInsts dflags)+      state   = pkgState dflags+      pkg_map = pkgIdMap state+      preload = preloadPackages state+      pairs = zip pkgids (repeat Nothing)+  in do+  all_pkgs <- throwErr dflags (foldM (add_package dflags pkg_map) preload pairs)+  return (map (getInstalledPackageDetails dflags) all_pkgs)++-- Takes a list of packages, and returns the list with dependencies included,+-- in reverse dependency order (a package appears before those it depends on).+closeDeps :: DynFlags+          -> PackageConfigMap+          -> [(InstalledUnitId, Maybe InstalledUnitId)]+          -> IO [InstalledUnitId]+closeDeps dflags pkg_map ps+    = throwErr dflags (closeDepsErr dflags pkg_map ps)++throwErr :: DynFlags -> MaybeErr MsgDoc a -> IO a+throwErr dflags m+              = case m of+                Failed e    -> throwGhcExceptionIO (CmdLineError (showSDoc dflags e))+                Succeeded r -> return r++closeDepsErr :: DynFlags+             -> PackageConfigMap+             -> [(InstalledUnitId,Maybe InstalledUnitId)]+             -> MaybeErr MsgDoc [InstalledUnitId]+closeDepsErr dflags pkg_map ps = foldM (add_package dflags pkg_map) [] ps++-- internal helper+add_package :: DynFlags+            -> PackageConfigMap+            -> [PreloadUnitId]+            -> (PreloadUnitId,Maybe PreloadUnitId)+            -> MaybeErr MsgDoc [PreloadUnitId]+add_package dflags pkg_db ps (p, mb_parent)+  | p `elem` ps = return ps     -- Check if we've already added this package+  | otherwise =+      case lookupInstalledPackage' pkg_db p of+        Nothing -> Failed (missingPackageMsg p <>+                           missingDependencyMsg mb_parent)+        Just pkg -> do+           -- Add the package's dependents also+           ps' <- foldM add_unit_key ps (depends pkg)+           return (p : ps')+          where+            add_unit_key ps key+              = add_package dflags pkg_db ps (key, Just p)++missingPackageMsg :: Outputable pkgid => pkgid -> SDoc+missingPackageMsg p = text "unknown package:" <+> ppr p++missingDependencyMsg :: Maybe InstalledUnitId -> SDoc+missingDependencyMsg Nothing = Outputable.empty+missingDependencyMsg (Just parent)+  = space <> parens (text "dependency of" <+> ftext (installedUnitIdFS parent))++-- -----------------------------------------------------------------------------++componentIdString :: DynFlags -> ComponentId -> Maybe String+componentIdString dflags cid = do+    conf <- lookupInstalledPackage dflags (componentIdToInstalledUnitId cid)+    return $+        case sourceLibName conf of+            Nothing -> sourcePackageIdString conf+            Just (PackageName libname) ->+                packageNameString conf+                    ++ "-" ++ showVersion (packageVersion conf)+                    ++ ":" ++ unpackFS libname++displayInstalledUnitId :: DynFlags -> InstalledUnitId -> Maybe String+displayInstalledUnitId dflags uid =+    fmap sourcePackageIdString (lookupInstalledPackage dflags uid)++-- | Will the 'Name' come from a dynamically linked library?+isDllName :: DynFlags -> Module -> Name -> Bool+-- Despite the "dll", I think this function just means that+-- the symbol comes from another dynamically-linked package,+-- and applies on all platforms, not just Windows+isDllName dflags this_mod name+  | not (gopt Opt_ExternalDynamicRefs dflags) = False+  | Just mod <- nameModule_maybe name+    -- Issue #8696 - when GHC is dynamically linked, it will attempt+    -- to load the dynamic dependencies of object files at compile+    -- time for things like QuasiQuotes or+    -- TemplateHaskell. Unfortunately, this interacts badly with+    -- intra-package linking, because we don't generate indirect+    -- (dynamic) symbols for intra-package calls. This means that if a+    -- module with an intra-package call is loaded without its+    -- dependencies, then GHC fails to link. This is the cause of #+    --+    -- In the mean time, always force dynamic indirections to be+    -- generated: when the module name isn't the module being+    -- compiled, references are dynamic.+    = case platformOS $ targetPlatform dflags of+        -- On Windows the hack for #8696 makes it unlinkable.+        -- As the entire setup of the code from Cmm down to the RTS expects+        -- the use of trampolines for the imported functions only when+        -- doing intra-package linking, e.g. refering to a symbol defined in the same+        -- package should not use a trampoline.+        -- I much rather have dynamic TH not supported than the entire Dynamic linking+        -- not due to a hack.+        -- Also not sure this would break on Windows anyway.+        OSMinGW32 -> moduleUnitId mod /= moduleUnitId this_mod++        -- For the other platforms, still perform the hack+        _         -> mod /= this_mod++  | otherwise = False  -- no, it is not even an external name++-- -----------------------------------------------------------------------------+-- Displaying packages++-- | Show (very verbose) package info+pprPackages :: DynFlags -> SDoc+pprPackages = pprPackagesWith pprPackageConfig++pprPackagesWith :: (PackageConfig -> SDoc) -> DynFlags -> SDoc+pprPackagesWith pprIPI dflags =+    vcat (intersperse (text "---") (map pprIPI (listPackageConfigMap dflags)))++-- | Show simplified package info.+--+-- The idea is to only print package id, and any information that might+-- be different from the package databases (exposure, trust)+pprPackagesSimple :: DynFlags -> SDoc+pprPackagesSimple = pprPackagesWith pprIPI+    where pprIPI ipi = let i = installedUnitIdFS (unitId ipi)+                           e = if exposed ipi then text "E" else text " "+                           t = if trusted ipi then text "T" else text " "+                       in e <> t <> text "  " <> ftext i++-- | Show the mapping of modules to where they come from.+pprModuleMap :: ModuleToPkgConfAll -> SDoc+pprModuleMap mod_map =+  vcat (map pprLine (Map.toList mod_map))+    where+      pprLine (m,e) = ppr m $$ nest 50 (vcat (map (pprEntry m) (Map.toList e)))+      pprEntry :: Outputable a => ModuleName -> (Module, a) -> SDoc+      pprEntry m (m',o)+        | m == moduleName m' = ppr (moduleUnitId m') <+> parens (ppr o)+        | otherwise = ppr m' <+> parens (ppr o)++fsPackageName :: PackageConfig -> FastString+fsPackageName = mkFastString . packageNameString++-- | Given a fully instantiated 'UnitId', improve it into a+-- 'InstalledUnitId' if we can find it in the package database.+improveUnitId :: PackageConfigMap -> UnitId -> UnitId+improveUnitId _ uid@(DefiniteUnitId _) = uid -- short circuit+improveUnitId pkg_map uid =+    -- Do NOT lookup indefinite ones, they won't be useful!+    case lookupPackage' False pkg_map uid of+        Nothing  -> uid+        Just pkg ->+            -- Do NOT improve if the indefinite unit id is not+            -- part of the closure unique set.  See+            -- Note [UnitId to InstalledUnitId improvement]+            if installedPackageConfigId pkg `elementOfUniqSet` preloadClosure pkg_map+                then packageConfigId pkg+                else uid++-- | Retrieve the 'PackageConfigMap' from 'DynFlags'; used+-- in the @hs-boot@ loop-breaker.+getPackageConfigMap :: DynFlags -> PackageConfigMap+getPackageConfigMap = pkgIdMap . pkgState
+ compiler/main/Packages.hs-boot view
@@ -0,0 +1,11 @@+module Packages where+import GhcPrelude+import {-# SOURCE #-} DynFlags(DynFlags)+import {-# SOURCE #-} Module(ComponentId, UnitId, InstalledUnitId)+data PackageState+data PackageConfigMap+emptyPackageState :: PackageState+componentIdString :: DynFlags -> ComponentId -> Maybe String+displayInstalledUnitId :: DynFlags -> InstalledUnitId -> Maybe String+improveUnitId :: PackageConfigMap -> UnitId -> UnitId+getPackageConfigMap :: DynFlags -> PackageConfigMap
+ compiler/main/PipelineMonad.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE NamedFieldPuns #-}+-- | The CompPipeline monad and associated ops+--+-- Defined in separate module so that it can safely be imported from Hooks+module PipelineMonad (+    CompPipeline(..), evalP+  , PhasePlus(..)+  , PipeEnv(..), PipeState(..), PipelineOutput(..)+  , getPipeEnv, getPipeState, setDynFlags, setModLocation, setForeignOs+  ) where++import GhcPrelude++import MonadUtils+import Outputable+import DynFlags+import DriverPhases+import HscTypes+import Module+import FileCleanup (TempFileLifetime)++import Control.Monad++newtype CompPipeline a = P { unP :: PipeEnv -> PipeState -> IO (PipeState, a) }++evalP :: CompPipeline a -> PipeEnv -> PipeState -> IO a+evalP f env st = liftM snd $ unP f env st++instance Functor CompPipeline where+    fmap = liftM++instance Applicative CompPipeline where+    pure a = P $ \_env state -> return (state, a)+    (<*>) = ap++instance Monad CompPipeline where+  P m >>= k = P $ \env state -> do (state',a) <- m env state+                                   unP (k a) env state'++instance MonadIO CompPipeline where+    liftIO m = P $ \_env state -> do a <- m; return (state, a)++data PhasePlus = RealPhase Phase+               | HscOut HscSource ModuleName HscStatus++instance Outputable PhasePlus where+    ppr (RealPhase p) = ppr p+    ppr (HscOut {}) = text "HscOut"++-- -----------------------------------------------------------------------------+-- The pipeline uses a monad to carry around various bits of information++-- PipeEnv: invariant information passed down+data PipeEnv = PipeEnv {+       stop_phase   :: Phase,       -- ^ Stop just before this phase+       src_filename :: String,      -- ^ basename of original input source+       src_basename :: String,      -- ^ basename of original input source+       src_suffix   :: String,      -- ^ its extension+       output_spec  :: PipelineOutput -- ^ says where to put the pipeline output+  }++-- PipeState: information that might change during a pipeline run+data PipeState = PipeState {+       hsc_env   :: HscEnv,+          -- ^ only the DynFlags change in the HscEnv.  The DynFlags change+          -- at various points, for example when we read the OPTIONS_GHC+          -- pragmas in the Cpp phase.+       maybe_loc :: Maybe ModLocation,+          -- ^ the ModLocation.  This is discovered during compilation,+          -- in the Hsc phase where we read the module header.+       foreign_os :: [FilePath]+         -- ^ additional object files resulting from compiling foreign+         -- code. They come from two sources: foreign stubs, and+         -- add{C,Cxx,Objc,Objcxx}File from template haskell+  }++data PipelineOutput+  = Temporary TempFileLifetime+        -- ^ Output should be to a temporary file: we're going to+        -- run more compilation steps on this output later.+  | Persistent+        -- ^ We want a persistent file, i.e. a file in the current directory+        -- derived from the input filename, but with the appropriate extension.+        -- eg. in "ghc -c Foo.hs" the output goes into ./Foo.o.+  | SpecificFile+        -- ^ The output must go into the specific outputFile in DynFlags.+        -- We don't store the filename in the constructor as it changes+        -- when doing -dynamic-too.+    deriving Show++getPipeEnv :: CompPipeline PipeEnv+getPipeEnv = P $ \env state -> return (state, env)++getPipeState :: CompPipeline PipeState+getPipeState = P $ \_env state -> return (state, state)++instance HasDynFlags CompPipeline where+    getDynFlags = P $ \_env state -> return (state, hsc_dflags (hsc_env state))++setDynFlags :: DynFlags -> CompPipeline ()+setDynFlags dflags = P $ \_env state ->+  return (state{hsc_env= (hsc_env state){ hsc_dflags = dflags }}, ())++setModLocation :: ModLocation -> CompPipeline ()+setModLocation loc = P $ \_env state ->+  return (state{ maybe_loc = Just loc }, ())++setForeignOs :: [FilePath] -> CompPipeline ()+setForeignOs os = P $ \_env state ->+  return (state{ foreign_os = os }, ())
+ compiler/main/PlatformConstants.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE CPP #-}++-------------------------------------------------------------------------------+--+-- | Platform constants+--+-- (c) The University of Glasgow 2013+--+-------------------------------------------------------------------------------++module PlatformConstants (PlatformConstants(..)) where++import GhcPrelude++-- Produced by deriveConstants+#include "GHCConstantsHaskellType.hs"+
+ compiler/main/Plugins.hs view
@@ -0,0 +1,241 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-}+module Plugins (+      -- * Plugins+      Plugin(..)+    , defaultPlugin+    , CommandLineOption+      -- ** Recompilation checking+    , purePlugin, impurePlugin, flagRecompile+    , PluginRecompile(..)++      -- * Plugin types+      -- ** Frontend plugins+    , FrontendPlugin(..), defaultFrontendPlugin, FrontendPluginAction+      -- ** Core plugins+      -- | Core plugins allow plugins to register as a Core-to-Core pass.+    , CorePlugin+      -- ** Typechecker plugins+      -- | Typechecker plugins allow plugins to provide evidence to the+      -- typechecker.+    , TcPlugin+      -- ** Source plugins+      -- | GHC offers a number of points where plugins can access and modify its+      -- front-end (\"source\") representation. These include:+      --+      -- - access to the parser result with 'parsedResultAction'+      -- - access to the renamed AST with 'renamedResultAction'+      -- - access to the typechecked AST with 'typeCheckResultAction'+      -- - access to the Template Haskell splices with 'spliceRunAction'+      -- - access to loaded interface files with 'interfaceLoadAction'+      --+    , keepRenamedSource++      -- * Internal+    , PluginWithArgs(..), plugins, pluginRecompile'+    , LoadedPlugin(..), lpModuleName+    , StaticPlugin(..)+    , mapPlugins, withPlugins, withPlugins_+    ) where++import GhcPrelude++import {-# SOURCE #-} CoreMonad ( CoreToDo, CoreM )+import qualified TcRnTypes+import TcRnTypes ( TcGblEnv, IfM, TcM, tcg_rn_decls, tcg_rn_exports )+import HsSyn+import DynFlags+import HscTypes+import GhcMonad+import DriverPhases+import Module ( ModuleName, Module(moduleName))+import Fingerprint+import Data.List+import Outputable (Outputable(..), text, (<+>))++--Qualified import so we can define a Semigroup instance+-- but it doesn't clash with Outputable.<>+import qualified Data.Semigroup++import Control.Monad++-- | Command line options gathered from the -PModule.Name:stuff syntax+-- are given to you as this type+type CommandLineOption = String++-- | 'Plugin' is the compiler plugin data type. Try to avoid+-- constructing one of these directly, and just modify some fields of+-- 'defaultPlugin' instead: this is to try and preserve source-code+-- compatibility when we add fields to this.+--+-- Nonetheless, this API is preliminary and highly likely to change in+-- the future.+data Plugin = Plugin {+    installCoreToDos :: CorePlugin+    -- ^ Modify the Core pipeline that will be used for compilation.+    -- This is called as the Core pipeline is built for every module+    -- being compiled, and plugins get the opportunity to modify the+    -- pipeline in a nondeterministic order.+  , tcPlugin :: TcPlugin+    -- ^ An optional typechecker plugin, which may modify the+    -- behaviour of the constraint solver.+  , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile+    -- ^ Specify how the plugin should affect recompilation.+  , parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule+                            -> Hsc HsParsedModule+    -- ^ Modify the module when it is parsed. This is called by+    -- HscMain when the parsing is successful.+  , renamedResultAction :: [CommandLineOption] -> TcGblEnv+                                -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)+    -- ^ Modify each group after it is renamed. This is called after each+    -- `HsGroup` has been renamed.+  , typeCheckResultAction :: [CommandLineOption] -> ModSummary -> TcGblEnv+                               -> TcM TcGblEnv+    -- ^ Modify the module when it is type checked. This is called at the+    -- very end of typechecking.+  , spliceRunAction :: [CommandLineOption] -> LHsExpr GhcTc+                         -> TcM (LHsExpr GhcTc)+    -- ^ Modify the TH splice or quasiqoute before it is run.+  , interfaceLoadAction :: forall lcl . [CommandLineOption] -> ModIface+                                          -> IfM lcl ModIface+    -- ^ Modify an interface that have been loaded. This is called by+    -- LoadIface when an interface is successfully loaded. Not applied to+    -- the loading of the plugin interface. Tools that rely on information from+    -- modules other than the currently compiled one should implement this+    -- function.+  }++-- Note [Source plugins]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- The `Plugin` datatype have been extended by fields that allow access to the+-- different inner representations that are generated during the compilation+-- process. These fields are `parsedResultAction`, `renamedResultAction`,+-- `typeCheckResultAction`, `spliceRunAction` and `interfaceLoadAction`.+--+-- The main purpose of these plugins is to help tool developers. They allow+-- development tools to extract the information about the source code of a big+-- Haskell project during the normal build procedure. In this case the plugin+-- acts as the tools access point to the compiler that can be controlled by+-- compiler flags. This is important because the manipulation of compiler flags+-- is supported by most build environment.+--+-- For the full discussion, check the full proposal at:+-- https://gitlab.haskell.org/ghc/ghc/wikis/extended-plugins-proposal++data PluginWithArgs = PluginWithArgs+  { paPlugin :: Plugin+    -- ^ the actual callable plugin+  , paArguments :: [CommandLineOption]+    -- ^ command line arguments for the plugin+  }++-- | A plugin with its arguments. The result of loading the plugin.+data LoadedPlugin = LoadedPlugin+  { lpPlugin :: PluginWithArgs+  -- ^ the actual plugin together with its commandline arguments+  , lpModule :: ModIface+  -- ^ the module containing the plugin+  }++-- | A static plugin with its arguments. For registering compiled-in plugins+-- through the GHC API.+data StaticPlugin = StaticPlugin+  { spPlugin :: PluginWithArgs+  -- ^ the actual plugin together with its commandline arguments+  }++lpModuleName :: LoadedPlugin -> ModuleName+lpModuleName = moduleName . mi_module . lpModule++pluginRecompile' :: PluginWithArgs -> IO PluginRecompile+pluginRecompile' (PluginWithArgs plugin args) = pluginRecompile plugin args++data PluginRecompile = ForceRecompile | NoForceRecompile | MaybeRecompile Fingerprint++instance Outputable PluginRecompile where+  ppr ForceRecompile = text "ForceRecompile"+  ppr NoForceRecompile = text "NoForceRecompile"+  ppr (MaybeRecompile fp) = text "MaybeRecompile" <+> ppr fp++instance Semigroup PluginRecompile where+  ForceRecompile <> _ = ForceRecompile+  NoForceRecompile <> r = r+  MaybeRecompile fp <> NoForceRecompile   = MaybeRecompile fp+  MaybeRecompile fp <> MaybeRecompile fp' = MaybeRecompile (fingerprintFingerprints [fp, fp'])+  MaybeRecompile _fp <> ForceRecompile     = ForceRecompile++instance Monoid PluginRecompile where+  mempty = NoForceRecompile++type CorePlugin = [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]+type TcPlugin = [CommandLineOption] -> Maybe TcRnTypes.TcPlugin++purePlugin, impurePlugin, flagRecompile :: [CommandLineOption] -> IO PluginRecompile+purePlugin _args = return NoForceRecompile++impurePlugin _args = return ForceRecompile++flagRecompile =+  return . MaybeRecompile . fingerprintFingerprints . map fingerprintString . sort++-- | Default plugin: does nothing at all, except for marking that safe+-- inference has failed unless @-fplugin-trustworthy@ is passed. For+-- compatibility reaso you should base all your plugin definitions on this+-- default value.+defaultPlugin :: Plugin+defaultPlugin = Plugin {+        installCoreToDos      = const return+      , tcPlugin              = const Nothing+      , pluginRecompile  = impurePlugin+      , renamedResultAction   = \_ env grp -> return (env, grp)+      , parsedResultAction    = \_ _ -> return+      , typeCheckResultAction = \_ _ -> return+      , spliceRunAction       = \_ -> return+      , interfaceLoadAction   = \_ -> return+    }+++-- | A renamer plugin which mades the renamed source available in+-- a typechecker plugin.+keepRenamedSource :: [CommandLineOption] -> TcGblEnv+                  -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)+keepRenamedSource _ gbl_env group =+  return (gbl_env { tcg_rn_decls = update (tcg_rn_decls gbl_env)+                  , tcg_rn_exports = update_exports (tcg_rn_exports gbl_env) }, group)+  where+    update_exports Nothing = Just []+    update_exports m = m++    update Nothing = Just emptyRnGroup+    update m       = m+++type PluginOperation m a = Plugin -> [CommandLineOption] -> a -> m a+type ConstPluginOperation m a = Plugin -> [CommandLineOption] -> a -> m ()++plugins :: DynFlags -> [PluginWithArgs]+plugins df =+  map lpPlugin (cachedPlugins df) +++  map spPlugin (staticPlugins df)++-- | Perform an operation by using all of the plugins in turn.+withPlugins :: Monad m => DynFlags -> PluginOperation m a -> a -> m a+withPlugins df transformation input = foldM go input (plugins df)+  where+    go arg (PluginWithArgs p opts) = transformation p opts arg++mapPlugins :: DynFlags -> (Plugin -> [CommandLineOption] -> a) -> [a]+mapPlugins df f = map (\(PluginWithArgs p opts) -> f p opts) (plugins df)++-- | Perform a constant operation by using all of the plugins in turn.+withPlugins_ :: Monad m => DynFlags -> ConstPluginOperation m a -> a -> m ()+withPlugins_ df transformation input+  = mapM_ (\(PluginWithArgs p opts) -> transformation p opts input)+          (plugins df)++type FrontendPluginAction = [String] -> [(String, Maybe Phase)] -> Ghc ()+data FrontendPlugin = FrontendPlugin {+      frontend :: FrontendPluginAction+    }+defaultFrontendPlugin :: FrontendPlugin+defaultFrontendPlugin = FrontendPlugin { frontend = \_ _ -> return () }
+ compiler/main/Plugins.hs-boot view
@@ -0,0 +1,10 @@+-- The plugins datatype is stored in DynFlags, so it needs to be+-- exposed without importing all of its implementation.+module Plugins where++import GhcPrelude ()++data Plugin++data LoadedPlugin+data StaticPlugin
+ compiler/main/SysTools/BaseDir.hs view
@@ -0,0 +1,184 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-+-----------------------------------------------------------------------------+--+-- (c) The University of Glasgow 2001-2017+--+-- Finding the compiler's base directory.+--+-----------------------------------------------------------------------------+-}++module SysTools.BaseDir+  ( expandTopDir, expandToolDir+  , findTopDir, findToolDir+  ) where++#include "HsVersions.h"++import GhcPrelude++import Panic++import System.Environment (lookupEnv)+import System.FilePath+import Data.List++-- POSIX+#if defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)+import System.Environment (getExecutablePath)+#endif++-- Windows+#if defined(mingw32_HOST_OS)+import System.Environment (getExecutablePath)+import System.Directory (doesDirectoryExist)+#endif++#if defined(mingw32_HOST_OS)+# if defined(i386_HOST_ARCH)+#  define WINDOWS_CCONV stdcall+# elif defined(x86_64_HOST_ARCH)+#  define WINDOWS_CCONV ccall+# else+#  error Unknown mingw32 arch+# endif+#endif++{-+Note [topdir: How GHC finds its files]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++GHC needs various support files (library packages, RTS etc), plus+various auxiliary programs (cp, gcc, etc).  It starts by finding topdir,+the root of GHC's support files++On Unix:+  - ghc always has a shell wrapper that passes a -B<dir> option++On Windows:+  - ghc never has a shell wrapper.+  - we can find the location of the ghc binary, which is+        $topdir/<foo>/<something>.exe+    where <something> may be "ghc", "ghc-stage2", or similar+  - we strip off the "<foo>/<something>.exe" to leave $topdir.++from topdir we can find package.conf, ghc-asm, etc.+++Note [tooldir: How GHC finds mingw on Windows]++GHC has some custom logic on Windows for finding the mingw+toolchain and perl. Depending on whether GHC is built+with the make build system or Hadrian, and on whether we're+running a bindist, we might find the mingw toolchain and perl+either under $topdir/../{mingw, perl}/ or+$topdir/../../{mingw, perl}/.++-}++-- | Expand occurrences of the @$topdir@ interpolation in a string.+expandTopDir :: FilePath -> String -> String+expandTopDir = expandPathVar "topdir"++-- | Expand occurrences of the @$tooldir@ interpolation in a string+-- on Windows, leave the string untouched otherwise.+expandToolDir :: Maybe FilePath -> String -> String+#if defined(mingw32_HOST_OS)+expandToolDir (Just tool_dir) s = expandPathVar "tooldir" tool_dir s+expandToolDir Nothing         _ = panic "Could not determine $tooldir"+#else+expandToolDir _ s = s+#endif++-- | @expandPathVar var value str@+--+--   replaces occurences of variable @$var@ with @value@ in str.+expandPathVar :: String -> FilePath -> String -> String+expandPathVar var value str+  | Just str' <- stripPrefix ('$':var) str+  , null str' || isPathSeparator (head str')+  = value ++ expandPathVar var value str'+expandPathVar var value (x:xs) = x : expandPathVar var value xs+expandPathVar _ _ [] = []++-- | Returns a Unix-format path pointing to TopDir.+findTopDir :: Maybe String -- Maybe TopDir path (without the '-B' prefix).+           -> IO String    -- TopDir (in Unix format '/' separated)+findTopDir (Just minusb) = return (normalise minusb)+findTopDir Nothing+    = do -- The _GHC_TOP_DIR environment variable can be used to specify+         -- the top dir when the -B argument is not specified. It is not+         -- intended for use by users, it was added specifically for the+         -- purpose of running GHC within GHCi.+         maybe_env_top_dir <- lookupEnv "_GHC_TOP_DIR"+         case maybe_env_top_dir of+             Just env_top_dir -> return env_top_dir+             Nothing -> do+                 -- Get directory of executable+                 maybe_exec_dir <- getBaseDir+                 case maybe_exec_dir of+                     -- "Just" on Windows, "Nothing" on unix+                     Nothing -> throwGhcExceptionIO $+                         InstallationError "missing -B<dir> option"+                     Just dir -> return dir++getBaseDir :: IO (Maybe String)++#if defined(mingw32_HOST_OS)++-- locate the "base dir" when given the path+-- to the real ghc executable (as opposed to symlink)+-- that is running this function.+rootDir :: FilePath -> FilePath+rootDir = takeDirectory . takeDirectory . normalise++getBaseDir = Just . (\p -> p </> "lib") . rootDir <$> getExecutablePath+#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)+-- on unix, this is a bit more confusing.+-- The layout right now is something like+--+--   /bin/ghc-X.Y.Z <- wrapper script (1)+--   /bin/ghc       <- symlink to wrapper script (2)+--   /lib/ghc-X.Y.Z/bin/ghc <- ghc executable (3)+--   /lib/ghc-X.Y.Z <- $topdir (4)+--+-- As such, we first need to find the absolute location to the+-- binary.+--+-- getExecutablePath will return (3). One takeDirectory will+-- give use /lib/ghc-X.Y.Z/bin, and another will give us (4).+--+-- This of course only works due to the current layout. If+-- the layout is changed, such that we have ghc-X.Y.Z/{bin,lib}+-- this would need to be changed accordingly.+--+getBaseDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath+#else+getBaseDir = return Nothing+#endif++-- See Note [tooldir: How GHC finds mingw and perl on Windows]+-- Returns @Nothing@ when not on Windows.+-- When called on Windows, it either throws an error when the+-- tooldir can't be located, or returns @Just tooldirpath@.+findToolDir+  :: FilePath -- ^ topdir+  -> IO (Maybe FilePath)+#if defined(mingw32_HOST_OS)+findToolDir top_dir = go 0 (top_dir </> "..")+  where maxDepth = 3+        go :: Int -> FilePath -> IO (Maybe FilePath)+        go k path+          | k == maxDepth = throwGhcExceptionIO $+              InstallationError "could not detect mingw toolchain"+          | otherwise = do+              oneLevel <- doesDirectoryExist (path </> "mingw")+              if oneLevel+                then return (Just path)+                else go (k+1) (path </> "..")+#else+findToolDir _ = return Nothing+#endif
+ compiler/main/SysTools/Terminal.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+module SysTools.Terminal (stderrSupportsAnsiColors) where++import GhcPrelude++#if defined MIN_VERSION_terminfo+import Control.Exception (catch)+import Data.Maybe (fromMaybe)+import System.Console.Terminfo (SetupTermError, Terminal, getCapability,+                                setupTermFromEnv, termColors)+import System.Posix (queryTerminal, stdError)+#elif defined mingw32_HOST_OS+import Control.Exception (catch, try)+import Data.Bits ((.|.), (.&.))+import Data.List (isInfixOf, isPrefixOf, isSuffixOf)+import Foreign (FunPtr, Ptr, allocaBytes, castPtrToFunPtr,+                peek, plusPtr, sizeOf, with)+import Foreign.C (CInt(..), CWchar, peekCWStringLen)+import qualified Graphics.Win32 as Win32+import qualified System.Win32 as Win32+#endif++#if defined mingw32_HOST_OS && !defined WINAPI+# if defined i386_HOST_ARCH+#  define WINAPI stdcall+# elif defined x86_64_HOST_ARCH+#  define WINAPI ccall+# else+#  error unknown architecture+# endif+#endif++-- | Check if ANSI escape sequences can be used to control color in stderr.+stderrSupportsAnsiColors :: IO Bool+stderrSupportsAnsiColors = do+#if defined MIN_VERSION_terminfo+  queryTerminal stdError `andM` do+    (termSupportsColors <$> setupTermFromEnv)+      `catch` \ (_ :: SetupTermError) ->+        pure False++  where++    andM :: Monad m => m Bool -> m Bool -> m Bool+    andM mx my = do+      x <- mx+      if x+        then my+        else pure x++    termSupportsColors :: Terminal -> Bool+    termSupportsColors term = fromMaybe 0 (getCapability term termColors) > 0++#elif defined mingw32_HOST_OS+  h <- Win32.getStdHandle Win32.sTD_ERROR_HANDLE+         `catch` \ (_ :: IOError) ->+           pure Win32.nullHANDLE+  if h == Win32.nullHANDLE+    then pure False+    else do+      eMode <- try (getConsoleMode h)+      case eMode of+        Left (_ :: IOError) -> queryCygwinTerminal h+        Right mode+          | modeHasVTP mode -> pure True+          | otherwise       -> enableVTP h mode++  where++    queryCygwinTerminal :: Win32.HANDLE -> IO Bool+    queryCygwinTerminal h = do+        fileType <- Win32.getFileType h+        if fileType /= Win32.fILE_TYPE_PIPE+          then pure False+          else do+            fn <- getFileNameByHandle h+            pure (("\\cygwin-" `isPrefixOf` fn || "\\msys-" `isPrefixOf` fn) &&+                  "-pty" `isInfixOf` fn &&+                  "-master" `isSuffixOf` fn)+      `catch` \ (_ :: IOError) ->+        pure False++    enableVTP :: Win32.HANDLE -> Win32.DWORD -> IO Bool+    enableVTP h mode = do+        setConsoleMode h (modeAddVTP mode)+        modeHasVTP <$> getConsoleMode h+      `catch` \ (_ :: IOError) ->+        pure False++    modeHasVTP :: Win32.DWORD -> Bool+    modeHasVTP mode = mode .&. eNABLE_VIRTUAL_TERMINAL_PROCESSING /= 0++    modeAddVTP :: Win32.DWORD -> Win32.DWORD+    modeAddVTP mode = mode .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING++eNABLE_VIRTUAL_TERMINAL_PROCESSING :: Win32.DWORD+eNABLE_VIRTUAL_TERMINAL_PROCESSING = 0x0004++getConsoleMode :: Win32.HANDLE -> IO Win32.DWORD+getConsoleMode h = with 64 $ \ mode -> do+  Win32.failIfFalse_ "GetConsoleMode" (c_GetConsoleMode h mode)+  peek mode++setConsoleMode :: Win32.HANDLE -> Win32.DWORD -> IO ()+setConsoleMode h mode = do+  Win32.failIfFalse_ "SetConsoleMode" (c_SetConsoleMode h mode)++foreign import WINAPI unsafe "windows.h GetConsoleMode" c_GetConsoleMode+  :: Win32.HANDLE -> Ptr Win32.DWORD -> IO Win32.BOOL++foreign import WINAPI unsafe "windows.h SetConsoleMode" c_SetConsoleMode+  :: Win32.HANDLE -> Win32.DWORD -> IO Win32.BOOL++fileNameInfo :: CInt+fileNameInfo = 2++mAX_PATH :: Num a => a+mAX_PATH = 260++getFileNameByHandle :: Win32.HANDLE -> IO String+getFileNameByHandle h = do+  let sizeOfDWORD = sizeOf (undefined :: Win32.DWORD)+  let sizeOfWchar = sizeOf (undefined :: CWchar)+  -- note: implicitly assuming that DWORD has stronger alignment than wchar_t+  let bufSize = sizeOfDWORD + mAX_PATH * sizeOfWchar+  allocaBytes bufSize $ \ buf -> do+    getFileInformationByHandleEx h fileNameInfo buf (fromIntegral bufSize)+    len :: Win32.DWORD <- peek buf+    let len' = fromIntegral len `div` sizeOfWchar+    peekCWStringLen (buf `plusPtr` sizeOfDWORD, min len' mAX_PATH)++getFileInformationByHandleEx+  :: Win32.HANDLE -> CInt -> Ptr a -> Win32.DWORD -> IO ()+getFileInformationByHandleEx h cls buf bufSize = do+  lib <- Win32.getModuleHandle (Just "kernel32.dll")+  ptr <- Win32.getProcAddress lib "GetFileInformationByHandleEx"+  let c_GetFileInformationByHandleEx =+        mk_GetFileInformationByHandleEx (castPtrToFunPtr ptr)+  Win32.failIfFalse_ "getFileInformationByHandleEx"+    (c_GetFileInformationByHandleEx h cls buf bufSize)++type F_GetFileInformationByHandleEx a =+  Win32.HANDLE -> CInt -> Ptr a -> Win32.DWORD -> IO Win32.BOOL++foreign import WINAPI "dynamic"+  mk_GetFileInformationByHandleEx+  :: FunPtr (F_GetFileInformationByHandleEx a)+  -> F_GetFileInformationByHandleEx a++#else+   pure False+#endif
+ compiler/nativeGen/NCG.h view
@@ -0,0 +1,11 @@+/* -----------------------------------------------------------------------------++   (c) The University of Glasgow, 1994-2004++   Native-code generator header file - just useful macros for now.++   -------------------------------------------------------------------------- */++#pragma once++#include "ghc_boot_platform.h"
+ compiler/parser/ApiAnnotation.hs view
@@ -0,0 +1,364 @@+{-# LANGUAGE DeriveDataTypeable #-}++module ApiAnnotation (+  getAnnotation, getAndRemoveAnnotation,+  getAnnotationComments,getAndRemoveAnnotationComments,+  ApiAnns,+  ApiAnnKey,+  AnnKeywordId(..),+  AnnotationComment(..),+  IsUnicodeSyntax(..),+  unicodeAnn,+  HasE(..),+  LRdrName -- Exists for haddocks only+  ) where++import GhcPrelude++import RdrName+import Outputable+import SrcLoc+import qualified Data.Map as Map+import Data.Data+++{-+Note [Api annotations]+~~~~~~~~~~~~~~~~~~~~~~+Given a parse tree of a Haskell module, how can we reconstruct+the original Haskell source code, retaining all whitespace and+source code comments?  We need to track the locations of all+elements from the original source: this includes keywords such as+'let' / 'in' / 'do' etc as well as punctuation such as commas and+braces, and also comments.  We collectively refer to this+metadata as the "API annotations".++Rather than annotate the resulting parse tree with these locations+directly (this would be a major change to some fairly core data+structures in GHC), we instead capture locations for these elements in a+structure separate from the parse tree, and returned in the+pm_annotations field of the ParsedModule type.++The full ApiAnns type is++> type ApiAnns = ( Map.Map ApiAnnKey [SrcSpan]                  -- non-comments+>                , Map.Map SrcSpan [Located AnnotationComment]) -- comments++NON-COMMENT ELEMENTS++Intuitively, every AST element directly contains a bag of keywords+(keywords can show up more than once in a node: a semicolon i.e. newline+can show up multiple times before the next AST element), each of which+needs to be associated with its location in the original source code.++Consequently, the structure that records non-comment elements is logically+a two level map, from the SrcSpan of the AST element containing it, to+a map from keywords ('AnnKeyWord') to all locations of the keyword directly+in the AST element:++> type ApiAnnKey = (SrcSpan,AnnKeywordId)+>+> Map.Map ApiAnnKey [SrcSpan]++So++> let x = 1 in 2 *x++would result in the AST element++  L span (HsLet (binds for x = 1) (2 * x))++and the annotations++  (span,AnnLet) having the location of the 'let' keyword+  (span,AnnEqual) having the location of the '=' sign+  (span,AnnIn)  having the location of the 'in' keyword++For any given element in the AST, there is only a set number of+keywords that are applicable for it (e.g., you'll never see an+'import' keyword associated with a let-binding.)  The set of allowed+keywords is documented in a comment associated with the constructor+of a given AST element, although the ground truth is in Parser+and RdrHsSyn (which actually add the annotations; see #13012).++COMMENT ELEMENTS++Every comment is associated with a *located* AnnotationComment.+We associate comments with the lowest (most specific) AST element+enclosing them:++> Map.Map SrcSpan [Located AnnotationComment]++PARSER STATE++There are three fields in PState (the parser state) which play a role+with annotations.++>  annotations :: [(ApiAnnKey,[SrcSpan])],+>  comment_q :: [Located AnnotationComment],+>  annotations_comments :: [(SrcSpan,[Located AnnotationComment])]++The 'annotations' and 'annotations_comments' fields are simple: they simply+accumulate annotations that will end up in 'ApiAnns' at the end+(after they are passed to Map.fromList).++The 'comment_q' field captures comments as they are seen in the token stream,+so that when they are ready to be allocated via the parser they are+available (at the time we lex a comment, we don't know what the enclosing+AST node of it is, so we can't associate it with a SrcSpan in+annotations_comments).++PARSER EMISSION OF ANNOTATIONS++The parser interacts with the lexer using the function++> addAnnotation :: SrcSpan -> AnnKeywordId -> SrcSpan -> P ()++which takes the AST element SrcSpan, the annotation keyword and the+target SrcSpan.++This adds the annotation to the `annotations` field of `PState` and+transfers any comments in `comment_q` WHICH ARE ENCLOSED by+the SrcSpan of this element to the `annotations_comments`+field.  (Comments which are outside of this annotation are deferred+until later. 'allocateComments' in 'Lexer' is responsible for+making sure we only attach comments that actually fit in the 'SrcSpan'.)++The wiki page describing this feature is+https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations++-}+-- ---------------------------------------------------------------------++-- If you update this, update the Note [Api annotations] above+type ApiAnns = ( Map.Map ApiAnnKey [SrcSpan]+               , Map.Map SrcSpan [Located AnnotationComment])++-- If you update this, update the Note [Api annotations] above+type ApiAnnKey = (SrcSpan,AnnKeywordId)+++-- | Retrieve a list of annotation 'SrcSpan's based on the 'SrcSpan'+-- of the annotated AST element, and the known type of the annotation.+getAnnotation :: ApiAnns -> SrcSpan -> AnnKeywordId -> [SrcSpan]+getAnnotation (anns,_) span ann+   = case Map.lookup (span,ann) anns of+       Nothing -> []+       Just ss -> ss++-- | Retrieve a list of annotation 'SrcSpan's based on the 'SrcSpan'+-- of the annotated AST element, and the known type of the annotation.+-- The list is removed from the annotations.+getAndRemoveAnnotation :: ApiAnns -> SrcSpan -> AnnKeywordId+                       -> ([SrcSpan],ApiAnns)+getAndRemoveAnnotation (anns,cs) span ann+   = case Map.lookup (span,ann) anns of+       Nothing -> ([],(anns,cs))+       Just ss -> (ss,(Map.delete (span,ann) anns,cs))++-- |Retrieve the comments allocated to the current 'SrcSpan'+--+--  Note: A given 'SrcSpan' may appear in multiple AST elements,+--  beware of duplicates+getAnnotationComments :: ApiAnns -> SrcSpan -> [Located AnnotationComment]+getAnnotationComments (_,anns) span =+  case Map.lookup span anns of+    Just cs -> cs+    Nothing -> []++-- |Retrieve the comments allocated to the current 'SrcSpan', and+-- remove them from the annotations+getAndRemoveAnnotationComments :: ApiAnns -> SrcSpan+                               -> ([Located AnnotationComment],ApiAnns)+getAndRemoveAnnotationComments (anns,canns) span =+  case Map.lookup span canns of+    Just cs -> (cs,(anns,Map.delete span canns))+    Nothing -> ([],(anns,canns))++-- --------------------------------------------------------------------++-- | API Annotations exist so that tools can perform source to source+-- conversions of Haskell code. They are used to keep track of the+-- various syntactic keywords that are not captured in the existing+-- AST.+--+-- The annotations, together with original source comments are made+-- available in the @'pm_annotations'@ field of @'GHC.ParsedModule'@.+-- Comments are only retained if @'Opt_KeepRawTokenStream'@ is set in+-- @'DynFlags.DynFlags'@ before parsing.+--+-- The wiki page describing this feature is+-- https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations+--+-- Note: in general the names of these are taken from the+-- corresponding token, unless otherwise noted+-- See note [Api annotations] above for details of the usage+data AnnKeywordId+    = AnnAnyclass+    | AnnAs+    | AnnAt+    | AnnBang  -- ^ '!'+    | AnnBackquote -- ^ '`'+    | AnnBy+    | AnnCase -- ^ case or lambda case+    | AnnClass+    | AnnClose -- ^  '\#)' or '\#-}'  etc+    | AnnCloseB -- ^ '|)'+    | AnnCloseBU -- ^ '|)', unicode variant+    | AnnCloseC -- ^ '}'+    | AnnCloseQ  -- ^ '|]'+    | AnnCloseQU -- ^ '|]', unicode variant+    | AnnCloseP -- ^ ')'+    | AnnCloseS -- ^ ']'+    | AnnColon+    | AnnComma -- ^ as a list separator+    | AnnCommaTuple -- ^ in a RdrName for a tuple+    | AnnDarrow -- ^ '=>'+    | AnnDarrowU -- ^ '=>', unicode variant+    | AnnData+    | AnnDcolon -- ^ '::'+    | AnnDcolonU -- ^ '::', unicode variant+    | AnnDefault+    | AnnDeriving+    | AnnDo+    | AnnDot    -- ^ '.'+    | AnnDotdot -- ^ '..'+    | AnnElse+    | AnnEqual+    | AnnExport+    | AnnFamily+    | AnnForall+    | AnnForallU -- ^ Unicode variant+    | AnnForeign+    | AnnFunId -- ^ for function name in matches where there are+               -- multiple equations for the function.+    | AnnGroup+    | AnnHeader -- ^ for CType+    | AnnHiding+    | AnnIf+    | AnnImport+    | AnnIn+    | AnnInfix -- ^ 'infix' or 'infixl' or 'infixr'+    | AnnInstance+    | AnnLam+    | AnnLarrow     -- ^ '<-'+    | AnnLarrowU    -- ^ '<-', unicode variant+    | AnnLet+    | AnnMdo+    | AnnMinus -- ^ '-'+    | AnnModule+    | AnnNewtype+    | AnnName -- ^ where a name loses its location in the AST, this carries it+    | AnnOf+    | AnnOpen    -- ^ '(\#' or '{-\# LANGUAGE' etc+    | AnnOpenB   -- ^ '(|'+    | AnnOpenBU  -- ^ '(|', unicode variant+    | AnnOpenC   -- ^ '{'+    | AnnOpenE   -- ^ '[e|' or '[e||'+    | AnnOpenEQ  -- ^ '[|'+    | AnnOpenEQU -- ^ '[|', unicode variant+    | AnnOpenP   -- ^ '('+    | AnnOpenPE  -- ^ '$('+    | AnnOpenPTE -- ^ '$$('+    | AnnOpenS   -- ^ '['+    | AnnPackageName+    | AnnPattern+    | AnnProc+    | AnnQualified+    | AnnRarrow -- ^ '->'+    | AnnRarrowU -- ^ '->', unicode variant+    | AnnRec+    | AnnRole+    | AnnSafe+    | AnnSemi -- ^ ';'+    | AnnSimpleQuote -- ^ '''+    | AnnSignature+    | AnnStatic -- ^ 'static'+    | AnnStock+    | AnnThen+    | AnnThIdSplice -- ^ '$'+    | AnnThIdTySplice -- ^ '$$'+    | AnnThTyQuote -- ^ double '''+    | AnnTilde -- ^ '~'+    | AnnType+    | AnnUnit -- ^ '()' for types+    | AnnUsing+    | AnnVal  -- ^ e.g. INTEGER+    | AnnValStr  -- ^ String value, will need quotes when output+    | AnnVbar -- ^ '|'+    | AnnVia -- ^ 'via'+    | AnnWhere+    | Annlarrowtail -- ^ '-<'+    | AnnlarrowtailU -- ^ '-<', unicode variant+    | Annrarrowtail -- ^ '->'+    | AnnrarrowtailU -- ^ '->', unicode variant+    | AnnLarrowtail -- ^ '-<<'+    | AnnLarrowtailU -- ^ '-<<', unicode variant+    | AnnRarrowtail -- ^ '>>-'+    | AnnRarrowtailU -- ^ '>>-', unicode variant+    | AnnEofPos+    deriving (Eq, Ord, Data, Show)++instance Outputable AnnKeywordId where+  ppr x = text (show x)++-- ---------------------------------------------------------------------++data AnnotationComment =+  -- Documentation annotations+    AnnDocCommentNext  String     -- ^ something beginning '-- |'+  | AnnDocCommentPrev  String     -- ^ something beginning '-- ^'+  | AnnDocCommentNamed String     -- ^ something beginning '-- $'+  | AnnDocSection      Int String -- ^ a section heading+  | AnnDocOptions      String     -- ^ doc options (prune, ignore-exports, etc)+  | AnnLineComment     String     -- ^ comment starting by "--"+  | AnnBlockComment    String     -- ^ comment in {- -}+    deriving (Eq, Ord, Data, Show)+-- Note: these are based on the Token versions, but the Token type is+-- defined in Lexer.x and bringing it in here would create a loop++instance Outputable AnnotationComment where+  ppr x = text (show x)++-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',+--             'ApiAnnotation.AnnClose','ApiAnnotation.AnnComma',+--             'ApiAnnotation.AnnRarrow'+--             'ApiAnnotation.AnnTilde'+--   - May have 'ApiAnnotation.AnnComma' when in a list+type LRdrName = Located RdrName+++-- | Certain tokens can have alternate representations when unicode syntax is+-- enabled. This flag is attached to those tokens in the lexer so that the+-- original source representation can be reproduced in the corresponding+-- 'ApiAnnotation'+data IsUnicodeSyntax = UnicodeSyntax | NormalSyntax+    deriving (Eq, Ord, Data, Show)++-- | Convert a normal annotation into its unicode equivalent one+unicodeAnn :: AnnKeywordId -> AnnKeywordId+unicodeAnn AnnForall     = AnnForallU+unicodeAnn AnnDcolon     = AnnDcolonU+unicodeAnn AnnLarrow     = AnnLarrowU+unicodeAnn AnnRarrow     = AnnRarrowU+unicodeAnn AnnDarrow     = AnnDarrowU+unicodeAnn Annlarrowtail = AnnlarrowtailU+unicodeAnn Annrarrowtail = AnnrarrowtailU+unicodeAnn AnnLarrowtail = AnnLarrowtailU+unicodeAnn AnnRarrowtail = AnnRarrowtailU+unicodeAnn AnnOpenB      = AnnOpenBU+unicodeAnn AnnCloseB     = AnnCloseBU+unicodeAnn AnnOpenEQ     = AnnOpenEQU+unicodeAnn AnnCloseQ     = AnnCloseQU+unicodeAnn ann           = ann+++-- | Some template haskell tokens have two variants, one with an `e` the other+-- not:+--+-- >  [| or [e|+-- >  [|| or [e||+--+-- This type indicates whether the 'e' is present or not.+data HasE = HasE | NoE+     deriving (Eq, Ord, Data, Show)
+ compiler/parser/Ctype.hs view
@@ -0,0 +1,215 @@+-- Character classification+{-# LANGUAGE CPP #-}+module Ctype+        ( is_ident      -- Char# -> Bool+        , is_symbol     -- Char# -> Bool+        , is_any        -- Char# -> Bool+        , is_space      -- Char# -> Bool+        , is_lower      -- Char# -> Bool+        , is_upper      -- Char# -> Bool+        , is_digit      -- Char# -> Bool+        , is_alphanum   -- Char# -> Bool++        , is_decdigit, is_hexdigit, is_octdigit, is_bindigit+        , hexDigit, octDecDigit+        ) where++#include "HsVersions.h"++import GhcPrelude++import Data.Bits        ( Bits((.&.),(.|.)) )+import Data.Char        ( ord, chr )+import Data.Word+import Panic++-- Bit masks++cIdent, cSymbol, cAny, cSpace, cLower, cUpper, cDigit :: Word8+cIdent  =  1+cSymbol =  2+cAny    =  4+cSpace  =  8+cLower  = 16+cUpper  = 32+cDigit  = 64++-- | The predicates below look costly, but aren't, GHC+GCC do a great job+-- at the big case below.++{-# INLINABLE is_ctype #-}+is_ctype :: Word8 -> Char -> Bool+is_ctype mask c = (charType c .&. mask) /= 0++is_ident, is_symbol, is_any, is_space, is_lower, is_upper, is_digit,+    is_alphanum :: Char -> Bool+is_ident  = is_ctype cIdent+is_symbol = is_ctype cSymbol+is_any    = is_ctype cAny+is_space  = is_ctype cSpace+is_lower  = is_ctype cLower+is_upper  = is_ctype cUpper+is_digit  = is_ctype cDigit+is_alphanum = is_ctype (cLower+cUpper+cDigit)++-- Utils++hexDigit :: Char -> Int+hexDigit c | is_decdigit c = ord c - ord '0'+           | otherwise     = ord (to_lower c) - ord 'a' + 10++octDecDigit :: Char -> Int+octDecDigit c = ord c - ord '0'++is_decdigit :: Char -> Bool+is_decdigit c+        =  c >= '0' && c <= '9'++is_hexdigit :: Char -> Bool+is_hexdigit c+        =  is_decdigit c+        || (c >= 'a' && c <= 'f')+        || (c >= 'A' && c <= 'F')++is_octdigit :: Char -> Bool+is_octdigit c = c >= '0' && c <= '7'++is_bindigit :: Char -> Bool+is_bindigit c = c == '0' || c == '1'++to_lower :: Char -> Char+to_lower c+  | c >=  'A' && c <= 'Z' = chr (ord c - (ord 'A' - ord 'a'))+  | otherwise = c++charType :: Char -> Word8+charType c = case c of+   '\0'   -> 0                             -- \000+   '\1'   -> 0                             -- \001+   '\2'   -> 0                             -- \002+   '\3'   -> 0                             -- \003+   '\4'   -> 0                             -- \004+   '\5'   -> 0                             -- \005+   '\6'   -> 0                             -- \006+   '\7'   -> 0                             -- \007+   '\8'   -> 0                             -- \010+   '\9'   -> cSpace                        -- \t  (not allowed in strings, so !cAny)+   '\10'  -> cSpace                        -- \n  (ditto)+   '\11'  -> cSpace                        -- \v  (ditto)+   '\12'  -> cSpace                        -- \f  (ditto)+   '\13'  -> cSpace                        --  ^M (ditto)+   '\14'  -> 0                             -- \016+   '\15'  -> 0                             -- \017+   '\16'  -> 0                             -- \020+   '\17'  -> 0                             -- \021+   '\18'  -> 0                             -- \022+   '\19'  -> 0                             -- \023+   '\20'  -> 0                             -- \024+   '\21'  -> 0                             -- \025+   '\22'  -> 0                             -- \026+   '\23'  -> 0                             -- \027+   '\24'  -> 0                             -- \030+   '\25'  -> 0                             -- \031+   '\26'  -> 0                             -- \032+   '\27'  -> 0                             -- \033+   '\28'  -> 0                             -- \034+   '\29'  -> 0                             -- \035+   '\30'  -> 0                             -- \036+   '\31'  -> 0                             -- \037+   '\32'  -> cAny .|. cSpace               --+   '\33'  -> cAny .|. cSymbol              -- !+   '\34'  -> cAny                          -- "+   '\35'  -> cAny .|. cSymbol              --  #+   '\36'  -> cAny .|. cSymbol              --  $+   '\37'  -> cAny .|. cSymbol              -- %+   '\38'  -> cAny .|. cSymbol              -- &+   '\39'  -> cAny .|. cIdent               -- '+   '\40'  -> cAny                          -- (+   '\41'  -> cAny                          -- )+   '\42'  -> cAny .|. cSymbol              --  *+   '\43'  -> cAny .|. cSymbol              -- ++   '\44'  -> cAny                          -- ,+   '\45'  -> cAny .|. cSymbol              -- -+   '\46'  -> cAny .|. cSymbol              -- .+   '\47'  -> cAny .|. cSymbol              --  /+   '\48'  -> cAny .|. cIdent  .|. cDigit   -- 0+   '\49'  -> cAny .|. cIdent  .|. cDigit   -- 1+   '\50'  -> cAny .|. cIdent  .|. cDigit   -- 2+   '\51'  -> cAny .|. cIdent  .|. cDigit   -- 3+   '\52'  -> cAny .|. cIdent  .|. cDigit   -- 4+   '\53'  -> cAny .|. cIdent  .|. cDigit   -- 5+   '\54'  -> cAny .|. cIdent  .|. cDigit   -- 6+   '\55'  -> cAny .|. cIdent  .|. cDigit   -- 7+   '\56'  -> cAny .|. cIdent  .|. cDigit   -- 8+   '\57'  -> cAny .|. cIdent  .|. cDigit   -- 9+   '\58'  -> cAny .|. cSymbol              -- :+   '\59'  -> cAny                          -- ;+   '\60'  -> cAny .|. cSymbol              -- <+   '\61'  -> cAny .|. cSymbol              -- =+   '\62'  -> cAny .|. cSymbol              -- >+   '\63'  -> cAny .|. cSymbol              -- ?+   '\64'  -> cAny .|. cSymbol              -- @+   '\65'  -> cAny .|. cIdent  .|. cUpper   -- A+   '\66'  -> cAny .|. cIdent  .|. cUpper   -- B+   '\67'  -> cAny .|. cIdent  .|. cUpper   -- C+   '\68'  -> cAny .|. cIdent  .|. cUpper   -- D+   '\69'  -> cAny .|. cIdent  .|. cUpper   -- E+   '\70'  -> cAny .|. cIdent  .|. cUpper   -- F+   '\71'  -> cAny .|. cIdent  .|. cUpper   -- G+   '\72'  -> cAny .|. cIdent  .|. cUpper   -- H+   '\73'  -> cAny .|. cIdent  .|. cUpper   -- I+   '\74'  -> cAny .|. cIdent  .|. cUpper   -- J+   '\75'  -> cAny .|. cIdent  .|. cUpper   -- K+   '\76'  -> cAny .|. cIdent  .|. cUpper   -- L+   '\77'  -> cAny .|. cIdent  .|. cUpper   -- M+   '\78'  -> cAny .|. cIdent  .|. cUpper   -- N+   '\79'  -> cAny .|. cIdent  .|. cUpper   -- O+   '\80'  -> cAny .|. cIdent  .|. cUpper   -- P+   '\81'  -> cAny .|. cIdent  .|. cUpper   -- Q+   '\82'  -> cAny .|. cIdent  .|. cUpper   -- R+   '\83'  -> cAny .|. cIdent  .|. cUpper   -- S+   '\84'  -> cAny .|. cIdent  .|. cUpper   -- T+   '\85'  -> cAny .|. cIdent  .|. cUpper   -- U+   '\86'  -> cAny .|. cIdent  .|. cUpper   -- V+   '\87'  -> cAny .|. cIdent  .|. cUpper   -- W+   '\88'  -> cAny .|. cIdent  .|. cUpper   -- X+   '\89'  -> cAny .|. cIdent  .|. cUpper   -- Y+   '\90'  -> cAny .|. cIdent  .|. cUpper   -- Z+   '\91'  -> cAny                          -- [+   '\92'  -> cAny .|. cSymbol              -- backslash+   '\93'  -> cAny                          -- ]+   '\94'  -> cAny .|. cSymbol              --  ^+   '\95'  -> cAny .|. cIdent  .|. cLower   -- _+   '\96'  -> cAny                          -- `+   '\97'  -> cAny .|. cIdent  .|. cLower   -- a+   '\98'  -> cAny .|. cIdent  .|. cLower   -- b+   '\99'  -> cAny .|. cIdent  .|. cLower   -- c+   '\100' -> cAny .|. cIdent  .|. cLower   -- d+   '\101' -> cAny .|. cIdent  .|. cLower   -- e+   '\102' -> cAny .|. cIdent  .|. cLower   -- f+   '\103' -> cAny .|. cIdent  .|. cLower   -- g+   '\104' -> cAny .|. cIdent  .|. cLower   -- h+   '\105' -> cAny .|. cIdent  .|. cLower   -- i+   '\106' -> cAny .|. cIdent  .|. cLower   -- j+   '\107' -> cAny .|. cIdent  .|. cLower   -- k+   '\108' -> cAny .|. cIdent  .|. cLower   -- l+   '\109' -> cAny .|. cIdent  .|. cLower   -- m+   '\110' -> cAny .|. cIdent  .|. cLower   -- n+   '\111' -> cAny .|. cIdent  .|. cLower   -- o+   '\112' -> cAny .|. cIdent  .|. cLower   -- p+   '\113' -> cAny .|. cIdent  .|. cLower   -- q+   '\114' -> cAny .|. cIdent  .|. cLower   -- r+   '\115' -> cAny .|. cIdent  .|. cLower   -- s+   '\116' -> cAny .|. cIdent  .|. cLower   -- t+   '\117' -> cAny .|. cIdent  .|. cLower   -- u+   '\118' -> cAny .|. cIdent  .|. cLower   -- v+   '\119' -> cAny .|. cIdent  .|. cLower   -- w+   '\120' -> cAny .|. cIdent  .|. cLower   -- x+   '\121' -> cAny .|. cIdent  .|. cLower   -- y+   '\122' -> cAny .|. cIdent  .|. cLower   -- z+   '\123' -> cAny                          -- {+   '\124' -> cAny .|. cSymbol              --  |+   '\125' -> cAny                          -- }+   '\126' -> cAny .|. cSymbol              -- ~+   '\127' -> 0                             -- \177+   _ -> panic ("charType: " ++ show c)
+ compiler/parser/HaddockUtils.hs view
@@ -0,0 +1,34 @@++module HaddockUtils where++import GhcPrelude++import HsSyn+import SrcLoc++import Control.Monad++-- -----------------------------------------------------------------------------+-- Adding documentation to record fields (used in parsing).++addFieldDoc :: LConDeclField a -> Maybe LHsDocString -> LConDeclField a+addFieldDoc (L l fld) doc+  = L l (fld { cd_fld_doc = cd_fld_doc fld `mplus` doc })++addFieldDocs :: [LConDeclField a] -> Maybe LHsDocString -> [LConDeclField a]+addFieldDocs [] _ = []+addFieldDocs (x:xs) doc = addFieldDoc x doc : xs+++addConDoc :: LConDecl a -> Maybe LHsDocString -> LConDecl a+addConDoc decl    Nothing = decl+addConDoc (L p c) doc     = L p ( c { con_doc = con_doc c `mplus` doc } )++addConDocs :: [LConDecl a] -> Maybe LHsDocString -> [LConDecl a]+addConDocs [] _ = []+addConDocs [x] doc = [addConDoc x doc]+addConDocs (x:xs) doc = x : addConDocs xs doc++addConDocFirst :: [LConDecl a] -> Maybe LHsDocString -> [LConDecl a]+addConDocFirst [] _ = []+addConDocFirst (x:xs) doc = addConDoc x doc : xs
+ compiler/parser/RdrHsSyn.hs view
@@ -0,0 +1,2764 @@+--+--  (c) The University of Glasgow 2002-2006+--++-- Functions over HsSyn specialised to RdrName.++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++module   RdrHsSyn (+        mkHsOpApp,+        mkHsIntegral, mkHsFractional, mkHsIsString,+        mkHsDo, mkSpliceDecl,+        mkRoleAnnotDecl,+        mkClassDecl,+        mkTyData, mkDataFamInst,+        mkTySynonym, mkTyFamInstEqn,+        mkTyFamInst,+        mkFamDecl, mkLHsSigType,+        mkInlinePragma,+        mkPatSynMatchGroup,+        mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp+        mkTyClD, mkInstD,+        mkRdrRecordCon, mkRdrRecordUpd,+        setRdrNameSpace,+        filterCTuple,++        cvBindGroup,+        cvBindsAndSigs,+        cvTopDecls,+        placeHolderPunRhs,++        -- Stuff to do with Foreign declarations+        mkImport,+        parseCImport,+        mkExport,+        mkExtName,    -- RdrName -> CLabelString+        mkGadtDecl,   -- [Located RdrName] -> LHsType RdrName -> ConDecl RdrName+        mkConDeclH98,+        mkATDefault,++        -- Bunch of functions in the parser monad for+        -- checking and constructing values+        checkBlockArguments,+        checkPrecP,           -- Int -> P Int+        checkContext,         -- HsType -> P HsContext+        checkPattern,         -- HsExp -> P HsPat+        bang_RDR,+        isBangRdr,+        isTildeRdr,+        checkPatterns,        -- SrcLoc -> [HsExp] -> P [HsPat]+        checkMonadComp,       -- P (HsStmtContext RdrName)+        checkValDef,          -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl+        checkValSigLhs,+        checkDoAndIfThenElse,+        LRuleTyTmVar, RuleTyTmVar(..),+        mkRuleBndrs, mkRuleTyVarBndrs,+        checkRuleTyVarBndrNames,+        checkRecordSyntax,+        checkEmptyGADTs,+        addFatalError, hintBangPat,+        TyEl(..), mergeOps, mergeDataCon,++        -- Help with processing exports+        ImpExpSubSpec(..),+        ImpExpQcSpec(..),+        mkModuleImpExp,+        mkTypeImpExp,+        mkImpExpSubSpec,+        checkImportSpec,++        -- Token symbols+        forallSym,+        starSym,++        -- Warnings and errors+        warnStarIsType,+        failOpFewArgs,++        SumOrTuple (..), mkSumOrTuple,++        -- Expression/command ambiguity resolution+        PV,+        ExpCmdP(ExpCmdP, runExpCmdP),+        ExpCmdI(..),+        ecFromExp,+        ecFromCmd,+        ecHsLam,+        ecHsLet,+        ecOpApp,+        ecHsCase,+        ecHsApp,+        ecHsIf,+        ecHsDo,+        ecHsPar,++    ) where++import GhcPrelude+import HsSyn            -- Lots of it+import TyCon            ( TyCon, isTupleTyCon, tyConSingleDataCon_maybe )+import DataCon          ( DataCon, dataConTyCon )+import ConLike          ( ConLike(..) )+import CoAxiom          ( Role, fsFromRole )+import RdrName+import Name+import BasicTypes+import TcEvidence       ( idHsWrapper )+import Lexer+import Lexeme           ( isLexCon )+import Type             ( TyThing(..), funTyCon )+import TysWiredIn       ( cTupleTyConName, tupleTyCon, tupleDataCon,+                          nilDataConName, nilDataConKey,+                          listTyConName, listTyConKey, eqTyCon_RDR,+                          tupleTyConName, cTupleTyConNameArity_maybe )+import ForeignCall+import PrelNames        ( allNameStrings )+import SrcLoc+import Unique           ( hasKey )+import OrdList          ( OrdList, fromOL )+import Bag              ( emptyBag, consBag )+import Outputable+import FastString+import Maybes+import Util+import ApiAnnotation+import Data.List+import DynFlags ( WarningFlag(..) )++import Control.Monad+import Text.ParserCombinators.ReadP as ReadP+import Data.Char+import qualified Data.Monoid as Monoid+import Data.Data       ( dataTypeOf, fromConstr, dataTypeConstrs )++#include "HsVersions.h"+++{- **********************************************************************++  Construction functions for Rdr stuff++  ********************************************************************* -}++-- | mkClassDecl builds a RdrClassDecl, filling in the names for tycon and+-- datacon by deriving them from the name of the class.  We fill in the names+-- for the tycon and datacon corresponding to the class, by deriving them+-- from the name of the class itself.  This saves recording the names in the+-- interface file (which would be equally good).++-- Similarly for mkConDecl, mkClassOpSig and default-method names.++--         *** See Note [The Naming story] in HsDecls ****++mkTyClD :: LTyClDecl (GhcPass p) -> LHsDecl (GhcPass p)+mkTyClD (dL->L loc d) = cL loc (TyClD noExt d)++mkInstD :: LInstDecl (GhcPass p) -> LHsDecl (GhcPass p)+mkInstD (dL->L loc d) = cL loc (InstD noExt d)++mkClassDecl :: SrcSpan+            -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)+            -> Located (a,[LHsFunDep GhcPs])+            -> OrdList (LHsDecl GhcPs)+            -> P (LTyClDecl GhcPs)++mkClassDecl loc (dL->L _ (mcxt, tycl_hdr)) fds where_cls+  = do { (binds, sigs, ats, at_insts, _, docs) <- cvBindsAndSigs where_cls+       ; let cxt = fromMaybe (noLoc []) mcxt+       ; (cls, tparams, fixity, ann) <- checkTyClHdr True tycl_hdr+       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan+       ; (tyvars,annst) <- checkTyVarsP (text "class") whereDots cls tparams+       ; addAnnsAt loc annst -- Add any API Annotations to the top SrcSpan+       ; (at_defs, annsi) <- mapAndUnzipM (eitherToP . mkATDefault) at_insts+       ; sequence_ annsi+       ; return (cL loc (ClassDecl { tcdCExt = noExt, tcdCtxt = cxt+                                   , tcdLName = cls, tcdTyVars = tyvars+                                   , tcdFixity = fixity+                                   , tcdFDs = snd (unLoc fds)+                                   , tcdSigs = mkClassOpSigs sigs+                                   , tcdMeths = binds+                                   , tcdATs = ats, tcdATDefs = at_defs+                                   , tcdDocs  = docs })) }++mkATDefault :: LTyFamInstDecl GhcPs+            -> Either (SrcSpan, SDoc) (LTyFamDefltEqn GhcPs, P ())+-- ^ Take a type-family instance declaration and turn it into+-- a type-family default equation for a class declaration.+-- We parse things as the former and use this function to convert to the latter+--+-- We use the Either monad because this also called from "Convert".+--+-- The @P ()@ we return corresponds represents an action which will add+-- some necessary paren annotations to the parsing context. Naturally, this+-- is not something that the "Convert" use cares about.+mkATDefault (dL->L loc (TyFamInstDecl { tfid_eqn = HsIB { hsib_body = e }}))+      | FamEqn { feqn_tycon = tc, feqn_bndrs = bndrs, feqn_pats = pats+               , feqn_fixity = fixity, feqn_rhs = rhs } <- e+      = do { (tvs, anns) <- checkTyVars (text "default") equalsDots tc pats+           ; let f = cL loc (FamEqn { feqn_ext    = noExt+                                    , feqn_tycon  = tc+                                    , feqn_bndrs  = ASSERT( isNothing bndrs )+                                                    Nothing+                                    , feqn_pats   = tvs+                                    , feqn_fixity = fixity+                                    , feqn_rhs    = rhs })+           ; pure (f, addAnnsAt loc anns) }+mkATDefault (dL->L _ (TyFamInstDecl (HsIB _ (XFamEqn _)))) = panic "mkATDefault"+mkATDefault (dL->L _ (TyFamInstDecl (XHsImplicitBndrs _))) = panic "mkATDefault"+mkATDefault _ = panic "mkATDefault: Impossible Match"+                                -- due to #15884++mkTyData :: SrcSpan+         -> NewOrData+         -> Maybe (Located CType)+         -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)+         -> Maybe (LHsKind GhcPs)+         -> [LConDecl GhcPs]+         -> HsDeriving GhcPs+         -> P (LTyClDecl GhcPs)+mkTyData loc new_or_data cType (dL->L _ (mcxt, tycl_hdr))+         ksig data_cons maybe_deriv+  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr+       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan+       ; (tyvars, anns) <- checkTyVarsP (ppr new_or_data) equalsDots tc tparams+       ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan+       ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv+       ; return (cL loc (DataDecl { tcdDExt = noExt,+                                    tcdLName = tc, tcdTyVars = tyvars,+                                    tcdFixity = fixity,+                                    tcdDataDefn = defn })) }++mkDataDefn :: NewOrData+           -> Maybe (Located CType)+           -> Maybe (LHsContext GhcPs)+           -> Maybe (LHsKind GhcPs)+           -> [LConDecl GhcPs]+           -> HsDeriving GhcPs+           -> P (HsDataDefn GhcPs)+mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv+  = do { checkDatatypeContext mcxt+       ; let cxt = fromMaybe (noLoc []) mcxt+       ; return (HsDataDefn { dd_ext = noExt+                            , dd_ND = new_or_data, dd_cType = cType+                            , dd_ctxt = cxt+                            , dd_cons = data_cons+                            , dd_kindSig = ksig+                            , dd_derivs = maybe_deriv }) }+++mkTySynonym :: SrcSpan+            -> LHsType GhcPs  -- LHS+            -> LHsType GhcPs  -- RHS+            -> P (LTyClDecl GhcPs)+mkTySynonym loc lhs rhs+  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs+       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan+       ; (tyvars, anns) <- checkTyVarsP (text "type") equalsDots tc tparams+       ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan+       ; return (cL loc (SynDecl { tcdSExt = noExt+                                 , tcdLName = tc, tcdTyVars = tyvars+                                 , tcdFixity = fixity+                                 , tcdRhs = rhs })) }++mkTyFamInstEqn :: Maybe [LHsTyVarBndr GhcPs]+               -> LHsType GhcPs+               -> LHsType GhcPs+               -> P (TyFamInstEqn GhcPs,[AddAnn])+mkTyFamInstEqn bndrs lhs rhs+  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs+       ; return (mkHsImplicitBndrs+                  (FamEqn { feqn_ext    = noExt+                          , feqn_tycon  = tc+                          , feqn_bndrs  = bndrs+                          , feqn_pats   = tparams+                          , feqn_fixity = fixity+                          , feqn_rhs    = rhs }),+                 ann) }++mkDataFamInst :: SrcSpan+              -> NewOrData+              -> Maybe (Located CType)+              -> (Maybe ( LHsContext GhcPs), Maybe [LHsTyVarBndr GhcPs]+                        , LHsType GhcPs)+              -> Maybe (LHsKind GhcPs)+              -> [LConDecl GhcPs]+              -> HsDeriving GhcPs+              -> P (LInstDecl GhcPs)+mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr)+              ksig data_cons maybe_deriv+  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr+       ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan+       ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv+       ; return (cL loc (DataFamInstD noExt (DataFamInstDecl (mkHsImplicitBndrs+                  (FamEqn { feqn_ext    = noExt+                          , feqn_tycon  = tc+                          , feqn_bndrs  = bndrs+                          , feqn_pats   = tparams+                          , feqn_fixity = fixity+                          , feqn_rhs    = defn }))))) }++mkTyFamInst :: SrcSpan+            -> TyFamInstEqn GhcPs+            -> P (LInstDecl GhcPs)+mkTyFamInst loc eqn+  = return (cL loc (TyFamInstD noExt (TyFamInstDecl eqn)))++mkFamDecl :: SrcSpan+          -> FamilyInfo GhcPs+          -> LHsType GhcPs                   -- LHS+          -> Located (FamilyResultSig GhcPs) -- Optional result signature+          -> Maybe (LInjectivityAnn GhcPs)   -- Injectivity annotation+          -> P (LTyClDecl GhcPs)+mkFamDecl loc info lhs ksig injAnn+  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs+       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan+       ; (tyvars, anns) <- checkTyVarsP (ppr info) equals_or_where tc tparams+       ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan+       ; return (cL loc (FamDecl noExt (FamilyDecl+                                           { fdExt       = noExt+                                           , fdInfo      = info, fdLName = tc+                                           , fdTyVars    = tyvars+                                           , fdFixity    = fixity+                                           , fdResultSig = ksig+                                           , fdInjectivityAnn = injAnn }))) }+  where+    equals_or_where = case info of+                        DataFamily          -> empty+                        OpenTypeFamily      -> empty+                        ClosedTypeFamily {} -> whereDots++mkSpliceDecl :: LHsExpr GhcPs -> HsDecl GhcPs+-- If the user wrote+--      [pads| ... ]   then return a QuasiQuoteD+--      $(e)           then return a SpliceD+-- but if she wrote, say,+--      f x            then behave as if she'd written $(f x)+--                     ie a SpliceD+--+-- Typed splices are not allowed at the top level, thus we do not represent them+-- as spliced declaration.  See #10945+mkSpliceDecl lexpr@(dL->L loc expr)+  | HsSpliceE _ splice@(HsUntypedSplice {}) <- expr+  = SpliceD noExt (SpliceDecl noExt (cL loc splice) ExplicitSplice)++  | HsSpliceE _ splice@(HsQuasiQuote {}) <- expr+  = SpliceD noExt (SpliceDecl noExt (cL loc splice) ExplicitSplice)++  | otherwise+  = SpliceD noExt (SpliceDecl noExt (cL loc (mkUntypedSplice NoParens lexpr))+                              ImplicitSplice)++mkRoleAnnotDecl :: SrcSpan+                -> Located RdrName                -- type being annotated+                -> [Located (Maybe FastString)]      -- roles+                -> P (LRoleAnnotDecl GhcPs)+mkRoleAnnotDecl loc tycon roles+  = do { roles' <- mapM parse_role roles+       ; return $ cL loc $ RoleAnnotDecl noExt tycon roles' }+  where+    role_data_type = dataTypeOf (undefined :: Role)+    all_roles = map fromConstr $ dataTypeConstrs role_data_type+    possible_roles = [(fsFromRole role, role) | role <- all_roles]++    parse_role (dL->L loc_role Nothing) = return $ cL loc_role Nothing+    parse_role (dL->L loc_role (Just role))+      = case lookup role possible_roles of+          Just found_role -> return $ cL loc_role $ Just found_role+          Nothing         ->+            let nearby = fuzzyLookup (unpackFS role)+                  (mapFst unpackFS possible_roles)+            in+            addFatalError loc_role+              (text "Illegal role name" <+> quotes (ppr role) $$+               suggestions nearby)+    parse_role _ = panic "parse_role: Impossible Match"+                                -- due to #15884++    suggestions []   = empty+    suggestions [r]  = text "Perhaps you meant" <+> quotes (ppr r)+      -- will this last case ever happen??+    suggestions list = hang (text "Perhaps you meant one of these:")+                       2 (pprWithCommas (quotes . ppr) list)++{- **********************************************************************++  #cvBinds-etc# Converting to @HsBinds@, etc.++  ********************************************************************* -}++-- | Function definitions are restructured here. Each is assumed to be recursive+-- initially, and non recursive definitions are discovered by the dependency+-- analyser.+++--  | Groups together bindings for a single function+cvTopDecls :: OrdList (LHsDecl GhcPs) -> [LHsDecl GhcPs]+cvTopDecls decls = go (fromOL decls)+  where+    go :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]+    go []                     = []+    go ((dL->L l (ValD x b)) : ds)+      = cL l' (ValD x b') : go ds'+        where (dL->L l' b', ds') = getMonoBind (cL l b) ds+    go (d : ds)                    = d : go ds++-- Declaration list may only contain value bindings and signatures.+cvBindGroup :: OrdList (LHsDecl GhcPs) -> P (HsValBinds GhcPs)+cvBindGroup binding+  = do { (mbs, sigs, fam_ds, tfam_insts+         , dfam_insts, _) <- cvBindsAndSigs binding+       ; ASSERT( null fam_ds && null tfam_insts && null dfam_insts)+         return $ ValBinds noExt mbs sigs }++cvBindsAndSigs :: OrdList (LHsDecl GhcPs)+  -> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs]+          , [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl])+-- Input decls contain just value bindings and signatures+-- and in case of class or instance declarations also+-- associated type declarations. They might also contain Haddock comments.+cvBindsAndSigs fb = go (fromOL fb)+  where+    go []              = return (emptyBag, [], [], [], [], [])+    go ((dL->L l (ValD _ b)) : ds)+      = do { (bs, ss, ts, tfis, dfis, docs) <- go ds'+           ; return (b' `consBag` bs, ss, ts, tfis, dfis, docs) }+      where+        (b', ds') = getMonoBind (cL l b) ds+    go ((dL->L l decl) : ds)+      = do { (bs, ss, ts, tfis, dfis, docs) <- go ds+           ; case decl of+               SigD _ s+                 -> return (bs, cL l s : ss, ts, tfis, dfis, docs)+               TyClD _ (FamDecl _ t)+                 -> return (bs, ss, cL l t : ts, tfis, dfis, docs)+               InstD _ (TyFamInstD { tfid_inst = tfi })+                 -> return (bs, ss, ts, cL l tfi : tfis, dfis, docs)+               InstD _ (DataFamInstD { dfid_inst = dfi })+                 -> return (bs, ss, ts, tfis, cL l dfi : dfis, docs)+               DocD _ d+                 -> return (bs, ss, ts, tfis, dfis, cL l d : docs)+               SpliceD _ d+                 -> addFatalError l $+                    hang (text "Declaration splices are allowed only" <+>+                          text "at the top level:")+                       2 (ppr d)+               _ -> pprPanic "cvBindsAndSigs" (ppr decl) }++-----------------------------------------------------------------------------+-- Group function bindings into equation groups++getMonoBind :: LHsBind GhcPs -> [LHsDecl GhcPs]+  -> (LHsBind GhcPs, [LHsDecl GhcPs])+-- Suppose      (b',ds') = getMonoBind b ds+--      ds is a list of parsed bindings+--      b is a MonoBinds that has just been read off the front++-- Then b' is the result of grouping more equations from ds that+-- belong with b into a single MonoBinds, and ds' is the depleted+-- list of parsed bindings.+--+-- All Haddock comments between equations inside the group are+-- discarded.+--+-- No AndMonoBinds or EmptyMonoBinds here; just single equations++getMonoBind (dL->L loc1 (FunBind { fun_id = fun_id1@(dL->L _ f1)+                                 , fun_matches =+                                   MG { mg_alts = (dL->L _ mtchs1) } }))+            binds+  | has_args mtchs1+  = go mtchs1 loc1 binds []+  where+    go mtchs loc+       ((dL->L loc2 (ValD _ (FunBind { fun_id = (dL->L _ f2)+                                    , fun_matches =+                                        MG { mg_alts = (dL->L _ mtchs2) } })))+         : binds) _+        | f1 == f2 = go (mtchs2 ++ mtchs)+                        (combineSrcSpans loc loc2) binds []+    go mtchs loc (doc_decl@(dL->L loc2 (DocD {})) : binds) doc_decls+        = let doc_decls' = doc_decl : doc_decls+          in go mtchs (combineSrcSpans loc loc2) binds doc_decls'+    go mtchs loc binds doc_decls+        = ( cL loc (makeFunBind fun_id1 (reverse mtchs))+          , (reverse doc_decls) ++ binds)+        -- Reverse the final matches, to get it back in the right order+        -- Do the same thing with the trailing doc comments++getMonoBind bind binds = (bind, binds)++has_args :: [LMatch GhcPs (LHsExpr GhcPs)] -> Bool+has_args []                                    = panic "RdrHsSyn:has_args"+has_args ((dL->L _ (Match { m_pats = args })) : _) = not (null args)+        -- Don't group together FunBinds if they have+        -- no arguments.  This is necessary now that variable bindings+        -- with no arguments are now treated as FunBinds rather+        -- than pattern bindings (tests/rename/should_fail/rnfail002).+has_args ((dL->L _ (XMatch _)) : _) = panic "has_args"+has_args (_ : _) = panic "has_args:Impossible Match" -- due to #15884++{- **********************************************************************++  #PrefixToHS-utils# Utilities for conversion++  ********************************************************************* -}++{- Note [Parsing data constructors is hard]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++The problem with parsing data constructors is that they look a lot like types.+Compare:++  (s1)   data T = C t1 t2+  (s2)   type T = C t1 t2++Syntactically, there's little difference between these declarations, except in+(s1) 'C' is a data constructor, but in (s2) 'C' is a type constructor.++This similarity would pose no problem if we knew ahead of time if we are+parsing a type or a constructor declaration. Looking at (s1) and (s2), a simple+(but wrong!) rule comes to mind: in 'data' declarations assume we are parsing+data constructors, and in other contexts (e.g. 'type' declarations) assume we+are parsing type constructors.++This simple rule does not work because of two problematic cases:++  (p1)   data T = C t1 t2 :+ t3+  (p2)   data T = C t1 t2 => t3++In (p1) we encounter (:+) and it turns out we are parsing an infix data+declaration, so (C t1 t2) is a type and 'C' is a type constructor.+In (p2) we encounter (=>) and it turns out we are parsing an existential+context, so (C t1 t2) is a constraint and 'C' is a type constructor.++As the result, in order to determine whether (C t1 t2) declares a data+constructor, a type, or a context, we would need unlimited lookahead which+'happy' is not so happy with.++To further complicate matters, the interpretation of (!) and (~) is different+in constructors and types:++  (b1)   type T = C ! D+  (b2)   data T = C ! D+  (b3)   data T = C ! D => E++In (b1) and (b3), (!) is a type operator with two arguments: 'C' and 'D'. At+the same time, in (b2) it is a strictness annotation: 'C' is a data constructor+with a single strict argument 'D'. For the programmer, these cases are usually+easy to tell apart due to whitespace conventions:++  (b2)   data T = C !D         -- no space after the bang hints that+                               -- it is a strictness annotation++For the parser, on the other hand, this whitespace does not matter. We cannot+tell apart (b2) from (b3) until we encounter (=>), so it requires unlimited+lookahead.++The solution that accounts for all of these issues is to initially parse data+declarations and types as a reversed list of TyEl:++  data TyEl = TyElOpr RdrName+            | TyElOpd (HsType GhcPs)+            | TyElBang | TyElTilde+            | ...++For example, both occurences of (C ! D) in the following example are parsed+into equal lists of TyEl:++  data T = C ! D => C ! D   results in   [ TyElOpd (HsTyVar "D")+                                         , TyElBang+                                         , TyElOpd (HsTyVar "C") ]++Note that elements are in reverse order. Also, 'C' is parsed as a type+constructor (HsTyVar) even when it is a data constructor. We fix this in+`tyConToDataCon`.++By the time the list of TyEl is assembled, we have looked ahead enough to+decide whether to reduce using `mergeOps` (for types) or `mergeDataCon` (for+data constructors). These functions are where the actual job of parsing is+done.++-}++-- | Reinterpret a type constructor, including type operators, as a data+--   constructor.+-- See Note [Parsing data constructors is hard]+tyConToDataCon :: SrcSpan -> RdrName -> Either (SrcSpan, SDoc) (Located RdrName)+tyConToDataCon loc tc+  | isTcOcc occ || isDataOcc occ+  , isLexCon (occNameFS occ)+  = return (cL loc (setRdrNameSpace tc srcDataName))++  | otherwise+  = Left (loc, msg)+  where+    occ = rdrNameOcc tc+    msg = text "Not a data constructor:" <+> quotes (ppr tc)++mkPatSynMatchGroup :: Located RdrName+                   -> Located (OrdList (LHsDecl GhcPs))+                   -> P (MatchGroup GhcPs (LHsExpr GhcPs))+mkPatSynMatchGroup (dL->L loc patsyn_name) (dL->L _ decls) =+    do { matches <- mapM fromDecl (fromOL decls)+       ; when (null matches) (wrongNumberErr loc)+       ; return $ mkMatchGroup FromSource matches }+  where+    fromDecl (dL->L loc decl@(ValD _ (PatBind _+                             pat@(dL->L _ (ConPatIn ln@(dL->L _ name) details))+                                   rhs _))) =+        do { unless (name == patsyn_name) $+               wrongNameBindingErr loc decl+           ; match <- case details of+               PrefixCon pats -> return $ Match { m_ext = noExt+                                                , m_ctxt = ctxt, m_pats = pats+                                                , m_grhss = rhs }+                   where+                     ctxt = FunRhs { mc_fun = ln+                                   , mc_fixity = Prefix+                                   , mc_strictness = NoSrcStrict }++               InfixCon p1 p2 -> return $ Match { m_ext = noExt+                                                , m_ctxt = ctxt+                                                , m_pats = [p1, p2]+                                                , m_grhss = rhs }+                   where+                     ctxt = FunRhs { mc_fun = ln+                                   , mc_fixity = Infix+                                   , mc_strictness = NoSrcStrict }++               RecCon{} -> recordPatSynErr loc pat+           ; return $ cL loc match }+    fromDecl (dL->L loc decl) = extraDeclErr loc decl++    extraDeclErr loc decl =+        addFatalError loc $+        text "pattern synonym 'where' clause must contain a single binding:" $$+        ppr decl++    wrongNameBindingErr loc decl =+      addFatalError loc $+      text "pattern synonym 'where' clause must bind the pattern synonym's name"+      <+> quotes (ppr patsyn_name) $$ ppr decl++    wrongNumberErr loc =+      addFatalError loc $+      text "pattern synonym 'where' clause cannot be empty" $$+      text "In the pattern synonym declaration for: " <+> ppr (patsyn_name)++recordPatSynErr :: SrcSpan -> LPat GhcPs -> P a+recordPatSynErr loc pat =+    addFatalError loc $+    text "record syntax not supported for pattern synonym declarations:" $$+    ppr pat++mkConDeclH98 :: Located RdrName -> Maybe [LHsTyVarBndr GhcPs]+                -> Maybe (LHsContext GhcPs) -> HsConDeclDetails GhcPs+                -> ConDecl GhcPs++mkConDeclH98 name mb_forall mb_cxt args+  = ConDeclH98 { con_ext    = noExt+               , con_name   = name+               , con_forall = noLoc $ isJust mb_forall+               , con_ex_tvs = mb_forall `orElse` []+               , con_mb_cxt = mb_cxt+               , con_args   = args'+               , con_doc    = Nothing }+  where+    args' = nudgeHsSrcBangs args++mkGadtDecl :: [Located RdrName]+           -> LHsType GhcPs     -- Always a HsForAllTy+           -> (ConDecl GhcPs, [AddAnn])+mkGadtDecl names ty+  = (ConDeclGADT { con_g_ext  = noExt+                 , con_names  = names+                 , con_forall = cL l $ isLHsForAllTy ty'+                 , con_qvars  = mkHsQTvs tvs+                 , con_mb_cxt = mcxt+                 , con_args   = args'+                 , con_res_ty = res_ty+                 , con_doc    = Nothing }+    , anns1 ++ anns2)+  where+    (ty'@(dL->L l _),anns1) = peel_parens ty []+    (tvs, rho) = splitLHsForAllTyInvis ty'+    (mcxt, tau, anns2) = split_rho rho []++    split_rho (dL->L _ (HsQualTy { hst_ctxt = cxt, hst_body = tau })) ann+      = (Just cxt, tau, ann)+    split_rho (dL->L l (HsParTy _ ty)) ann+      = split_rho ty (ann++mkParensApiAnn l)+    split_rho tau                  ann+      = (Nothing, tau, ann)++    (args, res_ty) = split_tau tau+    args' = nudgeHsSrcBangs args++    -- See Note [GADT abstract syntax] in HsDecls+    split_tau (dL->L _ (HsFunTy _ (dL->L loc (HsRecTy _ rf)) res_ty))+      = (RecCon (cL loc rf), res_ty)+    split_tau tau+      = (PrefixCon [], tau)++    peel_parens (dL->L l (HsParTy _ ty)) ann = peel_parens ty+                                                       (ann++mkParensApiAnn l)+    peel_parens ty                   ann = (ty, ann)++nudgeHsSrcBangs :: HsConDeclDetails GhcPs -> HsConDeclDetails GhcPs+-- ^ This function ensures that fields with strictness or packedness+-- annotations put these annotations on an outer 'HsBangTy'.+--+-- The problem is that in the parser, strictness and packedness annotations+-- bind more tightly that docstrings. However, the expectation downstream of+-- the parser (by functions such as 'getBangType' and 'getBangStrictness')+-- is that docstrings bind more tightly so that 'HsBangTy' may end up as the+-- top-level type.+--+-- See #15206+nudgeHsSrcBangs details+  = case details of+      PrefixCon as -> PrefixCon (map go as)+      RecCon r -> RecCon r+      InfixCon a1 a2 -> InfixCon (go a1) (go a2)+  where+    go (dL->L l (HsDocTy _ (dL->L _ (HsBangTy _ s lty)) lds)) =+      cL l (HsBangTy noExt s (addCLoc lty lds (HsDocTy noExt lty lds)))+    go lty = lty+++setRdrNameSpace :: RdrName -> NameSpace -> RdrName+-- ^ This rather gruesome function is used mainly by the parser.+-- When parsing:+--+-- > data T a = T | T1 Int+--+-- we parse the data constructors as /types/ because of parser ambiguities,+-- so then we need to change the /type constr/ to a /data constr/+--+-- The exact-name case /can/ occur when parsing:+--+-- > data [] a = [] | a : [a]+--+-- For the exact-name case we return an original name.+setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)+setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)+setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)+setRdrNameSpace (Exact n)    ns+  | Just thing <- wiredInNameTyThing_maybe n+  = setWiredInNameSpace thing ns+    -- Preserve Exact Names for wired-in things,+    -- notably tuples and lists++  | isExternalName n+  = Orig (nameModule n) occ++  | otherwise   -- This can happen when quoting and then+                -- splicing a fixity declaration for a type+  = Exact (mkSystemNameAt (nameUnique n) occ (nameSrcSpan n))+  where+    occ = setOccNameSpace ns (nameOccName n)++setWiredInNameSpace :: TyThing -> NameSpace -> RdrName+setWiredInNameSpace (ATyCon tc) ns+  | isDataConNameSpace ns+  = ty_con_data_con tc+  | isTcClsNameSpace ns+  = Exact (getName tc)      -- No-op++setWiredInNameSpace (AConLike (RealDataCon dc)) ns+  | isTcClsNameSpace ns+  = data_con_ty_con dc+  | isDataConNameSpace ns+  = Exact (getName dc)      -- No-op++setWiredInNameSpace thing ns+  = pprPanic "setWiredinNameSpace" (pprNameSpace ns <+> ppr thing)++ty_con_data_con :: TyCon -> RdrName+ty_con_data_con tc+  | isTupleTyCon tc+  , Just dc <- tyConSingleDataCon_maybe tc+  = Exact (getName dc)++  | tc `hasKey` listTyConKey+  = Exact nilDataConName++  | otherwise  -- See Note [setRdrNameSpace for wired-in names]+  = Unqual (setOccNameSpace srcDataName (getOccName tc))++data_con_ty_con :: DataCon -> RdrName+data_con_ty_con dc+  | let tc = dataConTyCon dc+  , isTupleTyCon tc+  = Exact (getName tc)++  | dc `hasKey` nilDataConKey+  = Exact listTyConName++  | otherwise  -- See Note [setRdrNameSpace for wired-in names]+  = Unqual (setOccNameSpace tcClsName (getOccName dc))++-- | Replaces constraint tuple names with corresponding boxed ones.+filterCTuple :: RdrName -> RdrName+filterCTuple (Exact n)+  | Just arity <- cTupleTyConNameArity_maybe n+  = Exact $ tupleTyConName BoxedTuple arity+filterCTuple rdr = rdr+++{- Note [setRdrNameSpace for wired-in names]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In GHC.Types, which declares (:), we have+  infixr 5 :+The ambiguity about which ":" is meant is resolved by parsing it as a+data constructor, but then using dataTcOccs to try the type constructor too;+and that in turn calls setRdrNameSpace to change the name-space of ":" to+tcClsName.  There isn't a corresponding ":" type constructor, but it's painful+to make setRdrNameSpace partial, so we just make an Unqual name instead. It+really doesn't matter!+-}++checkTyVarsP :: SDoc -> SDoc -> Located RdrName -> [LHsTypeArg GhcPs]+             -> P (LHsQTyVars GhcPs, [AddAnn])+-- Same as checkTyVars, but in the P monad+checkTyVarsP pp_what equals_or_where tc tparms+  = do { let checkedTvs = checkTyVars pp_what equals_or_where tc tparms+       ; eitherToP checkedTvs }++eitherToP :: Either (SrcSpan, SDoc) a -> P a+-- Adapts the Either monad to the P monad+eitherToP (Left (loc, doc)) = addFatalError loc doc+eitherToP (Right thing)     = return thing++checkTyVars :: SDoc -> SDoc -> Located RdrName -> [LHsTypeArg GhcPs]+            -> Either (SrcSpan, SDoc)+                      ( LHsQTyVars GhcPs  -- the synthesized type variables+                      , [AddAnn] )        -- action which adds annotations+-- ^ Check whether the given list of type parameters are all type variables+-- (possibly with a kind signature).+-- We use the Either monad because it's also called (via 'mkATDefault') from+-- "Convert".+checkTyVars pp_what equals_or_where tc tparms+  = do { (tvs, anns) <- fmap unzip $ mapM check tparms+       ; return (mkHsQTvs tvs, concat anns) }+  where+    check (HsTypeArg _ ki@(L loc _))+                              = Left (loc,+                                      vcat [ text "Unexpected type application" <+>+                                            text "@" <> ppr ki+                                          , text "In the" <+> pp_what <+>+                                            ptext (sLit "declaration for") <+> quotes (ppr tc)])+    check (HsValArg ty) = chkParens [] ty+    check (HsArgPar sp) = Left (sp, vcat [text "Malformed" <+> pp_what+                           <+> text "declaration for" <+> quotes (ppr tc)])+        -- Keep around an action for adjusting the annotations of extra parens+    chkParens :: [AddAnn] -> LHsType GhcPs+              -> Either (SrcSpan, SDoc) (LHsTyVarBndr GhcPs, [AddAnn])+    chkParens acc (dL->L l (HsParTy _ ty)) = chkParens (mkParensApiAnn l+                                                        ++ acc) ty+    chkParens acc ty = case chk ty of+      Left err -> Left err+      Right tv -> Right (tv, reverse acc)++        -- Check that the name space is correct!+    chk :: LHsType GhcPs -> Either (SrcSpan, SDoc) (LHsTyVarBndr GhcPs)+    chk (dL->L l (HsKindSig _ (dL->L lv (HsTyVar _ _ (dL->L _ tv))) k))+        | isRdrTyVar tv    = return (cL l (KindedTyVar noExt (cL lv tv) k))+    chk (dL->L l (HsTyVar _ _ (dL->L ltv tv)))+        | isRdrTyVar tv    = return (cL l (UserTyVar noExt (cL ltv tv)))+    chk t@(dL->L loc _)+        = Left (loc,+                vcat [ text "Unexpected type" <+> quotes (ppr t)+                     , text "In the" <+> pp_what+                       <+> ptext (sLit "declaration for") <+> quotes tc'+                     , vcat[ (text "A" <+> pp_what+                              <+> ptext (sLit "declaration should have form"))+                     , nest 2+                       (pp_what+                        <+> tc'+                        <+> hsep (map text (takeList tparms allNameStrings))+                        <+> equals_or_where) ] ])++    -- Avoid printing a constraint tuple in the error message. Print+    -- a plain old tuple instead (since that's what the user probably+    -- wrote). See #14907+    tc' = ppr $ fmap filterCTuple tc++++whereDots, equalsDots :: SDoc+-- Second argument to checkTyVars+whereDots  = text "where ..."+equalsDots = text "= ..."++checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P ()+checkDatatypeContext Nothing = return ()+checkDatatypeContext (Just c)+    = do allowed <- getBit DatatypeContextsBit+         unless allowed $+             addError (getLoc c)+                 (text "Illegal datatype context (use DatatypeContexts):"+                  <+> pprLHsContext c)++type LRuleTyTmVar = Located RuleTyTmVar+data RuleTyTmVar = RuleTyTmVar (Located RdrName) (Maybe (LHsType GhcPs))+-- ^ Essentially a wrapper for a @RuleBndr GhcPs@++-- turns RuleTyTmVars into RuleBnrs - this is straightforward+mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs]+mkRuleBndrs = fmap (fmap cvt_one)+  where cvt_one (RuleTyTmVar v Nothing)    = RuleBndr    noExt v+        cvt_one (RuleTyTmVar v (Just sig)) =+          RuleBndrSig noExt v (mkLHsSigWcType sig)++-- turns RuleTyTmVars into HsTyVarBndrs - this is more interesting+mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr GhcPs]+mkRuleTyVarBndrs = fmap (fmap cvt_one)+  where cvt_one (RuleTyTmVar v Nothing)    = UserTyVar   noExt (fmap tm_to_ty v)+        cvt_one (RuleTyTmVar v (Just sig))+          = KindedTyVar noExt (fmap tm_to_ty v) sig+    -- takes something in namespace 'varName' to something in namespace 'tvName'+        tm_to_ty (Unqual occ) = Unqual (setOccNameSpace tvName occ)+        tm_to_ty _ = panic "mkRuleTyVarBndrs"++-- See note [Parsing explicit foralls in Rules] in Parser.y+checkRuleTyVarBndrNames :: [LHsTyVarBndr GhcPs] -> P ()+checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName)+  where check (dL->L loc (Unqual occ)) = do+          when ((occNameString occ ==) `any` ["forall","family","role"])+               (addFatalError loc (text $ "parse error on input "+                                    ++ occNameString occ))+        check _ = panic "checkRuleTyVarBndrNames"++checkRecordSyntax :: Outputable a => Located a -> P (Located a)+checkRecordSyntax lr@(dL->L loc r)+    = do allowed <- getBit TraditionalRecordSyntaxBit+         unless allowed $ addError loc $+           text "Illegal record syntax (use TraditionalRecordSyntax):" <+> ppr r+         return lr++-- | Check if the gadt_constrlist is empty. Only raise parse error for+-- `data T where` to avoid affecting existing error message, see #8258.+checkEmptyGADTs :: Located ([AddAnn], [LConDecl GhcPs])+                -> P (Located ([AddAnn], [LConDecl GhcPs]))+checkEmptyGADTs gadts@(dL->L span (_, []))           -- Empty GADT declaration.+    = do gadtSyntax <- getBit GadtSyntaxBit   -- GADTs implies GADTSyntax+         unless gadtSyntax $ addError span $ vcat+           [ text "Illegal keyword 'where' in data declaration"+           , text "Perhaps you intended to use GADTs or a similar language"+           , text "extension to enable syntax: data T where"+           ]+         return gadts+checkEmptyGADTs gadts = return gadts              -- Ordinary GADT declaration.++checkTyClHdr :: Bool               -- True  <=> class header+                                   -- False <=> type header+             -> LHsType GhcPs+             -> P (Located RdrName,      -- the head symbol (type or class name)+                   [LHsTypeArg GhcPs],      -- parameters of head symbol+                   LexicalFixity,        -- the declaration is in infix format+                   [AddAnn]) -- API Annotation for HsParTy when stripping parens+-- Well-formedness check and decomposition of type and class heads.+-- Decomposes   T ty1 .. tyn   into    (T, [ty1, ..., tyn])+--              Int :*: Bool   into    (:*:, [Int, Bool])+-- returning the pieces+checkTyClHdr is_cls ty+  = goL ty [] [] Prefix+  where+    goL (dL->L l ty) acc ann fix = go l ty acc ann fix++    -- workaround to define '*' despite StarIsType+    go lp (HsParTy _ (dL->L l (HsStarTy _ isUni))) acc ann fix+      = do { warnStarBndr l+           ; let name = mkOccName tcClsName (starSym isUni)+           ; return (cL l (Unqual name), acc, fix, (ann ++ mkParensApiAnn lp)) }++    go l (HsTyVar _ _ (dL->L _ tc)) acc ann fix+      | isRdrTc tc               = return (cL l tc, acc, fix, ann)+    go _ (HsOpTy _ t1 ltc@(dL->L _ tc) t2) acc ann _fix+      | isRdrTc tc               = return (ltc, HsValArg t1:HsValArg t2:acc, Infix, ann)+    go l (HsParTy _ ty)    acc ann fix = goL ty acc (ann ++mkParensApiAnn l) fix+    go _ (HsAppTy _ t1 t2) acc ann fix = goL t1 (HsValArg t2:acc) ann fix+    go _ (HsAppKindTy l ty ki) acc ann fix = goL ty (HsTypeArg l ki:acc) ann fix+    go l (HsTupleTy _ HsBoxedOrConstraintTuple ts) [] ann fix+      = return (cL l (nameRdrName tup_name), map HsValArg ts, fix, ann)+      where+        arity = length ts+        tup_name | is_cls    = cTupleTyConName arity+                 | otherwise = getName (tupleTyCon Boxed arity)+          -- See Note [Unit tuples] in HsTypes  (TODO: is this still relevant?)+    go l _ _ _ _+      = addFatalError l (text "Malformed head of type or class declaration:"+                          <+> ppr ty)++-- | Yield a parse error if we have a function applied directly to a do block+-- etc. and BlockArguments is not enabled.+checkBlockArguments :: forall b. ExpCmdI b => Located (b GhcPs) -> PV ()+checkBlockArguments = case expCmdG @b of { ExpG -> checkExpr; CmdG -> checkCmd }+  where+    checkExpr :: LHsExpr GhcPs -> P ()+    checkExpr expr = case unLoc expr of+      HsDo _ DoExpr _ -> check "do block" expr+      HsDo _ MDoExpr _ -> check "mdo block" expr+      HsLam {} -> check "lambda expression" expr+      HsCase {} -> check "case expression" expr+      HsLamCase {} -> check "lambda-case expression" expr+      HsLet {} -> check "let expression" expr+      HsIf {} -> check "if expression" expr+      HsProc {} -> check "proc expression" expr+      _ -> return ()++    checkCmd :: LHsCmd GhcPs -> P ()+    checkCmd cmd = case unLoc cmd of+      HsCmdLam {} -> check "lambda command" cmd+      HsCmdCase {} -> check "case command" cmd+      HsCmdIf {} -> check "if command" cmd+      HsCmdLet {} -> check "let command" cmd+      HsCmdDo {} -> check "do command" cmd+      _ -> return ()++    check :: (HasSrcSpan a, Outputable a) => String -> a -> P ()+    check element a = do+      blockArguments <- getBit BlockArgumentsBit+      unless blockArguments $+        addError (getLoc a) $+          text "Unexpected " <> text element <> text " in function application:"+           $$ nest 4 (ppr a)+           $$ text "You could write it with parentheses"+           $$ text "Or perhaps you meant to enable BlockArguments?"++-- | Validate the context constraints and break up a context into a list+-- of predicates.+--+-- @+--     (Eq a, Ord b)        -->  [Eq a, Ord b]+--     Eq a                 -->  [Eq a]+--     (Eq a)               -->  [Eq a]+--     (((Eq a)))           -->  [Eq a]+-- @+checkContext :: LHsType GhcPs -> P ([AddAnn],LHsContext GhcPs)+checkContext (dL->L l orig_t)+  = check [] (cL l orig_t)+ where+  check anns (dL->L lp (HsTupleTy _ HsBoxedOrConstraintTuple ts))+    -- (Eq a, Ord b) shows up as a tuple type. Only boxed tuples can+    -- be used as context constraints.+    = return (anns ++ mkParensApiAnn lp,cL l ts)                -- Ditto ()++  check anns (dL->L lp1 (HsParTy _ ty))+                                  -- to be sure HsParTy doesn't get into the way+       = check anns' ty+         where anns' = if l == lp1 then anns+                                   else (anns ++ mkParensApiAnn lp1)++  -- no need for anns, returning original+  check _anns t = checkNoDocs msg t *> return ([],cL l [cL l orig_t])++  msg = text "data constructor context"++-- | Check recursively if there are any 'HsDocTy's in the given type.+-- This only works on a subset of types produced by 'btype_no_ops'+checkNoDocs :: SDoc -> LHsType GhcPs -> P ()+checkNoDocs msg ty = go ty+  where+    go (dL->L _ (HsAppKindTy _ ty ki)) = go ty *> go ki+    go (dL->L _ (HsAppTy _ t1 t2)) = go t1 *> go t2+    go (dL->L l (HsDocTy _ t ds)) = addError l $ hsep+                                  [ text "Unexpected haddock", quotes (ppr ds)+                                  , text "on", msg, quotes (ppr t) ]+    go _ = pure ()++-- -------------------------------------------------------------------------+-- Checking Patterns.++-- We parse patterns as expressions and check for valid patterns below,+-- converting the expression into a pattern at the same time.++checkPattern :: SDoc -> LHsExpr GhcPs -> P (LPat GhcPs)+checkPattern msg e = checkLPat msg e++checkPatterns :: SDoc -> [LHsExpr GhcPs] -> P [LPat GhcPs]+checkPatterns msg es = mapM (checkPattern msg) es++checkLPat :: SDoc -> LHsExpr GhcPs -> P (LPat GhcPs)+checkLPat msg e@(dL->L l _) = checkPat msg l e []++checkPat :: SDoc -> SrcSpan -> LHsExpr GhcPs -> [LPat GhcPs]+         -> P (LPat GhcPs)+checkPat _ loc (dL->L l e@(HsVar _ (dL->L _ c))) args+  | isRdrDataCon c = return (cL loc (ConPatIn (cL l c) (PrefixCon args)))+  | not (null args) && patIsRec c =+      patFail (text "Perhaps you intended to use RecursiveDo") l e+checkPat msg loc e args     -- OK to let this happen even if bang-patterns+                        -- are not enabled, because there is no valid+                        -- non-bang-pattern parse of (C ! e)+  | Just (e', args') <- splitBang e+  = do  { args'' <- checkPatterns msg args'+        ; checkPat msg loc e' (args'' ++ args) }+checkPat msg loc (dL->L _ (HsApp _ f e)) args+  = do p <- checkLPat msg e+       checkPat msg loc f (p : args)+checkPat msg loc (dL->L _ e) []+  = do p <- checkAPat msg loc e+       return (cL loc p)+checkPat msg loc e _+  = patFail msg loc (unLoc e)++checkAPat :: SDoc -> SrcSpan -> HsExpr GhcPs -> P (Pat GhcPs)+checkAPat msg loc e0 = do+ nPlusKPatterns <- getBit NPlusKPatternsBit+ case e0 of+   EWildPat _ -> return (WildPat noExt)+   HsVar _ x  -> return (VarPat noExt x)+   HsLit _ (HsStringPrim _ _) -- (#13260)+       -> addFatalError loc (text "Illegal unboxed string literal in pattern:"+                              $$ ppr e0)++   HsLit _ l  -> return (LitPat noExt l)++   -- Overloaded numeric patterns (e.g. f 0 x = x)+   -- Negation is recorded separately, so that the literal is zero or +ve+   -- NB. Negative *primitive* literals are already handled by the lexer+   HsOverLit _ pos_lit          -> return (mkNPat (cL loc pos_lit) Nothing)+   NegApp _ (dL->L l (HsOverLit _ pos_lit)) _+                        -> return (mkNPat (cL l pos_lit) (Just noSyntaxExpr))++   SectionR _ (dL->L lb (HsVar _ (dL->L _ bang))) e    -- (! x)+        | bang == bang_RDR+        -> do { hintBangPat loc e0+              ; e' <- checkLPat msg e+              ; addAnnotation loc AnnBang lb+              ; return  (BangPat noExt e') }++   ELazyPat _ e         -> checkLPat msg e >>= (return . (LazyPat noExt))+   EAsPat _ n e         -> checkLPat msg e >>= (return . (AsPat noExt) n)+   -- view pattern is well-formed if the pattern is+   EViewPat _ expr patE -> checkLPat msg patE >>=+                            (return . (\p -> ViewPat noExt expr p))+   ExprWithTySig _ e t  -> do e <- checkLPat msg e+                              return (SigPat noExt e t)++   -- n+k patterns+   OpApp _ (dL->L nloc (HsVar _ (dL->L _ n)))+           (dL->L _    (HsVar _ (dL->L _ plus)))+           (dL->L lloc (HsOverLit _ lit@(OverLit {ol_val = HsIntegral {}})))+                      | nPlusKPatterns && (plus == plus_RDR)+                      -> return (mkNPlusKPat (cL nloc n) (cL lloc lit))+   OpApp _ l (dL->L cl (HsVar _ (dL->L _ c))) r+     | isDataOcc (rdrNameOcc c) -> do+         l <- checkLPat msg l+         r <- checkLPat msg r+         return (ConPatIn (cL cl c) (InfixCon l r))++   OpApp {}           -> patFail msg loc e0++   ExplicitList _ _ es -> do ps <- mapM (checkLPat msg) es+                             return (ListPat noExt ps)++   HsPar _ e          -> checkLPat msg e >>= (return . (ParPat noExt))++   ExplicitTuple _ es b+     | all tupArgPresent es  -> do ps <- mapM (checkLPat msg)+                                           [e | (dL->L _ (Present _ e)) <- es]+                                   return (TuplePat noExt ps b)+     | otherwise -> addFatalError loc (text "Illegal tuple section in pattern:"+                                        $$ ppr e0)++   ExplicitSum _ alt arity expr -> do+     p <- checkLPat msg expr+     return (SumPat noExt p alt arity)++   RecordCon { rcon_con_name = c, rcon_flds = HsRecFields fs dd }+                        -> do fs <- mapM (checkPatField msg) fs+                              return (ConPatIn c (RecCon (HsRecFields fs dd)))+   HsSpliceE _ s | not (isTypedSplice s)+               -> return (SplicePat noExt s)+   _           -> patFail msg loc e0++placeHolderPunRhs :: LHsExpr GhcPs+-- The RHS of a punned record field will be filled in by the renamer+-- It's better not to make it an error, in case we want to print it when+-- debugging+placeHolderPunRhs = noLoc (HsVar noExt (noLoc pun_RDR))++plus_RDR, bang_RDR, pun_RDR :: RdrName+plus_RDR = mkUnqual varName (fsLit "+") -- Hack+bang_RDR = mkUnqual varName (fsLit "!") -- Hack+pun_RDR  = mkUnqual varName (fsLit "pun-right-hand-side")++isBangRdr, isTildeRdr :: RdrName -> Bool+isBangRdr (Unqual occ) = occNameFS occ == fsLit "!"+isBangRdr _ = False+isTildeRdr = (==eqTyCon_RDR)++checkPatField :: SDoc -> LHsRecField GhcPs (LHsExpr GhcPs)+              -> P (LHsRecField GhcPs (LPat GhcPs))+checkPatField msg (dL->L l fld) = do p <- checkLPat msg (hsRecFieldArg fld)+                                     return (cL l (fld { hsRecFieldArg = p }))++patFail :: SDoc -> SrcSpan -> HsExpr GhcPs -> P a+patFail msg loc e = addFatalError loc err+    where err = text "Parse error in pattern:" <+> ppr e+             $$ msg++patIsRec :: RdrName -> Bool+patIsRec e = e == mkUnqual varName (fsLit "rec")+++---------------------------------------------------------------------------+-- Check Equation Syntax++checkValDef :: SDoc+            -> SrcStrictness+            -> LHsExpr GhcPs+            -> Maybe (LHsType GhcPs)+            -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))+            -> P ([AddAnn],HsBind GhcPs)++checkValDef msg _strictness lhs (Just sig) grhss+        -- x :: ty = rhs  parses as a *pattern* binding+  = checkPatBind msg (cL (combineLocs lhs sig)+                        (ExprWithTySig noExt lhs (mkLHsSigWcType sig))) grhss++checkValDef msg strictness lhs Nothing g@(dL->L l (_,grhss))+  = do  { mb_fun <- isFunLhs lhs+        ; case mb_fun of+            Just (fun, is_infix, pats, ann) ->+              checkFunBind msg strictness ann (getLoc lhs)+                           fun is_infix pats (cL l grhss)+            Nothing -> checkPatBind msg lhs g }++checkFunBind :: SDoc+             -> SrcStrictness+             -> [AddAnn]+             -> SrcSpan+             -> Located RdrName+             -> LexicalFixity+             -> [LHsExpr GhcPs]+             -> Located (GRHSs GhcPs (LHsExpr GhcPs))+             -> P ([AddAnn],HsBind GhcPs)+checkFunBind msg strictness ann lhs_loc fun is_infix pats (dL->L rhs_span grhss)+  = do  ps <- checkPatterns msg pats+        let match_span = combineSrcSpans lhs_loc rhs_span+        -- Add back the annotations stripped from any HsPar values in the lhs+        -- mapM_ (\a -> a match_span) ann+        return (ann, makeFunBind fun+                  [cL match_span (Match { m_ext = noExt+                                        , m_ctxt = FunRhs+                                            { mc_fun    = fun+                                            , mc_fixity = is_infix+                                            , mc_strictness = strictness }+                                        , m_pats = ps+                                        , m_grhss = grhss })])+        -- The span of the match covers the entire equation.+        -- That isn't quite right, but it'll do for now.++makeFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]+            -> HsBind GhcPs+-- Like HsUtils.mkFunBind, but we need to be able to set the fixity too+makeFunBind fn ms+  = FunBind { fun_ext = noExt,+              fun_id = fn,+              fun_matches = mkMatchGroup FromSource ms,+              fun_co_fn = idHsWrapper,+              fun_tick = [] }++checkPatBind :: SDoc+             -> LHsExpr GhcPs+             -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))+             -> P ([AddAnn],HsBind GhcPs)+checkPatBind msg lhs (dL->L _ (_,grhss))+  = do  { lhs <- checkPattern msg lhs+        ; return ([],PatBind noExt lhs grhss+                    ([],[])) }++checkValSigLhs :: LHsExpr GhcPs -> P (Located RdrName)+checkValSigLhs (dL->L _ (HsVar _ lrdr@(dL->L _ v)))+  | isUnqual v+  , not (isDataOcc (rdrNameOcc v))+  = return lrdr++checkValSigLhs lhs@(dL->L l _)+  = addFatalError l ((text "Invalid type signature:" <+>+                       ppr lhs <+> text ":: ...")+                      $$ text hint)+  where+    hint | foreign_RDR `looks_like` lhs+         = "Perhaps you meant to use ForeignFunctionInterface?"+         | default_RDR `looks_like` lhs+         = "Perhaps you meant to use DefaultSignatures?"+         | pattern_RDR `looks_like` lhs+         = "Perhaps you meant to use PatternSynonyms?"+         | otherwise+         = "Should be of form <variable> :: <type>"++    -- A common error is to forget the ForeignFunctionInterface flag+    -- so check for that, and suggest.  cf #3805+    -- Sadly 'foreign import' still barfs 'parse error' because+    --  'import' is a keyword+    looks_like s (dL->L _ (HsVar _ (dL->L _ v))) = v == s+    looks_like s (dL->L _ (HsApp _ lhs _))   = looks_like s lhs+    looks_like _ _                       = False++    foreign_RDR = mkUnqual varName (fsLit "foreign")+    default_RDR = mkUnqual varName (fsLit "default")+    pattern_RDR = mkUnqual varName (fsLit "pattern")++checkDoAndIfThenElse+  :: forall b. ExpCmdI b =>+     LHsExpr GhcPs+  -> Bool+  -> Located (b GhcPs)+  -> Bool+  -> Located (b GhcPs)+  -> P ()+checkDoAndIfThenElse =+  case expCmdG @b of+    ExpG -> checkDoAndIfThenElse'+    CmdG -> checkDoAndIfThenElse'++checkDoAndIfThenElse'+  :: (HasSrcSpan a, Outputable a, Outputable b, HasSrcSpan c, Outputable c)+  => a -> Bool -> b -> Bool -> c -> P ()+checkDoAndIfThenElse' guardExpr semiThen thenExpr semiElse elseExpr+ | semiThen || semiElse+    = do doAndIfThenElse <- getBit DoAndIfThenElseBit+         unless doAndIfThenElse $ do+             addError (combineLocs guardExpr elseExpr)+                            (text "Unexpected semi-colons in conditional:"+                          $$ nest 4 expr+                          $$ text "Perhaps you meant to use DoAndIfThenElse?")+ | otherwise            = return ()+    where pprOptSemi True  = semi+          pprOptSemi False = empty+          expr = text "if"   <+> ppr guardExpr <> pprOptSemi semiThen <+>+                 text "then" <+> ppr thenExpr  <> pprOptSemi semiElse <+>+                 text "else" <+> ppr elseExpr+++        -- The parser left-associates, so there should+        -- not be any OpApps inside the e's+splitBang :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, [LHsExpr GhcPs])+-- Splits (f ! g a b) into (f, [(! g), a, b])+splitBang (dL->L _ (OpApp _ l_arg bang@(dL->L _ (HsVar _ (dL->L _ op))) r_arg))+  | op == bang_RDR = Just (l_arg, cL l' (SectionR noExt bang arg1) : argns)+  where+    l' = combineLocs bang arg1+    (arg1,argns) = split_bang r_arg []+    split_bang (dL->L _ (HsApp _ f e)) es = split_bang f (e:es)+    split_bang e                       es = (e,es)+splitBang _ = Nothing++-- See Note [isFunLhs vs mergeDataCon]+isFunLhs :: LHsExpr GhcPs+      -> P (Maybe (Located RdrName, LexicalFixity, [LHsExpr GhcPs],[AddAnn]))+-- A variable binding is parsed as a FunBind.+-- Just (fun, is_infix, arg_pats) if e is a function LHS+--+-- The whole LHS is parsed as a single expression.+-- Any infix operators on the LHS will parse left-associatively+-- E.g.         f !x y !z+--      will parse (rather strangely) as+--              (f ! x y) ! z+--      It's up to isFunLhs to sort out the mess+--+-- a .!. !b++isFunLhs e = go e [] []+ where+   go (dL->L loc (HsVar _ (dL->L _ f))) es ann+       | not (isRdrDataCon f)        = return (Just (cL loc f, Prefix, es, ann))+   go (dL->L _ (HsApp _ f e)) es       ann = go f (e:es) ann+   go (dL->L l (HsPar _ e))   es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)++        -- Things of the form `!x` are also FunBinds+        -- See Note [FunBind vs PatBind]+   go (dL->L _ (SectionR _ (dL->L _ (HsVar _ (dL->L _ bang)))+                (dL->L l (HsVar _ (L _ var))))) [] ann+        | bang == bang_RDR+        , not (isRdrDataCon var)     = return (Just (cL l var, Prefix, [], ann))++      -- For infix function defns, there should be only one infix *function*+      -- (though there may be infix *datacons* involved too).  So we don't+      -- need fixity info to figure out which function is being defined.+      --      a `K1` b `op` c `K2` d+      -- must parse as+      --      (a `K1` b) `op` (c `K2` d)+      -- The renamer checks later that the precedences would yield such a parse.+      --+      -- There is a complication to deal with bang patterns.+      --+      -- ToDo: what about this?+      --              x + 1 `op` y = ...++   go e@(L loc (OpApp _ l (dL->L loc' (HsVar _ (dL->L _ op))) r)) es ann+        | Just (e',es') <- splitBang e+        = do { bang_on <- getBit BangPatBit+             ; if bang_on then go e' (es' ++ es) ann+               else return (Just (cL loc' op, Infix, (l:r:es), ann)) }+                -- No bangs; behave just like the next case+        | not (isRdrDataCon op)         -- We have found the function!+        = return (Just (cL loc' op, Infix, (l:r:es), ann))+        | otherwise                     -- Infix data con; keep going+        = do { mb_l <- go l es ann+             ; case mb_l of+                 Just (op', Infix, j : k : es', ann')+                   -> return (Just (op', Infix, j : op_app : es', ann'))+                   where+                     op_app = cL loc (OpApp noExt k+                               (cL loc' (HsVar noExt (cL loc' op))) r)+                 _ -> return Nothing }+   go _ _ _ = return Nothing++-- | Either an operator or an operand.+data TyEl = TyElOpr RdrName | TyElOpd (HsType GhcPs)+          | TyElKindApp SrcSpan (LHsType GhcPs)+          -- See Note [TyElKindApp SrcSpan interpretation]+          | TyElTilde | TyElBang+          | TyElUnpackedness ([AddAnn], SourceText, SrcUnpackedness)+          | TyElDocPrev HsDocString+++{- Note [TyElKindApp SrcSpan interpretation]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++A TyElKindApp captures type application written in haskell as++    @ Foo++where Foo is some type.++The SrcSpan reflects both elements, and there are AnnAt and AnnVal API+Annotations attached to this SrcSpan for the specific locations of+each within it.+-}++instance Outputable TyEl where+  ppr (TyElOpr name) = ppr name+  ppr (TyElOpd ty) = ppr ty+  ppr (TyElKindApp _ ki) = text "@" <> ppr ki+  ppr TyElTilde = text "~"+  ppr TyElBang = text "!"+  ppr (TyElUnpackedness (_, _, unpk)) = ppr unpk+  ppr (TyElDocPrev doc) = ppr doc++tyElStrictness :: TyEl -> Maybe (AnnKeywordId, SrcStrictness)+tyElStrictness TyElTilde = Just (AnnTilde, SrcLazy)+tyElStrictness TyElBang = Just (AnnBang, SrcStrict)+tyElStrictness _ = Nothing++-- | Extract a strictness/unpackedness annotation from the front of a reversed+-- 'TyEl' list.+pStrictMark+  :: [Located TyEl] -- reversed TyEl+  -> Maybe ( Located HsSrcBang {- a strictness/upnackedness marker -}+           , [AddAnn]+           , [Located TyEl] {- remaining TyEl -})+pStrictMark ((dL->L l1 x1) : (dL->L l2 x2) : xs)+  | Just (strAnnId, str) <- tyElStrictness x1+  , TyElUnpackedness (unpkAnns, prag, unpk) <- x2+  = Just ( cL (combineSrcSpans l1 l2) (HsSrcBang prag unpk str)+         , unpkAnns ++ [\s -> addAnnotation s strAnnId l1]+         , xs )+pStrictMark ((dL->L l x1) : xs)+  | Just (strAnnId, str) <- tyElStrictness x1+  = Just ( cL l (HsSrcBang NoSourceText NoSrcUnpack str)+         , [\s -> addAnnotation s strAnnId l]+         , xs )+pStrictMark ((dL->L l x1) : xs)+  | TyElUnpackedness (anns, prag, unpk) <- x1+  = Just ( cL l (HsSrcBang prag unpk NoSrcStrict)+         , anns+         , xs )+pStrictMark _ = Nothing++pBangTy+  :: LHsType GhcPs  -- a type to be wrapped inside HsBangTy+  -> [Located TyEl] -- reversed TyEl+  -> ( Bool           {- has a strict mark been consumed? -}+     , LHsType GhcPs  {- the resulting BangTy -}+     , P ()           {- add annotations -}+     , [Located TyEl] {- remaining TyEl -})+pBangTy lt@(dL->L l1 _) xs =+  case pStrictMark xs of+    Nothing -> (False, lt, pure (), xs)+    Just (dL->L l2 strictMark, anns, xs') ->+      let bl = combineSrcSpans l1 l2+          bt = HsBangTy noExt strictMark lt+      in (True, cL bl bt, addAnnsAt bl anns, xs')++-- | Merge a /reversed/ and /non-empty/ soup of operators and operands+--   into a type.+--+-- User input: @F x y + G a b * X@+-- Input to 'mergeOps': [X, *, b, a, G, +, y, x, F]+-- Output corresponds to what the user wrote assuming all operators are of the+-- same fixity and right-associative.+--+-- It's a bit silly that we're doing it at all, as the renamer will have to+-- rearrange this, and it'd be easier to keep things separate.+--+-- See Note [Parsing data constructors is hard]+mergeOps :: [Located TyEl] -> P (LHsType GhcPs)+mergeOps ((dL->L l1 (TyElOpd t)) : xs)+  | (_, t', addAnns, xs') <- pBangTy (cL l1 t) xs+  , null xs' -- We accept a BangTy only when there are no preceding TyEl.+  = addAnns >> return t'+mergeOps all_xs = go (0 :: Int) [] id all_xs+  where+    -- NB. When modifying clauses in 'go', make sure that the reasoning in+    -- Note [Non-empty 'acc' in mergeOps clause [end]] is still correct.++    -- clause [unpk]:+    -- handle (NO)UNPACK pragmas+    go k acc ops_acc ((dL->L l (TyElUnpackedness (anns, unpkSrc, unpk))):xs) =+      if not (null acc) && null xs+      then do { acc' <- eitherToP $ mergeOpsAcc acc+              ; let a = ops_acc acc'+                    strictMark = HsSrcBang unpkSrc unpk NoSrcStrict+                    bl = combineSrcSpans l (getLoc a)+                    bt = HsBangTy noExt strictMark a+              ; addAnnsAt bl anns+              ; return (cL bl bt) }+      else addFatalError l unpkError+      where+        unpkSDoc = case unpkSrc of+          NoSourceText -> ppr unpk+          SourceText str -> text str <> text " #-}"+        unpkError+          | not (null xs) = unpkSDoc <+> text "cannot appear inside a type."+          | null acc && k == 0 = unpkSDoc <+> text "must be applied to a type."+          | otherwise =+              -- See Note [Impossible case in mergeOps clause [unpk]]+              panic "mergeOps.UNPACK: impossible position"++    -- clause [doc]:+    -- we do not expect to encounter any docs+    go _ _ _ ((dL->L l (TyElDocPrev _)):_) =+      failOpDocPrev l++    -- to improve error messages, we do a bit of guesswork to determine if the+    -- user intended a '!' or a '~' as a strictness annotation+    go k acc ops_acc ((dL->L l x) : xs)+      | Just (_, str) <- tyElStrictness x+      , let guess [] = True+            guess ((dL->L _ (TyElOpd _)):_) = False+            guess ((dL->L _ (TyElOpr _)):_) = True+            guess ((dL->L _ (TyElKindApp _ _)):_) = False+            guess ((dL->L _ (TyElTilde)):_) = True+            guess ((dL->L _ (TyElBang)):_) = True+            guess ((dL->L _ (TyElUnpackedness _)):_) = True+            guess ((dL->L _ (TyElDocPrev _)):xs') = guess xs'+            guess _ = panic "mergeOps.go.guess: Impossible Match"+                      -- due to #15884+        in guess xs+      = if not (null acc) && (k > 1 || length acc > 1)+        then do { a <- eitherToP (mergeOpsAcc acc)+                ; failOpStrictnessCompound (cL l str) (ops_acc a) }+        else failOpStrictnessPosition (cL l str)++    -- clause [opr]:+    -- when we encounter an operator, we must have accumulated+    -- something for its rhs, and there must be something left+    -- to build its lhs.+    go k acc ops_acc ((dL->L l (TyElOpr op)):xs) =+      if null acc || null (filter isTyElOpd xs)+        then failOpFewArgs (cL l op)+        else do { acc' <- eitherToP (mergeOpsAcc acc)+                ; go (k + 1) [] (\c -> mkLHsOpTy c (cL l op) (ops_acc acc')) xs }+      where+        isTyElOpd (dL->L _ (TyElOpd _)) = True+        isTyElOpd _ = False++    -- clause [opr.1]: interpret 'TyElTilde' as an operator+    go k acc ops_acc ((dL->L l TyElTilde):xs) =+      let op = eqTyCon_RDR+      in go k acc ops_acc (cL l (TyElOpr op):xs)++    -- clause [opr.2]: interpret 'TyElBang' as an operator+    go k acc ops_acc ((dL->L l TyElBang):xs) =+      let op = mkUnqual tcClsName (fsLit "!")+      in go k acc ops_acc (cL l (TyElOpr op):xs)++    -- clause [opd]:+    -- whenever an operand is encountered, it is added to the accumulator+    go k acc ops_acc ((dL->L l (TyElOpd a)):xs) = go k (HsValArg (cL l a):acc) ops_acc xs++    -- clause [tyapp]:+    -- whenever a type application is encountered, it is added to the accumulator+    go k acc ops_acc ((dL->L _ (TyElKindApp l a)):xs) = go k (HsTypeArg l a:acc) ops_acc xs++    -- clause [end]+    -- See Note [Non-empty 'acc' in mergeOps clause [end]]+    go _ acc ops_acc [] = do { acc' <- eitherToP (mergeOpsAcc acc)+                             ; return (ops_acc acc') }++    go _ _ _ _ = panic "mergeOps.go: Impossible Match"+                        -- due to #15884++mergeOpsAcc :: [HsArg (LHsType GhcPs) (LHsKind GhcPs)]+         -> Either (SrcSpan, SDoc) (LHsType GhcPs)+mergeOpsAcc [] = panic "mergeOpsAcc: empty input"+mergeOpsAcc (HsTypeArg _ (L loc ki):_)+  = Left (loc, text "Unexpected type application:" <+> ppr ki)+mergeOpsAcc (HsValArg ty : xs) = go1 ty xs+  where+    go1 :: LHsType GhcPs+        -> [HsArg (LHsType GhcPs) (LHsKind GhcPs)]+        -> Either (SrcSpan, SDoc) (LHsType GhcPs)+    go1 lhs []     = Right lhs+    go1 lhs (x:xs) = case x of+        HsValArg ty -> go1 (mkHsAppTy lhs ty) xs+        HsTypeArg loc ki -> let ty = mkHsAppKindTy loc lhs ki+                            in go1 ty xs+        HsArgPar _ -> go1 lhs xs+mergeOpsAcc (HsArgPar _: xs) = mergeOpsAcc xs++{- Note [Impossible case in mergeOps clause [unpk]]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+This case should never occur. Let us consider all possible+variations of 'acc', 'xs', and 'k':++  acc          xs        k+==============================+  null   |    null       0      -- "must be applied to a type"+  null   |  not null     0      -- "must be applied to a type"+not null |    null       0      -- successful parse+not null |  not null     0      -- "cannot appear inside a type"+  null   |    null      >0      -- handled in clause [opr]+  null   |  not null    >0      -- "cannot appear inside a type"+not null |    null      >0      -- successful parse+not null |  not null    >0      -- "cannot appear inside a type"++The (null acc && null xs && k>0) case is handled in clause [opr]+by the following check:++    if ... || null (filter isTyElOpd xs)+     then failOpFewArgs (L l op)++We know that this check has been performed because k>0, and by+the time we reach the end of the list (null xs), the only way+for (null acc) to hold is that there was not a single TyElOpd+between the operator and the end of the list. But this case is+caught by the check and reported as 'failOpFewArgs'.+-}++{- Note [Non-empty 'acc' in mergeOps clause [end]]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In clause [end] we need to know that 'acc' is non-empty to call 'mergeAcc'+without a check.++Running 'mergeOps' with an empty input list is forbidden, so we do not consider+this possibility. This means we'll hit at least one other clause before we+reach clause [end].++* Clauses [unpk] and [doc] do not call 'go' recursively, so we cannot hit+  clause [end] from there.+* Clause [opd] makes 'acc' non-empty, so if we hit clause [end] after it, 'acc'+  will be non-empty.+* Clause [opr] checks that (filter isTyElOpd xs) is not null - so we are going+  to hit clause [opd] at least once before we reach clause [end], making 'acc'+  non-empty.+* There are no other clauses.++Therefore, it is safe to omit a check for non-emptiness of 'acc' in clause+[end].++-}++pInfixSide :: [Located TyEl] -> Maybe (LHsType GhcPs, P (), [Located TyEl])+pInfixSide ((dL->L l (TyElOpd t)):xs)+  | (True, t', addAnns, xs') <- pBangTy (cL l t) xs+  = Just (t', addAnns, xs')+pInfixSide (el:xs1)+  | Just t1 <- pLHsTypeArg el+  = go [t1] xs1+   where+     go :: [HsArg (LHsType GhcPs) (LHsKind GhcPs)]+        -> [Located TyEl] -> Maybe (LHsType GhcPs, P (), [Located TyEl])+     go acc (el:xs)+       | Just t <- pLHsTypeArg el+       = go (t:acc) xs+     go acc xs = case mergeOpsAcc acc of+       Left _ -> Nothing+       Right acc' -> Just (acc', pure (), xs)+pInfixSide _ = Nothing++pLHsTypeArg :: Located TyEl -> Maybe (HsArg (LHsType GhcPs) (LHsKind GhcPs))+pLHsTypeArg (dL->L l (TyElOpd a)) = Just (HsValArg (L l a))+pLHsTypeArg (dL->L _ (TyElKindApp l a)) = Just (HsTypeArg l a)+pLHsTypeArg _ = Nothing++pDocPrev :: [Located TyEl] -> (Maybe LHsDocString, [Located TyEl])+pDocPrev = go Nothing+  where+    go mTrailingDoc ((dL->L l (TyElDocPrev doc)):xs) =+      go (mTrailingDoc `mplus` Just (cL l doc)) xs+    go mTrailingDoc xs = (mTrailingDoc, xs)++orErr :: Maybe a -> b -> Either b a+orErr (Just a) _ = Right a+orErr Nothing b = Left b++{- Note [isFunLhs vs mergeDataCon]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++When parsing a function LHS, we do not know whether to treat (!) as+a strictness annotation or an infix operator:++  f ! a = ...++Without -XBangPatterns, this parses as   (!) f a = ...+   with -XBangPatterns, this parses as   f (!a) = ...++So in function declarations we opted to always parse as if -XBangPatterns+were off, and then rejig in 'isFunLhs'.++There are two downsides to this approach:++1. It is not particularly elegant, as there's a point in our pipeline where+   the representation is awfully incorrect. For instance,+      f !a b !c = ...+   will be first parsed as+      (f ! a b) ! c = ...++2. There are cases that it fails to cover, for instance infix declarations:+      !a + !b = ...+   will trigger an error.++Unfortunately, we cannot define different productions in the 'happy' grammar+depending on whether -XBangPatterns are enabled.++When parsing data constructors, we face a similar issue:+  (a) data T1 = C ! D+  (b) data T2 = C ! D => ...++In (a) the first bang is a strictness annotation, but in (b) it is a type+operator. A 'happy'-based parser does not have unlimited lookahead to check for+=>, so we must first parse (C ! D) into a common representation.++If we tried to mirror the approach used in functions, we would parse both sides+of => as types, and then rejig. However, we take a different route and use an+intermediate data structure, a reversed list of 'TyEl'.+See Note [Parsing data constructors is hard] for details.++This approach does not suffer from the issues of 'isFunLhs':++1. A sequence of 'TyEl' is a dedicated intermediate representation, not an+   incorrectly parsed type. Therefore, we do not have confusing states in our+   pipeline. (Except for representing data constructors as type variables).++2. We can handle infix data constructors with strictness annotations:+    data T a b = !a :+ !b++-}+++-- | Merge a /reversed/ and /non-empty/ soup of operators and operands+--   into a data constructor.+--+-- User input: @C !A B -- ^ doc@+-- Input to 'mergeDataCon': ["doc", B, !, A, C]+-- Output: (C, PrefixCon [!A, B], "doc")+--+-- See Note [Parsing data constructors is hard]+-- See Note [isFunLhs vs mergeDataCon]+mergeDataCon+      :: [Located TyEl]+      -> P ( Located RdrName         -- constructor name+           , HsConDeclDetails GhcPs  -- constructor field information+           , Maybe LHsDocString      -- docstring to go on the constructor+           )+mergeDataCon all_xs =+  do { (addAnns, a) <- eitherToP res+     ; addAnns+     ; return a }+  where+    -- We start by splitting off the trailing documentation comment,+    -- if any exists.+    (mTrailingDoc, all_xs') = pDocPrev all_xs++    -- Determine whether the trailing documentation comment exists and is the+    -- only docstring in this constructor declaration.+    --+    -- When true, it means that it applies to the constructor itself:+    --    data T = C+    --             A+    --             B -- ^ Comment on C (singleDoc == True)+    --+    -- When false, it means that it applies to the last field:+    --    data T = C -- ^ Comment on C+    --             A -- ^ Comment on A+    --             B -- ^ Comment on B (singleDoc == False)+    singleDoc = isJust mTrailingDoc &&+                null [ () | (dL->L _ (TyElDocPrev _)) <- all_xs' ]++    -- The result of merging the list of reversed TyEl into a+    -- data constructor, along with [AddAnn].+    res = goFirst all_xs'++    -- Take the trailing docstring into account when interpreting+    -- the docstring near the constructor.+    --+    --    data T = C -- ^ docstring right after C+    --             A+    --             B -- ^ trailing docstring+    --+    -- 'mkConDoc' must be applied to the docstring right after C, so that it+    -- falls back to the trailing docstring when appropriate (see singleDoc).+    mkConDoc mDoc | singleDoc = mDoc `mplus` mTrailingDoc+                  | otherwise = mDoc++    -- The docstring for the last field of a data constructor.+    trailingFieldDoc | singleDoc = Nothing+                     | otherwise = mTrailingDoc++    goFirst [ dL->L l (TyElOpd (HsTyVar _ _ (dL->L _ tc))) ]+      = do { data_con <- tyConToDataCon l tc+           ; return (pure (), (data_con, PrefixCon [], mTrailingDoc)) }+    goFirst ((dL->L l (TyElOpd (HsRecTy _ fields))):xs)+      | (mConDoc, xs') <- pDocPrev xs+      , [ dL->L l' (TyElOpd (HsTyVar _ _ (dL->L _ tc))) ] <- xs'+      = do { data_con <- tyConToDataCon l' tc+           ; let mDoc = mTrailingDoc `mplus` mConDoc+           ; return (pure (), (data_con, RecCon (cL l fields), mDoc)) }+    goFirst [dL->L l (TyElOpd (HsTupleTy _ HsBoxedOrConstraintTuple ts))]+      = return ( pure ()+               , ( cL l (getRdrName (tupleDataCon Boxed (length ts)))+                 , PrefixCon ts+                 , mTrailingDoc ) )+    goFirst ((dL->L l (TyElOpd t)):xs)+      | (_, t', addAnns, xs') <- pBangTy (cL l t) xs+      = go addAnns Nothing [mkLHsDocTyMaybe t' trailingFieldDoc] xs'+    goFirst (L l (TyElKindApp _ _):_)+      = goInfix Monoid.<> Left (l, kindAppErr)+    goFirst xs+      = go (pure ()) mTrailingDoc [] xs++    go addAnns mLastDoc ts [ dL->L l (TyElOpd (HsTyVar _ _ (dL->L _ tc))) ]+      = do { data_con <- tyConToDataCon l tc+           ; return (addAnns, (data_con, PrefixCon ts, mkConDoc mLastDoc)) }+    go addAnns mLastDoc ts ((dL->L l (TyElDocPrev doc)):xs) =+      go addAnns (mLastDoc `mplus` Just (cL l doc)) ts xs+    go addAnns mLastDoc ts ((dL->L l (TyElOpd t)):xs)+      | (_, t', addAnns', xs') <- pBangTy (cL l t) xs+      , t'' <- mkLHsDocTyMaybe t' mLastDoc+      = go (addAnns >> addAnns') Nothing (t'':ts) xs'+    go _ _ _ ((dL->L _ (TyElOpr _)):_) =+      -- Encountered an operator: backtrack to the beginning and attempt+      -- to parse as an infix definition.+      goInfix+    go _ _ _ (L l (TyElKindApp _ _):_) =  goInfix Monoid.<> Left (l, kindAppErr)+    go _ _ _ _ = Left malformedErr+      where+        malformedErr =+          ( foldr combineSrcSpans noSrcSpan (map getLoc all_xs')+          , text "Cannot parse data constructor" <+>+            text "in a data/newtype declaration:" $$+            nest 2 (hsep . reverse $ map ppr all_xs'))++    goInfix =+      do { let xs0 = all_xs'+         ; (rhs_t, rhs_addAnns, xs1) <- pInfixSide xs0 `orErr` malformedErr+         ; let (mOpDoc, xs2) = pDocPrev xs1+         ; (op, xs3) <- case xs2 of+              (dL->L l (TyElOpr op)) : xs3 ->+                do { data_con <- tyConToDataCon l op+                   ; return (data_con, xs3) }+              _ -> Left malformedErr+         ; let (mLhsDoc, xs4) = pDocPrev xs3+         ; (lhs_t, lhs_addAnns, xs5) <- pInfixSide xs4 `orErr` malformedErr+         ; unless (null xs5) (Left malformedErr)+         ; let rhs = mkLHsDocTyMaybe rhs_t trailingFieldDoc+               lhs = mkLHsDocTyMaybe lhs_t mLhsDoc+               addAnns = lhs_addAnns >> rhs_addAnns+         ; return (addAnns, (op, InfixCon lhs rhs, mkConDoc mOpDoc)) }+      where+        malformedErr =+          ( foldr combineSrcSpans noSrcSpan (map getLoc all_xs')+          , text "Cannot parse an infix data constructor" <+>+            text "in a data/newtype declaration:" $$+            nest 2 (hsep . reverse $ map ppr all_xs'))++    kindAppErr =+      text "Unexpected kind application" <+>+      text "in a data/newtype declaration:" $$+      nest 2 (hsep . reverse $ map ppr all_xs')++---------------------------------------------------------------------------+-- | Check for monad comprehensions+--+-- If the flag MonadComprehensions is set, return a 'MonadComp' context,+-- otherwise use the usual 'ListComp' context++checkMonadComp :: P (HsStmtContext Name)+checkMonadComp = do+    monadComprehensions <- getBit MonadComprehensionsBit+    return $ if monadComprehensions+                then MonadComp+                else ListComp++-- -------------------------------------------------------------------------+-- Expression/command ambiguity (arrow syntax).+-- See Note [Ambiguous syntactic categories]+--++-- ExpCmdP as defined is isomorphic to a pair of parsers:+--+--   data ExpCmdP = ExpCmdP { expP :: PV (LHsExpr GhcPs)+--                          , cmdP :: PV (LHsCmd  GhcPs) }+--+-- See Note [Parser-Validator]+-- See Note [Ambiguous syntactic categories]+newtype ExpCmdP =+  ExpCmdP { runExpCmdP :: forall b. ExpCmdI b => PV (Located (b GhcPs)) }++-- See Note [Ambiguous syntactic categories]+data ExpCmdG b where+  ExpG :: ExpCmdG HsExpr+  CmdG :: ExpCmdG HsCmd++-- See Note [Ambiguous syntactic categories]+class    ExpCmdI b      where expCmdG :: ExpCmdG b+instance ExpCmdI HsExpr where expCmdG = ExpG+instance ExpCmdI HsCmd  where expCmdG = CmdG++ecFromCmd :: LHsCmd GhcPs -> ExpCmdP+ecFromCmd c@(getLoc -> l) = ExpCmdP onB+  where+    onB :: forall b. ExpCmdI b => PV (Located (b GhcPs))+    onB = case expCmdG @b of { ExpG -> onExp; CmdG -> return c }+    onExp :: P (LHsExpr GhcPs)+    onExp = do+      addError l $ vcat+        [ text "Arrow command found where an expression was expected:",+          nest 2 (ppr c) ]+      return (cL l hsHoleExpr)++ecFromExp :: LHsExpr GhcPs -> ExpCmdP+ecFromExp e@(getLoc -> l) = ExpCmdP onB+  where+    onB :: forall b. ExpCmdI b => PV (Located (b GhcPs))+    onB = case expCmdG @b of { ExpG -> return e; CmdG -> onCmd }+    onCmd :: P (LHsCmd GhcPs)+    onCmd =+      addFatalError l $+        text "Parse error in command:" <+> ppr e++hsHoleExpr :: HsExpr (GhcPass id)+hsHoleExpr = HsUnboundVar noExt (TrueExprHole (mkVarOcc "_"))++ecHsLam :: forall b. ExpCmdI b => MatchGroup GhcPs (Located (b GhcPs)) -> b GhcPs+ecHsLam = case expCmdG @b of { ExpG -> HsLam noExt; CmdG -> HsCmdLam noExt }++ecHsLet :: forall b. ExpCmdI b => LHsLocalBinds GhcPs -> Located (b GhcPs) -> b GhcPs+ecHsLet = case expCmdG @b of { ExpG -> HsLet noExt; CmdG -> HsCmdLet noExt }++ecOpApp :: forall b. ExpCmdI b => Located (b GhcPs) -> LHsExpr GhcPs+        -> Located (b GhcPs) -> b GhcPs+ecOpApp = case expCmdG @b of { ExpG -> OpApp noExt; CmdG -> cmdOpApp }+  where+    cmdOpApp c1 op c2 =+      let cmdArg c = cL (getLoc c) $ HsCmdTop noExt c in+      HsCmdArrForm noExt op Infix Nothing [cmdArg c1, cmdArg c2]++ecHsCase :: forall b. ExpCmdI b =>+  LHsExpr GhcPs -> MatchGroup GhcPs (Located (b GhcPs)) -> b GhcPs+ecHsCase = case expCmdG @b of { ExpG -> HsCase noExt; CmdG -> HsCmdCase noExt }++ecHsApp :: forall b. ExpCmdI b =>+  Located (b GhcPs) -> LHsExpr GhcPs -> b GhcPs+ecHsApp = case expCmdG @b of { ExpG -> HsApp noExt; CmdG -> HsCmdApp noExt }++ecHsIf :: forall b. ExpCmdI b =>+   LHsExpr GhcPs -> Located (b GhcPs) -> Located (b GhcPs) -> b GhcPs+ecHsIf = case expCmdG @b of { ExpG -> mkHsIf; CmdG -> mkHsCmdIf }++ecHsDo :: forall b. ExpCmdI b =>+  Located [LStmt GhcPs (Located (b GhcPs))] -> b GhcPs+ecHsDo = case expCmdG @b of { ExpG -> HsDo noExt DoExpr; CmdG -> HsCmdDo noExt }++ecHsPar :: forall b. ExpCmdI b => Located (b GhcPs) -> b GhcPs+ecHsPar = case expCmdG @b of { ExpG -> HsPar noExt; CmdG -> HsCmdPar noExt }++{- Note [Ambiguous syntactic categories]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++There are places in the grammar where we do not know whether we are parsing an+expression or a pattern without unlimited lookahead (which we do not have in+'happy'):++View patterns:++    f (Con a b     ) = ...  -- 'Con a b' is a pattern+    f (Con a b -> x) = ...  -- 'Con a b' is an expression++do-notation:++    do { Con a b <- x } -- 'Con a b' is a pattern+    do { Con a b }      -- 'Con a b' is an expression++Guards:++    x | True <- p && q = ...  -- 'True' is a pattern+    x | True           = ...  -- 'True' is an expression++Top-level value/function declarations (FunBind/PatBind):++    f !a         -- TH splice+    f !a = ...   -- function declaration++    Until we encounter the = sign, we don't know if it's a top-level+    TemplateHaskell splice where ! is an infix operator, or if it's a function+    declaration where ! is a strictness annotation.++There are also places in the grammar where we do not know whether we are+parsing an expression or a command:++    proc x -> do { (stuff) -< x }   -- 'stuff' is an expression+    proc x -> do { (stuff) }        -- 'stuff' is a command++    Until we encounter arrow syntax (-<) we don't know whether to parse 'stuff'+    as an expression or a command.++In fact, do-notation is subject to both ambiguities:++    proc x -> do { (stuff) -< x }        -- 'stuff' is an expression+    proc x -> do { (stuff) <- f -< x }   -- 'stuff' is a pattern+    proc x -> do { (stuff) }             -- 'stuff' is a command++There are many possible solutions to this problem. For an overview of the ones+we decided against, see Note [Resolving parsing ambiguities: non-taken alternatives]++The solution that keeps basic definitions (such as HsExpr) clean, keeps the+concerns local to the parser, and does not require duplication of hsSyn types,+or an extra pass over the entire AST, is to parse into a function from a GADT+to a parser-validator:++    data ExpCmdG b where+      ExpG :: ExpCmdG HsExpr+      CmdG :: ExpCmdG HsCmd++    type ExpCmd = forall b. ExpCmdG b -> PV (Located (b GhcPs))++    checkExp :: ExpCmd -> PV (LHsExpr GhcPs)+    checkCmd :: ExpCmd -> PV (LHsCmd GhcPs)+    checkExp f = f ExpG  -- interpret as an expression+    checkCmd f = f CmdG  -- interpret as a command++Consider the 'alts' production used to parse case-of alternatives:++  alts :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }+    : alts1     { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }+    | ';' alts  { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }++We abstract over LHsExpr, and it becomes:++  alts :: { forall b. ExpCmdG b -> PV (Located ([AddAnn],[LMatch GhcPs (Located (b GhcPs))])) }+    : alts1+        { \tag -> $1 tag >>= \ $1 ->+                  return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }+    | ';' alts+        { \tag -> $2 tag >>= \ $2 ->+                  return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }++Note that 'ExpCmdG' is a singleton type, the value is completely+determined by the type:++  when (b~HsExpr),  tag = ExpG+  when (b~HsCmd),   tag = CmdG++This is a clear indication that we can use a class to pass this value behind+the scenes:++  class    ExpCmdI b      where expCmdG :: ExpCmdG b+  instance ExpCmdI HsExpr where expCmdG = ExpG+  instance ExpCmdI HsCmd  where expCmdG = CmdG++And now the 'alts' production is simplified, as we no longer need to+thread 'tag' explicitly:++  alts :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LMatch GhcPs (Located (b GhcPs))])) }+    : alts1     { $1 >>= \ $1 ->+                  return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }+    | ';' alts  { $2 >>= \ $2 ->+                  return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }++Compared to the initial definition, the added bits are:++    forall b. ExpCmdI b => PV ( ... ) -- in the type signature+    $1 >>= \ $1 -> return $           -- in one reduction rule+    $2 >>= \ $2 -> return $           -- in another reduction rule++The overhead is constant relative to the size of the rest of the reduction+rule, so this approach scales well to large parser productions.++-}+++{- Note [Resolving parsing ambiguities: non-taken alternatives]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Alternative I, extra constructors in HsExpr+-------------------------------------------+We could add extra constructors to HsExpr to represent command-specific and+pattern-specific syntactic constructs. Under this scheme, we parse patterns+and commands as expressions and rejig later.  This is what GHC used to do, and+it polluted 'HsExpr' with irrelevant constructors:++  * for commands: 'HsArrForm', 'HsArrApp'+  * for patterns: 'EWildPat', 'EAsPat', 'EViewPat', 'ELazyPat'++(As of now, we still do that for patterns, but we plan to fix it).++There are several issues with this:++  * The implementation details of parsing are leaking into hsSyn definitions.++  * Code that uses HsExpr has to panic on these impossible-after-parsing cases.++  * HsExpr is arbitrarily selected as the extension basis. Why not extend+    HsCmd or HsPat with extra constructors instead?++  * We cannot handle corner cases. For instance, the following function+    declaration LHS is not a valid expression (see #1087):++      !a + !b = ...++  * There are points in the pipeline where the representation was awfully+    incorrect. For instance,++      f !a b !c = ...++    is first parsed as++      (f ! a b) ! c = ...+++Alternative II, extra constructors in HsExpr for GhcPs+------------------------------------------------------+We could address some of the problems with Alternative I by using Trees That+Grow and extending HsExpr only in the GhcPs pass. However, GhcPs corresponds to+the output of parsing, not to its intermediate results, so we wouldn't want+them there either.++Alternative III, extra constructors in HsExpr for GhcPrePs+----------------------------------------------------------+We could introduce a new pass, GhcPrePs, to keep GhcPs pristine.+Unfortunately, creating a new pass would significantly bloat conversion code+and slow down the compiler by adding another linear-time pass over the entire+AST. For example, in order to build HsExpr GhcPrePs, we would need to build+HsLocalBinds GhcPrePs (as part of HsLet), and we never want HsLocalBinds+GhcPrePs.+++Alternative IV, sum type and bottom-up data flow+------------------------------------------------+Expressions and commands are disjoint. There are no user inputs that could be+interpreted as either an expression or a command depending on outer context:++  5        -- definitely an expression+  x -< y   -- definitely a command++Even though we have both 'HsLam' and 'HsCmdLam', we can look at+the body to disambiguate:++  \p -> 5        -- definitely an expression+  \p -> x -< y   -- definitely a command++This means we could use a bottom-up flow of information to determine+whether we are parsing an expression or a command, using a sum type+for intermediate results:++  Either (LHsExpr GhcPs) (LHsCmd GhcPs)++There are two problems with this:++  * We cannot handle the ambiguity between expressions and+    patterns, which are not disjoint.++  * Bottom-up flow of information leads to poor error messages. Consider++        if ... then 5 else (x -< y)++    Do we report that '5' is not a valid command or that (x -< y) is not a+    valid expression?  It depends on whether we want the entire node to be+    'HsIf' or 'HsCmdIf', and this information flows top-down, from the+    surrounding parsing context (are we in 'proc'?)++Alternative V, backtracking with parser combinators+---------------------------------------------------+One might think we could sidestep the issue entirely by using a backtracking+parser and doing something along the lines of (try pExpr <|> pPat).++Turns out, this wouldn't work very well, as there can be patterns inside+expressions (e.g. via 'case', 'let', 'do') and expressions inside patterns+(e.g. view patterns). To handle this, we would need to backtrack while+backtracking, and unbound levels of backtracking lead to very fragile+performance.++Alternative VI, an intermediate data type+-----------------------------------------+There are common syntactic elements of expressions, commands, and patterns+(e.g. all of them must have balanced parentheses), and we can capture this+common structure in an intermediate data type, Frame:++data Frame+  = FrameVar RdrName+    -- ^ Identifier: Just, map, BS.length+  | FrameTuple [LTupArgFrame] Boxity+    -- ^ Tuple (section): (a,b) (a,b,c) (a,,) (,a,)+  | FrameTySig LFrame (LHsSigWcType GhcPs)+    -- ^ Type signature: x :: ty+  | FramePar (SrcSpan, SrcSpan) LFrame+    -- ^ Parentheses+  | FrameIf LFrame LFrame LFrame+    -- ^ If-expression: if p then x else y+  | FrameCase LFrame [LFrameMatch]+    -- ^ Case-expression: case x of { p1 -> e1; p2 -> e2 }+  | FrameDo (HsStmtContext Name) [LFrameStmt]+    -- ^ Do-expression: do { s1; a <- s2; s3 }+  ...+  | FrameExpr (HsExpr GhcPs)   -- unambiguously an expression+  | FramePat (HsPat GhcPs)     -- unambiguously a pattern+  | FrameCommand (HsCmd GhcPs) -- unambiguously a command++To determine which constructors 'Frame' needs to have, we take the union of+intersections between HsExpr, HsCmd, and HsPat.++The intersection between HsPat and HsExpr:++  HsPat  =  VarPat   | TuplePat      | SigPat        | ParPat   | ...+  HsExpr =  HsVar    | ExplicitTuple | ExprWithTySig | HsPar    | ...+  -------------------------------------------------------------------+  Frame  =  FrameVar | FrameTuple    | FrameTySig    | FramePar | ...++The intersection between HsCmd and HsExpr:++  HsCmd  = HsCmdIf | HsCmdCase | HsCmdDo | HsCmdPar+  HsExpr = HsIf    | HsCase    | HsDo    | HsPar+  ------------------------------------------------+  Frame = FrameIf  | FrameCase | FrameDo | FramePar++The intersection between HsCmd and HsPat:++  HsPat  = ParPat   | ...+  HsCmd  = HsCmdPar | ...+  -----------------------+  Frame  = FramePar | ...++Take the union of each intersection and this yields the final 'Frame' data+type. The problem with this approach is that we end up duplicating a good+portion of hsSyn:++    Frame         for  HsExpr, HsPat, HsCmd+    TupArgFrame   for  HsTupArg+    FrameMatch    for  Match+    FrameStmt     for  StmtLR+    FrameGRHS     for  GRHS+    FrameGRHSs    for  GRHSs+    ...++Alternative VII, a product type+-------------------------------+We could avoid the intermediate representation of Alternative VI by parsing+into a product of interpretations directly:++    -- See Note [Parser-Validator]+    type ExpCmdPat = ( PV (LHsExpr GhcPs)+                     , PV (LHsCmd GhcPs)+                     , PV (LHsPat GhcPs) )++This means that in positions where we do not know whether to produce+expression, a pattern, or a command, we instead produce a parser-validator for+each possible option.++Then, as soon as we have parsed far enough to resolve the ambiguity, we pick+the appropriate component of the product, discarding the rest:++    checkExpOf3 (e, _, _) = e  -- interpret as an expression+    checkCmdOf3 (_, c, _) = c  -- interpret as a command+    checkPatOf3 (_, _, p) = p  -- interpret as a pattern++We can easily define ambiguities between arbitrary subsets of interpretations.+For example, when we know ahead of type that only an expression or a command is+possible, but not a pattern, we can use a smaller type:++    -- See Note [Parser-Validator]+    type ExpCmd = (PV (LHsExpr GhcPs), PV (LHsCmd GhcPs))++    checkExpOf2 (e, _) = e  -- interpret as an expression+    checkCmdOf2 (_, c) = c  -- interpret as a command++However, there is a slight problem with this approach, namely code duplication+in parser productions. Consider the 'alts' production used to parse case-of+alternatives:++  alts :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }+    : alts1     { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }+    | ';' alts  { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }++Under the new scheme, we have to completely duplicate its type signature and+each reduction rule:++  alts :: { ( PV (Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)])) -- as an expression+            , PV (Located ([AddAnn],[LMatch GhcPs (LHsCmd GhcPs)]))  -- as a command+            ) }+    : alts1+        { ( checkExpOf2 $1 >>= \ $1 ->+            return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1)+          , checkCmdOf2 $1 >>= \ $1 ->+            return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1)+          ) }+    | ';' alts+        { ( checkExpOf2 $2 >>= \ $2 ->+            return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2)+          , checkCmdOf2 $2 >>= \ $2 ->+            return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2)+          ) }++And the same goes for other productions: 'altslist', 'alts1', 'alt', 'alt_rhs',+'ralt', 'gdpats', 'gdpat', 'exp', ... and so on. That is a lot of code!++-}++---------------------------------------------------------------------------+-- Miscellaneous utilities++-- | Check if a fixity is valid. We support bypassing the usual bound checks+-- for some special operators.+checkPrecP+        :: Located (SourceText,Int)             -- ^ precedence+        -> Located (OrdList (Located RdrName))  -- ^ operators+        -> P ()+checkPrecP (dL->L l (_,i)) (dL->L _ ol)+ | 0 <= i, i <= maxPrecedence = pure ()+ | all specialOp ol = pure ()+ | otherwise = addFatalError l (text ("Precedence out of range: " ++ show i))+  where+    specialOp op = unLoc op `elem` [ eqTyCon_RDR+                                   , getRdrName funTyCon ]++mkRecConstrOrUpdate+        :: LHsExpr GhcPs+        -> SrcSpan+        -> ([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)+        -> P (HsExpr GhcPs)++mkRecConstrOrUpdate (dL->L l (HsVar _ (dL->L _ c))) _ (fs,dd)+  | isRdrDataCon c+  = return (mkRdrRecordCon (cL l c) (mk_rec_fields fs dd))+mkRecConstrOrUpdate exp _ (fs,dd)+  | Just dd_loc <- dd = addFatalError dd_loc (text "You cannot use `..' in a record update")+  | otherwise = return (mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) fs))++mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs+mkRdrRecordUpd exp flds+  = RecordUpd { rupd_ext  = noExt+              , rupd_expr = exp+              , rupd_flds = flds }++mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs+mkRdrRecordCon con flds+  = RecordCon { rcon_ext = noExt, rcon_con_name = con, rcon_flds = flds }++mk_rec_fields :: [LHsRecField id arg] -> Maybe SrcSpan -> HsRecFields id arg+mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }+mk_rec_fields fs (Just s)  = HsRecFields { rec_flds = fs+                                     , rec_dotdot = Just (cL s (length fs)) }++mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs+mk_rec_upd_field (HsRecField (dL->L loc (FieldOcc _ rdr)) arg pun)+  = HsRecField (L loc (Unambiguous noExt rdr)) arg pun+mk_rec_upd_field (HsRecField (dL->L _ (XFieldOcc _)) _ _)+  = panic "mk_rec_upd_field"+mk_rec_upd_field (HsRecField _ _ _)+  = panic "mk_rec_upd_field: Impossible Match" -- due to #15884++mkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation+               -> InlinePragma+-- The (Maybe Activation) is because the user can omit+-- the activation spec (and usually does)+mkInlinePragma src (inl, match_info) mb_act+  = InlinePragma { inl_src = src -- Note [Pragma source text] in BasicTypes+                 , inl_inline = inl+                 , inl_sat    = Nothing+                 , inl_act    = act+                 , inl_rule   = match_info }+  where+    act = case mb_act of+            Just act -> act+            Nothing  -> -- No phase specified+                        case inl of+                          NoInline -> NeverActive+                          _other   -> AlwaysActive++-----------------------------------------------------------------------------+-- utilities for foreign declarations++-- construct a foreign import declaration+--+mkImport :: Located CCallConv+         -> Located Safety+         -> (Located StringLiteral, Located RdrName, LHsSigType GhcPs)+         -> P (HsDecl GhcPs)+mkImport cconv safety (L loc (StringLiteral esrc entity), v, ty) =+    case unLoc cconv of+      CCallConv          -> mkCImport+      CApiConv           -> mkCImport+      StdCallConv        -> mkCImport+      PrimCallConv       -> mkOtherImport+      JavaScriptCallConv -> mkOtherImport+  where+    -- Parse a C-like entity string of the following form:+    --   "[static] [chname] [&] [cid]" | "dynamic" | "wrapper"+    -- If 'cid' is missing, the function name 'v' is used instead as symbol+    -- name (cf section 8.5.1 in Haskell 2010 report).+    mkCImport = do+      let e = unpackFS entity+      case parseCImport cconv safety (mkExtName (unLoc v)) e (cL loc esrc) of+        Nothing         -> addFatalError loc (text "Malformed entity string")+        Just importSpec -> returnSpec importSpec++    -- currently, all the other import conventions only support a symbol name in+    -- the entity string. If it is missing, we use the function name instead.+    mkOtherImport = returnSpec importSpec+      where+        entity'    = if nullFS entity+                        then mkExtName (unLoc v)+                        else entity+        funcTarget = CFunction (StaticTarget esrc entity' Nothing True)+        importSpec = CImport cconv safety Nothing funcTarget (cL loc esrc)++    returnSpec spec = return $ ForD noExt $ ForeignImport+          { fd_i_ext  = noExt+          , fd_name   = v+          , fd_sig_ty = ty+          , fd_fi     = spec+          }++++-- the string "foo" is ambiguous: either a header or a C identifier.  The+-- C identifier case comes first in the alternatives below, so we pick+-- that one.+parseCImport :: Located CCallConv -> Located Safety -> FastString -> String+             -> Located SourceText+             -> Maybe ForeignImport+parseCImport cconv safety nm str sourceText =+ listToMaybe $ map fst $ filter (null.snd) $+     readP_to_S parse str+ where+   parse = do+       skipSpaces+       r <- choice [+          string "dynamic" >> return (mk Nothing (CFunction DynamicTarget)),+          string "wrapper" >> return (mk Nothing CWrapper),+          do optional (token "static" >> skipSpaces)+             ((mk Nothing <$> cimp nm) ++++              (do h <- munch1 hdr_char+                  skipSpaces+                  mk (Just (Header (SourceText h) (mkFastString h)))+                      <$> cimp nm))+         ]+       skipSpaces+       return r++   token str = do _ <- string str+                  toks <- look+                  case toks of+                      c : _+                       | id_char c -> pfail+                      _            -> return ()++   mk h n = CImport cconv safety h n sourceText++   hdr_char c = not (isSpace c)+   -- header files are filenames, which can contain+   -- pretty much any char (depending on the platform),+   -- so just accept any non-space character+   id_first_char c = isAlpha    c || c == '_'+   id_char       c = isAlphaNum c || c == '_'++   cimp nm = (ReadP.char '&' >> skipSpaces >> CLabel <$> cid)+             +++ (do isFun <- case unLoc cconv of+                               CApiConv ->+                                  option True+                                         (do token "value"+                                             skipSpaces+                                             return False)+                               _ -> return True+                     cid' <- cid+                     return (CFunction (StaticTarget NoSourceText cid'+                                        Nothing isFun)))+          where+            cid = return nm ++++                  (do c  <- satisfy id_first_char+                      cs <-  many (satisfy id_char)+                      return (mkFastString (c:cs)))+++-- construct a foreign export declaration+--+mkExport :: Located CCallConv+         -> (Located StringLiteral, Located RdrName, LHsSigType GhcPs)+         -> P (HsDecl GhcPs)+mkExport (dL->L lc cconv) (dL->L le (StringLiteral esrc entity), v, ty)+ = return $ ForD noExt $+   ForeignExport { fd_e_ext = noExt, fd_name = v, fd_sig_ty = ty+                 , fd_fe = CExport (cL lc (CExportStatic esrc entity' cconv))+                                   (cL le esrc) }+  where+    entity' | nullFS entity = mkExtName (unLoc v)+            | otherwise     = entity++-- Supplying the ext_name in a foreign decl is optional; if it+-- isn't there, the Haskell name is assumed. Note that no transformation+-- of the Haskell name is then performed, so if you foreign export (++),+-- it's external name will be "++". Too bad; it's important because we don't+-- want z-encoding (e.g. names with z's in them shouldn't be doubled)+--+mkExtName :: RdrName -> CLabelString+mkExtName rdrNm = mkFastString (occNameString (rdrNameOcc rdrNm))++--------------------------------------------------------------------------------+-- Help with module system imports/exports++data ImpExpSubSpec = ImpExpAbs+                   | ImpExpAll+                   | ImpExpList [Located ImpExpQcSpec]+                   | ImpExpAllWith [Located ImpExpQcSpec]++data ImpExpQcSpec = ImpExpQcName (Located RdrName)+                  | ImpExpQcType (Located RdrName)+                  | ImpExpQcWildcard++mkModuleImpExp :: Located ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs)+mkModuleImpExp (dL->L l specname) subs =+  case subs of+    ImpExpAbs+      | isVarNameSpace (rdrNameSpace name)+                       -> return $ IEVar noExt (cL l (ieNameFromSpec specname))+      | otherwise      -> IEThingAbs noExt . cL l <$> nameT+    ImpExpAll          -> IEThingAll noExt . cL l <$> nameT+    ImpExpList xs      ->+      (\newName -> IEThingWith noExt (cL l newName)+        NoIEWildcard (wrapped xs) []) <$> nameT+    ImpExpAllWith xs                       ->+      do allowed <- getBit PatternSynonymsBit+         if allowed+          then+            let withs = map unLoc xs+                pos   = maybe NoIEWildcard IEWildcard+                          (findIndex isImpExpQcWildcard withs)+                ies   = wrapped $ filter (not . isImpExpQcWildcard . unLoc) xs+            in (\newName+                        -> IEThingWith noExt (cL l newName) pos ies [])+               <$> nameT+          else addFatalError l+            (text "Illegal export form (use PatternSynonyms to enable)")+  where+    name = ieNameVal specname+    nameT =+      if isVarNameSpace (rdrNameSpace name)+        then addFatalError l+              (text "Expecting a type constructor but found a variable,"+               <+> quotes (ppr name) <> text "."+              $$ if isSymOcc $ rdrNameOcc name+                   then text "If" <+> quotes (ppr name)+                        <+> text "is a type constructor"+           <+> text "then enable ExplicitNamespaces and use the 'type' keyword."+                   else empty)+        else return $ ieNameFromSpec specname++    ieNameVal (ImpExpQcName ln)  = unLoc ln+    ieNameVal (ImpExpQcType ln)  = unLoc ln+    ieNameVal (ImpExpQcWildcard) = panic "ieNameVal got wildcard"++    ieNameFromSpec (ImpExpQcName ln)  = IEName ln+    ieNameFromSpec (ImpExpQcType ln)  = IEType ln+    ieNameFromSpec (ImpExpQcWildcard) = panic "ieName got wildcard"++    wrapped = map (onHasSrcSpan ieNameFromSpec)++mkTypeImpExp :: Located RdrName   -- TcCls or Var name space+             -> P (Located RdrName)+mkTypeImpExp name =+  do allowed <- getBit ExplicitNamespacesBit+     unless allowed $ addError (getLoc name) $+       text "Illegal keyword 'type' (use ExplicitNamespaces to enable)"+     return (fmap (`setRdrNameSpace` tcClsName) name)++checkImportSpec :: Located [LIE GhcPs] -> P (Located [LIE GhcPs])+checkImportSpec ie@(dL->L _ specs) =+    case [l | (dL->L l (IEThingWith _ _ (IEWildcard _) _ _)) <- specs] of+      [] -> return ie+      (l:_) -> importSpecError l+  where+    importSpecError l =+      addFatalError l+        (text "Illegal import form, this syntax can only be used to bundle"+        $+$ text "pattern synonyms with types in module exports.")++-- In the correct order+mkImpExpSubSpec :: [Located ImpExpQcSpec] -> P ([AddAnn], ImpExpSubSpec)+mkImpExpSubSpec [] = return ([], ImpExpList [])+mkImpExpSubSpec [dL->L _ ImpExpQcWildcard] =+  return ([], ImpExpAll)+mkImpExpSubSpec xs =+  if (any (isImpExpQcWildcard . unLoc) xs)+    then return $ ([], ImpExpAllWith xs)+    else return $ ([], ImpExpList xs)++isImpExpQcWildcard :: ImpExpQcSpec -> Bool+isImpExpQcWildcard ImpExpQcWildcard = True+isImpExpQcWildcard _                = False++-----------------------------------------------------------------------------+-- Warnings and failures++warnStarIsType :: SrcSpan -> P ()+warnStarIsType span = addWarning Opt_WarnStarIsType span msg+  where+    msg =  text "Using" <+> quotes (text "*")+           <+> text "(or its Unicode variant) to mean"+           <+> quotes (text "Data.Kind.Type")+        $$ text "relies on the StarIsType extension, which will become"+        $$ text "deprecated in the future."+        $$ text "Suggested fix: use" <+> quotes (text "Type")+           <+> text "from" <+> quotes (text "Data.Kind") <+> text "instead."++warnStarBndr :: SrcSpan -> P ()+warnStarBndr span = addWarning Opt_WarnStarBinder span msg+  where+    msg =  text "Found binding occurrence of" <+> quotes (text "*")+           <+> text "yet StarIsType is enabled."+        $$ text "NB. To use (or export) this operator in"+           <+> text "modules with StarIsType,"+        $$ text "    including the definition module, you must qualify it."++failOpFewArgs :: Located RdrName -> P a+failOpFewArgs (dL->L loc op) =+  do { star_is_type <- getBit StarIsTypeBit+     ; let msg = too_few $$ starInfo star_is_type op+     ; addFatalError loc msg }+  where+    too_few = text "Operator applied to too few arguments:" <+> ppr op++failOpDocPrev :: SrcSpan -> P a+failOpDocPrev loc = addFatalError loc msg+  where+    msg = text "Unexpected documentation comment."++failOpStrictnessCompound :: Located SrcStrictness -> LHsType GhcPs -> P a+failOpStrictnessCompound (dL->L _ str) (dL->L loc ty) = addFatalError loc msg+  where+    msg = text "Strictness annotation applied to a compound type." $$+          text "Did you mean to add parentheses?" $$+          nest 2 (ppr str <> parens (ppr ty))++failOpStrictnessPosition :: Located SrcStrictness -> P a+failOpStrictnessPosition (dL->L loc _) = addFatalError loc msg+  where+    msg = text "Strictness annotation cannot appear in this position."++-----------------------------------------------------------------------------+-- Misc utils++type PV = P -- See Note [Parser-Validator]++{- Note [Parser-Validator]+~~~~~~~~~~~~~~~~~~~~~~~~~~++When resolving ambiguities, we need to postpone failure to make a choice later.+For example, if we have ambiguity between some A and B, our parser could be++  abParser :: P (Maybe A, Maybe B)++This way we can represent four possible outcomes of parsing:++    (Just a, Nothing)       -- definitely A+    (Nothing, Just b)       -- definitely B+    (Just a, Just b)        -- either A or B+    (Nothing, Nothing)      -- neither A nor B++However, if we want to report informative parse errors, accumulate warnings,+and add API annotations, we are better off using 'P' instead of 'Maybe':++  abParser :: P (P A, P B)++So we have an outer layer of P that consumes the input and builds the inner+layer, which validates the input.++For clarity, we introduce the notion of a parser-validator: a parser that does+not consume any input, but may fail or use other effects. Thus we have:++  abParser :: P (PV A, PV B)++-}++-- | Hint about bang patterns, assuming @BangPatterns@ is off.+hintBangPat :: SrcSpan -> HsExpr GhcPs -> P ()+hintBangPat span e = do+    bang_on <- getBit BangPatBit+    unless bang_on $+      addFatalError span+        (text "Illegal bang-pattern (use BangPatterns):" $$ ppr e)++data SumOrTuple+  = Sum ConTag Arity (LHsExpr GhcPs)+  | Tuple [LHsTupArg GhcPs]++mkSumOrTuple :: Boxity -> SrcSpan -> SumOrTuple -> P (HsExpr GhcPs)++-- Tuple+mkSumOrTuple boxity _ (Tuple es) = return (ExplicitTuple noExt es boxity)++-- Sum+mkSumOrTuple Unboxed _ (Sum alt arity e) =+    return (ExplicitSum noExt alt arity e)+mkSumOrTuple Boxed l (Sum alt arity (dL->L _ e)) =+    addFatalError l (hang (text "Boxed sums not supported:") 2+                      (ppr_boxed_sum alt arity e))+  where+    ppr_boxed_sum :: ConTag -> Arity -> HsExpr GhcPs -> SDoc+    ppr_boxed_sum alt arity e =+      text "(" <+> ppr_bars (alt - 1) <+> ppr e <+> ppr_bars (arity - alt)+      <+> text ")"++    ppr_bars n = hsep (replicate n (Outputable.char '|'))++mkLHsOpTy :: LHsType GhcPs -> Located RdrName -> LHsType GhcPs -> LHsType GhcPs+mkLHsOpTy x op y =+  let loc = getLoc x `combineSrcSpans` getLoc op `combineSrcSpans` getLoc y+  in cL loc (mkHsOpTy x op y)++mkLHsDocTy :: LHsType GhcPs -> LHsDocString -> LHsType GhcPs+mkLHsDocTy t doc =+  let loc = getLoc t `combineSrcSpans` getLoc doc+  in cL loc (HsDocTy noExt t doc)++mkLHsDocTyMaybe :: LHsType GhcPs -> Maybe LHsDocString -> LHsType GhcPs+mkLHsDocTyMaybe t = maybe t (mkLHsDocTy t)++-----------------------------------------------------------------------------+-- Token symbols++starSym :: Bool -> String+starSym True = "★"+starSym False = "*"++forallSym :: Bool -> String+forallSym True = "∀"+forallSym False = "forall"
+ compiler/parser/cutils.c view
@@ -0,0 +1,30 @@+/*+These utility routines are used various+places in the GHC library.+*/++#include "Rts.h"++#include "HsFFI.h"++#include <string.h>++#if defined(HAVE_UNISTD_H)+#include <unistd.h>+#endif++void+enableTimingStats( void )       /* called from the driver */+{+    RtsFlags.GcFlags.giveStats = ONELINE_GC_STATS;+}++void+setHeapSize( HsInt size )+{+    RtsFlags.GcFlags.heapSizeSuggestion = size / BLOCK_SIZE;+    if (RtsFlags.GcFlags.maxHeapSize != 0 &&+        RtsFlags.GcFlags.heapSizeSuggestion > RtsFlags.GcFlags.maxHeapSize) {+        RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;+    }+}
+ compiler/prelude/ForeignCall.hs view
@@ -0,0 +1,348 @@+{-+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[Foreign]{Foreign calls}+-}++{-# LANGUAGE DeriveDataTypeable #-}++module ForeignCall (+        ForeignCall(..), isSafeForeignCall,+        Safety(..), playSafe, playInterruptible,++        CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,+        CCallSpec(..),+        CCallTarget(..), isDynamicTarget,+        CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,++        Header(..), CType(..),+    ) where++import GhcPrelude++import FastString+import Binary+import Outputable+import Module+import BasicTypes ( SourceText, pprWithSourceText )++import Data.Char+import Data.Data++{-+************************************************************************+*                                                                      *+\subsubsection{Data types}+*                                                                      *+************************************************************************+-}++newtype ForeignCall = CCall CCallSpec+  deriving Eq++isSafeForeignCall :: ForeignCall -> Bool+isSafeForeignCall (CCall (CCallSpec _ _ safe)) = playSafe safe++-- We may need more clues to distinguish foreign calls+-- but this simple printer will do for now+instance Outputable ForeignCall where+  ppr (CCall cc)  = ppr cc++data Safety+  = PlaySafe            -- Might invoke Haskell GC, or do a call back, or+                        -- switch threads, etc.  So make sure things are+                        -- tidy before the call. Additionally, in the threaded+                        -- RTS we arrange for the external call to be executed+                        -- by a separate OS thread, i.e., _concurrently_ to the+                        -- execution of other Haskell threads.++  | PlayInterruptible   -- Like PlaySafe, but additionally+                        -- the worker thread running this foreign call may+                        -- be unceremoniously killed, so it must be scheduled+                        -- on an unbound thread.++  | PlayRisky           -- None of the above can happen; the call will return+                        -- without interacting with the runtime system at all+  deriving ( Eq, Show, Data )+        -- Show used just for Show Lex.Token, I think++instance Outputable Safety where+  ppr PlaySafe = text "safe"+  ppr PlayInterruptible = text "interruptible"+  ppr PlayRisky = text "unsafe"++playSafe :: Safety -> Bool+playSafe PlaySafe = True+playSafe PlayInterruptible = True+playSafe PlayRisky = False++playInterruptible :: Safety -> Bool+playInterruptible PlayInterruptible = True+playInterruptible _ = False++{-+************************************************************************+*                                                                      *+\subsubsection{Calling C}+*                                                                      *+************************************************************************+-}++data CExportSpec+  = CExportStatic               -- foreign export ccall foo :: ty+        SourceText              -- of the CLabelString.+                                -- See note [Pragma source text] in BasicTypes+        CLabelString            -- C Name of exported function+        CCallConv+  deriving Data++data CCallSpec+  =  CCallSpec  CCallTarget     -- What to call+                CCallConv       -- Calling convention to use.+                Safety+  deriving( Eq )++-- The call target:++-- | How to call a particular function in C-land.+data CCallTarget+  -- An "unboxed" ccall# to named function in a particular package.+  = StaticTarget+        SourceText                -- of the CLabelString.+                                  -- See note [Pragma source text] in BasicTypes+        CLabelString                    -- C-land name of label.++        (Maybe UnitId)              -- What package the function is in.+                                        -- If Nothing, then it's taken to be in the current package.+                                        -- Note: This information is only used for PrimCalls on Windows.+                                        --       See CLabel.labelDynamic and CoreToStg.coreToStgApp+                                        --       for the difference in representation between PrimCalls+                                        --       and ForeignCalls. If the CCallTarget is representing+                                        --       a regular ForeignCall then it's safe to set this to Nothing.++  -- The first argument of the import is the name of a function pointer (an Addr#).+  --    Used when importing a label as "foreign import ccall "dynamic" ..."+        Bool                            -- True => really a function+                                        -- False => a value; only+                                        -- allowed in CAPI imports+  | DynamicTarget++  deriving( Eq, Data )++isDynamicTarget :: CCallTarget -> Bool+isDynamicTarget DynamicTarget = True+isDynamicTarget _             = False++{-+Stuff to do with calling convention:++ccall:          Caller allocates parameters, *and* deallocates them.++stdcall:        Caller allocates parameters, callee deallocates.+                Function name has @N after it, where N is number of arg bytes+                e.g.  _Foo@8. This convention is x86 (win32) specific.++See: http://www.programmersheaven.com/2/Calling-conventions+-}++-- any changes here should be replicated in  the CallConv type in template haskell+data CCallConv = CCallConv | CApiConv | StdCallConv | PrimCallConv | JavaScriptCallConv+  deriving (Eq, Data)++instance Outputable CCallConv where+  ppr StdCallConv = text "stdcall"+  ppr CCallConv   = text "ccall"+  ppr CApiConv    = text "capi"+  ppr PrimCallConv = text "prim"+  ppr JavaScriptCallConv = text "javascript"++defaultCCallConv :: CCallConv+defaultCCallConv = CCallConv++ccallConvToInt :: CCallConv -> Int+ccallConvToInt StdCallConv = 0+ccallConvToInt CCallConv   = 1+ccallConvToInt CApiConv    = panic "ccallConvToInt CApiConv"+ccallConvToInt (PrimCallConv {}) = panic "ccallConvToInt PrimCallConv"+ccallConvToInt JavaScriptCallConv = panic "ccallConvToInt JavaScriptCallConv"++{-+Generate the gcc attribute corresponding to the given+calling convention (used by PprAbsC):+-}++ccallConvAttribute :: CCallConv -> SDoc+ccallConvAttribute StdCallConv       = text "__attribute__((__stdcall__))"+ccallConvAttribute CCallConv         = empty+ccallConvAttribute CApiConv          = empty+ccallConvAttribute (PrimCallConv {}) = panic "ccallConvAttribute PrimCallConv"+ccallConvAttribute JavaScriptCallConv = panic "ccallConvAttribute JavaScriptCallConv"++type CLabelString = FastString          -- A C label, completely unencoded++pprCLabelString :: CLabelString -> SDoc+pprCLabelString lbl = ftext lbl++isCLabelString :: CLabelString -> Bool  -- Checks to see if this is a valid C label+isCLabelString lbl+  = all ok (unpackFS lbl)+  where+    ok c = isAlphaNum c || c == '_' || c == '.'+        -- The '.' appears in e.g. "foo.so" in the+        -- module part of a ExtName.  Maybe it should be separate++-- Printing into C files:++instance Outputable CExportSpec where+  ppr (CExportStatic _ str _) = pprCLabelString str++instance Outputable CCallSpec where+  ppr (CCallSpec fun cconv safety)+    = hcat [ whenPprDebug callconv, ppr_fun fun ]+    where+      callconv = text "{-" <> ppr cconv <> text "-}"++      gc_suf | playSafe safety = text "_GC"+             | otherwise       = empty++      ppr_fun (StaticTarget st _fn mPkgId isFun)+        = text (if isFun then "__pkg_ccall"+                         else "__pkg_ccall_value")+       <> gc_suf+       <+> (case mPkgId of+            Nothing -> empty+            Just pkgId -> ppr pkgId)+       <+> (pprWithSourceText st empty)++      ppr_fun DynamicTarget+        = text "__dyn_ccall" <> gc_suf <+> text "\"\""++-- The filename for a C header file+-- Note [Pragma source text] in BasicTypes+data Header = Header SourceText FastString+    deriving (Eq, Data)++instance Outputable Header where+    ppr (Header st h) = pprWithSourceText st (doubleQuotes $ ppr h)++-- | A C type, used in CAPI FFI calls+--+--  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# CTYPE'@,+--        'ApiAnnotation.AnnHeader','ApiAnnotation.AnnVal',+--        'ApiAnnotation.AnnClose' @'\#-}'@,++-- For details on above see note [Api annotations] in ApiAnnotation+data CType = CType SourceText -- Note [Pragma source text] in BasicTypes+                   (Maybe Header) -- header to include for this type+                   (SourceText,FastString) -- the type itself+    deriving (Eq, Data)++instance Outputable CType where+    ppr (CType stp mh (stct,ct))+      = pprWithSourceText stp (text "{-# CTYPE") <+> hDoc+        <+> pprWithSourceText stct (doubleQuotes (ftext ct)) <+> text "#-}"+        where hDoc = case mh of+                     Nothing -> empty+                     Just h -> ppr h++{-+************************************************************************+*                                                                      *+\subsubsection{Misc}+*                                                                      *+************************************************************************+-}++instance Binary ForeignCall where+    put_ bh (CCall aa) = put_ bh aa+    get bh = do aa <- get bh; return (CCall aa)++instance Binary Safety where+    put_ bh PlaySafe = do+            putByte bh 0+    put_ bh PlayInterruptible = do+            putByte bh 1+    put_ bh PlayRisky = do+            putByte bh 2+    get bh = do+            h <- getByte bh+            case h of+              0 -> do return PlaySafe+              1 -> do return PlayInterruptible+              _ -> do return PlayRisky++instance Binary CExportSpec where+    put_ bh (CExportStatic ss aa ab) = do+            put_ bh ss+            put_ bh aa+            put_ bh ab+    get bh = do+          ss <- get bh+          aa <- get bh+          ab <- get bh+          return (CExportStatic ss aa ab)++instance Binary CCallSpec where+    put_ bh (CCallSpec aa ab ac) = do+            put_ bh aa+            put_ bh ab+            put_ bh ac+    get bh = do+          aa <- get bh+          ab <- get bh+          ac <- get bh+          return (CCallSpec aa ab ac)++instance Binary CCallTarget where+    put_ bh (StaticTarget ss aa ab ac) = do+            putByte bh 0+            put_ bh ss+            put_ bh aa+            put_ bh ab+            put_ bh ac+    put_ bh DynamicTarget = do+            putByte bh 1+    get bh = do+            h <- getByte bh+            case h of+              0 -> do ss <- get bh+                      aa <- get bh+                      ab <- get bh+                      ac <- get bh+                      return (StaticTarget ss aa ab ac)+              _ -> do return DynamicTarget++instance Binary CCallConv where+    put_ bh CCallConv = do+            putByte bh 0+    put_ bh StdCallConv = do+            putByte bh 1+    put_ bh PrimCallConv = do+            putByte bh 2+    put_ bh CApiConv = do+            putByte bh 3+    put_ bh JavaScriptCallConv = do+            putByte bh 4+    get bh = do+            h <- getByte bh+            case h of+              0 -> do return CCallConv+              1 -> do return StdCallConv+              2 -> do return PrimCallConv+              3 -> do return CApiConv+              _ -> do return JavaScriptCallConv++instance Binary CType where+    put_ bh (CType s mh fs) = do put_ bh s+                                 put_ bh mh+                                 put_ bh fs+    get bh = do s  <- get bh+                mh <- get bh+                fs <- get bh+                return (CType s mh fs)++instance Binary Header where+    put_ bh (Header s h) = put_ bh s >> put_ bh h+    get bh = do s <- get bh+                h <- get bh+                return (Header s h)
+ compiler/prelude/KnownUniques.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE CPP #-}++-- | This is where we define a mapping from Uniques to their associated+-- known-key Names for things associated with tuples and sums. We use this+-- mapping while deserializing known-key Names in interface file symbol tables,+-- which are encoded as their Unique. See Note [Symbol table representation of+-- names] for details.+--++module KnownUniques+    ( -- * Looking up known-key names+      knownUniqueName++      -- * Getting the 'Unique's of 'Name's+      -- ** Anonymous sums+    , mkSumTyConUnique+    , mkSumDataConUnique+      -- ** Tuples+      -- *** Vanilla+    , mkTupleTyConUnique+    , mkTupleDataConUnique+      -- *** Constraint+    , mkCTupleTyConUnique+    , mkCTupleDataConUnique+    ) where++#include "HsVersions.h"++import GhcPrelude++import TysWiredIn+import TyCon+import DataCon+import Id+import BasicTypes+import Outputable+import Unique+import Name+import Util++import Data.Bits+import Data.Maybe++-- | Get the 'Name' associated with a known-key 'Unique'.+knownUniqueName :: Unique -> Maybe Name+knownUniqueName u =+    case tag of+      'z' -> Just $ getUnboxedSumName n+      '4' -> Just $ getTupleTyConName Boxed n+      '5' -> Just $ getTupleTyConName Unboxed n+      '7' -> Just $ getTupleDataConName Boxed n+      '8' -> Just $ getTupleDataConName Unboxed n+      'k' -> Just $ getCTupleTyConName n+      'm' -> Just $ getCTupleDataConUnique n+      _   -> Nothing+  where+    (tag, n) = unpkUnique u++--------------------------------------------------+-- Anonymous sums+--+-- Sum arities start from 2. The encoding is a bit funny: we break up the+-- integral part into bitfields for the arity, an alternative index (which is+-- taken to be 0xff in the case of the TyCon), and, in the case of a datacon, a+-- tag (used to identify the sum's TypeRep binding).+--+-- This layout is chosen to remain compatible with the usual unique allocation+-- for wired-in data constructors described in Unique.hs+--+-- TyCon for sum of arity k:+--   00000000 kkkkkkkk 11111100++-- TypeRep of TyCon for sum of arity k:+--   00000000 kkkkkkkk 11111101+--+-- DataCon for sum of arity k and alternative n (zero-based):+--   00000000 kkkkkkkk nnnnnn00+--+-- TypeRep for sum DataCon of arity k and alternative n (zero-based):+--   00000000 kkkkkkkk nnnnnn10++mkSumTyConUnique :: Arity -> Unique+mkSumTyConUnique arity =+    ASSERT(arity < 0x3f) -- 0x3f since we only have 6 bits to encode the+                         -- alternative+    mkUnique 'z' (arity `shiftL` 8 .|. 0xfc)++mkSumDataConUnique :: ConTagZ -> Arity -> Unique+mkSumDataConUnique alt arity+  | alt >= arity+  = panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity)+  | otherwise+  = mkUnique 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -}++getUnboxedSumName :: Int -> Name+getUnboxedSumName n+  | n .&. 0xfc == 0xfc+  = case tag of+      0x0 -> tyConName $ sumTyCon arity+      0x1 -> getRep $ sumTyCon arity+      _   -> pprPanic "getUnboxedSumName: invalid tag" (ppr tag)+  | tag == 0x0+  = dataConName $ sumDataCon (alt + 1) arity+  | tag == 0x1+  = getName $ dataConWrapId $ sumDataCon (alt + 1) arity+  | tag == 0x2+  = getRep $ promoteDataCon $ sumDataCon (alt + 1) arity+  | otherwise+  = pprPanic "getUnboxedSumName" (ppr n)+  where+    arity = n `shiftR` 8+    alt = (n .&. 0xfc) `shiftR` 2+    tag = 0x3 .&. n+    getRep tycon =+        fromMaybe (pprPanic "getUnboxedSumName(getRep)" (ppr tycon))+        $ tyConRepName_maybe tycon++-- Note [Uniques for tuple type and data constructors]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- Wired-in type constructor keys occupy *two* slots:+--    * u: the TyCon itself+--    * u+1: the TyConRepName of the TyCon+--+-- Wired-in tuple data constructor keys occupy *three* slots:+--    * u: the DataCon itself+--    * u+1: its worker Id+--    * u+2: the TyConRepName of the promoted TyCon++--------------------------------------------------+-- Constraint tuples++mkCTupleTyConUnique :: Arity -> Unique+mkCTupleTyConUnique a = mkUnique 'k' (2*a)++mkCTupleDataConUnique :: Arity -> Unique+mkCTupleDataConUnique a = mkUnique 'm' (3*a)++getCTupleTyConName :: Int -> Name+getCTupleTyConName n =+    case n `divMod` 2 of+      (arity, 0) -> cTupleTyConName arity+      (arity, 1) -> mkPrelTyConRepName $ cTupleTyConName arity+      _          -> panic "getCTupleTyConName: impossible"++getCTupleDataConUnique :: Int -> Name+getCTupleDataConUnique n =+    case n `divMod` 3 of+      (arity,  0) -> cTupleDataConName arity+      (_arity, 1) -> panic "getCTupleDataConName: no worker"+      (arity,  2) -> mkPrelTyConRepName $ cTupleDataConName arity+      _           -> panic "getCTupleDataConName: impossible"++--------------------------------------------------+-- Normal tuples++mkTupleDataConUnique :: Boxity -> Arity -> Unique+mkTupleDataConUnique Boxed          a = mkUnique '7' (3*a)    -- may be used in C labels+mkTupleDataConUnique Unboxed        a = mkUnique '8' (3*a)++mkTupleTyConUnique :: Boxity -> Arity -> Unique+mkTupleTyConUnique Boxed           a  = mkUnique '4' (2*a)+mkTupleTyConUnique Unboxed         a  = mkUnique '5' (2*a)++getTupleTyConName :: Boxity -> Int -> Name+getTupleTyConName boxity n =+    case n `divMod` 2 of+      (arity, 0) -> tyConName $ tupleTyCon boxity arity+      (arity, 1) -> fromMaybe (panic "getTupleTyConName")+                    $ tyConRepName_maybe $ tupleTyCon boxity arity+      _          -> panic "getTupleTyConName: impossible"++getTupleDataConName :: Boxity -> Int -> Name+getTupleDataConName boxity n =+    case n `divMod` 3 of+      (arity, 0) -> dataConName $ tupleDataCon boxity arity+      (arity, 1) -> idName $ dataConWorkId $ tupleDataCon boxity arity+      (arity, 2) -> fromMaybe (panic "getTupleDataCon")+                    $ tyConRepName_maybe $ promotedTupleDataCon boxity arity+      _          -> panic "getTupleDataConName: impossible"
+ compiler/prelude/KnownUniques.hs-boot view
@@ -0,0 +1,18 @@+module KnownUniques where++import GhcPrelude+import Unique+import Name+import BasicTypes++-- Needed by TysWiredIn+knownUniqueName :: Unique -> Maybe Name++mkSumTyConUnique :: Arity -> Unique+mkSumDataConUnique :: ConTagZ -> Arity -> Unique++mkCTupleTyConUnique :: Arity -> Unique+mkCTupleDataConUnique :: Arity -> Unique++mkTupleTyConUnique :: Boxity -> Arity -> Unique+mkTupleDataConUnique :: Boxity -> Arity -> Unique
+ compiler/prelude/PrelNames.hs view
@@ -0,0 +1,2485 @@+{-+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[PrelNames]{Definitions of prelude modules and names}+++Nota Bene: all Names defined in here should come from the base package++ - ModuleNames for prelude modules,+        e.g.    pREL_BASE_Name :: ModuleName++ - Modules for prelude modules+        e.g.    pREL_Base :: Module++ - Uniques for Ids, DataCons, TyCons and Classes that the compiler+   "knows about" in some way+        e.g.    intTyConKey :: Unique+                minusClassOpKey :: Unique++ - Names for Ids, DataCons, TyCons and Classes that the compiler+   "knows about" in some way+        e.g.    intTyConName :: Name+                minusName    :: Name+   One of these Names contains+        (a) the module and occurrence name of the thing+        (b) its Unique+   The way the compiler "knows about" one of these things is+   where the type checker or desugarer needs to look it up. For+   example, when desugaring list comprehensions the desugarer+   needs to conjure up 'foldr'.  It does this by looking up+   foldrName in the environment.++ - RdrNames for Ids, DataCons etc that the compiler may emit into+   generated code (e.g. for deriving).  It's not necessary to know+   the uniques for these guys, only their names+++Note [Known-key names]+~~~~~~~~~~~~~~~~~~~~~~+It is *very* important that the compiler gives wired-in things and+things with "known-key" names the correct Uniques wherever they+occur. We have to be careful about this in exactly two places:++  1. When we parse some source code, renaming the AST better yield an+     AST whose Names have the correct uniques++  2. When we read an interface file, the read-in gubbins better have+     the right uniques++This is accomplished through a combination of mechanisms:++  1. When parsing source code, the RdrName-decorated AST has some+     RdrNames which are Exact. These are wired-in RdrNames where the+     we could directly tell from the parsed syntax what Name to+     use. For example, when we parse a [] in a type we can just insert+     an Exact RdrName Name with the listTyConKey.++     Currently, I believe this is just an optimisation: it would be+     equally valid to just output Orig RdrNames that correctly record+     the module etc we expect the final Name to come from. However,+     were we to eliminate isBuiltInOcc_maybe it would become essential+     (see point 3).++  2. The knownKeyNames (which consist of the basicKnownKeyNames from+     the module, and those names reachable via the wired-in stuff from+     TysWiredIn) are used to initialise the "OrigNameCache" in+     IfaceEnv.  This initialization ensures that when the type checker+     or renamer (both of which use IfaceEnv) look up an original name+     (i.e. a pair of a Module and an OccName) for a known-key name+     they get the correct Unique.++     This is the most important mechanism for ensuring that known-key+     stuff gets the right Unique, and is why it is so important to+     place your known-key names in the appropriate lists.++  3. For "infinite families" of known-key names (i.e. tuples and sums), we+     have to be extra careful. Because there are an infinite number of+     these things, we cannot add them to the list of known-key names+     used to initialise the OrigNameCache. Instead, we have to+     rely on never having to look them up in that cache. See+     Note [Infinite families of known-key names] for details.+++Note [Infinite families of known-key names]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Infinite families of known-key things (e.g. tuples and sums) pose a tricky+problem: we can't add them to the knownKeyNames finite map which we use to+ensure that, e.g., a reference to (,) gets assigned the right unique (if this+doesn't sound familiar see Note [Known-key names] above).++We instead handle tuples and sums separately from the "vanilla" known-key+things,++  a) The parser recognises them specially and generates an Exact Name (hence not+     looked up in the orig-name cache)++  b) The known infinite families of names are specially serialised by+     BinIface.putName, with that special treatment detected when we read back to+     ensure that we get back to the correct uniques. See Note [Symbol table+     representation of names] in BinIface and Note [How tuples work] in+     TysWiredIn.++Most of the infinite families cannot occur in source code, so mechanisms (a) and (b)+suffice to ensure that they always have the right Unique. In particular,+implicit param TyCon names, constraint tuples and Any TyCons cannot be mentioned+by the user. For those things that *can* appear in source programs,++  c) IfaceEnv.lookupOrigNameCache uses isBuiltInOcc_maybe to map built-in syntax+     directly onto the corresponding name, rather than trying to find it in the+     original-name cache.++     See also Note [Built-in syntax and the OrigNameCache]+++Note [The integer library]+~~~~~~~~~~~~~~~~~~~~~~~~~~++Clearly, we need to know the names of various definitions of the integer+library, e.g. the type itself, `mkInteger` etc. But there are two possible+implementations of the integer library:++ * integer-gmp (fast, but uses libgmp, which may not be available on all+   targets and is GPL licensed)+ * integer-simple (slow, but pure Haskell and BSD-licensed)++We want the compiler to work with either one. The way we achieve this is:++ * When compiling the integer-{gmp,simple} library, we pass+     -this-unit-id  integer-wired-in+   to GHC (see the cabal file libraries/integer-{gmp,simple}.+ * This way, GHC can use just this UnitID (see Module.integerUnitId) when+   generating code, and the linker will succeed.++Unfortuately, the abstraction is not complete: When using integer-gmp, we+really want to use the S# constructor directly. This is controlled by+the `integerLibrary` field of `DynFlags`: If it is IntegerGMP, we use+this constructor directly (see  CorePrep.lookupIntegerSDataConName)++When GHC reads the package data base, it (internally only) pretends it has UnitId+`integer-wired-in` instead of the actual UnitId (which includes the version+number); just like for `base` and other packages, as described in+Note [Wired-in packages] in Module. This is done in Packages.findWiredInPackages.+-}++{-# LANGUAGE CPP #-}++module PrelNames (+        Unique, Uniquable(..), hasKey,  -- Re-exported for convenience++        -----------------------------------------------------------+        module PrelNames,       -- A huge bunch of (a) Names,  e.g. intTyConName+                                --                 (b) Uniques e.g. intTyConKey+                                --                 (c) Groups of classes and types+                                --                 (d) miscellaneous things+                                -- So many that we export them all+    ) where++#include "HsVersions.h"++import GhcPrelude++import Module+import OccName+import RdrName+import Unique+import Name+import SrcLoc+import FastString++{-+************************************************************************+*                                                                      *+     allNameStrings+*                                                                      *+************************************************************************+-}++allNameStrings :: [String]+-- Infinite list of a,b,c...z, aa, ab, ac, ... etc+allNameStrings = [ c:cs | cs <- "" : allNameStrings, c <- ['a'..'z'] ]++{-+************************************************************************+*                                                                      *+\subsection{Local Names}+*                                                                      *+************************************************************************++This *local* name is used by the interactive stuff+-}++itName :: Unique -> SrcSpan -> Name+itName uniq loc = mkInternalName uniq (mkOccNameFS varName (fsLit "it")) loc++-- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly+-- during compiler debugging.+mkUnboundName :: OccName -> Name+mkUnboundName occ = mkInternalName unboundKey occ noSrcSpan++isUnboundName :: Name -> Bool+isUnboundName name = name `hasKey` unboundKey++{-+************************************************************************+*                                                                      *+\subsection{Known key Names}+*                                                                      *+************************************************************************++This section tells what the compiler knows about the association of+names with uniques.  These ones are the *non* wired-in ones.  The+wired in ones are defined in TysWiredIn etc.+-}++basicKnownKeyNames :: [Name]  -- See Note [Known-key names]+basicKnownKeyNames+ = genericTyConNames+ ++ [   --  Classes.  *Must* include:+        --      classes that are grabbed by key (e.g., eqClassKey)+        --      classes in "Class.standardClassKeys" (quite a few)+        eqClassName,                    -- mentioned, derivable+        ordClassName,                   -- derivable+        boundedClassName,               -- derivable+        numClassName,                   -- mentioned, numeric+        enumClassName,                  -- derivable+        monadClassName,+        functorClassName,+        realClassName,                  -- numeric+        integralClassName,              -- numeric+        fractionalClassName,            -- numeric+        floatingClassName,              -- numeric+        realFracClassName,              -- numeric+        realFloatClassName,             -- numeric+        dataClassName,+        isStringClassName,+        applicativeClassName,+        alternativeClassName,+        foldableClassName,+        traversableClassName,+        semigroupClassName, sappendName,+        monoidClassName, memptyName, mappendName, mconcatName,++        -- The IO type+        -- See Note [TyConRepNames for non-wired-in TyCons]+        ioTyConName, ioDataConName,+        runMainIOName,+        runRWName,++        -- Type representation types+        trModuleTyConName, trModuleDataConName,+        trNameTyConName, trNameSDataConName, trNameDDataConName,+        trTyConTyConName, trTyConDataConName,++        -- Typeable+        typeableClassName,+        typeRepTyConName,+        someTypeRepTyConName,+        someTypeRepDataConName,+        kindRepTyConName,+        kindRepTyConAppDataConName,+        kindRepVarDataConName,+        kindRepAppDataConName,+        kindRepFunDataConName,+        kindRepTYPEDataConName,+        kindRepTypeLitSDataConName,+        kindRepTypeLitDDataConName,+        typeLitSortTyConName,+        typeLitSymbolDataConName,+        typeLitNatDataConName,+        typeRepIdName,+        mkTrTypeName,+        mkTrConName,+        mkTrAppName,+        mkTrFunName,+        typeSymbolTypeRepName, typeNatTypeRepName,+        trGhcPrimModuleName,++        -- KindReps for common cases+        starKindRepName,+        starArrStarKindRepName,+        starArrStarArrStarKindRepName,++        -- Dynamic+        toDynName,++        -- Numeric stuff+        negateName, minusName, geName, eqName,++        -- Conversion functions+        rationalTyConName,+        ratioTyConName, ratioDataConName,+        fromRationalName, fromIntegerName,+        toIntegerName, toRationalName,+        fromIntegralName, realToFracName,++        -- Int# stuff+        divIntName, modIntName,++        -- String stuff+        fromStringName,++        -- Enum stuff+        enumFromName, enumFromThenName,+        enumFromThenToName, enumFromToName,++        -- Applicative stuff+        pureAName, apAName, thenAName,++        -- Functor stuff+        fmapName,++        -- Monad stuff+        thenIOName, bindIOName, returnIOName, failIOName, bindMName, thenMName,+        returnMName, joinMName,++        -- MonadFail+        monadFailClassName, failMName,++        -- MonadFix+        monadFixClassName, mfixName,++        -- Arrow stuff+        arrAName, composeAName, firstAName,+        appAName, choiceAName, loopAName,++        -- Ix stuff+        ixClassName,++        -- Show stuff+        showClassName,++        -- Read stuff+        readClassName,++        -- Stable pointers+        newStablePtrName,++        -- GHC Extensions+        groupWithName,++        -- Strings and lists+        unpackCStringName,+        unpackCStringFoldrName, unpackCStringUtf8Name,++        -- Overloaded lists+        isListClassName,+        fromListName,+        fromListNName,+        toListName,++        -- List operations+        concatName, filterName, mapName,+        zipName, foldrName, buildName, augmentName, appendName,++        -- FFI primitive types that are not wired-in.+        stablePtrTyConName, ptrTyConName, funPtrTyConName,+        int8TyConName, int16TyConName, int32TyConName, int64TyConName,+        word16TyConName, word32TyConName, word64TyConName,++        -- Others+        otherwiseIdName, inlineIdName,+        eqStringName, assertName, breakpointName, breakpointCondName,+        opaqueTyConName,+        assertErrorName, traceName,+        printName, fstName, sndName,+        dollarName,++        -- Integer+        integerTyConName, mkIntegerName,+        integerToWord64Name, integerToInt64Name,+        word64ToIntegerName, int64ToIntegerName,+        plusIntegerName, timesIntegerName, smallIntegerName,+        wordToIntegerName,+        integerToWordName, integerToIntName, minusIntegerName,+        negateIntegerName, eqIntegerPrimName, neqIntegerPrimName,+        absIntegerName, signumIntegerName,+        leIntegerPrimName, gtIntegerPrimName, ltIntegerPrimName, geIntegerPrimName,+        compareIntegerName, quotRemIntegerName, divModIntegerName,+        quotIntegerName, remIntegerName, divIntegerName, modIntegerName,+        floatFromIntegerName, doubleFromIntegerName,+        encodeFloatIntegerName, encodeDoubleIntegerName,+        decodeDoubleIntegerName,+        gcdIntegerName, lcmIntegerName,+        andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,+        shiftLIntegerName, shiftRIntegerName, bitIntegerName,+        integerSDataConName,naturalSDataConName,++        -- Natural+        naturalTyConName,+        naturalFromIntegerName, naturalToIntegerName,+        plusNaturalName, minusNaturalName, timesNaturalName, mkNaturalName,+        wordToNaturalName,++        -- Float/Double+        rationalToFloatName,+        rationalToDoubleName,++        -- Other classes+        randomClassName, randomGenClassName, monadPlusClassName,++        -- Type-level naturals+        knownNatClassName, knownSymbolClassName,++        -- Overloaded labels+        isLabelClassName,++        -- Implicit Parameters+        ipClassName,++        -- Overloaded record fields+        hasFieldClassName,++        -- Call Stacks+        callStackTyConName,+        emptyCallStackName, pushCallStackName,++        -- Source Locations+        srcLocDataConName,++        -- Annotation type checking+        toAnnotationWrapperName++        -- The Ordering type+        , orderingTyConName+        , ordLTDataConName, ordEQDataConName, ordGTDataConName++        -- The SPEC type for SpecConstr+        , specTyConName++        -- The Either type+        , eitherTyConName, leftDataConName, rightDataConName++        -- Plugins+        , pluginTyConName+        , frontendPluginTyConName++        -- Generics+        , genClassName, gen1ClassName+        , datatypeClassName, constructorClassName, selectorClassName++        -- Monad comprehensions+        , guardMName+        , liftMName+        , mzipName++        -- GHCi Sandbox+        , ghciIoClassName, ghciStepIoMName++        -- StaticPtr+        , makeStaticName+        , staticPtrTyConName+        , staticPtrDataConName, staticPtrInfoDataConName+        , fromStaticPtrName++        -- Fingerprint+        , fingerprintDataConName++        -- Custom type errors+        , errorMessageTypeErrorFamName+        , typeErrorTextDataConName+        , typeErrorAppendDataConName+        , typeErrorVAppendDataConName+        , typeErrorShowTypeDataConName++    ]++genericTyConNames :: [Name]+genericTyConNames = [+    v1TyConName, u1TyConName, par1TyConName, rec1TyConName,+    k1TyConName, m1TyConName, sumTyConName, prodTyConName,+    compTyConName, rTyConName, dTyConName,+    cTyConName, sTyConName, rec0TyConName,+    d1TyConName, c1TyConName, s1TyConName, noSelTyConName,+    repTyConName, rep1TyConName, uRecTyConName,+    uAddrTyConName, uCharTyConName, uDoubleTyConName,+    uFloatTyConName, uIntTyConName, uWordTyConName,+    prefixIDataConName, infixIDataConName, leftAssociativeDataConName,+    rightAssociativeDataConName, notAssociativeDataConName,+    sourceUnpackDataConName, sourceNoUnpackDataConName,+    noSourceUnpackednessDataConName, sourceLazyDataConName,+    sourceStrictDataConName, noSourceStrictnessDataConName,+    decidedLazyDataConName, decidedStrictDataConName, decidedUnpackDataConName,+    metaDataDataConName, metaConsDataConName, metaSelDataConName+  ]++{-+************************************************************************+*                                                                      *+\subsection{Module names}+*                                                                      *+************************************************************************+++--MetaHaskell Extension Add a new module here+-}++pRELUDE :: Module+pRELUDE         = mkBaseModule_ pRELUDE_NAME++gHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,+    gHC_CLASSES, gHC_BASE, gHC_ENUM, gHC_GHCI, gHC_CSTRING,+    gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE, gHC_INTEGER_TYPE, gHC_NATURAL,+    gHC_LIST, gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_STRING,+    dATA_FOLDABLE, dATA_TRAVERSABLE,+    gHC_CONC, gHC_IO, gHC_IO_Exception,+    gHC_ST, gHC_ARR, gHC_STABLE, gHC_PTR, gHC_ERR, gHC_REAL,+    gHC_FLOAT, gHC_TOP_HANDLER, sYSTEM_IO, dYNAMIC,+    tYPEABLE, tYPEABLE_INTERNAL, gENERICS,+    rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, mONAD_ZIP, mONAD_FAIL,+    aRROW, cONTROL_APPLICATIVE, gHC_DESUGAR, rANDOM, gHC_EXTS,+    cONTROL_EXCEPTION_BASE, gHC_TYPELITS, gHC_TYPENATS, dATA_TYPE_EQUALITY,+    dATA_COERCE, dEBUG_TRACE :: Module++gHC_PRIM        = mkPrimModule (fsLit "GHC.Prim")   -- Primitive types and values+gHC_TYPES       = mkPrimModule (fsLit "GHC.Types")+gHC_MAGIC       = mkPrimModule (fsLit "GHC.Magic")+gHC_CSTRING     = mkPrimModule (fsLit "GHC.CString")+gHC_CLASSES     = mkPrimModule (fsLit "GHC.Classes")++gHC_BASE        = mkBaseModule (fsLit "GHC.Base")+gHC_ENUM        = mkBaseModule (fsLit "GHC.Enum")+gHC_GHCI        = mkBaseModule (fsLit "GHC.GHCi")+gHC_SHOW        = mkBaseModule (fsLit "GHC.Show")+gHC_READ        = mkBaseModule (fsLit "GHC.Read")+gHC_NUM         = mkBaseModule (fsLit "GHC.Num")+gHC_MAYBE       = mkBaseModule (fsLit "GHC.Maybe")+gHC_INTEGER_TYPE= mkIntegerModule (fsLit "GHC.Integer.Type")+gHC_NATURAL     = mkBaseModule (fsLit "GHC.Natural")+gHC_LIST        = mkBaseModule (fsLit "GHC.List")+gHC_TUPLE       = mkPrimModule (fsLit "GHC.Tuple")+dATA_TUPLE      = mkBaseModule (fsLit "Data.Tuple")+dATA_EITHER     = mkBaseModule (fsLit "Data.Either")+dATA_STRING     = mkBaseModule (fsLit "Data.String")+dATA_FOLDABLE   = mkBaseModule (fsLit "Data.Foldable")+dATA_TRAVERSABLE= mkBaseModule (fsLit "Data.Traversable")+gHC_CONC        = mkBaseModule (fsLit "GHC.Conc")+gHC_IO          = mkBaseModule (fsLit "GHC.IO")+gHC_IO_Exception = mkBaseModule (fsLit "GHC.IO.Exception")+gHC_ST          = mkBaseModule (fsLit "GHC.ST")+gHC_ARR         = mkBaseModule (fsLit "GHC.Arr")+gHC_STABLE      = mkBaseModule (fsLit "GHC.Stable")+gHC_PTR         = mkBaseModule (fsLit "GHC.Ptr")+gHC_ERR         = mkBaseModule (fsLit "GHC.Err")+gHC_REAL        = mkBaseModule (fsLit "GHC.Real")+gHC_FLOAT       = mkBaseModule (fsLit "GHC.Float")+gHC_TOP_HANDLER = mkBaseModule (fsLit "GHC.TopHandler")+sYSTEM_IO       = mkBaseModule (fsLit "System.IO")+dYNAMIC         = mkBaseModule (fsLit "Data.Dynamic")+tYPEABLE        = mkBaseModule (fsLit "Data.Typeable")+tYPEABLE_INTERNAL = mkBaseModule (fsLit "Data.Typeable.Internal")+gENERICS        = mkBaseModule (fsLit "Data.Data")+rEAD_PREC       = mkBaseModule (fsLit "Text.ParserCombinators.ReadPrec")+lEX             = mkBaseModule (fsLit "Text.Read.Lex")+gHC_INT         = mkBaseModule (fsLit "GHC.Int")+gHC_WORD        = mkBaseModule (fsLit "GHC.Word")+mONAD           = mkBaseModule (fsLit "Control.Monad")+mONAD_FIX       = mkBaseModule (fsLit "Control.Monad.Fix")+mONAD_ZIP       = mkBaseModule (fsLit "Control.Monad.Zip")+mONAD_FAIL      = mkBaseModule (fsLit "Control.Monad.Fail")+aRROW           = mkBaseModule (fsLit "Control.Arrow")+cONTROL_APPLICATIVE = mkBaseModule (fsLit "Control.Applicative")+gHC_DESUGAR = mkBaseModule (fsLit "GHC.Desugar")+rANDOM          = mkBaseModule (fsLit "System.Random")+gHC_EXTS        = mkBaseModule (fsLit "GHC.Exts")+cONTROL_EXCEPTION_BASE = mkBaseModule (fsLit "Control.Exception.Base")+gHC_GENERICS    = mkBaseModule (fsLit "GHC.Generics")+gHC_TYPELITS    = mkBaseModule (fsLit "GHC.TypeLits")+gHC_TYPENATS    = mkBaseModule (fsLit "GHC.TypeNats")+dATA_TYPE_EQUALITY = mkBaseModule (fsLit "Data.Type.Equality")+dATA_COERCE     = mkBaseModule (fsLit "Data.Coerce")+dEBUG_TRACE     = mkBaseModule (fsLit "Debug.Trace")++gHC_SRCLOC :: Module+gHC_SRCLOC = mkBaseModule (fsLit "GHC.SrcLoc")++gHC_STACK, gHC_STACK_TYPES :: Module+gHC_STACK = mkBaseModule (fsLit "GHC.Stack")+gHC_STACK_TYPES = mkBaseModule (fsLit "GHC.Stack.Types")++gHC_STATICPTR :: Module+gHC_STATICPTR = mkBaseModule (fsLit "GHC.StaticPtr")++gHC_STATICPTR_INTERNAL :: Module+gHC_STATICPTR_INTERNAL = mkBaseModule (fsLit "GHC.StaticPtr.Internal")++gHC_FINGERPRINT_TYPE :: Module+gHC_FINGERPRINT_TYPE = mkBaseModule (fsLit "GHC.Fingerprint.Type")++gHC_OVER_LABELS :: Module+gHC_OVER_LABELS = mkBaseModule (fsLit "GHC.OverloadedLabels")++gHC_RECORDS :: Module+gHC_RECORDS = mkBaseModule (fsLit "GHC.Records")++mAIN, rOOT_MAIN :: Module+mAIN            = mkMainModule_ mAIN_NAME+rOOT_MAIN       = mkMainModule (fsLit ":Main") -- Root module for initialisation++mkInteractiveModule :: Int -> Module+-- (mkInteractiveMoudule 9) makes module 'interactive:M9'+mkInteractiveModule n = mkModule interactiveUnitId (mkModuleName ("Ghci" ++ show n))++pRELUDE_NAME, mAIN_NAME :: ModuleName+pRELUDE_NAME   = mkModuleNameFS (fsLit "Prelude")+mAIN_NAME      = mkModuleNameFS (fsLit "Main")++dATA_ARRAY_PARALLEL_NAME, dATA_ARRAY_PARALLEL_PRIM_NAME :: ModuleName+dATA_ARRAY_PARALLEL_NAME      = mkModuleNameFS (fsLit "Data.Array.Parallel")+dATA_ARRAY_PARALLEL_PRIM_NAME = mkModuleNameFS (fsLit "Data.Array.Parallel.Prim")++mkPrimModule :: FastString -> Module+mkPrimModule m = mkModule primUnitId (mkModuleNameFS m)++mkIntegerModule :: FastString -> Module+mkIntegerModule m = mkModule integerUnitId (mkModuleNameFS m)++mkBaseModule :: FastString -> Module+mkBaseModule m = mkModule baseUnitId (mkModuleNameFS m)++mkBaseModule_ :: ModuleName -> Module+mkBaseModule_ m = mkModule baseUnitId m++mkThisGhcModule :: FastString -> Module+mkThisGhcModule m = mkModule thisGhcUnitId (mkModuleNameFS m)++mkThisGhcModule_ :: ModuleName -> Module+mkThisGhcModule_ m = mkModule thisGhcUnitId m++mkMainModule :: FastString -> Module+mkMainModule m = mkModule mainUnitId (mkModuleNameFS m)++mkMainModule_ :: ModuleName -> Module+mkMainModule_ m = mkModule mainUnitId m++{-+************************************************************************+*                                                                      *+                        RdrNames+*                                                                      *+************************************************************************+-}++main_RDR_Unqual    :: RdrName+main_RDR_Unqual = mkUnqual varName (fsLit "main")+        -- We definitely don't want an Orig RdrName, because+        -- main might, in principle, be imported into module Main++eq_RDR, ge_RDR, le_RDR, lt_RDR, gt_RDR, compare_RDR,+    ltTag_RDR, eqTag_RDR, gtTag_RDR :: RdrName+eq_RDR                  = nameRdrName eqName+ge_RDR                  = nameRdrName geName+le_RDR                  = varQual_RDR  gHC_CLASSES (fsLit "<=")+lt_RDR                  = varQual_RDR  gHC_CLASSES (fsLit "<")+gt_RDR                  = varQual_RDR  gHC_CLASSES (fsLit ">")+compare_RDR             = varQual_RDR  gHC_CLASSES (fsLit "compare")+ltTag_RDR               = nameRdrName  ordLTDataConName+eqTag_RDR               = nameRdrName  ordEQDataConName+gtTag_RDR               = nameRdrName  ordGTDataConName++eqClass_RDR, numClass_RDR, ordClass_RDR, enumClass_RDR, monadClass_RDR+    :: RdrName+eqClass_RDR             = nameRdrName eqClassName+numClass_RDR            = nameRdrName numClassName+ordClass_RDR            = nameRdrName ordClassName+enumClass_RDR           = nameRdrName enumClassName+monadClass_RDR          = nameRdrName monadClassName++map_RDR, append_RDR :: RdrName+map_RDR                 = nameRdrName mapName+append_RDR              = nameRdrName appendName++foldr_RDR, build_RDR, returnM_RDR, bindM_RDR, failM_RDR+    :: RdrName+foldr_RDR               = nameRdrName foldrName+build_RDR               = nameRdrName buildName+returnM_RDR             = nameRdrName returnMName+bindM_RDR               = nameRdrName bindMName+failM_RDR               = nameRdrName failMName++left_RDR, right_RDR :: RdrName+left_RDR                = nameRdrName leftDataConName+right_RDR               = nameRdrName rightDataConName++fromEnum_RDR, toEnum_RDR :: RdrName+fromEnum_RDR            = varQual_RDR gHC_ENUM (fsLit "fromEnum")+toEnum_RDR              = varQual_RDR gHC_ENUM (fsLit "toEnum")++enumFrom_RDR, enumFromTo_RDR, enumFromThen_RDR, enumFromThenTo_RDR :: RdrName+enumFrom_RDR            = nameRdrName enumFromName+enumFromTo_RDR          = nameRdrName enumFromToName+enumFromThen_RDR        = nameRdrName enumFromThenName+enumFromThenTo_RDR      = nameRdrName enumFromThenToName++ratioDataCon_RDR, plusInteger_RDR, timesInteger_RDR :: RdrName+ratioDataCon_RDR        = nameRdrName ratioDataConName+plusInteger_RDR         = nameRdrName plusIntegerName+timesInteger_RDR        = nameRdrName timesIntegerName++ioDataCon_RDR :: RdrName+ioDataCon_RDR           = nameRdrName ioDataConName++eqString_RDR, unpackCString_RDR, unpackCStringFoldr_RDR,+    unpackCStringUtf8_RDR :: RdrName+eqString_RDR            = nameRdrName eqStringName+unpackCString_RDR       = nameRdrName unpackCStringName+unpackCStringFoldr_RDR  = nameRdrName unpackCStringFoldrName+unpackCStringUtf8_RDR   = nameRdrName unpackCStringUtf8Name++newStablePtr_RDR :: RdrName+newStablePtr_RDR        = nameRdrName newStablePtrName++bindIO_RDR, returnIO_RDR :: RdrName+bindIO_RDR              = nameRdrName bindIOName+returnIO_RDR            = nameRdrName returnIOName++fromInteger_RDR, fromRational_RDR, minus_RDR, times_RDR, plus_RDR :: RdrName+fromInteger_RDR         = nameRdrName fromIntegerName+fromRational_RDR        = nameRdrName fromRationalName+minus_RDR               = nameRdrName minusName+times_RDR               = varQual_RDR  gHC_NUM (fsLit "*")+plus_RDR                = varQual_RDR gHC_NUM (fsLit "+")++toInteger_RDR, toRational_RDR, fromIntegral_RDR :: RdrName+toInteger_RDR           = nameRdrName toIntegerName+toRational_RDR          = nameRdrName toRationalName+fromIntegral_RDR        = nameRdrName fromIntegralName++stringTy_RDR, fromString_RDR :: RdrName+stringTy_RDR            = tcQual_RDR gHC_BASE (fsLit "String")+fromString_RDR          = nameRdrName fromStringName++fromList_RDR, fromListN_RDR, toList_RDR :: RdrName+fromList_RDR = nameRdrName fromListName+fromListN_RDR = nameRdrName fromListNName+toList_RDR = nameRdrName toListName++compose_RDR :: RdrName+compose_RDR             = varQual_RDR gHC_BASE (fsLit ".")++not_RDR, getTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR,+    and_RDR, range_RDR, inRange_RDR, index_RDR,+    unsafeIndex_RDR, unsafeRangeSize_RDR :: RdrName+and_RDR                 = varQual_RDR gHC_CLASSES (fsLit "&&")+not_RDR                 = varQual_RDR gHC_CLASSES (fsLit "not")+getTag_RDR              = varQual_RDR gHC_BASE (fsLit "getTag")+succ_RDR                = varQual_RDR gHC_ENUM (fsLit "succ")+pred_RDR                = varQual_RDR gHC_ENUM (fsLit "pred")+minBound_RDR            = varQual_RDR gHC_ENUM (fsLit "minBound")+maxBound_RDR            = varQual_RDR gHC_ENUM (fsLit "maxBound")+range_RDR               = varQual_RDR gHC_ARR (fsLit "range")+inRange_RDR             = varQual_RDR gHC_ARR (fsLit "inRange")+index_RDR               = varQual_RDR gHC_ARR (fsLit "index")+unsafeIndex_RDR         = varQual_RDR gHC_ARR (fsLit "unsafeIndex")+unsafeRangeSize_RDR     = varQual_RDR gHC_ARR (fsLit "unsafeRangeSize")++readList_RDR, readListDefault_RDR, readListPrec_RDR, readListPrecDefault_RDR,+    readPrec_RDR, parens_RDR, choose_RDR, lexP_RDR, expectP_RDR :: RdrName+readList_RDR            = varQual_RDR gHC_READ (fsLit "readList")+readListDefault_RDR     = varQual_RDR gHC_READ (fsLit "readListDefault")+readListPrec_RDR        = varQual_RDR gHC_READ (fsLit "readListPrec")+readListPrecDefault_RDR = varQual_RDR gHC_READ (fsLit "readListPrecDefault")+readPrec_RDR            = varQual_RDR gHC_READ (fsLit "readPrec")+parens_RDR              = varQual_RDR gHC_READ (fsLit "parens")+choose_RDR              = varQual_RDR gHC_READ (fsLit "choose")+lexP_RDR                = varQual_RDR gHC_READ (fsLit "lexP")+expectP_RDR             = varQual_RDR gHC_READ (fsLit "expectP")++readField_RDR, readFieldHash_RDR, readSymField_RDR :: RdrName+readField_RDR           = varQual_RDR gHC_READ (fsLit "readField")+readFieldHash_RDR       = varQual_RDR gHC_READ (fsLit "readFieldHash")+readSymField_RDR        = varQual_RDR gHC_READ (fsLit "readSymField")++punc_RDR, ident_RDR, symbol_RDR :: RdrName+punc_RDR                = dataQual_RDR lEX (fsLit "Punc")+ident_RDR               = dataQual_RDR lEX (fsLit "Ident")+symbol_RDR              = dataQual_RDR lEX (fsLit "Symbol")++step_RDR, alt_RDR, reset_RDR, prec_RDR, pfail_RDR :: RdrName+step_RDR                = varQual_RDR  rEAD_PREC (fsLit "step")+alt_RDR                 = varQual_RDR  rEAD_PREC (fsLit "+++")+reset_RDR               = varQual_RDR  rEAD_PREC (fsLit "reset")+prec_RDR                = varQual_RDR  rEAD_PREC (fsLit "prec")+pfail_RDR               = varQual_RDR  rEAD_PREC (fsLit "pfail")++showsPrec_RDR, shows_RDR, showString_RDR,+    showSpace_RDR, showCommaSpace_RDR, showParen_RDR :: RdrName+showsPrec_RDR           = varQual_RDR gHC_SHOW (fsLit "showsPrec")+shows_RDR               = varQual_RDR gHC_SHOW (fsLit "shows")+showString_RDR          = varQual_RDR gHC_SHOW (fsLit "showString")+showSpace_RDR           = varQual_RDR gHC_SHOW (fsLit "showSpace")+showCommaSpace_RDR      = varQual_RDR gHC_SHOW (fsLit "showCommaSpace")+showParen_RDR           = varQual_RDR gHC_SHOW (fsLit "showParen")++undefined_RDR :: RdrName+undefined_RDR = varQual_RDR gHC_ERR (fsLit "undefined")++error_RDR :: RdrName+error_RDR = varQual_RDR gHC_ERR (fsLit "error")++-- Generics (constructors and functions)+u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR,+  k1DataCon_RDR, m1DataCon_RDR, l1DataCon_RDR, r1DataCon_RDR,+  prodDataCon_RDR, comp1DataCon_RDR,+  unPar1_RDR, unRec1_RDR, unK1_RDR, unComp1_RDR,+  from_RDR, from1_RDR, to_RDR, to1_RDR,+  datatypeName_RDR, moduleName_RDR, packageName_RDR, isNewtypeName_RDR,+  conName_RDR, conFixity_RDR, conIsRecord_RDR, selName_RDR,+  prefixDataCon_RDR, infixDataCon_RDR, leftAssocDataCon_RDR,+  rightAssocDataCon_RDR, notAssocDataCon_RDR,+  uAddrDataCon_RDR, uCharDataCon_RDR, uDoubleDataCon_RDR,+  uFloatDataCon_RDR, uIntDataCon_RDR, uWordDataCon_RDR,+  uAddrHash_RDR, uCharHash_RDR, uDoubleHash_RDR,+  uFloatHash_RDR, uIntHash_RDR, uWordHash_RDR :: RdrName++u1DataCon_RDR    = dataQual_RDR gHC_GENERICS (fsLit "U1")+par1DataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit "Par1")+rec1DataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit "Rec1")+k1DataCon_RDR    = dataQual_RDR gHC_GENERICS (fsLit "K1")+m1DataCon_RDR    = dataQual_RDR gHC_GENERICS (fsLit "M1")++l1DataCon_RDR     = dataQual_RDR gHC_GENERICS (fsLit "L1")+r1DataCon_RDR     = dataQual_RDR gHC_GENERICS (fsLit "R1")++prodDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit ":*:")+comp1DataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit "Comp1")++unPar1_RDR  = varQual_RDR gHC_GENERICS (fsLit "unPar1")+unRec1_RDR  = varQual_RDR gHC_GENERICS (fsLit "unRec1")+unK1_RDR    = varQual_RDR gHC_GENERICS (fsLit "unK1")+unComp1_RDR = varQual_RDR gHC_GENERICS (fsLit "unComp1")++from_RDR  = varQual_RDR gHC_GENERICS (fsLit "from")+from1_RDR = varQual_RDR gHC_GENERICS (fsLit "from1")+to_RDR    = varQual_RDR gHC_GENERICS (fsLit "to")+to1_RDR   = varQual_RDR gHC_GENERICS (fsLit "to1")++datatypeName_RDR  = varQual_RDR gHC_GENERICS (fsLit "datatypeName")+moduleName_RDR    = varQual_RDR gHC_GENERICS (fsLit "moduleName")+packageName_RDR   = varQual_RDR gHC_GENERICS (fsLit "packageName")+isNewtypeName_RDR = varQual_RDR gHC_GENERICS (fsLit "isNewtype")+selName_RDR       = varQual_RDR gHC_GENERICS (fsLit "selName")+conName_RDR       = varQual_RDR gHC_GENERICS (fsLit "conName")+conFixity_RDR     = varQual_RDR gHC_GENERICS (fsLit "conFixity")+conIsRecord_RDR   = varQual_RDR gHC_GENERICS (fsLit "conIsRecord")++prefixDataCon_RDR     = dataQual_RDR gHC_GENERICS (fsLit "Prefix")+infixDataCon_RDR      = dataQual_RDR gHC_GENERICS (fsLit "Infix")+leftAssocDataCon_RDR  = nameRdrName leftAssociativeDataConName+rightAssocDataCon_RDR = nameRdrName rightAssociativeDataConName+notAssocDataCon_RDR   = nameRdrName notAssociativeDataConName++uAddrDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit "UAddr")+uCharDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit "UChar")+uDoubleDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UDouble")+uFloatDataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit "UFloat")+uIntDataCon_RDR    = dataQual_RDR gHC_GENERICS (fsLit "UInt")+uWordDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit "UWord")++uAddrHash_RDR   = varQual_RDR gHC_GENERICS (fsLit "uAddr#")+uCharHash_RDR   = varQual_RDR gHC_GENERICS (fsLit "uChar#")+uDoubleHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uDouble#")+uFloatHash_RDR  = varQual_RDR gHC_GENERICS (fsLit "uFloat#")+uIntHash_RDR    = varQual_RDR gHC_GENERICS (fsLit "uInt#")+uWordHash_RDR   = varQual_RDR gHC_GENERICS (fsLit "uWord#")++fmap_RDR, replace_RDR, pure_RDR, ap_RDR, liftA2_RDR, foldable_foldr_RDR,+    foldMap_RDR, null_RDR, all_RDR, traverse_RDR, mempty_RDR,+    mappend_RDR :: RdrName+fmap_RDR                = nameRdrName fmapName+replace_RDR             = varQual_RDR gHC_BASE (fsLit "<$")+pure_RDR                = nameRdrName pureAName+ap_RDR                  = nameRdrName apAName+liftA2_RDR              = varQual_RDR gHC_BASE (fsLit "liftA2")+foldable_foldr_RDR      = varQual_RDR dATA_FOLDABLE       (fsLit "foldr")+foldMap_RDR             = varQual_RDR dATA_FOLDABLE       (fsLit "foldMap")+null_RDR                = varQual_RDR dATA_FOLDABLE       (fsLit "null")+all_RDR                 = varQual_RDR dATA_FOLDABLE       (fsLit "all")+traverse_RDR            = varQual_RDR dATA_TRAVERSABLE    (fsLit "traverse")+mempty_RDR              = nameRdrName memptyName+mappend_RDR             = nameRdrName mappendName++----------------------+varQual_RDR, tcQual_RDR, clsQual_RDR, dataQual_RDR+    :: Module -> FastString -> RdrName+varQual_RDR  mod str = mkOrig mod (mkOccNameFS varName str)+tcQual_RDR   mod str = mkOrig mod (mkOccNameFS tcName str)+clsQual_RDR  mod str = mkOrig mod (mkOccNameFS clsName str)+dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str)++{-+************************************************************************+*                                                                      *+\subsection{Known-key names}+*                                                                      *+************************************************************************++Many of these Names are not really "built in", but some parts of the+compiler (notably the deriving mechanism) need to mention their names,+and it's convenient to write them all down in one place.+-}++wildCardName :: Name+wildCardName = mkSystemVarName wildCardKey (fsLit "wild")++runMainIOName, runRWName :: Name+runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey+runRWName     = varQual gHC_MAGIC       (fsLit "runRW#")    runRWKey++orderingTyConName, ordLTDataConName, ordEQDataConName, ordGTDataConName :: Name+orderingTyConName = tcQual  gHC_TYPES (fsLit "Ordering") orderingTyConKey+ordLTDataConName     = dcQual gHC_TYPES (fsLit "LT") ordLTDataConKey+ordEQDataConName     = dcQual gHC_TYPES (fsLit "EQ") ordEQDataConKey+ordGTDataConName     = dcQual gHC_TYPES (fsLit "GT") ordGTDataConKey++specTyConName :: Name+specTyConName     = tcQual gHC_TYPES (fsLit "SPEC") specTyConKey++eitherTyConName, leftDataConName, rightDataConName :: Name+eitherTyConName   = tcQual  dATA_EITHER (fsLit "Either") eitherTyConKey+leftDataConName   = dcQual dATA_EITHER (fsLit "Left")   leftDataConKey+rightDataConName  = dcQual dATA_EITHER (fsLit "Right")  rightDataConKey++-- Generics (types)+v1TyConName, u1TyConName, par1TyConName, rec1TyConName,+  k1TyConName, m1TyConName, sumTyConName, prodTyConName,+  compTyConName, rTyConName, dTyConName,+  cTyConName, sTyConName, rec0TyConName,+  d1TyConName, c1TyConName, s1TyConName, noSelTyConName,+  repTyConName, rep1TyConName, uRecTyConName,+  uAddrTyConName, uCharTyConName, uDoubleTyConName,+  uFloatTyConName, uIntTyConName, uWordTyConName,+  prefixIDataConName, infixIDataConName, leftAssociativeDataConName,+  rightAssociativeDataConName, notAssociativeDataConName,+  sourceUnpackDataConName, sourceNoUnpackDataConName,+  noSourceUnpackednessDataConName, sourceLazyDataConName,+  sourceStrictDataConName, noSourceStrictnessDataConName,+  decidedLazyDataConName, decidedStrictDataConName, decidedUnpackDataConName,+  metaDataDataConName, metaConsDataConName, metaSelDataConName :: Name++v1TyConName  = tcQual gHC_GENERICS (fsLit "V1") v1TyConKey+u1TyConName  = tcQual gHC_GENERICS (fsLit "U1") u1TyConKey+par1TyConName  = tcQual gHC_GENERICS (fsLit "Par1") par1TyConKey+rec1TyConName  = tcQual gHC_GENERICS (fsLit "Rec1") rec1TyConKey+k1TyConName  = tcQual gHC_GENERICS (fsLit "K1") k1TyConKey+m1TyConName  = tcQual gHC_GENERICS (fsLit "M1") m1TyConKey++sumTyConName    = tcQual gHC_GENERICS (fsLit ":+:") sumTyConKey+prodTyConName   = tcQual gHC_GENERICS (fsLit ":*:") prodTyConKey+compTyConName   = tcQual gHC_GENERICS (fsLit ":.:") compTyConKey++rTyConName  = tcQual gHC_GENERICS (fsLit "R") rTyConKey+dTyConName  = tcQual gHC_GENERICS (fsLit "D") dTyConKey+cTyConName  = tcQual gHC_GENERICS (fsLit "C") cTyConKey+sTyConName  = tcQual gHC_GENERICS (fsLit "S") sTyConKey++rec0TyConName  = tcQual gHC_GENERICS (fsLit "Rec0") rec0TyConKey+d1TyConName  = tcQual gHC_GENERICS (fsLit "D1") d1TyConKey+c1TyConName  = tcQual gHC_GENERICS (fsLit "C1") c1TyConKey+s1TyConName  = tcQual gHC_GENERICS (fsLit "S1") s1TyConKey+noSelTyConName = tcQual gHC_GENERICS (fsLit "NoSelector") noSelTyConKey++repTyConName  = tcQual gHC_GENERICS (fsLit "Rep")  repTyConKey+rep1TyConName = tcQual gHC_GENERICS (fsLit "Rep1") rep1TyConKey++uRecTyConName      = tcQual gHC_GENERICS (fsLit "URec") uRecTyConKey+uAddrTyConName     = tcQual gHC_GENERICS (fsLit "UAddr") uAddrTyConKey+uCharTyConName     = tcQual gHC_GENERICS (fsLit "UChar") uCharTyConKey+uDoubleTyConName   = tcQual gHC_GENERICS (fsLit "UDouble") uDoubleTyConKey+uFloatTyConName    = tcQual gHC_GENERICS (fsLit "UFloat") uFloatTyConKey+uIntTyConName      = tcQual gHC_GENERICS (fsLit "UInt") uIntTyConKey+uWordTyConName     = tcQual gHC_GENERICS (fsLit "UWord") uWordTyConKey++prefixIDataConName = dcQual gHC_GENERICS (fsLit "PrefixI")  prefixIDataConKey+infixIDataConName  = dcQual gHC_GENERICS (fsLit "InfixI")   infixIDataConKey+leftAssociativeDataConName  = dcQual gHC_GENERICS (fsLit "LeftAssociative")   leftAssociativeDataConKey+rightAssociativeDataConName = dcQual gHC_GENERICS (fsLit "RightAssociative")  rightAssociativeDataConKey+notAssociativeDataConName   = dcQual gHC_GENERICS (fsLit "NotAssociative")    notAssociativeDataConKey++sourceUnpackDataConName         = dcQual gHC_GENERICS (fsLit "SourceUnpack")         sourceUnpackDataConKey+sourceNoUnpackDataConName       = dcQual gHC_GENERICS (fsLit "SourceNoUnpack")       sourceNoUnpackDataConKey+noSourceUnpackednessDataConName = dcQual gHC_GENERICS (fsLit "NoSourceUnpackedness") noSourceUnpackednessDataConKey+sourceLazyDataConName           = dcQual gHC_GENERICS (fsLit "SourceLazy")           sourceLazyDataConKey+sourceStrictDataConName         = dcQual gHC_GENERICS (fsLit "SourceStrict")         sourceStrictDataConKey+noSourceStrictnessDataConName   = dcQual gHC_GENERICS (fsLit "NoSourceStrictness")   noSourceStrictnessDataConKey+decidedLazyDataConName          = dcQual gHC_GENERICS (fsLit "DecidedLazy")          decidedLazyDataConKey+decidedStrictDataConName        = dcQual gHC_GENERICS (fsLit "DecidedStrict")        decidedStrictDataConKey+decidedUnpackDataConName        = dcQual gHC_GENERICS (fsLit "DecidedUnpack")        decidedUnpackDataConKey++metaDataDataConName  = dcQual gHC_GENERICS (fsLit "MetaData")  metaDataDataConKey+metaConsDataConName  = dcQual gHC_GENERICS (fsLit "MetaCons")  metaConsDataConKey+metaSelDataConName   = dcQual gHC_GENERICS (fsLit "MetaSel")   metaSelDataConKey++-- Primitive Int+divIntName, modIntName :: Name+divIntName = varQual gHC_CLASSES (fsLit "divInt#") divIntIdKey+modIntName = varQual gHC_CLASSES (fsLit "modInt#") modIntIdKey++-- Base strings Strings+unpackCStringName, unpackCStringFoldrName,+    unpackCStringUtf8Name, eqStringName :: Name+unpackCStringName       = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey+unpackCStringFoldrName  = varQual gHC_CSTRING (fsLit "unpackFoldrCString#") unpackCStringFoldrIdKey+unpackCStringUtf8Name   = varQual gHC_CSTRING (fsLit "unpackCStringUtf8#") unpackCStringUtf8IdKey+eqStringName            = varQual gHC_BASE (fsLit "eqString")  eqStringIdKey++-- The 'inline' function+inlineIdName :: Name+inlineIdName            = varQual gHC_MAGIC (fsLit "inline") inlineIdKey++-- Base classes (Eq, Ord, Functor)+fmapName, eqClassName, eqName, ordClassName, geName, functorClassName :: Name+eqClassName       = clsQual gHC_CLASSES (fsLit "Eq")      eqClassKey+eqName            = varQual gHC_CLASSES (fsLit "==")      eqClassOpKey+ordClassName      = clsQual gHC_CLASSES (fsLit "Ord")     ordClassKey+geName            = varQual gHC_CLASSES (fsLit ">=")      geClassOpKey+functorClassName  = clsQual gHC_BASE    (fsLit "Functor") functorClassKey+fmapName          = varQual gHC_BASE    (fsLit "fmap")    fmapClassOpKey++-- Class Monad+monadClassName, thenMName, bindMName, returnMName :: Name+monadClassName     = clsQual gHC_BASE (fsLit "Monad")  monadClassKey+thenMName          = varQual gHC_BASE (fsLit ">>")     thenMClassOpKey+bindMName          = varQual gHC_BASE (fsLit ">>=")    bindMClassOpKey+returnMName        = varQual gHC_BASE (fsLit "return") returnMClassOpKey++-- Class MonadFail+monadFailClassName, failMName :: Name+monadFailClassName = clsQual mONAD_FAIL (fsLit "MonadFail") monadFailClassKey+failMName          = varQual mONAD_FAIL (fsLit "fail")      failMClassOpKey++-- Class Applicative+applicativeClassName, pureAName, apAName, thenAName :: Name+applicativeClassName = clsQual gHC_BASE (fsLit "Applicative") applicativeClassKey+apAName              = varQual gHC_BASE (fsLit "<*>")         apAClassOpKey+pureAName            = varQual gHC_BASE (fsLit "pure")        pureAClassOpKey+thenAName            = varQual gHC_BASE (fsLit "*>")          thenAClassOpKey++-- Classes (Foldable, Traversable)+foldableClassName, traversableClassName :: Name+foldableClassName     = clsQual  dATA_FOLDABLE       (fsLit "Foldable")    foldableClassKey+traversableClassName  = clsQual  dATA_TRAVERSABLE    (fsLit "Traversable") traversableClassKey++-- Classes (Semigroup, Monoid)+semigroupClassName, sappendName :: Name+semigroupClassName = clsQual gHC_BASE       (fsLit "Semigroup") semigroupClassKey+sappendName        = varQual gHC_BASE       (fsLit "<>")        sappendClassOpKey+monoidClassName, memptyName, mappendName, mconcatName :: Name+monoidClassName    = clsQual gHC_BASE       (fsLit "Monoid")    monoidClassKey+memptyName         = varQual gHC_BASE       (fsLit "mempty")    memptyClassOpKey+mappendName        = varQual gHC_BASE       (fsLit "mappend")   mappendClassOpKey+mconcatName        = varQual gHC_BASE       (fsLit "mconcat")   mconcatClassOpKey++++-- AMP additions++joinMName, alternativeClassName :: Name+joinMName            = varQual gHC_BASE (fsLit "join")        joinMIdKey+alternativeClassName = clsQual mONAD (fsLit "Alternative") alternativeClassKey++--+joinMIdKey, apAClassOpKey, pureAClassOpKey, thenAClassOpKey,+    alternativeClassKey :: Unique+joinMIdKey          = mkPreludeMiscIdUnique 750+apAClassOpKey       = mkPreludeMiscIdUnique 751 -- <*>+pureAClassOpKey     = mkPreludeMiscIdUnique 752+thenAClassOpKey     = mkPreludeMiscIdUnique 753+alternativeClassKey = mkPreludeMiscIdUnique 754+++-- Functions for GHC extensions+groupWithName :: Name+groupWithName = varQual gHC_EXTS (fsLit "groupWith") groupWithIdKey++-- Random PrelBase functions+fromStringName, otherwiseIdName, foldrName, buildName, augmentName,+    mapName, appendName, assertName,+    breakpointName, breakpointCondName,+    opaqueTyConName, dollarName :: Name+dollarName        = varQual gHC_BASE (fsLit "$")          dollarIdKey+otherwiseIdName   = varQual gHC_BASE (fsLit "otherwise")  otherwiseIdKey+foldrName         = varQual gHC_BASE (fsLit "foldr")      foldrIdKey+buildName         = varQual gHC_BASE (fsLit "build")      buildIdKey+augmentName       = varQual gHC_BASE (fsLit "augment")    augmentIdKey+mapName           = varQual gHC_BASE (fsLit "map")        mapIdKey+appendName        = varQual gHC_BASE (fsLit "++")         appendIdKey+assertName        = varQual gHC_BASE (fsLit "assert")     assertIdKey+breakpointName    = varQual gHC_BASE (fsLit "breakpoint") breakpointIdKey+breakpointCondName= varQual gHC_BASE (fsLit "breakpointCond") breakpointCondIdKey+opaqueTyConName   = tcQual  gHC_BASE (fsLit "Opaque")     opaqueTyConKey+fromStringName = varQual dATA_STRING (fsLit "fromString") fromStringClassOpKey++-- PrelTup+fstName, sndName :: Name+fstName           = varQual dATA_TUPLE (fsLit "fst") fstIdKey+sndName           = varQual dATA_TUPLE (fsLit "snd") sndIdKey++-- Module GHC.Num+numClassName, fromIntegerName, minusName, negateName :: Name+numClassName      = clsQual gHC_NUM (fsLit "Num")         numClassKey+fromIntegerName   = varQual gHC_NUM (fsLit "fromInteger") fromIntegerClassOpKey+minusName         = varQual gHC_NUM (fsLit "-")           minusClassOpKey+negateName        = varQual gHC_NUM (fsLit "negate")      negateClassOpKey++integerTyConName, mkIntegerName, integerSDataConName,+    integerToWord64Name, integerToInt64Name,+    word64ToIntegerName, int64ToIntegerName,+    plusIntegerName, timesIntegerName, smallIntegerName,+    wordToIntegerName,+    integerToWordName, integerToIntName, minusIntegerName,+    negateIntegerName, eqIntegerPrimName, neqIntegerPrimName,+    absIntegerName, signumIntegerName,+    leIntegerPrimName, gtIntegerPrimName, ltIntegerPrimName, geIntegerPrimName,+    compareIntegerName, quotRemIntegerName, divModIntegerName,+    quotIntegerName, remIntegerName, divIntegerName, modIntegerName,+    floatFromIntegerName, doubleFromIntegerName,+    encodeFloatIntegerName, encodeDoubleIntegerName,+    decodeDoubleIntegerName,+    gcdIntegerName, lcmIntegerName,+    andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,+    shiftLIntegerName, shiftRIntegerName, bitIntegerName :: Name+integerTyConName      = tcQual gHC_INTEGER_TYPE (fsLit "Integer")           integerTyConKey+integerSDataConName   = dcQual gHC_INTEGER_TYPE (fsLit "S#")                integerSDataConKey+mkIntegerName         = varQual gHC_INTEGER_TYPE (fsLit "mkInteger")         mkIntegerIdKey+integerToWord64Name   = varQual gHC_INTEGER_TYPE (fsLit "integerToWord64")   integerToWord64IdKey+integerToInt64Name    = varQual gHC_INTEGER_TYPE (fsLit "integerToInt64")    integerToInt64IdKey+word64ToIntegerName   = varQual gHC_INTEGER_TYPE (fsLit "word64ToInteger")   word64ToIntegerIdKey+int64ToIntegerName    = varQual gHC_INTEGER_TYPE (fsLit "int64ToInteger")    int64ToIntegerIdKey+plusIntegerName       = varQual gHC_INTEGER_TYPE (fsLit "plusInteger")       plusIntegerIdKey+timesIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "timesInteger")      timesIntegerIdKey+smallIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "smallInteger")      smallIntegerIdKey+wordToIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "wordToInteger")     wordToIntegerIdKey+integerToWordName     = varQual gHC_INTEGER_TYPE (fsLit "integerToWord")     integerToWordIdKey+integerToIntName      = varQual gHC_INTEGER_TYPE (fsLit "integerToInt")      integerToIntIdKey+minusIntegerName      = varQual gHC_INTEGER_TYPE (fsLit "minusInteger")      minusIntegerIdKey+negateIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "negateInteger")     negateIntegerIdKey+eqIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "eqInteger#")        eqIntegerPrimIdKey+neqIntegerPrimName    = varQual gHC_INTEGER_TYPE (fsLit "neqInteger#")       neqIntegerPrimIdKey+absIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "absInteger")        absIntegerIdKey+signumIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "signumInteger")     signumIntegerIdKey+leIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "leInteger#")        leIntegerPrimIdKey+gtIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "gtInteger#")        gtIntegerPrimIdKey+ltIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "ltInteger#")        ltIntegerPrimIdKey+geIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit "geInteger#")        geIntegerPrimIdKey+compareIntegerName    = varQual gHC_INTEGER_TYPE (fsLit "compareInteger")    compareIntegerIdKey+quotRemIntegerName    = varQual gHC_INTEGER_TYPE (fsLit "quotRemInteger")    quotRemIntegerIdKey+divModIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "divModInteger")     divModIntegerIdKey+quotIntegerName       = varQual gHC_INTEGER_TYPE (fsLit "quotInteger")       quotIntegerIdKey+remIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "remInteger")        remIntegerIdKey+divIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "divInteger")        divIntegerIdKey+modIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "modInteger")        modIntegerIdKey+floatFromIntegerName  = varQual gHC_INTEGER_TYPE (fsLit "floatFromInteger")      floatFromIntegerIdKey+doubleFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "doubleFromInteger")     doubleFromIntegerIdKey+encodeFloatIntegerName  = varQual gHC_INTEGER_TYPE (fsLit "encodeFloatInteger")  encodeFloatIntegerIdKey+encodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit "encodeDoubleInteger") encodeDoubleIntegerIdKey+decodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit "decodeDoubleInteger") decodeDoubleIntegerIdKey+gcdIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "gcdInteger")        gcdIntegerIdKey+lcmIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "lcmInteger")        lcmIntegerIdKey+andIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "andInteger")        andIntegerIdKey+orIntegerName         = varQual gHC_INTEGER_TYPE (fsLit "orInteger")         orIntegerIdKey+xorIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "xorInteger")        xorIntegerIdKey+complementIntegerName = varQual gHC_INTEGER_TYPE (fsLit "complementInteger") complementIntegerIdKey+shiftLIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "shiftLInteger")     shiftLIntegerIdKey+shiftRIntegerName     = varQual gHC_INTEGER_TYPE (fsLit "shiftRInteger")     shiftRIntegerIdKey+bitIntegerName        = varQual gHC_INTEGER_TYPE (fsLit "bitInteger")        bitIntegerIdKey++-- GHC.Natural types+naturalTyConName, naturalSDataConName :: Name+naturalTyConName     = tcQual gHC_NATURAL (fsLit "Natural") naturalTyConKey+naturalSDataConName  = dcQual gHC_NATURAL (fsLit "NatS#")   naturalSDataConKey++naturalFromIntegerName :: Name+naturalFromIntegerName = varQual gHC_NATURAL (fsLit "naturalFromInteger") naturalFromIntegerIdKey++naturalToIntegerName, plusNaturalName, minusNaturalName, timesNaturalName,+   mkNaturalName, wordToNaturalName :: Name+naturalToIntegerName  = varQual gHC_NATURAL (fsLit "naturalToInteger")  naturalToIntegerIdKey+plusNaturalName       = varQual gHC_NATURAL (fsLit "plusNatural")       plusNaturalIdKey+minusNaturalName      = varQual gHC_NATURAL (fsLit "minusNatural")      minusNaturalIdKey+timesNaturalName      = varQual gHC_NATURAL (fsLit "timesNatural")      timesNaturalIdKey+mkNaturalName         = varQual gHC_NATURAL (fsLit "mkNatural")         mkNaturalIdKey+wordToNaturalName     = varQual gHC_NATURAL (fsLit "wordToNatural#")    wordToNaturalIdKey++-- GHC.Real types and classes+rationalTyConName, ratioTyConName, ratioDataConName, realClassName,+    integralClassName, realFracClassName, fractionalClassName,+    fromRationalName, toIntegerName, toRationalName, fromIntegralName,+    realToFracName :: Name+rationalTyConName   = tcQual  gHC_REAL (fsLit "Rational")     rationalTyConKey+ratioTyConName      = tcQual  gHC_REAL (fsLit "Ratio")        ratioTyConKey+ratioDataConName    = dcQual  gHC_REAL (fsLit ":%")           ratioDataConKey+realClassName       = clsQual gHC_REAL (fsLit "Real")         realClassKey+integralClassName   = clsQual gHC_REAL (fsLit "Integral")     integralClassKey+realFracClassName   = clsQual gHC_REAL (fsLit "RealFrac")     realFracClassKey+fractionalClassName = clsQual gHC_REAL (fsLit "Fractional")   fractionalClassKey+fromRationalName    = varQual gHC_REAL (fsLit "fromRational") fromRationalClassOpKey+toIntegerName       = varQual gHC_REAL (fsLit "toInteger")    toIntegerClassOpKey+toRationalName      = varQual gHC_REAL (fsLit "toRational")   toRationalClassOpKey+fromIntegralName    = varQual  gHC_REAL (fsLit "fromIntegral")fromIntegralIdKey+realToFracName      = varQual  gHC_REAL (fsLit "realToFrac")  realToFracIdKey++-- PrelFloat classes+floatingClassName, realFloatClassName :: Name+floatingClassName  = clsQual gHC_FLOAT (fsLit "Floating")  floatingClassKey+realFloatClassName = clsQual gHC_FLOAT (fsLit "RealFloat") realFloatClassKey++-- other GHC.Float functions+rationalToFloatName, rationalToDoubleName :: Name+rationalToFloatName  = varQual gHC_FLOAT (fsLit "rationalToFloat") rationalToFloatIdKey+rationalToDoubleName = varQual gHC_FLOAT (fsLit "rationalToDouble") rationalToDoubleIdKey++-- Class Ix+ixClassName :: Name+ixClassName = clsQual gHC_ARR (fsLit "Ix") ixClassKey++-- Typeable representation types+trModuleTyConName+  , trModuleDataConName+  , trNameTyConName+  , trNameSDataConName+  , trNameDDataConName+  , trTyConTyConName+  , trTyConDataConName+  :: Name+trModuleTyConName     = tcQual gHC_TYPES          (fsLit "Module")         trModuleTyConKey+trModuleDataConName   = dcQual gHC_TYPES          (fsLit "Module")         trModuleDataConKey+trNameTyConName       = tcQual gHC_TYPES          (fsLit "TrName")         trNameTyConKey+trNameSDataConName    = dcQual gHC_TYPES          (fsLit "TrNameS")        trNameSDataConKey+trNameDDataConName    = dcQual gHC_TYPES          (fsLit "TrNameD")        trNameDDataConKey+trTyConTyConName      = tcQual gHC_TYPES          (fsLit "TyCon")          trTyConTyConKey+trTyConDataConName    = dcQual gHC_TYPES          (fsLit "TyCon")          trTyConDataConKey++kindRepTyConName+  , kindRepTyConAppDataConName+  , kindRepVarDataConName+  , kindRepAppDataConName+  , kindRepFunDataConName+  , kindRepTYPEDataConName+  , kindRepTypeLitSDataConName+  , kindRepTypeLitDDataConName+  :: Name+kindRepTyConName      = tcQual gHC_TYPES          (fsLit "KindRep")        kindRepTyConKey+kindRepTyConAppDataConName = dcQual gHC_TYPES     (fsLit "KindRepTyConApp") kindRepTyConAppDataConKey+kindRepVarDataConName = dcQual gHC_TYPES          (fsLit "KindRepVar")     kindRepVarDataConKey+kindRepAppDataConName = dcQual gHC_TYPES          (fsLit "KindRepApp")     kindRepAppDataConKey+kindRepFunDataConName = dcQual gHC_TYPES          (fsLit "KindRepFun")     kindRepFunDataConKey+kindRepTYPEDataConName = dcQual gHC_TYPES         (fsLit "KindRepTYPE")    kindRepTYPEDataConKey+kindRepTypeLitSDataConName = dcQual gHC_TYPES     (fsLit "KindRepTypeLitS") kindRepTypeLitSDataConKey+kindRepTypeLitDDataConName = dcQual gHC_TYPES     (fsLit "KindRepTypeLitD") kindRepTypeLitDDataConKey++typeLitSortTyConName+  , typeLitSymbolDataConName+  , typeLitNatDataConName+  :: Name+typeLitSortTyConName     = tcQual gHC_TYPES       (fsLit "TypeLitSort")    typeLitSortTyConKey+typeLitSymbolDataConName = dcQual gHC_TYPES       (fsLit "TypeLitSymbol")  typeLitSymbolDataConKey+typeLitNatDataConName    = dcQual gHC_TYPES       (fsLit "TypeLitNat")     typeLitNatDataConKey++-- Class Typeable, and functions for constructing `Typeable` dictionaries+typeableClassName+  , typeRepTyConName+  , someTypeRepTyConName+  , someTypeRepDataConName+  , mkTrTypeName+  , mkTrConName+  , mkTrAppName+  , mkTrFunName+  , typeRepIdName+  , typeNatTypeRepName+  , typeSymbolTypeRepName+  , trGhcPrimModuleName+  :: Name+typeableClassName     = clsQual tYPEABLE_INTERNAL (fsLit "Typeable")       typeableClassKey+typeRepTyConName      = tcQual  tYPEABLE_INTERNAL (fsLit "TypeRep")        typeRepTyConKey+someTypeRepTyConName   = tcQual tYPEABLE_INTERNAL (fsLit "SomeTypeRep")    someTypeRepTyConKey+someTypeRepDataConName = dcQual tYPEABLE_INTERNAL (fsLit "SomeTypeRep")    someTypeRepDataConKey+typeRepIdName         = varQual tYPEABLE_INTERNAL (fsLit "typeRep#")       typeRepIdKey+mkTrTypeName          = varQual tYPEABLE_INTERNAL (fsLit "mkTrType")       mkTrTypeKey+mkTrConName           = varQual tYPEABLE_INTERNAL (fsLit "mkTrCon")        mkTrConKey+mkTrAppName           = varQual tYPEABLE_INTERNAL (fsLit "mkTrApp")        mkTrAppKey+mkTrFunName           = varQual tYPEABLE_INTERNAL (fsLit "mkTrFun")        mkTrFunKey+typeNatTypeRepName    = varQual tYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey+typeSymbolTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") typeSymbolTypeRepKey+-- this is the Typeable 'Module' for GHC.Prim (which has no code, so we place in GHC.Types)+-- See Note [Grand plan for Typeable] in TcTypeable.+trGhcPrimModuleName   = varQual gHC_TYPES         (fsLit "tr$ModuleGHCPrim")  trGhcPrimModuleKey++-- Typeable KindReps for some common cases+starKindRepName, starArrStarKindRepName, starArrStarArrStarKindRepName :: Name+starKindRepName        = varQual gHC_TYPES         (fsLit "krep$*")         starKindRepKey+starArrStarKindRepName = varQual gHC_TYPES         (fsLit "krep$*Arr*")     starArrStarKindRepKey+starArrStarArrStarKindRepName = varQual gHC_TYPES  (fsLit "krep$*->*->*")   starArrStarArrStarKindRepKey++-- Custom type errors+errorMessageTypeErrorFamName+  , typeErrorTextDataConName+  , typeErrorAppendDataConName+  , typeErrorVAppendDataConName+  , typeErrorShowTypeDataConName+  :: Name++errorMessageTypeErrorFamName =+  tcQual gHC_TYPELITS (fsLit "TypeError") errorMessageTypeErrorFamKey++typeErrorTextDataConName =+  dcQual gHC_TYPELITS (fsLit "Text") typeErrorTextDataConKey++typeErrorAppendDataConName =+  dcQual gHC_TYPELITS (fsLit ":<>:") typeErrorAppendDataConKey++typeErrorVAppendDataConName =+  dcQual gHC_TYPELITS (fsLit ":$$:") typeErrorVAppendDataConKey++typeErrorShowTypeDataConName =+  dcQual gHC_TYPELITS (fsLit "ShowType") typeErrorShowTypeDataConKey++++-- Dynamic+toDynName :: Name+toDynName = varQual dYNAMIC (fsLit "toDyn") toDynIdKey++-- Class Data+dataClassName :: Name+dataClassName = clsQual gENERICS (fsLit "Data") dataClassKey++-- Error module+assertErrorName    :: Name+assertErrorName   = varQual gHC_IO_Exception (fsLit "assertError") assertErrorIdKey++-- Debug.Trace+traceName          :: Name+traceName         = varQual dEBUG_TRACE (fsLit "trace") traceKey++-- Enum module (Enum, Bounded)+enumClassName, enumFromName, enumFromToName, enumFromThenName,+    enumFromThenToName, boundedClassName :: Name+enumClassName      = clsQual gHC_ENUM (fsLit "Enum")           enumClassKey+enumFromName       = varQual gHC_ENUM (fsLit "enumFrom")       enumFromClassOpKey+enumFromToName     = varQual gHC_ENUM (fsLit "enumFromTo")     enumFromToClassOpKey+enumFromThenName   = varQual gHC_ENUM (fsLit "enumFromThen")   enumFromThenClassOpKey+enumFromThenToName = varQual gHC_ENUM (fsLit "enumFromThenTo") enumFromThenToClassOpKey+boundedClassName   = clsQual gHC_ENUM (fsLit "Bounded")        boundedClassKey++-- List functions+concatName, filterName, zipName :: Name+concatName        = varQual gHC_LIST (fsLit "concat") concatIdKey+filterName        = varQual gHC_LIST (fsLit "filter") filterIdKey+zipName           = varQual gHC_LIST (fsLit "zip")    zipIdKey++-- Overloaded lists+isListClassName, fromListName, fromListNName, toListName :: Name+isListClassName = clsQual gHC_EXTS (fsLit "IsList")    isListClassKey+fromListName    = varQual gHC_EXTS (fsLit "fromList")  fromListClassOpKey+fromListNName   = varQual gHC_EXTS (fsLit "fromListN") fromListNClassOpKey+toListName      = varQual gHC_EXTS (fsLit "toList")    toListClassOpKey++-- Class Show+showClassName :: Name+showClassName   = clsQual gHC_SHOW (fsLit "Show")      showClassKey++-- Class Read+readClassName :: Name+readClassName   = clsQual gHC_READ (fsLit "Read")      readClassKey++-- Classes Generic and Generic1, Datatype, Constructor and Selector+genClassName, gen1ClassName, datatypeClassName, constructorClassName,+  selectorClassName :: Name+genClassName  = clsQual gHC_GENERICS (fsLit "Generic")  genClassKey+gen1ClassName = clsQual gHC_GENERICS (fsLit "Generic1") gen1ClassKey++datatypeClassName    = clsQual gHC_GENERICS (fsLit "Datatype")    datatypeClassKey+constructorClassName = clsQual gHC_GENERICS (fsLit "Constructor") constructorClassKey+selectorClassName    = clsQual gHC_GENERICS (fsLit "Selector")    selectorClassKey++genericClassNames :: [Name]+genericClassNames = [genClassName, gen1ClassName]++-- GHCi things+ghciIoClassName, ghciStepIoMName :: Name+ghciIoClassName = clsQual gHC_GHCI (fsLit "GHCiSandboxIO") ghciIoClassKey+ghciStepIoMName = varQual gHC_GHCI (fsLit "ghciStepIO") ghciStepIoMClassOpKey++-- IO things+ioTyConName, ioDataConName,+  thenIOName, bindIOName, returnIOName, failIOName :: Name+ioTyConName       = tcQual  gHC_TYPES (fsLit "IO")       ioTyConKey+ioDataConName     = dcQual  gHC_TYPES (fsLit "IO")       ioDataConKey+thenIOName        = varQual gHC_BASE  (fsLit "thenIO")   thenIOIdKey+bindIOName        = varQual gHC_BASE  (fsLit "bindIO")   bindIOIdKey+returnIOName      = varQual gHC_BASE  (fsLit "returnIO") returnIOIdKey+failIOName        = varQual gHC_IO    (fsLit "failIO")   failIOIdKey++-- IO things+printName :: Name+printName         = varQual sYSTEM_IO (fsLit "print") printIdKey++-- Int, Word, and Addr things+int8TyConName, int16TyConName, int32TyConName, int64TyConName :: Name+int8TyConName     = tcQual gHC_INT  (fsLit "Int8")  int8TyConKey+int16TyConName    = tcQual gHC_INT  (fsLit "Int16") int16TyConKey+int32TyConName    = tcQual gHC_INT  (fsLit "Int32") int32TyConKey+int64TyConName    = tcQual gHC_INT  (fsLit "Int64") int64TyConKey++-- Word module+word16TyConName, word32TyConName, word64TyConName :: Name+word16TyConName   = tcQual  gHC_WORD (fsLit "Word16") word16TyConKey+word32TyConName   = tcQual  gHC_WORD (fsLit "Word32") word32TyConKey+word64TyConName   = tcQual  gHC_WORD (fsLit "Word64") word64TyConKey++-- PrelPtr module+ptrTyConName, funPtrTyConName :: Name+ptrTyConName      = tcQual   gHC_PTR (fsLit "Ptr")    ptrTyConKey+funPtrTyConName   = tcQual   gHC_PTR (fsLit "FunPtr") funPtrTyConKey++-- Foreign objects and weak pointers+stablePtrTyConName, newStablePtrName :: Name+stablePtrTyConName    = tcQual   gHC_STABLE (fsLit "StablePtr")    stablePtrTyConKey+newStablePtrName      = varQual  gHC_STABLE (fsLit "newStablePtr") newStablePtrIdKey++-- Recursive-do notation+monadFixClassName, mfixName :: Name+monadFixClassName  = clsQual mONAD_FIX (fsLit "MonadFix") monadFixClassKey+mfixName           = varQual mONAD_FIX (fsLit "mfix")     mfixIdKey++-- Arrow notation+arrAName, composeAName, firstAName, appAName, choiceAName, loopAName :: Name+arrAName           = varQual aRROW (fsLit "arr")       arrAIdKey+composeAName       = varQual gHC_DESUGAR (fsLit ">>>") composeAIdKey+firstAName         = varQual aRROW (fsLit "first")     firstAIdKey+appAName           = varQual aRROW (fsLit "app")       appAIdKey+choiceAName        = varQual aRROW (fsLit "|||")       choiceAIdKey+loopAName          = varQual aRROW (fsLit "loop")      loopAIdKey++-- Monad comprehensions+guardMName, liftMName, mzipName :: Name+guardMName         = varQual mONAD (fsLit "guard")    guardMIdKey+liftMName          = varQual mONAD (fsLit "liftM")    liftMIdKey+mzipName           = varQual mONAD_ZIP (fsLit "mzip") mzipIdKey+++-- Annotation type checking+toAnnotationWrapperName :: Name+toAnnotationWrapperName = varQual gHC_DESUGAR (fsLit "toAnnotationWrapper") toAnnotationWrapperIdKey++-- Other classes, needed for type defaulting+monadPlusClassName, randomClassName, randomGenClassName,+    isStringClassName :: Name+monadPlusClassName  = clsQual mONAD (fsLit "MonadPlus")      monadPlusClassKey+randomClassName     = clsQual rANDOM (fsLit "Random")        randomClassKey+randomGenClassName  = clsQual rANDOM (fsLit "RandomGen")     randomGenClassKey+isStringClassName   = clsQual dATA_STRING (fsLit "IsString") isStringClassKey++-- Type-level naturals+knownNatClassName :: Name+knownNatClassName     = clsQual gHC_TYPENATS (fsLit "KnownNat") knownNatClassNameKey+knownSymbolClassName :: Name+knownSymbolClassName  = clsQual gHC_TYPELITS (fsLit "KnownSymbol") knownSymbolClassNameKey++-- Overloaded labels+isLabelClassName :: Name+isLabelClassName+ = clsQual gHC_OVER_LABELS (fsLit "IsLabel") isLabelClassNameKey++-- Implicit Parameters+ipClassName :: Name+ipClassName+  = clsQual gHC_CLASSES (fsLit "IP") ipClassKey++-- Overloaded record fields+hasFieldClassName :: Name+hasFieldClassName+ = clsQual gHC_RECORDS (fsLit "HasField") hasFieldClassNameKey++-- Source Locations+callStackTyConName, emptyCallStackName, pushCallStackName,+  srcLocDataConName :: Name+callStackTyConName+  = tcQual gHC_STACK_TYPES  (fsLit "CallStack") callStackTyConKey+emptyCallStackName+  = varQual gHC_STACK_TYPES (fsLit "emptyCallStack") emptyCallStackKey+pushCallStackName+  = varQual gHC_STACK_TYPES (fsLit "pushCallStack") pushCallStackKey+srcLocDataConName+  = dcQual gHC_STACK_TYPES  (fsLit "SrcLoc")    srcLocDataConKey++-- plugins+pLUGINS :: Module+pLUGINS = mkThisGhcModule (fsLit "Plugins")+pluginTyConName :: Name+pluginTyConName = tcQual pLUGINS (fsLit "Plugin") pluginTyConKey+frontendPluginTyConName :: Name+frontendPluginTyConName = tcQual pLUGINS (fsLit "FrontendPlugin") frontendPluginTyConKey++-- Static pointers+makeStaticName :: Name+makeStaticName =+    varQual gHC_STATICPTR_INTERNAL (fsLit "makeStatic") makeStaticKey++staticPtrInfoTyConName :: Name+staticPtrInfoTyConName =+    tcQual gHC_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoTyConKey++staticPtrInfoDataConName :: Name+staticPtrInfoDataConName =+    dcQual gHC_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoDataConKey++staticPtrTyConName :: Name+staticPtrTyConName =+    tcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrTyConKey++staticPtrDataConName :: Name+staticPtrDataConName =+    dcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrDataConKey++fromStaticPtrName :: Name+fromStaticPtrName =+    varQual gHC_STATICPTR (fsLit "fromStaticPtr") fromStaticPtrClassOpKey++fingerprintDataConName :: Name+fingerprintDataConName =+    dcQual gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey++{-+************************************************************************+*                                                                      *+\subsection{Local helpers}+*                                                                      *+************************************************************************++All these are original names; hence mkOrig+-}++varQual, tcQual, clsQual, dcQual :: Module -> FastString -> Unique -> Name+varQual  = mk_known_key_name varName+tcQual   = mk_known_key_name tcName+clsQual  = mk_known_key_name clsName+dcQual   = mk_known_key_name dataName++mk_known_key_name :: NameSpace -> Module -> FastString -> Unique -> Name+mk_known_key_name space modu str unique+  = mkExternalName unique modu (mkOccNameFS space str) noSrcSpan+++{-+************************************************************************+*                                                                      *+\subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}+*                                                                      *+************************************************************************+--MetaHaskell extension hand allocate keys here+-}++boundedClassKey, enumClassKey, eqClassKey, floatingClassKey,+    fractionalClassKey, integralClassKey, monadClassKey, dataClassKey,+    functorClassKey, numClassKey, ordClassKey, readClassKey, realClassKey,+    realFloatClassKey, realFracClassKey, showClassKey, ixClassKey :: Unique+boundedClassKey         = mkPreludeClassUnique 1+enumClassKey            = mkPreludeClassUnique 2+eqClassKey              = mkPreludeClassUnique 3+floatingClassKey        = mkPreludeClassUnique 5+fractionalClassKey      = mkPreludeClassUnique 6+integralClassKey        = mkPreludeClassUnique 7+monadClassKey           = mkPreludeClassUnique 8+dataClassKey            = mkPreludeClassUnique 9+functorClassKey         = mkPreludeClassUnique 10+numClassKey             = mkPreludeClassUnique 11+ordClassKey             = mkPreludeClassUnique 12+readClassKey            = mkPreludeClassUnique 13+realClassKey            = mkPreludeClassUnique 14+realFloatClassKey       = mkPreludeClassUnique 15+realFracClassKey        = mkPreludeClassUnique 16+showClassKey            = mkPreludeClassUnique 17+ixClassKey              = mkPreludeClassUnique 18++typeableClassKey, typeable1ClassKey, typeable2ClassKey, typeable3ClassKey,+    typeable4ClassKey, typeable5ClassKey, typeable6ClassKey, typeable7ClassKey+    :: Unique+typeableClassKey        = mkPreludeClassUnique 20+typeable1ClassKey       = mkPreludeClassUnique 21+typeable2ClassKey       = mkPreludeClassUnique 22+typeable3ClassKey       = mkPreludeClassUnique 23+typeable4ClassKey       = mkPreludeClassUnique 24+typeable5ClassKey       = mkPreludeClassUnique 25+typeable6ClassKey       = mkPreludeClassUnique 26+typeable7ClassKey       = mkPreludeClassUnique 27++monadFixClassKey :: Unique+monadFixClassKey        = mkPreludeClassUnique 28++monadFailClassKey :: Unique+monadFailClassKey       = mkPreludeClassUnique 29++monadPlusClassKey, randomClassKey, randomGenClassKey :: Unique+monadPlusClassKey       = mkPreludeClassUnique 30+randomClassKey          = mkPreludeClassUnique 31+randomGenClassKey       = mkPreludeClassUnique 32++isStringClassKey :: Unique+isStringClassKey        = mkPreludeClassUnique 33++applicativeClassKey, foldableClassKey, traversableClassKey :: Unique+applicativeClassKey     = mkPreludeClassUnique 34+foldableClassKey        = mkPreludeClassUnique 35+traversableClassKey     = mkPreludeClassUnique 36++genClassKey, gen1ClassKey, datatypeClassKey, constructorClassKey,+  selectorClassKey :: Unique+genClassKey   = mkPreludeClassUnique 37+gen1ClassKey  = mkPreludeClassUnique 38++datatypeClassKey    = mkPreludeClassUnique 39+constructorClassKey = mkPreludeClassUnique 40+selectorClassKey    = mkPreludeClassUnique 41++-- KnownNat: see Note [KnowNat & KnownSymbol and EvLit] in TcEvidence+knownNatClassNameKey :: Unique+knownNatClassNameKey = mkPreludeClassUnique 42++-- KnownSymbol: see Note [KnownNat & KnownSymbol and EvLit] in TcEvidence+knownSymbolClassNameKey :: Unique+knownSymbolClassNameKey = mkPreludeClassUnique 43++ghciIoClassKey :: Unique+ghciIoClassKey = mkPreludeClassUnique 44++isLabelClassNameKey :: Unique+isLabelClassNameKey = mkPreludeClassUnique 45++semigroupClassKey, monoidClassKey :: Unique+semigroupClassKey = mkPreludeClassUnique 46+monoidClassKey    = mkPreludeClassUnique 47++-- Implicit Parameters+ipClassKey :: Unique+ipClassKey = mkPreludeClassUnique 48++-- Overloaded record fields+hasFieldClassNameKey :: Unique+hasFieldClassNameKey = mkPreludeClassUnique 49+++---------------- Template Haskell -------------------+--      THNames.hs: USES ClassUniques 200-299+-----------------------------------------------------++{-+************************************************************************+*                                                                      *+\subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}+*                                                                      *+************************************************************************+-}++addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey,+    byteArrayPrimTyConKey, charPrimTyConKey, charTyConKey, doublePrimTyConKey,+    doubleTyConKey, floatPrimTyConKey, floatTyConKey, funTyConKey,+    intPrimTyConKey, intTyConKey, int8TyConKey, int16TyConKey,+    int8PrimTyConKey, int16PrimTyConKey, int32PrimTyConKey, int32TyConKey,+    int64PrimTyConKey, int64TyConKey,+    integerTyConKey, naturalTyConKey,+    listTyConKey, foreignObjPrimTyConKey, maybeTyConKey,+    weakPrimTyConKey, mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey,+    mutableByteArrayPrimTyConKey, orderingTyConKey, mVarPrimTyConKey,+    ratioTyConKey, rationalTyConKey, realWorldTyConKey, stablePtrPrimTyConKey,+    stablePtrTyConKey, eqTyConKey, heqTyConKey,+    smallArrayPrimTyConKey, smallMutableArrayPrimTyConKey :: Unique+addrPrimTyConKey                        = mkPreludeTyConUnique  1+arrayPrimTyConKey                       = mkPreludeTyConUnique  3+boolTyConKey                            = mkPreludeTyConUnique  4+byteArrayPrimTyConKey                   = mkPreludeTyConUnique  5+charPrimTyConKey                        = mkPreludeTyConUnique  7+charTyConKey                            = mkPreludeTyConUnique  8+doublePrimTyConKey                      = mkPreludeTyConUnique  9+doubleTyConKey                          = mkPreludeTyConUnique 10+floatPrimTyConKey                       = mkPreludeTyConUnique 11+floatTyConKey                           = mkPreludeTyConUnique 12+funTyConKey                             = mkPreludeTyConUnique 13+intPrimTyConKey                         = mkPreludeTyConUnique 14+intTyConKey                             = mkPreludeTyConUnique 15+int8PrimTyConKey                        = mkPreludeTyConUnique 16+int8TyConKey                            = mkPreludeTyConUnique 17+int16PrimTyConKey                       = mkPreludeTyConUnique 18+int16TyConKey                           = mkPreludeTyConUnique 19+int32PrimTyConKey                       = mkPreludeTyConUnique 20+int32TyConKey                           = mkPreludeTyConUnique 21+int64PrimTyConKey                       = mkPreludeTyConUnique 22+int64TyConKey                           = mkPreludeTyConUnique 23+integerTyConKey                         = mkPreludeTyConUnique 24+naturalTyConKey                         = mkPreludeTyConUnique 25++listTyConKey                            = mkPreludeTyConUnique 26+foreignObjPrimTyConKey                  = mkPreludeTyConUnique 27+maybeTyConKey                           = mkPreludeTyConUnique 28+weakPrimTyConKey                        = mkPreludeTyConUnique 29+mutableArrayPrimTyConKey                = mkPreludeTyConUnique 30+mutableByteArrayPrimTyConKey            = mkPreludeTyConUnique 31+orderingTyConKey                        = mkPreludeTyConUnique 32+mVarPrimTyConKey                        = mkPreludeTyConUnique 33+ratioTyConKey                           = mkPreludeTyConUnique 34+rationalTyConKey                        = mkPreludeTyConUnique 35+realWorldTyConKey                       = mkPreludeTyConUnique 36+stablePtrPrimTyConKey                   = mkPreludeTyConUnique 37+stablePtrTyConKey                       = mkPreludeTyConUnique 38+eqTyConKey                              = mkPreludeTyConUnique 40+heqTyConKey                             = mkPreludeTyConUnique 41+arrayArrayPrimTyConKey                  = mkPreludeTyConUnique 42+mutableArrayArrayPrimTyConKey           = mkPreludeTyConUnique 43++statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey,+    mutVarPrimTyConKey, ioTyConKey,+    wordPrimTyConKey, wordTyConKey, word8PrimTyConKey, word8TyConKey,+    word16PrimTyConKey, word16TyConKey, word32PrimTyConKey, word32TyConKey,+    word64PrimTyConKey, word64TyConKey,+    liftedConKey, unliftedConKey, anyBoxConKey, kindConKey, boxityConKey,+    typeConKey, threadIdPrimTyConKey, bcoPrimTyConKey, ptrTyConKey,+    funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey,+    eqReprPrimTyConKey, eqPhantPrimTyConKey, voidPrimTyConKey,+    compactPrimTyConKey :: Unique+statePrimTyConKey                       = mkPreludeTyConUnique 50+stableNamePrimTyConKey                  = mkPreludeTyConUnique 51+stableNameTyConKey                      = mkPreludeTyConUnique 52+eqPrimTyConKey                          = mkPreludeTyConUnique 53+eqReprPrimTyConKey                      = mkPreludeTyConUnique 54+eqPhantPrimTyConKey                     = mkPreludeTyConUnique 55+mutVarPrimTyConKey                      = mkPreludeTyConUnique 56+ioTyConKey                              = mkPreludeTyConUnique 57+voidPrimTyConKey                        = mkPreludeTyConUnique 58+wordPrimTyConKey                        = mkPreludeTyConUnique 59+wordTyConKey                            = mkPreludeTyConUnique 60+word8PrimTyConKey                       = mkPreludeTyConUnique 61+word8TyConKey                           = mkPreludeTyConUnique 62+word16PrimTyConKey                      = mkPreludeTyConUnique 63+word16TyConKey                          = mkPreludeTyConUnique 64+word32PrimTyConKey                      = mkPreludeTyConUnique 65+word32TyConKey                          = mkPreludeTyConUnique 66+word64PrimTyConKey                      = mkPreludeTyConUnique 67+word64TyConKey                          = mkPreludeTyConUnique 68+liftedConKey                            = mkPreludeTyConUnique 69+unliftedConKey                          = mkPreludeTyConUnique 70+anyBoxConKey                            = mkPreludeTyConUnique 71+kindConKey                              = mkPreludeTyConUnique 72+boxityConKey                            = mkPreludeTyConUnique 73+typeConKey                              = mkPreludeTyConUnique 74+threadIdPrimTyConKey                    = mkPreludeTyConUnique 75+bcoPrimTyConKey                         = mkPreludeTyConUnique 76+ptrTyConKey                             = mkPreludeTyConUnique 77+funPtrTyConKey                          = mkPreludeTyConUnique 78+tVarPrimTyConKey                        = mkPreludeTyConUnique 79+compactPrimTyConKey                     = mkPreludeTyConUnique 80++-- dotnet interop+objectTyConKey :: Unique+objectTyConKey                          = mkPreludeTyConUnique 83++eitherTyConKey :: Unique+eitherTyConKey                          = mkPreludeTyConUnique 84++-- Kind constructors+liftedTypeKindTyConKey, tYPETyConKey,+  constraintKindTyConKey, runtimeRepTyConKey,+  vecCountTyConKey, vecElemTyConKey :: Unique+liftedTypeKindTyConKey                  = mkPreludeTyConUnique 87+tYPETyConKey                            = mkPreludeTyConUnique 88+constraintKindTyConKey                  = mkPreludeTyConUnique 92+runtimeRepTyConKey                      = mkPreludeTyConUnique 95+vecCountTyConKey                        = mkPreludeTyConUnique 96+vecElemTyConKey                         = mkPreludeTyConUnique 97++pluginTyConKey, frontendPluginTyConKey :: Unique+pluginTyConKey                          = mkPreludeTyConUnique 102+frontendPluginTyConKey                  = mkPreludeTyConUnique 103++unknownTyConKey, unknown1TyConKey, unknown2TyConKey, unknown3TyConKey,+    opaqueTyConKey :: Unique+unknownTyConKey                         = mkPreludeTyConUnique 129+unknown1TyConKey                        = mkPreludeTyConUnique 130+unknown2TyConKey                        = mkPreludeTyConUnique 131+unknown3TyConKey                        = mkPreludeTyConUnique 132+opaqueTyConKey                          = mkPreludeTyConUnique 133++-- Generics (Unique keys)+v1TyConKey, u1TyConKey, par1TyConKey, rec1TyConKey,+  k1TyConKey, m1TyConKey, sumTyConKey, prodTyConKey,+  compTyConKey, rTyConKey, dTyConKey,+  cTyConKey, sTyConKey, rec0TyConKey,+  d1TyConKey, c1TyConKey, s1TyConKey, noSelTyConKey,+  repTyConKey, rep1TyConKey, uRecTyConKey,+  uAddrTyConKey, uCharTyConKey, uDoubleTyConKey,+  uFloatTyConKey, uIntTyConKey, uWordTyConKey :: Unique++v1TyConKey    = mkPreludeTyConUnique 135+u1TyConKey    = mkPreludeTyConUnique 136+par1TyConKey  = mkPreludeTyConUnique 137+rec1TyConKey  = mkPreludeTyConUnique 138+k1TyConKey    = mkPreludeTyConUnique 139+m1TyConKey    = mkPreludeTyConUnique 140++sumTyConKey   = mkPreludeTyConUnique 141+prodTyConKey  = mkPreludeTyConUnique 142+compTyConKey  = mkPreludeTyConUnique 143++rTyConKey = mkPreludeTyConUnique 144+dTyConKey = mkPreludeTyConUnique 146+cTyConKey = mkPreludeTyConUnique 147+sTyConKey = mkPreludeTyConUnique 148++rec0TyConKey  = mkPreludeTyConUnique 149+d1TyConKey    = mkPreludeTyConUnique 151+c1TyConKey    = mkPreludeTyConUnique 152+s1TyConKey    = mkPreludeTyConUnique 153+noSelTyConKey = mkPreludeTyConUnique 154++repTyConKey  = mkPreludeTyConUnique 155+rep1TyConKey = mkPreludeTyConUnique 156++uRecTyConKey    = mkPreludeTyConUnique 157+uAddrTyConKey   = mkPreludeTyConUnique 158+uCharTyConKey   = mkPreludeTyConUnique 159+uDoubleTyConKey = mkPreludeTyConUnique 160+uFloatTyConKey  = mkPreludeTyConUnique 161+uIntTyConKey    = mkPreludeTyConUnique 162+uWordTyConKey   = mkPreludeTyConUnique 163++-- Type-level naturals+typeNatKindConNameKey, typeSymbolKindConNameKey,+  typeNatAddTyFamNameKey, typeNatMulTyFamNameKey, typeNatExpTyFamNameKey,+  typeNatLeqTyFamNameKey, typeNatSubTyFamNameKey+  , typeSymbolCmpTyFamNameKey, typeNatCmpTyFamNameKey+  , typeNatDivTyFamNameKey+  , typeNatModTyFamNameKey+  , typeNatLogTyFamNameKey+  :: Unique+typeNatKindConNameKey     = mkPreludeTyConUnique 164+typeSymbolKindConNameKey  = mkPreludeTyConUnique 165+typeNatAddTyFamNameKey    = mkPreludeTyConUnique 166+typeNatMulTyFamNameKey    = mkPreludeTyConUnique 167+typeNatExpTyFamNameKey    = mkPreludeTyConUnique 168+typeNatLeqTyFamNameKey    = mkPreludeTyConUnique 169+typeNatSubTyFamNameKey    = mkPreludeTyConUnique 170+typeSymbolCmpTyFamNameKey = mkPreludeTyConUnique 171+typeNatCmpTyFamNameKey    = mkPreludeTyConUnique 172+typeNatDivTyFamNameKey  = mkPreludeTyConUnique 173+typeNatModTyFamNameKey  = mkPreludeTyConUnique 174+typeNatLogTyFamNameKey  = mkPreludeTyConUnique 175++-- Custom user type-errors+errorMessageTypeErrorFamKey :: Unique+errorMessageTypeErrorFamKey =  mkPreludeTyConUnique 176++++ntTyConKey:: Unique+ntTyConKey = mkPreludeTyConUnique 177+coercibleTyConKey :: Unique+coercibleTyConKey = mkPreludeTyConUnique 178++proxyPrimTyConKey :: Unique+proxyPrimTyConKey = mkPreludeTyConUnique 179++specTyConKey :: Unique+specTyConKey = mkPreludeTyConUnique 180++anyTyConKey :: Unique+anyTyConKey = mkPreludeTyConUnique 181++smallArrayPrimTyConKey        = mkPreludeTyConUnique  182+smallMutableArrayPrimTyConKey = mkPreludeTyConUnique  183++staticPtrTyConKey  :: Unique+staticPtrTyConKey  = mkPreludeTyConUnique 184++staticPtrInfoTyConKey :: Unique+staticPtrInfoTyConKey = mkPreludeTyConUnique 185++callStackTyConKey :: Unique+callStackTyConKey = mkPreludeTyConUnique 186++-- Typeables+typeRepTyConKey, someTypeRepTyConKey, someTypeRepDataConKey :: Unique+typeRepTyConKey       = mkPreludeTyConUnique 187+someTypeRepTyConKey   = mkPreludeTyConUnique 188+someTypeRepDataConKey = mkPreludeTyConUnique 189+++typeSymbolAppendFamNameKey :: Unique+typeSymbolAppendFamNameKey = mkPreludeTyConUnique 190++---------------- Template Haskell -------------------+--      THNames.hs: USES TyConUniques 200-299+-----------------------------------------------------++----------------------- SIMD ------------------------+--      USES TyConUniques 300-399+-----------------------------------------------------++#include "primop-vector-uniques.hs-incl"++{-+************************************************************************+*                                                                      *+\subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}+*                                                                      *+************************************************************************+-}++charDataConKey, consDataConKey, doubleDataConKey, falseDataConKey,+    floatDataConKey, intDataConKey, integerSDataConKey, nilDataConKey,+    ratioDataConKey, stableNameDataConKey, trueDataConKey, wordDataConKey,+    word8DataConKey, ioDataConKey, integerDataConKey, heqDataConKey,+    coercibleDataConKey, eqDataConKey, nothingDataConKey, justDataConKey :: Unique++charDataConKey                          = mkPreludeDataConUnique  1+consDataConKey                          = mkPreludeDataConUnique  2+doubleDataConKey                        = mkPreludeDataConUnique  3+falseDataConKey                         = mkPreludeDataConUnique  4+floatDataConKey                         = mkPreludeDataConUnique  5+intDataConKey                           = mkPreludeDataConUnique  6+integerSDataConKey                      = mkPreludeDataConUnique  7+nothingDataConKey                       = mkPreludeDataConUnique  8+justDataConKey                          = mkPreludeDataConUnique  9+eqDataConKey                            = mkPreludeDataConUnique 10+nilDataConKey                           = mkPreludeDataConUnique 11+ratioDataConKey                         = mkPreludeDataConUnique 12+word8DataConKey                         = mkPreludeDataConUnique 13+stableNameDataConKey                    = mkPreludeDataConUnique 14+trueDataConKey                          = mkPreludeDataConUnique 15+wordDataConKey                          = mkPreludeDataConUnique 16+ioDataConKey                            = mkPreludeDataConUnique 17+integerDataConKey                       = mkPreludeDataConUnique 18+heqDataConKey                           = mkPreludeDataConUnique 19++-- Generic data constructors+crossDataConKey, inlDataConKey, inrDataConKey, genUnitDataConKey :: Unique+crossDataConKey                         = mkPreludeDataConUnique 20+inlDataConKey                           = mkPreludeDataConUnique 21+inrDataConKey                           = mkPreludeDataConUnique 22+genUnitDataConKey                       = mkPreludeDataConUnique 23++leftDataConKey, rightDataConKey :: Unique+leftDataConKey                          = mkPreludeDataConUnique 25+rightDataConKey                         = mkPreludeDataConUnique 26++ordLTDataConKey, ordEQDataConKey, ordGTDataConKey :: Unique+ordLTDataConKey                         = mkPreludeDataConUnique 27+ordEQDataConKey                         = mkPreludeDataConUnique 28+ordGTDataConKey                         = mkPreludeDataConUnique 29+++coercibleDataConKey                     = mkPreludeDataConUnique 32++staticPtrDataConKey :: Unique+staticPtrDataConKey                     = mkPreludeDataConUnique 33++staticPtrInfoDataConKey :: Unique+staticPtrInfoDataConKey                 = mkPreludeDataConUnique 34++fingerprintDataConKey :: Unique+fingerprintDataConKey                   = mkPreludeDataConUnique 35++srcLocDataConKey :: Unique+srcLocDataConKey                        = mkPreludeDataConUnique 37++trTyConTyConKey, trTyConDataConKey,+  trModuleTyConKey, trModuleDataConKey,+  trNameTyConKey, trNameSDataConKey, trNameDDataConKey,+  trGhcPrimModuleKey, kindRepTyConKey,+  typeLitSortTyConKey :: Unique+trTyConTyConKey                         = mkPreludeDataConUnique 40+trTyConDataConKey                       = mkPreludeDataConUnique 41+trModuleTyConKey                        = mkPreludeDataConUnique 42+trModuleDataConKey                      = mkPreludeDataConUnique 43+trNameTyConKey                          = mkPreludeDataConUnique 44+trNameSDataConKey                       = mkPreludeDataConUnique 45+trNameDDataConKey                       = mkPreludeDataConUnique 46+trGhcPrimModuleKey                      = mkPreludeDataConUnique 47+kindRepTyConKey                         = mkPreludeDataConUnique 48+typeLitSortTyConKey                     = mkPreludeDataConUnique 49++typeErrorTextDataConKey,+  typeErrorAppendDataConKey,+  typeErrorVAppendDataConKey,+  typeErrorShowTypeDataConKey+  :: Unique+typeErrorTextDataConKey                 = mkPreludeDataConUnique 50+typeErrorAppendDataConKey               = mkPreludeDataConUnique 51+typeErrorVAppendDataConKey              = mkPreludeDataConUnique 52+typeErrorShowTypeDataConKey             = mkPreludeDataConUnique 53++prefixIDataConKey, infixIDataConKey, leftAssociativeDataConKey,+    rightAssociativeDataConKey, notAssociativeDataConKey,+    sourceUnpackDataConKey, sourceNoUnpackDataConKey,+    noSourceUnpackednessDataConKey, sourceLazyDataConKey,+    sourceStrictDataConKey, noSourceStrictnessDataConKey,+    decidedLazyDataConKey, decidedStrictDataConKey, decidedUnpackDataConKey,+    metaDataDataConKey, metaConsDataConKey, metaSelDataConKey :: Unique+prefixIDataConKey                       = mkPreludeDataConUnique 54+infixIDataConKey                        = mkPreludeDataConUnique 55+leftAssociativeDataConKey               = mkPreludeDataConUnique 56+rightAssociativeDataConKey              = mkPreludeDataConUnique 57+notAssociativeDataConKey                = mkPreludeDataConUnique 58+sourceUnpackDataConKey                  = mkPreludeDataConUnique 59+sourceNoUnpackDataConKey                = mkPreludeDataConUnique 60+noSourceUnpackednessDataConKey          = mkPreludeDataConUnique 61+sourceLazyDataConKey                    = mkPreludeDataConUnique 62+sourceStrictDataConKey                  = mkPreludeDataConUnique 63+noSourceStrictnessDataConKey            = mkPreludeDataConUnique 64+decidedLazyDataConKey                   = mkPreludeDataConUnique 65+decidedStrictDataConKey                 = mkPreludeDataConUnique 66+decidedUnpackDataConKey                 = mkPreludeDataConUnique 67+metaDataDataConKey                      = mkPreludeDataConUnique 68+metaConsDataConKey                      = mkPreludeDataConUnique 69+metaSelDataConKey                       = mkPreludeDataConUnique 70++vecRepDataConKey, tupleRepDataConKey, sumRepDataConKey :: Unique+vecRepDataConKey                        = mkPreludeDataConUnique 71+tupleRepDataConKey                      = mkPreludeDataConUnique 72+sumRepDataConKey                        = mkPreludeDataConUnique 73++-- See Note [Wiring in RuntimeRep] in TysWiredIn+runtimeRepSimpleDataConKeys, unliftedSimpleRepDataConKeys, unliftedRepDataConKeys :: [Unique]+liftedRepDataConKey :: Unique+runtimeRepSimpleDataConKeys@(liftedRepDataConKey : unliftedSimpleRepDataConKeys)+  = map mkPreludeDataConUnique [74..86]++unliftedRepDataConKeys = vecRepDataConKey :+                         tupleRepDataConKey :+                         sumRepDataConKey :+                         unliftedSimpleRepDataConKeys++-- See Note [Wiring in RuntimeRep] in TysWiredIn+-- VecCount+vecCountDataConKeys :: [Unique]+vecCountDataConKeys = map mkPreludeDataConUnique [87..92]++-- See Note [Wiring in RuntimeRep] in TysWiredIn+-- VecElem+vecElemDataConKeys :: [Unique]+vecElemDataConKeys = map mkPreludeDataConUnique [93..102]++-- Typeable things+kindRepTyConAppDataConKey, kindRepVarDataConKey, kindRepAppDataConKey,+    kindRepFunDataConKey, kindRepTYPEDataConKey,+    kindRepTypeLitSDataConKey, kindRepTypeLitDDataConKey+    :: Unique+kindRepTyConAppDataConKey = mkPreludeDataConUnique 103+kindRepVarDataConKey      = mkPreludeDataConUnique 104+kindRepAppDataConKey      = mkPreludeDataConUnique 105+kindRepFunDataConKey      = mkPreludeDataConUnique 106+kindRepTYPEDataConKey     = mkPreludeDataConUnique 107+kindRepTypeLitSDataConKey = mkPreludeDataConUnique 108+kindRepTypeLitDDataConKey = mkPreludeDataConUnique 109++typeLitSymbolDataConKey, typeLitNatDataConKey :: Unique+typeLitSymbolDataConKey   = mkPreludeDataConUnique 110+typeLitNatDataConKey      = mkPreludeDataConUnique 111+++---------------- Template Haskell -------------------+--      THNames.hs: USES DataUniques 200-250+-----------------------------------------------------+++{-+************************************************************************+*                                                                      *+\subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}+*                                                                      *+************************************************************************+-}++wildCardKey, absentErrorIdKey, augmentIdKey, appendIdKey,+    buildIdKey, errorIdKey, foldrIdKey, recSelErrorIdKey,+    seqIdKey, eqStringIdKey,+    noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey,+    runtimeErrorIdKey, patErrorIdKey, voidPrimIdKey,+    realWorldPrimIdKey, recConErrorIdKey,+    unpackCStringUtf8IdKey, unpackCStringAppendIdKey,+    unpackCStringFoldrIdKey, unpackCStringIdKey,+    typeErrorIdKey, divIntIdKey, modIntIdKey,+    absentSumFieldErrorIdKey :: Unique++wildCardKey                   = mkPreludeMiscIdUnique  0  -- See Note [WildCard binders]+absentErrorIdKey              = mkPreludeMiscIdUnique  1+augmentIdKey                  = mkPreludeMiscIdUnique  2+appendIdKey                   = mkPreludeMiscIdUnique  3+buildIdKey                    = mkPreludeMiscIdUnique  4+errorIdKey                    = mkPreludeMiscIdUnique  5+foldrIdKey                    = mkPreludeMiscIdUnique  6+recSelErrorIdKey              = mkPreludeMiscIdUnique  7+seqIdKey                      = mkPreludeMiscIdUnique  8+eqStringIdKey                 = mkPreludeMiscIdUnique 10+noMethodBindingErrorIdKey     = mkPreludeMiscIdUnique 11+nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 12+runtimeErrorIdKey             = mkPreludeMiscIdUnique 13+patErrorIdKey                 = mkPreludeMiscIdUnique 14+realWorldPrimIdKey            = mkPreludeMiscIdUnique 15+recConErrorIdKey              = mkPreludeMiscIdUnique 16+unpackCStringUtf8IdKey        = mkPreludeMiscIdUnique 17+unpackCStringAppendIdKey      = mkPreludeMiscIdUnique 18+unpackCStringFoldrIdKey       = mkPreludeMiscIdUnique 19+unpackCStringIdKey            = mkPreludeMiscIdUnique 20+voidPrimIdKey                 = mkPreludeMiscIdUnique 21+typeErrorIdKey                = mkPreludeMiscIdUnique 22+divIntIdKey                   = mkPreludeMiscIdUnique 23+modIntIdKey                   = mkPreludeMiscIdUnique 24+absentSumFieldErrorIdKey      = mkPreludeMiscIdUnique 9++unsafeCoerceIdKey, concatIdKey, filterIdKey, zipIdKey, bindIOIdKey,+    returnIOIdKey, newStablePtrIdKey,+    printIdKey, failIOIdKey, nullAddrIdKey, voidArgIdKey,+    fstIdKey, sndIdKey, otherwiseIdKey, assertIdKey :: Unique+unsafeCoerceIdKey             = mkPreludeMiscIdUnique 30+concatIdKey                   = mkPreludeMiscIdUnique 31+filterIdKey                   = mkPreludeMiscIdUnique 32+zipIdKey                      = mkPreludeMiscIdUnique 33+bindIOIdKey                   = mkPreludeMiscIdUnique 34+returnIOIdKey                 = mkPreludeMiscIdUnique 35+newStablePtrIdKey             = mkPreludeMiscIdUnique 36+printIdKey                    = mkPreludeMiscIdUnique 37+failIOIdKey                   = mkPreludeMiscIdUnique 38+nullAddrIdKey                 = mkPreludeMiscIdUnique 39+voidArgIdKey                  = mkPreludeMiscIdUnique 40+fstIdKey                      = mkPreludeMiscIdUnique 41+sndIdKey                      = mkPreludeMiscIdUnique 42+otherwiseIdKey                = mkPreludeMiscIdUnique 43+assertIdKey                   = mkPreludeMiscIdUnique 44++mkIntegerIdKey, smallIntegerIdKey, wordToIntegerIdKey,+    integerToWordIdKey, integerToIntIdKey,+    integerToWord64IdKey, integerToInt64IdKey,+    word64ToIntegerIdKey, int64ToIntegerIdKey,+    plusIntegerIdKey, timesIntegerIdKey, minusIntegerIdKey,+    negateIntegerIdKey,+    eqIntegerPrimIdKey, neqIntegerPrimIdKey, absIntegerIdKey, signumIntegerIdKey,+    leIntegerPrimIdKey, gtIntegerPrimIdKey, ltIntegerPrimIdKey, geIntegerPrimIdKey,+    compareIntegerIdKey, quotRemIntegerIdKey, divModIntegerIdKey,+    quotIntegerIdKey, remIntegerIdKey, divIntegerIdKey, modIntegerIdKey,+    floatFromIntegerIdKey, doubleFromIntegerIdKey,+    encodeFloatIntegerIdKey, encodeDoubleIntegerIdKey,+    decodeDoubleIntegerIdKey,+    gcdIntegerIdKey, lcmIntegerIdKey,+    andIntegerIdKey, orIntegerIdKey, xorIntegerIdKey, complementIntegerIdKey,+    shiftLIntegerIdKey, shiftRIntegerIdKey :: Unique+mkIntegerIdKey                = mkPreludeMiscIdUnique 60+smallIntegerIdKey             = mkPreludeMiscIdUnique 61+integerToWordIdKey            = mkPreludeMiscIdUnique 62+integerToIntIdKey             = mkPreludeMiscIdUnique 63+integerToWord64IdKey          = mkPreludeMiscIdUnique 64+integerToInt64IdKey           = mkPreludeMiscIdUnique 65+plusIntegerIdKey              = mkPreludeMiscIdUnique 66+timesIntegerIdKey             = mkPreludeMiscIdUnique 67+minusIntegerIdKey             = mkPreludeMiscIdUnique 68+negateIntegerIdKey            = mkPreludeMiscIdUnique 69+eqIntegerPrimIdKey            = mkPreludeMiscIdUnique 70+neqIntegerPrimIdKey           = mkPreludeMiscIdUnique 71+absIntegerIdKey               = mkPreludeMiscIdUnique 72+signumIntegerIdKey            = mkPreludeMiscIdUnique 73+leIntegerPrimIdKey            = mkPreludeMiscIdUnique 74+gtIntegerPrimIdKey            = mkPreludeMiscIdUnique 75+ltIntegerPrimIdKey            = mkPreludeMiscIdUnique 76+geIntegerPrimIdKey            = mkPreludeMiscIdUnique 77+compareIntegerIdKey           = mkPreludeMiscIdUnique 78+quotIntegerIdKey              = mkPreludeMiscIdUnique 79+remIntegerIdKey               = mkPreludeMiscIdUnique 80+divIntegerIdKey               = mkPreludeMiscIdUnique 81+modIntegerIdKey               = mkPreludeMiscIdUnique 82+divModIntegerIdKey            = mkPreludeMiscIdUnique 83+quotRemIntegerIdKey           = mkPreludeMiscIdUnique 84+floatFromIntegerIdKey         = mkPreludeMiscIdUnique 85+doubleFromIntegerIdKey        = mkPreludeMiscIdUnique 86+encodeFloatIntegerIdKey       = mkPreludeMiscIdUnique 87+encodeDoubleIntegerIdKey      = mkPreludeMiscIdUnique 88+gcdIntegerIdKey               = mkPreludeMiscIdUnique 89+lcmIntegerIdKey               = mkPreludeMiscIdUnique 90+andIntegerIdKey               = mkPreludeMiscIdUnique 91+orIntegerIdKey                = mkPreludeMiscIdUnique 92+xorIntegerIdKey               = mkPreludeMiscIdUnique 93+complementIntegerIdKey        = mkPreludeMiscIdUnique 94+shiftLIntegerIdKey            = mkPreludeMiscIdUnique 95+shiftRIntegerIdKey            = mkPreludeMiscIdUnique 96+wordToIntegerIdKey            = mkPreludeMiscIdUnique 97+word64ToIntegerIdKey          = mkPreludeMiscIdUnique 98+int64ToIntegerIdKey           = mkPreludeMiscIdUnique 99+decodeDoubleIntegerIdKey      = mkPreludeMiscIdUnique 100++rootMainKey, runMainKey :: Unique+rootMainKey                   = mkPreludeMiscIdUnique 101+runMainKey                    = mkPreludeMiscIdUnique 102++thenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey, runRWKey :: Unique+thenIOIdKey                   = mkPreludeMiscIdUnique 103+lazyIdKey                     = mkPreludeMiscIdUnique 104+assertErrorIdKey              = mkPreludeMiscIdUnique 105+oneShotKey                    = mkPreludeMiscIdUnique 106+runRWKey                      = mkPreludeMiscIdUnique 107++traceKey :: Unique+traceKey                      = mkPreludeMiscIdUnique 108++breakpointIdKey, breakpointCondIdKey :: Unique+breakpointIdKey               = mkPreludeMiscIdUnique 110+breakpointCondIdKey           = mkPreludeMiscIdUnique 111++inlineIdKey, noinlineIdKey :: Unique+inlineIdKey                   = mkPreludeMiscIdUnique 120+-- see below++mapIdKey, groupWithIdKey, dollarIdKey :: Unique+mapIdKey              = mkPreludeMiscIdUnique 121+groupWithIdKey        = mkPreludeMiscIdUnique 122+dollarIdKey           = mkPreludeMiscIdUnique 123++coercionTokenIdKey :: Unique+coercionTokenIdKey    = mkPreludeMiscIdUnique 124++noinlineIdKey                 = mkPreludeMiscIdUnique 125++rationalToFloatIdKey, rationalToDoubleIdKey :: Unique+rationalToFloatIdKey   = mkPreludeMiscIdUnique 130+rationalToDoubleIdKey  = mkPreludeMiscIdUnique 131++-- dotnet interop+unmarshalObjectIdKey, marshalObjectIdKey, marshalStringIdKey,+    unmarshalStringIdKey, checkDotnetResNameIdKey :: Unique+unmarshalObjectIdKey          = mkPreludeMiscIdUnique 150+marshalObjectIdKey            = mkPreludeMiscIdUnique 151+marshalStringIdKey            = mkPreludeMiscIdUnique 152+unmarshalStringIdKey          = mkPreludeMiscIdUnique 153+checkDotnetResNameIdKey       = mkPreludeMiscIdUnique 154++undefinedKey :: Unique+undefinedKey                  = mkPreludeMiscIdUnique 155++magicDictKey :: Unique+magicDictKey                  = mkPreludeMiscIdUnique 156++coerceKey :: Unique+coerceKey                     = mkPreludeMiscIdUnique 157++{-+Certain class operations from Prelude classes.  They get their own+uniques so we can look them up easily when we want to conjure them up+during type checking.+-}++-- Just a placeholder for unbound variables produced by the renamer:+unboundKey :: Unique+unboundKey                    = mkPreludeMiscIdUnique 158++fromIntegerClassOpKey, minusClassOpKey, fromRationalClassOpKey,+    enumFromClassOpKey, enumFromThenClassOpKey, enumFromToClassOpKey,+    enumFromThenToClassOpKey, eqClassOpKey, geClassOpKey, negateClassOpKey,+    bindMClassOpKey, thenMClassOpKey, returnMClassOpKey, fmapClassOpKey+    :: Unique+fromIntegerClassOpKey         = mkPreludeMiscIdUnique 160+minusClassOpKey               = mkPreludeMiscIdUnique 161+fromRationalClassOpKey        = mkPreludeMiscIdUnique 162+enumFromClassOpKey            = mkPreludeMiscIdUnique 163+enumFromThenClassOpKey        = mkPreludeMiscIdUnique 164+enumFromToClassOpKey          = mkPreludeMiscIdUnique 165+enumFromThenToClassOpKey      = mkPreludeMiscIdUnique 166+eqClassOpKey                  = mkPreludeMiscIdUnique 167+geClassOpKey                  = mkPreludeMiscIdUnique 168+negateClassOpKey              = mkPreludeMiscIdUnique 169+bindMClassOpKey               = mkPreludeMiscIdUnique 171 -- (>>=)+thenMClassOpKey               = mkPreludeMiscIdUnique 172 -- (>>)+fmapClassOpKey                = mkPreludeMiscIdUnique 173+returnMClassOpKey             = mkPreludeMiscIdUnique 174++-- Recursive do notation+mfixIdKey :: Unique+mfixIdKey       = mkPreludeMiscIdUnique 175++-- MonadFail operations+failMClassOpKey :: Unique+failMClassOpKey = mkPreludeMiscIdUnique 176++-- Arrow notation+arrAIdKey, composeAIdKey, firstAIdKey, appAIdKey, choiceAIdKey,+    loopAIdKey :: Unique+arrAIdKey       = mkPreludeMiscIdUnique 180+composeAIdKey   = mkPreludeMiscIdUnique 181 -- >>>+firstAIdKey     = mkPreludeMiscIdUnique 182+appAIdKey       = mkPreludeMiscIdUnique 183+choiceAIdKey    = mkPreludeMiscIdUnique 184 --  |||+loopAIdKey      = mkPreludeMiscIdUnique 185++fromStringClassOpKey :: Unique+fromStringClassOpKey          = mkPreludeMiscIdUnique 186++-- Annotation type checking+toAnnotationWrapperIdKey :: Unique+toAnnotationWrapperIdKey      = mkPreludeMiscIdUnique 187++-- Conversion functions+fromIntegralIdKey, realToFracIdKey, toIntegerClassOpKey, toRationalClassOpKey :: Unique+fromIntegralIdKey    = mkPreludeMiscIdUnique 190+realToFracIdKey      = mkPreludeMiscIdUnique 191+toIntegerClassOpKey  = mkPreludeMiscIdUnique 192+toRationalClassOpKey = mkPreludeMiscIdUnique 193++-- Monad comprehensions+guardMIdKey, liftMIdKey, mzipIdKey :: Unique+guardMIdKey     = mkPreludeMiscIdUnique 194+liftMIdKey      = mkPreludeMiscIdUnique 195+mzipIdKey       = mkPreludeMiscIdUnique 196++-- GHCi+ghciStepIoMClassOpKey :: Unique+ghciStepIoMClassOpKey = mkPreludeMiscIdUnique 197++-- Overloaded lists+isListClassKey, fromListClassOpKey, fromListNClassOpKey, toListClassOpKey :: Unique+isListClassKey = mkPreludeMiscIdUnique 198+fromListClassOpKey = mkPreludeMiscIdUnique 199+fromListNClassOpKey = mkPreludeMiscIdUnique 500+toListClassOpKey = mkPreludeMiscIdUnique 501++proxyHashKey :: Unique+proxyHashKey = mkPreludeMiscIdUnique 502++---------------- Template Haskell -------------------+--      THNames.hs: USES IdUniques 200-499+-----------------------------------------------------++-- Used to make `Typeable` dictionaries+mkTyConKey+  , mkTrTypeKey+  , mkTrConKey+  , mkTrAppKey+  , mkTrFunKey+  , typeNatTypeRepKey+  , typeSymbolTypeRepKey+  , typeRepIdKey+  :: Unique+mkTyConKey            = mkPreludeMiscIdUnique 503+mkTrTypeKey           = mkPreludeMiscIdUnique 504+mkTrConKey            = mkPreludeMiscIdUnique 505+mkTrAppKey            = mkPreludeMiscIdUnique 506+typeNatTypeRepKey     = mkPreludeMiscIdUnique 507+typeSymbolTypeRepKey  = mkPreludeMiscIdUnique 508+typeRepIdKey          = mkPreludeMiscIdUnique 509+mkTrFunKey            = mkPreludeMiscIdUnique 510++-- Representations for primitive types+trTYPEKey+  ,trTYPE'PtrRepLiftedKey+  , trRuntimeRepKey+  , tr'PtrRepLiftedKey+  :: Unique+trTYPEKey              = mkPreludeMiscIdUnique 511+trTYPE'PtrRepLiftedKey = mkPreludeMiscIdUnique 512+trRuntimeRepKey        = mkPreludeMiscIdUnique 513+tr'PtrRepLiftedKey     = mkPreludeMiscIdUnique 514++-- KindReps for common cases+starKindRepKey, starArrStarKindRepKey, starArrStarArrStarKindRepKey :: Unique+starKindRepKey        = mkPreludeMiscIdUnique 520+starArrStarKindRepKey = mkPreludeMiscIdUnique 521+starArrStarArrStarKindRepKey = mkPreludeMiscIdUnique 522++-- Dynamic+toDynIdKey :: Unique+toDynIdKey            = mkPreludeMiscIdUnique 523+++bitIntegerIdKey :: Unique+bitIntegerIdKey       = mkPreludeMiscIdUnique 550++heqSCSelIdKey, eqSCSelIdKey, coercibleSCSelIdKey :: Unique+eqSCSelIdKey        = mkPreludeMiscIdUnique 551+heqSCSelIdKey       = mkPreludeMiscIdUnique 552+coercibleSCSelIdKey = mkPreludeMiscIdUnique 553++sappendClassOpKey :: Unique+sappendClassOpKey = mkPreludeMiscIdUnique 554++memptyClassOpKey, mappendClassOpKey, mconcatClassOpKey :: Unique+memptyClassOpKey  = mkPreludeMiscIdUnique 555+mappendClassOpKey = mkPreludeMiscIdUnique 556+mconcatClassOpKey = mkPreludeMiscIdUnique 557++emptyCallStackKey, pushCallStackKey :: Unique+emptyCallStackKey = mkPreludeMiscIdUnique 558+pushCallStackKey  = mkPreludeMiscIdUnique 559++fromStaticPtrClassOpKey :: Unique+fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 560++makeStaticKey :: Unique+makeStaticKey = mkPreludeMiscIdUnique 561++-- Natural+naturalFromIntegerIdKey, naturalToIntegerIdKey, plusNaturalIdKey,+   minusNaturalIdKey, timesNaturalIdKey, mkNaturalIdKey,+   naturalSDataConKey, wordToNaturalIdKey :: Unique+naturalFromIntegerIdKey = mkPreludeMiscIdUnique 562+naturalToIntegerIdKey   = mkPreludeMiscIdUnique 563+plusNaturalIdKey        = mkPreludeMiscIdUnique 564+minusNaturalIdKey       = mkPreludeMiscIdUnique 565+timesNaturalIdKey       = mkPreludeMiscIdUnique 566+mkNaturalIdKey          = mkPreludeMiscIdUnique 567+naturalSDataConKey      = mkPreludeMiscIdUnique 568+wordToNaturalIdKey      = mkPreludeMiscIdUnique 569++{-+************************************************************************+*                                                                      *+\subsection[Class-std-groups]{Standard groups of Prelude classes}+*                                                                      *+************************************************************************++NOTE: @Eq@ and @Text@ do need to appear in @standardClasses@+even though every numeric class has these two as a superclass,+because the list of ambiguous dictionaries hasn't been simplified.+-}++numericClassKeys :: [Unique]+numericClassKeys =+        [ numClassKey+        , realClassKey+        , integralClassKey+        ]+        ++ fractionalClassKeys++fractionalClassKeys :: [Unique]+fractionalClassKeys =+        [ fractionalClassKey+        , floatingClassKey+        , realFracClassKey+        , realFloatClassKey+        ]++-- The "standard classes" are used in defaulting (Haskell 98 report 4.3.4),+-- and are: "classes defined in the Prelude or a standard library"+standardClassKeys :: [Unique]+standardClassKeys = derivableClassKeys ++ numericClassKeys+                  ++ [randomClassKey, randomGenClassKey,+                      functorClassKey,+                      monadClassKey, monadPlusClassKey, monadFailClassKey,+                      semigroupClassKey, monoidClassKey,+                      isStringClassKey,+                      applicativeClassKey, foldableClassKey,+                      traversableClassKey, alternativeClassKey+                     ]++{-+@derivableClassKeys@ is also used in checking \tr{deriving} constructs+(@TcDeriv@).+-}++derivableClassKeys :: [Unique]+derivableClassKeys+  = [ eqClassKey, ordClassKey, enumClassKey, ixClassKey,+      boundedClassKey, showClassKey, readClassKey ]+++-- These are the "interactive classes" that are consulted when doing+-- defaulting. Does not include Num or IsString, which have special+-- handling.+interactiveClassNames :: [Name]+interactiveClassNames+  = [ showClassName, eqClassName, ordClassName, foldableClassName+    , traversableClassName ]++interactiveClassKeys :: [Unique]+interactiveClassKeys = map getUnique interactiveClassNames++{-+************************************************************************+*                                                                      *+   Semi-builtin names+*                                                                      *+************************************************************************++The following names should be considered by GHCi to be in scope always.++-}++pretendNameIsInScope :: Name -> Bool+pretendNameIsInScope n+  = any (n `hasKey`)+    [ liftedTypeKindTyConKey, tYPETyConKey+    , runtimeRepTyConKey, liftedRepDataConKey ]
+ compiler/prelude/PrelNames.hs-boot view
@@ -0,0 +1,7 @@+module PrelNames where++import Module+import Unique++mAIN :: Module+liftedTypeKindTyConKey :: Unique
+ compiler/prelude/PrelRules.hs view
@@ -0,0 +1,2172 @@+{-+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[ConFold]{Constant Folder}++Conceptually, constant folding should be parameterized with the kind+of target machine to get identical behaviour during compilation time+and runtime. We cheat a little bit here...++ToDo:+   check boundaries before folding, e.g. we can fold the Float addition+   (i1 + i2) only if it results in a valid Float.+-}++{-# LANGUAGE CPP, RankNTypes, PatternSynonyms, ViewPatterns, RecordWildCards #-}+{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}++module PrelRules+   ( primOpRules+   , builtinRules+   , caseRules+   )+where++#include "HsVersions.h"+#include "../includes/MachDeps.h"++import GhcPrelude++import {-# SOURCE #-} MkId ( mkPrimOpId, magicDictId )++import CoreSyn+import MkCore+import Id+import Literal+import CoreOpt     ( exprIsLiteral_maybe )+import PrimOp      ( PrimOp(..), tagToEnumKey )+import TysWiredIn+import TysPrim+import TyCon       ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon+                   , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons+                   , tyConFamilySize )+import DataCon     ( dataConTagZ, dataConTyCon, dataConWorkId )+import CoreUtils   ( cheapEqExpr, exprIsHNF, exprType )+import CoreUnfold  ( exprIsConApp_maybe )+import Type+import OccName     ( occNameFS )+import PrelNames+import Maybes      ( orElse )+import Name        ( Name, nameOccName )+import Outputable+import FastString+import BasicTypes+import DynFlags+import Platform+import Util+import Coercion     (mkUnbranchedAxInstCo,mkSymCo,Role(..))++import Control.Applicative ( Alternative(..) )++import Control.Monad+import qualified Control.Monad.Fail as MonadFail+import Data.Bits as Bits+import qualified Data.ByteString as BS+import Data.Int+import Data.Ratio+import Data.Word++{-+Note [Constant folding]+~~~~~~~~~~~~~~~~~~~~~~~+primOpRules generates a rewrite rule for each primop+These rules do what is often called "constant folding"+E.g. the rules for +# might say+        4 +# 5 = 9+Well, of course you'd need a lot of rules if you did it+like that, so we use a BuiltinRule instead, so that we+can match in any two literal values.  So the rule is really+more like+        (Lit x) +# (Lit y) = Lit (x+#y)+where the (+#) on the rhs is done at compile time++That is why these rules are built in here.+-}++primOpRules :: Name -> PrimOp -> Maybe CoreRule+    -- ToDo: something for integer-shift ops?+    --       NotOp+primOpRules nm TagToEnumOp = mkPrimOpRule nm 2 [ tagToEnumRule ]+primOpRules nm DataToTagOp = mkPrimOpRule nm 2 [ dataToTagRule ]++-- Int operations+primOpRules nm IntAddOp    = mkPrimOpRule nm 2 [ binaryLit (intOp2 (+))+                                               , identityDynFlags zeroi+                                               , numFoldingRules IntAddOp intPrimOps+                                               ]+primOpRules nm IntSubOp    = mkPrimOpRule nm 2 [ binaryLit (intOp2 (-))+                                               , rightIdentityDynFlags zeroi+                                               , equalArgs >> retLit zeroi+                                               , numFoldingRules IntSubOp intPrimOps+                                               ]+primOpRules nm IntAddCOp   = mkPrimOpRule nm 2 [ binaryLit (intOpC2 (+))+                                               , identityCDynFlags zeroi ]+primOpRules nm IntSubCOp   = mkPrimOpRule nm 2 [ binaryLit (intOpC2 (-))+                                               , rightIdentityCDynFlags zeroi+                                               , equalArgs >> retLitNoC zeroi ]+primOpRules nm IntMulOp    = mkPrimOpRule nm 2 [ binaryLit (intOp2 (*))+                                               , zeroElem zeroi+                                               , identityDynFlags onei+                                               , numFoldingRules IntMulOp intPrimOps+                                               ]+primOpRules nm IntQuotOp   = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (intOp2 quot)+                                               , leftZero zeroi+                                               , rightIdentityDynFlags onei+                                               , equalArgs >> retLit onei ]+primOpRules nm IntRemOp    = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (intOp2 rem)+                                               , leftZero zeroi+                                               , do l <- getLiteral 1+                                                    dflags <- getDynFlags+                                                    guard (l == onei dflags)+                                                    retLit zeroi+                                               , equalArgs >> retLit zeroi+                                               , equalArgs >> retLit zeroi ]+primOpRules nm AndIOp      = mkPrimOpRule nm 2 [ binaryLit (intOp2 (.&.))+                                               , idempotent+                                               , zeroElem zeroi ]+primOpRules nm OrIOp       = mkPrimOpRule nm 2 [ binaryLit (intOp2 (.|.))+                                               , idempotent+                                               , identityDynFlags zeroi ]+primOpRules nm XorIOp      = mkPrimOpRule nm 2 [ binaryLit (intOp2 xor)+                                               , identityDynFlags zeroi+                                               , equalArgs >> retLit zeroi ]+primOpRules nm NotIOp      = mkPrimOpRule nm 1 [ unaryLit complementOp+                                               , inversePrimOp NotIOp ]+primOpRules nm IntNegOp    = mkPrimOpRule nm 1 [ unaryLit negOp+                                               , inversePrimOp IntNegOp ]+primOpRules nm ISllOp      = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL)+                                               , rightIdentityDynFlags zeroi ]+primOpRules nm ISraOp      = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftR)+                                               , rightIdentityDynFlags zeroi ]+primOpRules nm ISrlOp      = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical+                                               , rightIdentityDynFlags zeroi ]++-- Word operations+primOpRules nm WordAddOp   = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (+))+                                               , identityDynFlags zerow+                                               , numFoldingRules WordAddOp wordPrimOps+                                               ]+primOpRules nm WordSubOp   = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (-))+                                               , rightIdentityDynFlags zerow+                                               , equalArgs >> retLit zerow+                                               , numFoldingRules WordSubOp wordPrimOps+                                               ]+primOpRules nm WordAddCOp  = mkPrimOpRule nm 2 [ binaryLit (wordOpC2 (+))+                                               , identityCDynFlags zerow ]+primOpRules nm WordSubCOp  = mkPrimOpRule nm 2 [ binaryLit (wordOpC2 (-))+                                               , rightIdentityCDynFlags zerow+                                               , equalArgs >> retLitNoC zerow ]+primOpRules nm WordMulOp   = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (*))+                                               , identityDynFlags onew+                                               , numFoldingRules WordMulOp wordPrimOps+                                               ]+primOpRules nm WordQuotOp  = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (wordOp2 quot)+                                               , rightIdentityDynFlags onew ]+primOpRules nm WordRemOp   = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (wordOp2 rem)+                                               , leftZero zerow+                                               , do l <- getLiteral 1+                                                    dflags <- getDynFlags+                                                    guard (l == onew dflags)+                                                    retLit zerow+                                               , equalArgs >> retLit zerow ]+primOpRules nm AndOp       = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.&.))+                                               , idempotent+                                               , zeroElem zerow ]+primOpRules nm OrOp        = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.|.))+                                               , idempotent+                                               , identityDynFlags zerow ]+primOpRules nm XorOp       = mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor)+                                               , identityDynFlags zerow+                                               , equalArgs >> retLit zerow ]+primOpRules nm NotOp       = mkPrimOpRule nm 1 [ unaryLit complementOp+                                               , inversePrimOp NotOp ]+primOpRules nm SllOp       = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) ]+primOpRules nm SrlOp       = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical ]++-- coercions+primOpRules nm Word2IntOp     = mkPrimOpRule nm 1 [ liftLitDynFlags word2IntLit+                                                  , inversePrimOp Int2WordOp ]+primOpRules nm Int2WordOp     = mkPrimOpRule nm 1 [ liftLitDynFlags int2WordLit+                                                  , inversePrimOp Word2IntOp ]+primOpRules nm Narrow8IntOp   = mkPrimOpRule nm 1 [ liftLit narrow8IntLit+                                                  , subsumedByPrimOp Narrow8IntOp+                                                  , Narrow8IntOp `subsumesPrimOp` Narrow16IntOp+                                                  , Narrow8IntOp `subsumesPrimOp` Narrow32IntOp ]+primOpRules nm Narrow16IntOp  = mkPrimOpRule nm 1 [ liftLit narrow16IntLit+                                                  , subsumedByPrimOp Narrow8IntOp+                                                  , subsumedByPrimOp Narrow16IntOp+                                                  , Narrow16IntOp `subsumesPrimOp` Narrow32IntOp ]+primOpRules nm Narrow32IntOp  = mkPrimOpRule nm 1 [ liftLit narrow32IntLit+                                                  , subsumedByPrimOp Narrow8IntOp+                                                  , subsumedByPrimOp Narrow16IntOp+                                                  , subsumedByPrimOp Narrow32IntOp+                                                  , removeOp32 ]+primOpRules nm Narrow8WordOp  = mkPrimOpRule nm 1 [ liftLit narrow8WordLit+                                                  , subsumedByPrimOp Narrow8WordOp+                                                  , Narrow8WordOp `subsumesPrimOp` Narrow16WordOp+                                                  , Narrow8WordOp `subsumesPrimOp` Narrow32WordOp ]+primOpRules nm Narrow16WordOp = mkPrimOpRule nm 1 [ liftLit narrow16WordLit+                                                  , subsumedByPrimOp Narrow8WordOp+                                                  , subsumedByPrimOp Narrow16WordOp+                                                  , Narrow16WordOp `subsumesPrimOp` Narrow32WordOp ]+primOpRules nm Narrow32WordOp = mkPrimOpRule nm 1 [ liftLit narrow32WordLit+                                                  , subsumedByPrimOp Narrow8WordOp+                                                  , subsumedByPrimOp Narrow16WordOp+                                                  , subsumedByPrimOp Narrow32WordOp+                                                  , removeOp32 ]+primOpRules nm OrdOp          = mkPrimOpRule nm 1 [ liftLit char2IntLit+                                                  , inversePrimOp ChrOp ]+primOpRules nm ChrOp          = mkPrimOpRule nm 1 [ do [Lit lit] <- getArgs+                                                       guard (litFitsInChar lit)+                                                       liftLit int2CharLit+                                                  , inversePrimOp OrdOp ]+primOpRules nm Float2IntOp    = mkPrimOpRule nm 1 [ liftLit float2IntLit ]+primOpRules nm Int2FloatOp    = mkPrimOpRule nm 1 [ liftLit int2FloatLit ]+primOpRules nm Double2IntOp   = mkPrimOpRule nm 1 [ liftLit double2IntLit ]+primOpRules nm Int2DoubleOp   = mkPrimOpRule nm 1 [ liftLit int2DoubleLit ]+-- SUP: Not sure what the standard says about precision in the following 2 cases+primOpRules nm Float2DoubleOp = mkPrimOpRule nm 1 [ liftLit float2DoubleLit ]+primOpRules nm Double2FloatOp = mkPrimOpRule nm 1 [ liftLit double2FloatLit ]++-- Float+primOpRules nm FloatAddOp   = mkPrimOpRule nm 2 [ binaryLit (floatOp2 (+))+                                                , identity zerof ]+primOpRules nm FloatSubOp   = mkPrimOpRule nm 2 [ binaryLit (floatOp2 (-))+                                                , rightIdentity zerof ]+primOpRules nm FloatMulOp   = mkPrimOpRule nm 2 [ binaryLit (floatOp2 (*))+                                                , identity onef+                                                , strengthReduction twof FloatAddOp  ]+                         -- zeroElem zerof doesn't hold because of NaN+primOpRules nm FloatDivOp   = mkPrimOpRule nm 2 [ guardFloatDiv >> binaryLit (floatOp2 (/))+                                                , rightIdentity onef ]+primOpRules nm FloatNegOp   = mkPrimOpRule nm 1 [ unaryLit negOp+                                                , inversePrimOp FloatNegOp ]++-- Double+primOpRules nm DoubleAddOp   = mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (+))+                                                 , identity zerod ]+primOpRules nm DoubleSubOp   = mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (-))+                                                 , rightIdentity zerod ]+primOpRules nm DoubleMulOp   = mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (*))+                                                 , identity oned+                                                 , strengthReduction twod DoubleAddOp  ]+                          -- zeroElem zerod doesn't hold because of NaN+primOpRules nm DoubleDivOp   = mkPrimOpRule nm 2 [ guardDoubleDiv >> binaryLit (doubleOp2 (/))+                                                 , rightIdentity oned ]+primOpRules nm DoubleNegOp   = mkPrimOpRule nm 1 [ unaryLit negOp+                                                 , inversePrimOp DoubleNegOp ]++-- Relational operators++primOpRules nm IntEqOp    = mkRelOpRule nm (==) [ litEq True ]+primOpRules nm IntNeOp    = mkRelOpRule nm (/=) [ litEq False ]+primOpRules nm CharEqOp   = mkRelOpRule nm (==) [ litEq True ]+primOpRules nm CharNeOp   = mkRelOpRule nm (/=) [ litEq False ]++primOpRules nm IntGtOp    = mkRelOpRule nm (>)  [ boundsCmp Gt ]+primOpRules nm IntGeOp    = mkRelOpRule nm (>=) [ boundsCmp Ge ]+primOpRules nm IntLeOp    = mkRelOpRule nm (<=) [ boundsCmp Le ]+primOpRules nm IntLtOp    = mkRelOpRule nm (<)  [ boundsCmp Lt ]++primOpRules nm CharGtOp   = mkRelOpRule nm (>)  [ boundsCmp Gt ]+primOpRules nm CharGeOp   = mkRelOpRule nm (>=) [ boundsCmp Ge ]+primOpRules nm CharLeOp   = mkRelOpRule nm (<=) [ boundsCmp Le ]+primOpRules nm CharLtOp   = mkRelOpRule nm (<)  [ boundsCmp Lt ]++primOpRules nm FloatGtOp  = mkFloatingRelOpRule nm (>)+primOpRules nm FloatGeOp  = mkFloatingRelOpRule nm (>=)+primOpRules nm FloatLeOp  = mkFloatingRelOpRule nm (<=)+primOpRules nm FloatLtOp  = mkFloatingRelOpRule nm (<)+primOpRules nm FloatEqOp  = mkFloatingRelOpRule nm (==)+primOpRules nm FloatNeOp  = mkFloatingRelOpRule nm (/=)++primOpRules nm DoubleGtOp = mkFloatingRelOpRule nm (>)+primOpRules nm DoubleGeOp = mkFloatingRelOpRule nm (>=)+primOpRules nm DoubleLeOp = mkFloatingRelOpRule nm (<=)+primOpRules nm DoubleLtOp = mkFloatingRelOpRule nm (<)+primOpRules nm DoubleEqOp = mkFloatingRelOpRule nm (==)+primOpRules nm DoubleNeOp = mkFloatingRelOpRule nm (/=)++primOpRules nm WordGtOp   = mkRelOpRule nm (>)  [ boundsCmp Gt ]+primOpRules nm WordGeOp   = mkRelOpRule nm (>=) [ boundsCmp Ge ]+primOpRules nm WordLeOp   = mkRelOpRule nm (<=) [ boundsCmp Le ]+primOpRules nm WordLtOp   = mkRelOpRule nm (<)  [ boundsCmp Lt ]+primOpRules nm WordEqOp   = mkRelOpRule nm (==) [ litEq True ]+primOpRules nm WordNeOp   = mkRelOpRule nm (/=) [ litEq False ]++primOpRules nm AddrAddOp  = mkPrimOpRule nm 2 [ rightIdentityDynFlags zeroi ]++primOpRules nm SeqOp      = mkPrimOpRule nm 4 [ seqRule ]+primOpRules nm SparkOp    = mkPrimOpRule nm 4 [ sparkRule ]++primOpRules _  _          = Nothing++{-+************************************************************************+*                                                                      *+\subsection{Doing the business}+*                                                                      *+************************************************************************+-}++-- useful shorthands+mkPrimOpRule :: Name -> Int -> [RuleM CoreExpr] -> Maybe CoreRule+mkPrimOpRule nm arity rules = Just $ mkBasicRule nm arity (msum rules)++mkRelOpRule :: Name -> (forall a . Ord a => a -> a -> Bool)+            -> [RuleM CoreExpr] -> Maybe CoreRule+mkRelOpRule nm cmp extra+  = mkPrimOpRule nm 2 $+    binaryCmpLit cmp : equal_rule : extra+  where+        -- x `cmp` x does not depend on x, so+        -- compute it for the arbitrary value 'True'+        -- and use that result+    equal_rule = do { equalArgs+                    ; dflags <- getDynFlags+                    ; return (if cmp True True+                              then trueValInt  dflags+                              else falseValInt dflags) }++{- Note [Rules for floating-point comparisons]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We need different rules for floating-point values because for floats+it is not true that x = x (for NaNs); so we do not want the equal_rule+rule that mkRelOpRule uses.++Note also that, in the case of equality/inequality, we do /not/+want to switch to a case-expression.  For example, we do not want+to convert+   case (eqFloat# x 3.8#) of+     True -> this+     False -> that+to+  case x of+    3.8#::Float# -> this+    _            -> that+See #9238.  Reason: comparing floating-point values for equality+delicate, and we don't want to implement that delicacy in the code for+case expressions.  So we make it an invariant of Core that a case+expression never scrutinises a Float# or Double#.++This transformation is what the litEq rule does;+see Note [The litEq rule: converting equality to case].+So we /refrain/ from using litEq for mkFloatingRelOpRule.+-}++mkFloatingRelOpRule :: Name -> (forall a . Ord a => a -> a -> Bool)+                    -> Maybe CoreRule+-- See Note [Rules for floating-point comparisons]+mkFloatingRelOpRule nm cmp+  = mkPrimOpRule nm 2 [binaryCmpLit cmp]++-- common constants+zeroi, onei, zerow, onew :: DynFlags -> Literal+zeroi dflags = mkLitInt  dflags 0+onei  dflags = mkLitInt  dflags 1+zerow dflags = mkLitWord dflags 0+onew  dflags = mkLitWord dflags 1++zerof, onef, twof, zerod, oned, twod :: Literal+zerof = mkLitFloat 0.0+onef  = mkLitFloat 1.0+twof  = mkLitFloat 2.0+zerod = mkLitDouble 0.0+oned  = mkLitDouble 1.0+twod  = mkLitDouble 2.0++cmpOp :: DynFlags -> (forall a . Ord a => a -> a -> Bool)+      -> Literal -> Literal -> Maybe CoreExpr+cmpOp dflags cmp = go+  where+    done True  = Just $ trueValInt  dflags+    done False = Just $ falseValInt dflags++    -- These compares are at different types+    go (LitChar i1)   (LitChar i2)   = done (i1 `cmp` i2)+    go (LitFloat i1)  (LitFloat i2)  = done (i1 `cmp` i2)+    go (LitDouble i1) (LitDouble i2) = done (i1 `cmp` i2)+    go (LitNumber nt1 i1 _) (LitNumber nt2 i2 _)+      | nt1 /= nt2 = Nothing+      | otherwise  = done (i1 `cmp` i2)+    go _               _               = Nothing++--------------------------++negOp :: DynFlags -> Literal -> Maybe CoreExpr  -- Negate+negOp _      (LitFloat 0.0)  = Nothing  -- can't represent -0.0 as a Rational+negOp dflags (LitFloat f)    = Just (mkFloatVal dflags (-f))+negOp _      (LitDouble 0.0) = Nothing+negOp dflags (LitDouble d)   = Just (mkDoubleVal dflags (-d))+negOp dflags (LitNumber nt i t)+   | litNumIsSigned nt = Just (Lit (mkLitNumberWrap dflags nt (-i) t))+negOp _      _                = Nothing++complementOp :: DynFlags -> Literal -> Maybe CoreExpr  -- Binary complement+complementOp dflags (LitNumber nt i t) =+   Just (Lit (mkLitNumberWrap dflags nt (complement i) t))+complementOp _      _            = Nothing++--------------------------+intOp2 :: (Integral a, Integral b)+       => (a -> b -> Integer)+       -> DynFlags -> Literal -> Literal -> Maybe CoreExpr+intOp2 = intOp2' . const++intOp2' :: (Integral a, Integral b)+        => (DynFlags -> a -> b -> Integer)+        -> DynFlags -> Literal -> Literal -> Maybe CoreExpr+intOp2' op dflags (LitNumber LitNumInt i1 _) (LitNumber LitNumInt i2 _) =+  let o = op dflags+  in  intResult dflags (fromInteger i1 `o` fromInteger i2)+intOp2' _  _      _            _            = Nothing  -- Could find LitLit++intOpC2 :: (Integral a, Integral b)+        => (a -> b -> Integer)+        -> DynFlags -> Literal -> Literal -> Maybe CoreExpr+intOpC2 op dflags (LitNumber LitNumInt i1 _) (LitNumber LitNumInt i2 _) = do+  intCResult dflags (fromInteger i1 `op` fromInteger i2)+intOpC2 _  _      _            _            = Nothing  -- Could find LitLit++shiftRightLogical :: DynFlags -> Integer -> Int -> Integer+-- Shift right, putting zeros in rather than sign-propagating as Bits.shiftR would do+-- Do this by converting to Word and back.  Obviously this won't work for big+-- values, but its ok as we use it here+shiftRightLogical dflags x n+  | wordSizeInBits dflags == 32 = fromIntegral (fromInteger x `shiftR` n :: Word32)+  | wordSizeInBits dflags == 64 = fromIntegral (fromInteger x `shiftR` n :: Word64)+  | otherwise = panic "shiftRightLogical: unsupported word size"++--------------------------+retLit :: (DynFlags -> Literal) -> RuleM CoreExpr+retLit l = do dflags <- getDynFlags+              return $ Lit $ l dflags++retLitNoC :: (DynFlags -> Literal) -> RuleM CoreExpr+retLitNoC l = do dflags <- getDynFlags+                 let lit = l dflags+                 let ty = literalType lit+                 return $ mkCoreUbxTup [ty, ty] [Lit lit, Lit (zeroi dflags)]++wordOp2 :: (Integral a, Integral b)+        => (a -> b -> Integer)+        -> DynFlags -> Literal -> Literal -> Maybe CoreExpr+wordOp2 op dflags (LitNumber LitNumWord w1 _) (LitNumber LitNumWord w2 _)+    = wordResult dflags (fromInteger w1 `op` fromInteger w2)+wordOp2 _ _ _ _ = Nothing  -- Could find LitLit++wordOpC2 :: (Integral a, Integral b)+        => (a -> b -> Integer)+        -> DynFlags -> Literal -> Literal -> Maybe CoreExpr+wordOpC2 op dflags (LitNumber LitNumWord w1 _) (LitNumber LitNumWord w2 _) =+  wordCResult dflags (fromInteger w1 `op` fromInteger w2)+wordOpC2 _ _ _ _ = Nothing  -- Could find LitLit++shiftRule :: (DynFlags -> Integer -> Int -> Integer) -> RuleM CoreExpr+-- Shifts take an Int; hence third arg of op is Int+-- Used for shift primops+--    ISllOp, ISraOp, ISrlOp :: Word# -> Int# -> Word#+--    SllOp, SrlOp           :: Word# -> Int# -> Word#+-- See Note [Guarding against silly shifts]+shiftRule shift_op+  = do { dflags <- getDynFlags+       ; [e1, Lit (LitNumber LitNumInt shift_len _)] <- getArgs+       ; case e1 of+           _ | shift_len == 0+             -> return e1++           -- Do the shift at type Integer, but shift length is Int+           Lit (LitNumber nt x t)+             | 0 < shift_len+             , shift_len <= wordSizeInBits dflags+             -> let op = shift_op dflags+                    y  = x `op` fromInteger shift_len+                in  liftMaybe $ Just (Lit (mkLitNumberWrap dflags nt y t))++           _ -> mzero }++wordSizeInBits :: DynFlags -> Integer+wordSizeInBits dflags = toInteger (platformWordSize (targetPlatform dflags) `shiftL` 3)++--------------------------+floatOp2 :: (Rational -> Rational -> Rational)+         -> DynFlags -> Literal -> Literal+         -> Maybe (Expr CoreBndr)+floatOp2 op dflags (LitFloat f1) (LitFloat f2)+  = Just (mkFloatVal dflags (f1 `op` f2))+floatOp2 _ _ _ _ = Nothing++--------------------------+doubleOp2 :: (Rational -> Rational -> Rational)+          -> DynFlags -> Literal -> Literal+          -> Maybe (Expr CoreBndr)+doubleOp2 op dflags (LitDouble f1) (LitDouble f2)+  = Just (mkDoubleVal dflags (f1 `op` f2))+doubleOp2 _ _ _ _ = Nothing++--------------------------+{- Note [The litEq rule: converting equality to case]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+This stuff turns+     n ==# 3#+into+     case n of+       3# -> True+       m  -> False++This is a Good Thing, because it allows case-of case things+to happen, and case-default absorption to happen.  For+example:++     if (n ==# 3#) || (n ==# 4#) then e1 else e2+will transform to+     case n of+       3# -> e1+       4# -> e1+       m  -> e2+(modulo the usual precautions to avoid duplicating e1)+-}++litEq :: Bool  -- True <=> equality, False <=> inequality+      -> RuleM CoreExpr+litEq is_eq = msum+  [ do [Lit lit, expr] <- getArgs+       dflags <- getDynFlags+       do_lit_eq dflags lit expr+  , do [expr, Lit lit] <- getArgs+       dflags <- getDynFlags+       do_lit_eq dflags lit expr ]+  where+    do_lit_eq dflags lit expr = do+      guard (not (litIsLifted lit))+      return (mkWildCase expr (literalType lit) intPrimTy+                    [(DEFAULT,    [], val_if_neq),+                     (LitAlt lit, [], val_if_eq)])+      where+        val_if_eq  | is_eq     = trueValInt  dflags+                   | otherwise = falseValInt dflags+        val_if_neq | is_eq     = falseValInt dflags+                   | otherwise = trueValInt  dflags+++-- | Check if there is comparison with minBound or maxBound, that is+-- always true or false. For instance, an Int cannot be smaller than its+-- minBound, so we can replace such comparison with False.+boundsCmp :: Comparison -> RuleM CoreExpr+boundsCmp op = do+  dflags <- getDynFlags+  [a, b] <- getArgs+  liftMaybe $ mkRuleFn dflags op a b++data Comparison = Gt | Ge | Lt | Le++mkRuleFn :: DynFlags -> Comparison -> CoreExpr -> CoreExpr -> Maybe CoreExpr+mkRuleFn dflags Gt (Lit lit) _ | isMinBound dflags lit = Just $ falseValInt dflags+mkRuleFn dflags Le (Lit lit) _ | isMinBound dflags lit = Just $ trueValInt  dflags+mkRuleFn dflags Ge _ (Lit lit) | isMinBound dflags lit = Just $ trueValInt  dflags+mkRuleFn dflags Lt _ (Lit lit) | isMinBound dflags lit = Just $ falseValInt dflags+mkRuleFn dflags Ge (Lit lit) _ | isMaxBound dflags lit = Just $ trueValInt  dflags+mkRuleFn dflags Lt (Lit lit) _ | isMaxBound dflags lit = Just $ falseValInt dflags+mkRuleFn dflags Gt _ (Lit lit) | isMaxBound dflags lit = Just $ falseValInt dflags+mkRuleFn dflags Le _ (Lit lit) | isMaxBound dflags lit = Just $ trueValInt  dflags+mkRuleFn _ _ _ _                                       = Nothing++isMinBound :: DynFlags -> Literal -> Bool+isMinBound _      (LitChar c)        = c == minBound+isMinBound dflags (LitNumber nt i _) = case nt of+   LitNumInt     -> i == tARGET_MIN_INT dflags+   LitNumInt64   -> i == toInteger (minBound :: Int64)+   LitNumWord    -> i == 0+   LitNumWord64  -> i == 0+   LitNumNatural -> i == 0+   LitNumInteger -> False+isMinBound _      _                  = False++isMaxBound :: DynFlags -> Literal -> Bool+isMaxBound _      (LitChar c)       = c == maxBound+isMaxBound dflags (LitNumber nt i _) = case nt of+   LitNumInt     -> i == tARGET_MAX_INT dflags+   LitNumInt64   -> i == toInteger (maxBound :: Int64)+   LitNumWord    -> i == tARGET_MAX_WORD dflags+   LitNumWord64  -> i == toInteger (maxBound :: Word64)+   LitNumNatural -> False+   LitNumInteger -> False+isMaxBound _      _                  = False++-- | Create an Int literal expression while ensuring the given Integer is in the+-- target Int range+intResult :: DynFlags -> Integer -> Maybe CoreExpr+intResult dflags result = Just (intResult' dflags result)++intResult' :: DynFlags -> Integer -> CoreExpr+intResult' dflags result = Lit (mkLitIntWrap dflags result)++-- | Create an unboxed pair of an Int literal expression, ensuring the given+-- Integer is in the target Int range and the corresponding overflow flag+-- (@0#@/@1#@) if it wasn't.+intCResult :: DynFlags -> Integer -> Maybe CoreExpr+intCResult dflags result = Just (mkPair [Lit lit, Lit c])+  where+    mkPair = mkCoreUbxTup [intPrimTy, intPrimTy]+    (lit, b) = mkLitIntWrapC dflags result+    c = if b then onei dflags else zeroi dflags++-- | Create a Word literal expression while ensuring the given Integer is in the+-- target Word range+wordResult :: DynFlags -> Integer -> Maybe CoreExpr+wordResult dflags result = Just (wordResult' dflags result)++wordResult' :: DynFlags -> Integer -> CoreExpr+wordResult' dflags result = Lit (mkLitWordWrap dflags result)++-- | Create an unboxed pair of a Word literal expression, ensuring the given+-- Integer is in the target Word range and the corresponding carry flag+-- (@0#@/@1#@) if it wasn't.+wordCResult :: DynFlags -> Integer -> Maybe CoreExpr+wordCResult dflags result = Just (mkPair [Lit lit, Lit c])+  where+    mkPair = mkCoreUbxTup [wordPrimTy, intPrimTy]+    (lit, b) = mkLitWordWrapC dflags result+    c = if b then onei dflags else zeroi dflags++inversePrimOp :: PrimOp -> RuleM CoreExpr+inversePrimOp primop = do+  [Var primop_id `App` e] <- getArgs+  matchPrimOpId primop primop_id+  return e++subsumesPrimOp :: PrimOp -> PrimOp -> RuleM CoreExpr+this `subsumesPrimOp` that = do+  [Var primop_id `App` e] <- getArgs+  matchPrimOpId that primop_id+  return (Var (mkPrimOpId this) `App` e)++subsumedByPrimOp :: PrimOp -> RuleM CoreExpr+subsumedByPrimOp primop = do+  [e@(Var primop_id `App` _)] <- getArgs+  matchPrimOpId primop primop_id+  return e++idempotent :: RuleM CoreExpr+idempotent = do [e1, e2] <- getArgs+                guard $ cheapEqExpr e1 e2+                return e1++{-+Note [Guarding against silly shifts]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider this code:++  import Data.Bits( (.|.), shiftL )+  chunkToBitmap :: [Bool] -> Word32+  chunkToBitmap chunk = foldr (.|.) 0 [ 1 `shiftL` n | (True,n) <- zip chunk [0..] ]++This optimises to:+Shift.$wgo = \ (w_sCS :: GHC.Prim.Int#) (w1_sCT :: [GHC.Types.Bool]) ->+    case w1_sCT of _ {+      [] -> 0##;+      : x_aAW xs_aAX ->+        case x_aAW of _ {+          GHC.Types.False ->+            case w_sCS of wild2_Xh {+              __DEFAULT -> Shift.$wgo (GHC.Prim.+# wild2_Xh 1) xs_aAX;+              9223372036854775807 -> 0## };+          GHC.Types.True ->+            case GHC.Prim.>=# w_sCS 64 of _ {+              GHC.Types.False ->+                case w_sCS of wild3_Xh {+                  __DEFAULT ->+                    case Shift.$wgo (GHC.Prim.+# wild3_Xh 1) xs_aAX of ww_sCW { __DEFAULT ->+                      GHC.Prim.or# (GHC.Prim.narrow32Word#+                                      (GHC.Prim.uncheckedShiftL# 1## wild3_Xh))+                                   ww_sCW+                     };+                  9223372036854775807 ->+                    GHC.Prim.narrow32Word#+!!!!-->                  (GHC.Prim.uncheckedShiftL# 1## 9223372036854775807)+                };+              GHC.Types.True ->+                case w_sCS of wild3_Xh {+                  __DEFAULT -> Shift.$wgo (GHC.Prim.+# wild3_Xh 1) xs_aAX;+                  9223372036854775807 -> 0##+                } } } }++Note the massive shift on line "!!!!".  It can't happen, because we've checked+that w < 64, but the optimiser didn't spot that. We DO NOT want to constant-fold this!+Moreover, if the programmer writes (n `uncheckedShiftL` 9223372036854775807), we+can't constant fold it, but if it gets to the assember we get+     Error: operand type mismatch for `shl'++So the best thing to do is to rewrite the shift with a call to error,+when the second arg is stupid.++There are two cases:++- Shifting fixed-width things: the primops ISll, Sll, etc+  These are handled by shiftRule.++  We are happy to shift by any amount up to wordSize but no more.++- Shifting Integers: the function shiftLInteger, shiftRInteger+  from the 'integer' library.   These are handled by rule_shift_op,+  and match_Integer_shift_op.++  Here we could in principle shift by any amount, but we arbitary+  limit the shift to 4 bits; in particualr we do not want shift by a+  huge amount, which can happen in code like that above.++The two cases are more different in their code paths that is comfortable,+but that is only a historical accident.+++************************************************************************+*                                                                      *+\subsection{Vaguely generic functions}+*                                                                      *+************************************************************************+-}++mkBasicRule :: Name -> Int -> RuleM CoreExpr -> CoreRule+-- Gives the Rule the same name as the primop itself+mkBasicRule op_name n_args rm+  = BuiltinRule { ru_name = occNameFS (nameOccName op_name),+                  ru_fn = op_name,+                  ru_nargs = n_args,+                  ru_try = \ dflags in_scope _ -> runRuleM rm dflags in_scope }++newtype RuleM r = RuleM+  { runRuleM :: DynFlags -> InScopeEnv -> [CoreExpr] -> Maybe r }++instance Functor RuleM where+    fmap = liftM++instance Applicative RuleM where+    pure x = RuleM $ \_ _ _ -> Just x+    (<*>) = ap++instance Monad RuleM where+  RuleM f >>= g = RuleM $ \dflags iu e -> case f dflags iu e of+    Nothing -> Nothing+    Just r -> runRuleM (g r) dflags iu e+#if !MIN_VERSION_base(4,13,0)+  fail = MonadFail.fail+#endif++instance MonadFail.MonadFail RuleM where+    fail _ = mzero++instance Alternative RuleM where+  empty = RuleM $ \_ _ _ -> Nothing+  RuleM f1 <|> RuleM f2 = RuleM $ \dflags iu args ->+    f1 dflags iu args <|> f2 dflags iu args++instance MonadPlus RuleM++instance HasDynFlags RuleM where+    getDynFlags = RuleM $ \dflags _ _ -> Just dflags++liftMaybe :: Maybe a -> RuleM a+liftMaybe Nothing = mzero+liftMaybe (Just x) = return x++liftLit :: (Literal -> Literal) -> RuleM CoreExpr+liftLit f = liftLitDynFlags (const f)++liftLitDynFlags :: (DynFlags -> Literal -> Literal) -> RuleM CoreExpr+liftLitDynFlags f = do+  dflags <- getDynFlags+  [Lit lit] <- getArgs+  return $ Lit (f dflags lit)++removeOp32 :: RuleM CoreExpr+removeOp32 = do+  dflags <- getDynFlags+  if wordSizeInBits dflags == 32+  then do+    [e] <- getArgs+    return e+  else mzero++getArgs :: RuleM [CoreExpr]+getArgs = RuleM $ \_ _ args -> Just args++getInScopeEnv :: RuleM InScopeEnv+getInScopeEnv = RuleM $ \_ iu _ -> Just iu++-- return the n-th argument of this rule, if it is a literal+-- argument indices start from 0+getLiteral :: Int -> RuleM Literal+getLiteral n = RuleM $ \_ _ exprs -> case drop n exprs of+  (Lit l:_) -> Just l+  _ -> Nothing++unaryLit :: (DynFlags -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr+unaryLit op = do+  dflags <- getDynFlags+  [Lit l] <- getArgs+  liftMaybe $ op dflags (convFloating dflags l)++binaryLit :: (DynFlags -> Literal -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr+binaryLit op = do+  dflags <- getDynFlags+  [Lit l1, Lit l2] <- getArgs+  liftMaybe $ op dflags (convFloating dflags l1) (convFloating dflags l2)++binaryCmpLit :: (forall a . Ord a => a -> a -> Bool) -> RuleM CoreExpr+binaryCmpLit op = do+  dflags <- getDynFlags+  binaryLit (\_ -> cmpOp dflags op)++leftIdentity :: Literal -> RuleM CoreExpr+leftIdentity id_lit = leftIdentityDynFlags (const id_lit)++rightIdentity :: Literal -> RuleM CoreExpr+rightIdentity id_lit = rightIdentityDynFlags (const id_lit)++identity :: Literal -> RuleM CoreExpr+identity lit = leftIdentity lit `mplus` rightIdentity lit++leftIdentityDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr+leftIdentityDynFlags id_lit = do+  dflags <- getDynFlags+  [Lit l1, e2] <- getArgs+  guard $ l1 == id_lit dflags+  return e2++-- | Left identity rule for PrimOps like 'IntAddC' and 'WordAddC', where, in+-- addition to the result, we have to indicate that no carry/overflow occured.+leftIdentityCDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr+leftIdentityCDynFlags id_lit = do+  dflags <- getDynFlags+  [Lit l1, e2] <- getArgs+  guard $ l1 == id_lit dflags+  let no_c = Lit (zeroi dflags)+  return (mkCoreUbxTup [exprType e2, intPrimTy] [e2, no_c])++rightIdentityDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr+rightIdentityDynFlags id_lit = do+  dflags <- getDynFlags+  [e1, Lit l2] <- getArgs+  guard $ l2 == id_lit dflags+  return e1++-- | Right identity rule for PrimOps like 'IntSubC' and 'WordSubC', where, in+-- addition to the result, we have to indicate that no carry/overflow occured.+rightIdentityCDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr+rightIdentityCDynFlags id_lit = do+  dflags <- getDynFlags+  [e1, Lit l2] <- getArgs+  guard $ l2 == id_lit dflags+  let no_c = Lit (zeroi dflags)+  return (mkCoreUbxTup [exprType e1, intPrimTy] [e1, no_c])++identityDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr+identityDynFlags lit =+  leftIdentityDynFlags lit `mplus` rightIdentityDynFlags lit++-- | Identity rule for PrimOps like 'IntAddC' and 'WordAddC', where, in addition+-- to the result, we have to indicate that no carry/overflow occured.+identityCDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr+identityCDynFlags lit =+  leftIdentityCDynFlags lit `mplus` rightIdentityCDynFlags lit++leftZero :: (DynFlags -> Literal) -> RuleM CoreExpr+leftZero zero = do+  dflags <- getDynFlags+  [Lit l1, _] <- getArgs+  guard $ l1 == zero dflags+  return $ Lit l1++rightZero :: (DynFlags -> Literal) -> RuleM CoreExpr+rightZero zero = do+  dflags <- getDynFlags+  [_, Lit l2] <- getArgs+  guard $ l2 == zero dflags+  return $ Lit l2++zeroElem :: (DynFlags -> Literal) -> RuleM CoreExpr+zeroElem lit = leftZero lit `mplus` rightZero lit++equalArgs :: RuleM ()+equalArgs = do+  [e1, e2] <- getArgs+  guard $ e1 `cheapEqExpr` e2++nonZeroLit :: Int -> RuleM ()+nonZeroLit n = getLiteral n >>= guard . not . isZeroLit++-- When excess precision is not requested, cut down the precision of the+-- Rational value to that of Float/Double. We confuse host architecture+-- and target architecture here, but it's convenient (and wrong :-).+convFloating :: DynFlags -> Literal -> Literal+convFloating dflags (LitFloat  f) | not (gopt Opt_ExcessPrecision dflags) =+   LitFloat  (toRational (fromRational f :: Float ))+convFloating dflags (LitDouble d) | not (gopt Opt_ExcessPrecision dflags) =+   LitDouble (toRational (fromRational d :: Double))+convFloating _ l = l++guardFloatDiv :: RuleM ()+guardFloatDiv = do+  [Lit (LitFloat f1), Lit (LitFloat f2)] <- getArgs+  guard $ (f1 /=0 || f2 > 0) -- see Note [negative zero]+       && f2 /= 0            -- avoid NaN and Infinity/-Infinity++guardDoubleDiv :: RuleM ()+guardDoubleDiv = do+  [Lit (LitDouble d1), Lit (LitDouble d2)] <- getArgs+  guard $ (d1 /=0 || d2 > 0) -- see Note [negative zero]+       && d2 /= 0            -- avoid NaN and Infinity/-Infinity+-- Note [negative zero] Avoid (0 / -d), otherwise 0/(-1) reduces to+-- zero, but we might want to preserve the negative zero here which+-- is representable in Float/Double but not in (normalised)+-- Rational. (#3676) Perhaps we should generate (0 :% (-1)) instead?++strengthReduction :: Literal -> PrimOp -> RuleM CoreExpr+strengthReduction two_lit add_op = do -- Note [Strength reduction]+  arg <- msum [ do [arg, Lit mult_lit] <- getArgs+                   guard (mult_lit == two_lit)+                   return arg+              , do [Lit mult_lit, arg] <- getArgs+                   guard (mult_lit == two_lit)+                   return arg ]+  return $ Var (mkPrimOpId add_op) `App` arg `App` arg++-- Note [Strength reduction]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- This rule turns floating point multiplications of the form 2.0 * x and+-- x * 2.0 into x + x addition, because addition costs less than multiplication.+-- See #7116++-- Note [What's true and false]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- trueValInt and falseValInt represent true and false values returned by+-- comparison primops for Char, Int, Word, Integer, Double, Float and Addr.+-- True is represented as an unboxed 1# literal, while false is represented+-- as 0# literal.+-- We still need Bool data constructors (True and False) to use in a rule+-- for constant folding of equal Strings++trueValInt, falseValInt :: DynFlags -> Expr CoreBndr+trueValInt  dflags = Lit $ onei  dflags -- see Note [What's true and false]+falseValInt dflags = Lit $ zeroi dflags++trueValBool, falseValBool :: Expr CoreBndr+trueValBool   = Var trueDataConId -- see Note [What's true and false]+falseValBool  = Var falseDataConId++ltVal, eqVal, gtVal :: Expr CoreBndr+ltVal = Var ordLTDataConId+eqVal = Var ordEQDataConId+gtVal = Var ordGTDataConId++mkIntVal :: DynFlags -> Integer -> Expr CoreBndr+mkIntVal dflags i = Lit (mkLitInt dflags i)+mkFloatVal :: DynFlags -> Rational -> Expr CoreBndr+mkFloatVal dflags f = Lit (convFloating dflags (LitFloat  f))+mkDoubleVal :: DynFlags -> Rational -> Expr CoreBndr+mkDoubleVal dflags d = Lit (convFloating dflags (LitDouble d))++matchPrimOpId :: PrimOp -> Id -> RuleM ()+matchPrimOpId op id = do+  op' <- liftMaybe $ isPrimOpId_maybe id+  guard $ op == op'++{-+************************************************************************+*                                                                      *+\subsection{Special rules for seq, tagToEnum, dataToTag}+*                                                                      *+************************************************************************++Note [tagToEnum#]+~~~~~~~~~~~~~~~~~+Nasty check to ensure that tagToEnum# is applied to a type that is an+enumeration TyCon.  Unification may refine the type later, but this+check won't see that, alas.  It's crude but it works.++Here's are two cases that should fail+        f :: forall a. a+        f = tagToEnum# 0        -- Can't do tagToEnum# at a type variable++        g :: Int+        g = tagToEnum# 0        -- Int is not an enumeration++We used to make this check in the type inference engine, but it's quite+ugly to do so, because the delayed constraint solving means that we don't+really know what's going on until the end. It's very much a corner case+because we don't expect the user to call tagToEnum# at all; we merely+generate calls in derived instances of Enum.  So we compromise: a+rewrite rule rewrites a bad instance of tagToEnum# to an error call,+and emits a warning.+-}++tagToEnumRule :: RuleM CoreExpr+-- If     data T a = A | B | C+-- then   tag2Enum# (T ty) 2# -->  B ty+tagToEnumRule = do+  [Type ty, Lit (LitNumber LitNumInt i _)] <- getArgs+  case splitTyConApp_maybe ty of+    Just (tycon, tc_args) | isEnumerationTyCon tycon -> do+      let tag = fromInteger i+          correct_tag dc = (dataConTagZ dc) == tag+      (dc:rest) <- return $ filter correct_tag (tyConDataCons_maybe tycon `orElse` [])+      ASSERT(null rest) return ()+      return $ mkTyApps (Var (dataConWorkId dc)) tc_args++    -- See Note [tagToEnum#]+    _ -> WARN( True, text "tagToEnum# on non-enumeration type" <+> ppr ty )+         return $ mkRuntimeErrorApp rUNTIME_ERROR_ID ty "tagToEnum# on non-enumeration type"++------------------------------+dataToTagRule :: RuleM CoreExpr+-- See Note [dataToTag#] in primops.txt.pp+dataToTagRule = a `mplus` b+  where+    -- dataToTag (tagToEnum x)   ==>   x+    a = do+      [Type ty1, Var tag_to_enum `App` Type ty2 `App` tag] <- getArgs+      guard $ tag_to_enum `hasKey` tagToEnumKey+      guard $ ty1 `eqType` ty2+      return tag++    -- dataToTag (K e1 e2)  ==>   tag-of K+    -- This also works (via exprIsConApp_maybe) for+    --   dataToTag x+    -- where x's unfolding is a constructor application+    b = do+      dflags <- getDynFlags+      [_, val_arg] <- getArgs+      in_scope <- getInScopeEnv+      (_,floats, dc,_,_) <- liftMaybe $ exprIsConApp_maybe in_scope val_arg+      ASSERT( not (isNewTyCon (dataConTyCon dc)) ) return ()+      return $ wrapFloats floats (mkIntVal dflags (toInteger (dataConTagZ dc)))++{- Note [dataToTag# magic]+~~~~~~~~~~~~~~~~~~~~~~~~~~+The primop dataToTag# is unusual because it evaluates its argument.+Only `SeqOp` shares that property.  (Other primops do not do anything+as fancy as argument evaluation.)  The special handling for dataToTag#+is:++* CoreUtils.exprOkForSpeculation has a special case for DataToTagOp,+  (actually in app_ok).  Most primops with lifted arguments do not+  evaluate those arguments, but DataToTagOp and SeqOp are two+  exceptions.  We say that they are /never/ ok-for-speculation,+  regardless of the evaluated-ness of their argument.+  See CoreUtils Note [exprOkForSpeculation and SeqOp/DataToTagOp]++* There is a special case for DataToTagOp in StgCmmExpr.cgExpr,+  that evaluates its argument and then extracts the tag from+  the returned value.++* An application like (dataToTag# (Just x)) is optimised by+  dataToTagRule in PrelRules.++* A case expression like+     case (dataToTag# e) of <alts>+  gets transformed t+     case e of <transformed alts>+  by PrelRules.caseRules; see Note [caseRules for dataToTag]++See #15696 for a long saga.+++************************************************************************+*                                                                      *+\subsection{Rules for seq# and spark#}+*                                                                      *+************************************************************************+-}++{- Note [seq# magic]+~~~~~~~~~~~~~~~~~~~~+The primop+   seq# :: forall a s . a -> State# s -> (# State# s, a #)++is /not/ the same as the Prelude function seq :: a -> b -> b+as you can see from its type.  In fact, seq# is the implementation+mechanism for 'evaluate'++   evaluate :: a -> IO a+   evaluate a = IO $ \s -> seq# a s++The semantics of seq# is+  * evaluate its first argument+  * and return it++Things to note++* Why do we need a primop at all?  That is, instead of+      case seq# x s of (# x, s #) -> blah+  why not instead say this?+      case x of { DEFAULT -> blah)++  Reason (see #5129): if we saw+    catch# (\s -> case x of { DEFAULT -> raiseIO# exn s }) handler++  then we'd drop the 'case x' because the body of the case is bottom+  anyway. But we don't want to do that; the whole /point/ of+  seq#/evaluate is to evaluate 'x' first in the IO monad.++  In short, we /always/ evaluate the first argument and never+  just discard it.++* Why return the value?  So that we can control sharing of seq'd+  values: in+     let x = e in x `seq` ... x ...+  We don't want to inline x, so better to represent it as+       let x = e in case seq# x RW of (# _, x' #) -> ... x' ...+  also it matches the type of rseq in the Eval monad.++Implementing seq#.  The compiler has magic for SeqOp in++- PrelRules.seqRule: eliminate (seq# <whnf> s)++- StgCmmExpr.cgExpr, and cgCase: special case for seq#++- CoreUtils.exprOkForSpeculation;+  see Note [exprOkForSpeculation and SeqOp/DataToTagOp] in CoreUtils++- Simplify.addEvals records evaluated-ness for the result; see+  Note [Adding evaluatedness info to pattern-bound variables]+  in Simplify+-}++seqRule :: RuleM CoreExpr+seqRule = do+  [Type ty_a, Type _ty_s, a, s] <- getArgs+  guard $ exprIsHNF a+  return $ mkCoreUbxTup [exprType s, ty_a] [s, a]++-- spark# :: forall a s . a -> State# s -> (# State# s, a #)+sparkRule :: RuleM CoreExpr+sparkRule = seqRule -- reduce on HNF, just the same+  -- XXX perhaps we shouldn't do this, because a spark eliminated by+  -- this rule won't be counted as a dud at runtime?++{-+************************************************************************+*                                                                      *+\subsection{Built in rules}+*                                                                      *+************************************************************************++Note [Scoping for Builtin rules]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When compiling a (base-package) module that defines one of the+functions mentioned in the RHS of a built-in rule, there's a danger+that we'll see++        f = ...(eq String x)....++        ....and lower down...++        eqString = ...++Then a rewrite would give++        f = ...(eqString x)...+        ....and lower down...+        eqString = ...++and lo, eqString is not in scope.  This only really matters when we get to code+generation.  With -O we do a GlomBinds step that does a new SCC analysis on the whole+set of bindings, which sorts out the dependency.  Without -O we don't do any rule+rewriting so again we are fine.++(This whole thing doesn't show up for non-built-in rules because their dependencies+are explicit.)+-}++builtinRules :: [CoreRule]+-- Rules for non-primops that can't be expressed using a RULE pragma+builtinRules+  = [BuiltinRule { ru_name = fsLit "AppendLitString",+                   ru_fn = unpackCStringFoldrName,+                   ru_nargs = 4, ru_try = match_append_lit },+     BuiltinRule { ru_name = fsLit "EqString", ru_fn = eqStringName,+                   ru_nargs = 2, ru_try = match_eq_string },+     BuiltinRule { ru_name = fsLit "Inline", ru_fn = inlineIdName,+                   ru_nargs = 2, ru_try = \_ _ _ -> match_inline },+     BuiltinRule { ru_name = fsLit "MagicDict", ru_fn = idName magicDictId,+                   ru_nargs = 4, ru_try = \_ _ _ -> match_magicDict },+     mkBasicRule divIntName 2 $ msum+        [ nonZeroLit 1 >> binaryLit (intOp2 div)+        , leftZero zeroi+        , do+          [arg, Lit (LitNumber LitNumInt d _)] <- getArgs+          Just n <- return $ exactLog2 d+          dflags <- getDynFlags+          return $ Var (mkPrimOpId ISraOp) `App` arg `App` mkIntVal dflags n+        ],+     mkBasicRule modIntName 2 $ msum+        [ nonZeroLit 1 >> binaryLit (intOp2 mod)+        , leftZero zeroi+        , do+          [arg, Lit (LitNumber LitNumInt d _)] <- getArgs+          Just _ <- return $ exactLog2 d+          dflags <- getDynFlags+          return $ Var (mkPrimOpId AndIOp)+            `App` arg `App` mkIntVal dflags (d - 1)+        ]+     ]+ ++ builtinIntegerRules+ ++ builtinNaturalRules+{-# NOINLINE builtinRules #-}+-- there is no benefit to inlining these yet, despite this, GHC produces+-- unfoldings for this regardless since the floated list entries look small.++builtinIntegerRules :: [CoreRule]+builtinIntegerRules =+ [rule_IntToInteger   "smallInteger"        smallIntegerName,+  rule_WordToInteger  "wordToInteger"       wordToIntegerName,+  rule_Int64ToInteger  "int64ToInteger"     int64ToIntegerName,+  rule_Word64ToInteger "word64ToInteger"    word64ToIntegerName,+  rule_convert        "integerToWord"       integerToWordName       mkWordLitWord,+  rule_convert        "integerToInt"        integerToIntName        mkIntLitInt,+  rule_convert        "integerToWord64"     integerToWord64Name     (\_ -> mkWord64LitWord64),+  rule_convert        "integerToInt64"      integerToInt64Name      (\_ -> mkInt64LitInt64),+  rule_binop          "plusInteger"         plusIntegerName         (+),+  rule_binop          "minusInteger"        minusIntegerName        (-),+  rule_binop          "timesInteger"        timesIntegerName        (*),+  rule_unop           "negateInteger"       negateIntegerName       negate,+  rule_binop_Prim     "eqInteger#"          eqIntegerPrimName       (==),+  rule_binop_Prim     "neqInteger#"         neqIntegerPrimName      (/=),+  rule_unop           "absInteger"          absIntegerName          abs,+  rule_unop           "signumInteger"       signumIntegerName       signum,+  rule_binop_Prim     "leInteger#"          leIntegerPrimName       (<=),+  rule_binop_Prim     "gtInteger#"          gtIntegerPrimName       (>),+  rule_binop_Prim     "ltInteger#"          ltIntegerPrimName       (<),+  rule_binop_Prim     "geInteger#"          geIntegerPrimName       (>=),+  rule_binop_Ordering "compareInteger"      compareIntegerName      compare,+  rule_encodeFloat    "encodeFloatInteger"  encodeFloatIntegerName  mkFloatLitFloat,+  rule_convert        "floatFromInteger"    floatFromIntegerName    (\_ -> mkFloatLitFloat),+  rule_encodeFloat    "encodeDoubleInteger" encodeDoubleIntegerName mkDoubleLitDouble,+  rule_decodeDouble   "decodeDoubleInteger" decodeDoubleIntegerName,+  rule_convert        "doubleFromInteger"   doubleFromIntegerName   (\_ -> mkDoubleLitDouble),+  rule_rationalTo     "rationalToFloat"     rationalToFloatName     mkFloatExpr,+  rule_rationalTo     "rationalToDouble"    rationalToDoubleName    mkDoubleExpr,+  rule_binop          "gcdInteger"          gcdIntegerName          gcd,+  rule_binop          "lcmInteger"          lcmIntegerName          lcm,+  rule_binop          "andInteger"          andIntegerName          (.&.),+  rule_binop          "orInteger"           orIntegerName           (.|.),+  rule_binop          "xorInteger"          xorIntegerName          xor,+  rule_unop           "complementInteger"   complementIntegerName   complement,+  rule_shift_op       "shiftLInteger"       shiftLIntegerName       shiftL,+  rule_shift_op       "shiftRInteger"       shiftRIntegerName       shiftR,+  rule_bitInteger     "bitInteger"          bitIntegerName,+  -- See Note [Integer division constant folding] in libraries/base/GHC/Real.hs+  rule_divop_one      "quotInteger"         quotIntegerName         quot,+  rule_divop_one      "remInteger"          remIntegerName          rem,+  rule_divop_one      "divInteger"          divIntegerName          div,+  rule_divop_one      "modInteger"          modIntegerName          mod,+  rule_divop_both     "divModInteger"       divModIntegerName       divMod,+  rule_divop_both     "quotRemInteger"      quotRemIntegerName      quotRem,+  -- These rules below don't actually have to be built in, but if we+  -- put them in the Haskell source then we'd have to duplicate them+  -- between all Integer implementations+  rule_XToIntegerToX "smallIntegerToInt"       integerToIntName    smallIntegerName,+  rule_XToIntegerToX "wordToIntegerToWord"     integerToWordName   wordToIntegerName,+  rule_XToIntegerToX "int64ToIntegerToInt64"   integerToInt64Name  int64ToIntegerName,+  rule_XToIntegerToX "word64ToIntegerToWord64" integerToWord64Name word64ToIntegerName,+  rule_smallIntegerTo "smallIntegerToWord"   integerToWordName     Int2WordOp,+  rule_smallIntegerTo "smallIntegerToFloat"  floatFromIntegerName  Int2FloatOp,+  rule_smallIntegerTo "smallIntegerToDouble" doubleFromIntegerName Int2DoubleOp+  ]+    where rule_convert str name convert+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,+                           ru_try = match_Integer_convert convert }+          rule_IntToInteger str name+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,+                           ru_try = match_IntToInteger }+          rule_WordToInteger str name+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,+                           ru_try = match_WordToInteger }+          rule_Int64ToInteger str name+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,+                           ru_try = match_Int64ToInteger }+          rule_Word64ToInteger str name+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,+                           ru_try = match_Word64ToInteger }+          rule_unop str name op+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,+                           ru_try = match_Integer_unop op }+          rule_bitInteger str name+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,+                           ru_try = match_bitInteger }+          rule_binop str name op+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,+                           ru_try = match_Integer_binop op }+          rule_divop_both str name op+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,+                           ru_try = match_Integer_divop_both op }+          rule_divop_one str name op+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,+                           ru_try = match_Integer_divop_one op }+          rule_shift_op str name op+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,+                           ru_try = match_Integer_shift_op op }+          rule_binop_Prim str name op+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,+                           ru_try = match_Integer_binop_Prim op }+          rule_binop_Ordering str name op+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,+                           ru_try = match_Integer_binop_Ordering op }+          rule_encodeFloat str name op+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,+                           ru_try = match_Integer_Int_encodeFloat op }+          rule_decodeDouble str name+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,+                           ru_try = match_decodeDouble }+          rule_XToIntegerToX str name toIntegerName+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,+                           ru_try = match_XToIntegerToX toIntegerName }+          rule_smallIntegerTo str name primOp+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,+                           ru_try = match_smallIntegerTo primOp }+          rule_rationalTo str name mkLit+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,+                           ru_try = match_rationalTo mkLit }++builtinNaturalRules :: [CoreRule]+builtinNaturalRules =+ [rule_binop              "plusNatural"        plusNaturalName         (+)+ ,rule_partial_binop      "minusNatural"       minusNaturalName        (\a b -> if a >= b then Just (a - b) else Nothing)+ ,rule_binop              "timesNatural"       timesNaturalName        (*)+ ,rule_NaturalFromInteger "naturalFromInteger" naturalFromIntegerName+ ,rule_NaturalToInteger   "naturalToInteger"   naturalToIntegerName+ ,rule_WordToNatural      "wordToNatural"      wordToNaturalName+ ]+    where rule_binop str name op+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,+                           ru_try = match_Natural_binop op }+          rule_partial_binop str name op+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,+                           ru_try = match_Natural_partial_binop op }+          rule_NaturalToInteger str name+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,+                           ru_try = match_NaturalToInteger }+          rule_NaturalFromInteger str name+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,+                           ru_try = match_NaturalFromInteger }+          rule_WordToNatural str name+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,+                           ru_try = match_WordToNatural }++---------------------------------------------------+-- The rule is this:+--      unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)+--      =  unpackFoldrCString# "foobaz" c n++match_append_lit :: RuleFun+match_append_lit _ id_unf _+        [ Type ty1+        , lit1+        , c1+        , Var unpk `App` Type ty2+                   `App` lit2+                   `App` c2+                   `App` n+        ]+  | unpk `hasKey` unpackCStringFoldrIdKey &&+    c1 `cheapEqExpr` c2+  , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1+  , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2+  = ASSERT( ty1 `eqType` ty2 )+    Just (Var unpk `App` Type ty1+                   `App` Lit (LitString (s1 `BS.append` s2))+                   `App` c1+                   `App` n)++match_append_lit _ _ _ _ = Nothing++---------------------------------------------------+-- The rule is this:+--      eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2)) = s1==s2++match_eq_string :: RuleFun+match_eq_string _ id_unf _+        [Var unpk1 `App` lit1, Var unpk2 `App` lit2]+  | unpk1 `hasKey` unpackCStringIdKey+  , unpk2 `hasKey` unpackCStringIdKey+  , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1+  , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2+  = Just (if s1 == s2 then trueValBool else falseValBool)++match_eq_string _ _ _ _ = Nothing+++---------------------------------------------------+-- The rule is this:+--      inline f_ty (f a b c) = <f's unfolding> a b c+-- (if f has an unfolding, EVEN if it's a loop breaker)+--+-- It's important to allow the argument to 'inline' to have args itself+-- (a) because its more forgiving to allow the programmer to write+--       inline f a b c+--   or  inline (f a b c)+-- (b) because a polymorphic f wll get a type argument that the+--     programmer can't avoid+--+-- Also, don't forget about 'inline's type argument!+match_inline :: [Expr CoreBndr] -> Maybe (Expr CoreBndr)+match_inline (Type _ : e : _)+  | (Var f, args1) <- collectArgs e,+    Just unf <- maybeUnfoldingTemplate (realIdUnfolding f)+             -- Ignore the IdUnfoldingFun here!+  = Just (mkApps unf args1)++match_inline _ = Nothing+++-- See Note [magicDictId magic] in `basicTypes/MkId.hs`+-- for a description of what is going on here.+match_magicDict :: [Expr CoreBndr] -> Maybe (Expr CoreBndr)+match_magicDict [Type _, Var wrap `App` Type a `App` Type _ `App` f, x, y ]+  | Just (fieldTy, _)   <- splitFunTy_maybe $ dropForAlls $ idType wrap+  , Just (dictTy, _)    <- splitFunTy_maybe fieldTy+  , Just dictTc         <- tyConAppTyCon_maybe dictTy+  , Just (_,_,co)       <- unwrapNewTyCon_maybe dictTc+  = Just+  $ f `App` Cast x (mkSymCo (mkUnbranchedAxInstCo Representational co [a] []))+      `App` y++match_magicDict _ = Nothing++-------------------------------------------------+-- Integer rules+--   smallInteger  (79::Int#)  = 79::Integer+--   wordToInteger (79::Word#) = 79::Integer+-- Similarly Int64, Word64++match_IntToInteger :: RuleFun+match_IntToInteger = match_IntToInteger_unop id++match_WordToInteger :: RuleFun+match_WordToInteger _ id_unf id [xl]+  | Just (LitNumber LitNumWord x _) <- exprIsLiteral_maybe id_unf xl+  = case splitFunTy_maybe (idType id) of+    Just (_, integerTy) ->+        Just (Lit (mkLitInteger x integerTy))+    _ ->+        panic "match_WordToInteger: Id has the wrong type"+match_WordToInteger _ _ _ _ = Nothing++match_Int64ToInteger :: RuleFun+match_Int64ToInteger _ id_unf id [xl]+  | Just (LitNumber LitNumInt64 x _) <- exprIsLiteral_maybe id_unf xl+  = case splitFunTy_maybe (idType id) of+    Just (_, integerTy) ->+        Just (Lit (mkLitInteger x integerTy))+    _ ->+        panic "match_Int64ToInteger: Id has the wrong type"+match_Int64ToInteger _ _ _ _ = Nothing++match_Word64ToInteger :: RuleFun+match_Word64ToInteger _ id_unf id [xl]+  | Just (LitNumber LitNumWord64 x _) <- exprIsLiteral_maybe id_unf xl+  = case splitFunTy_maybe (idType id) of+    Just (_, integerTy) ->+        Just (Lit (mkLitInteger x integerTy))+    _ ->+        panic "match_Word64ToInteger: Id has the wrong type"+match_Word64ToInteger _ _ _ _ = Nothing++match_NaturalToInteger :: RuleFun+match_NaturalToInteger _ id_unf id [xl]+  | Just (LitNumber LitNumNatural x _) <- exprIsLiteral_maybe id_unf xl+  = case splitFunTy_maybe (idType id) of+    Just (_, naturalTy) ->+        Just (Lit (LitNumber LitNumInteger x naturalTy))+    _ ->+        panic "match_NaturalToInteger: Id has the wrong type"+match_NaturalToInteger _ _ _ _ = Nothing++match_NaturalFromInteger :: RuleFun+match_NaturalFromInteger _ id_unf id [xl]+  | Just (LitNumber LitNumInteger x _) <- exprIsLiteral_maybe id_unf xl+  , x >= 0+  = case splitFunTy_maybe (idType id) of+    Just (_, naturalTy) ->+        Just (Lit (LitNumber LitNumNatural x naturalTy))+    _ ->+        panic "match_NaturalFromInteger: Id has the wrong type"+match_NaturalFromInteger _ _ _ _ = Nothing++match_WordToNatural :: RuleFun+match_WordToNatural _ id_unf id [xl]+  | Just (LitNumber LitNumWord x _) <- exprIsLiteral_maybe id_unf xl+  = case splitFunTy_maybe (idType id) of+    Just (_, naturalTy) ->+        Just (Lit (LitNumber LitNumNatural x naturalTy))+    _ ->+        panic "match_WordToNatural: Id has the wrong type"+match_WordToNatural _ _ _ _ = Nothing++-------------------------------------------------+{- Note [Rewriting bitInteger]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For most types the bitInteger operation can be implemented in terms of shifts.+The integer-gmp package, however, can do substantially better than this if+allowed to provide its own implementation. However, in so doing it previously lost+constant-folding (see #8832). The bitInteger rule above provides constant folding+specifically for this function.++There is, however, a bit of trickiness here when it comes to ranges. While the+AST encodes all integers as Integers, `bit` expects the bit+index to be given as an Int. Hence we coerce to an Int in the rule definition.+This will behave a bit funny for constants larger than the word size, but the user+should expect some funniness given that they will have at very least ignored a+warning in this case.+-}++match_bitInteger :: RuleFun+-- Just for GHC.Integer.Type.bitInteger :: Int# -> Integer+match_bitInteger dflags id_unf fn [arg]+  | Just (LitNumber LitNumInt x _) <- exprIsLiteral_maybe id_unf arg+  , x >= 0+  , x <= (wordSizeInBits dflags - 1)+    -- Make sure x is small enough to yield a decently small iteger+    -- Attempting to construct the Integer for+    --    (bitInteger 9223372036854775807#)+    -- would be a bad idea (#14959)+  , let x_int = fromIntegral x :: Int+  = case splitFunTy_maybe (idType fn) of+    Just (_, integerTy)+      -> Just (Lit (LitNumber LitNumInteger (bit x_int) integerTy))+    _ -> panic "match_IntToInteger_unop: Id has the wrong type"++match_bitInteger _ _ _ _ = Nothing+++-------------------------------------------------+match_Integer_convert :: Num a+                      => (DynFlags -> a -> Expr CoreBndr)+                      -> RuleFun+match_Integer_convert convert dflags id_unf _ [xl]+  | Just (LitNumber LitNumInteger x _) <- exprIsLiteral_maybe id_unf xl+  = Just (convert dflags (fromInteger x))+match_Integer_convert _ _ _ _ _ = Nothing++match_Integer_unop :: (Integer -> Integer) -> RuleFun+match_Integer_unop unop _ id_unf _ [xl]+  | Just (LitNumber LitNumInteger x i) <- exprIsLiteral_maybe id_unf xl+  = Just (Lit (LitNumber LitNumInteger (unop x) i))+match_Integer_unop _ _ _ _ _ = Nothing++match_IntToInteger_unop :: (Integer -> Integer) -> RuleFun+match_IntToInteger_unop unop _ id_unf fn [xl]+  | Just (LitNumber LitNumInt x _) <- exprIsLiteral_maybe id_unf xl+  = case splitFunTy_maybe (idType fn) of+    Just (_, integerTy) ->+        Just (Lit (LitNumber LitNumInteger (unop x) integerTy))+    _ ->+        panic "match_IntToInteger_unop: Id has the wrong type"+match_IntToInteger_unop _ _ _ _ _ = Nothing++match_Integer_binop :: (Integer -> Integer -> Integer) -> RuleFun+match_Integer_binop binop _ id_unf _ [xl,yl]+  | Just (LitNumber LitNumInteger x i) <- exprIsLiteral_maybe id_unf xl+  , Just (LitNumber LitNumInteger y _) <- exprIsLiteral_maybe id_unf yl+  = Just (Lit (mkLitInteger (x `binop` y) i))+match_Integer_binop _ _ _ _ _ = Nothing++match_Natural_binop :: (Integer -> Integer -> Integer) -> RuleFun+match_Natural_binop binop _ id_unf _ [xl,yl]+  | Just (LitNumber LitNumNatural x i) <- exprIsLiteral_maybe id_unf xl+  , Just (LitNumber LitNumNatural y _) <- exprIsLiteral_maybe id_unf yl+  = Just (Lit (mkLitNatural (x `binop` y) i))+match_Natural_binop _ _ _ _ _ = Nothing++match_Natural_partial_binop :: (Integer -> Integer -> Maybe Integer) -> RuleFun+match_Natural_partial_binop binop _ id_unf _ [xl,yl]+  | Just (LitNumber LitNumNatural x i) <- exprIsLiteral_maybe id_unf xl+  , Just (LitNumber LitNumNatural y _) <- exprIsLiteral_maybe id_unf yl+  , Just z <- x `binop` y+  = Just (Lit (mkLitNatural z i))+match_Natural_partial_binop _ _ _ _ _ = Nothing++-- This helper is used for the quotRem and divMod functions+match_Integer_divop_both+   :: (Integer -> Integer -> (Integer, Integer)) -> RuleFun+match_Integer_divop_both divop _ id_unf _ [xl,yl]+  | Just (LitNumber LitNumInteger x t) <- exprIsLiteral_maybe id_unf xl+  , Just (LitNumber LitNumInteger y _) <- exprIsLiteral_maybe id_unf yl+  , y /= 0+  , (r,s) <- x `divop` y+  = Just $ mkCoreUbxTup [t,t] [Lit (mkLitInteger r t), Lit (mkLitInteger s t)]+match_Integer_divop_both _ _ _ _ _ = Nothing++-- This helper is used for the quot and rem functions+match_Integer_divop_one :: (Integer -> Integer -> Integer) -> RuleFun+match_Integer_divop_one divop _ id_unf _ [xl,yl]+  | Just (LitNumber LitNumInteger x i) <- exprIsLiteral_maybe id_unf xl+  , Just (LitNumber LitNumInteger y _) <- exprIsLiteral_maybe id_unf yl+  , y /= 0+  = Just (Lit (mkLitInteger (x `divop` y) i))+match_Integer_divop_one _ _ _ _ _ = Nothing++match_Integer_shift_op :: (Integer -> Int -> Integer) -> RuleFun+-- Used for shiftLInteger, shiftRInteger :: Integer -> Int# -> Integer+-- See Note [Guarding against silly shifts]+match_Integer_shift_op binop _ id_unf _ [xl,yl]+  | Just (LitNumber LitNumInteger x i) <- exprIsLiteral_maybe id_unf xl+  , Just (LitNumber LitNumInt y _)     <- exprIsLiteral_maybe id_unf yl+  , y >= 0+  , y <= 4   -- Restrict constant-folding of shifts on Integers, somewhat+             -- arbitrary.  We can get huge shifts in inaccessible code+             -- (#15673)+  = Just (Lit (mkLitInteger (x `binop` fromIntegral y) i))+match_Integer_shift_op _ _ _ _ _ = Nothing++match_Integer_binop_Prim :: (Integer -> Integer -> Bool) -> RuleFun+match_Integer_binop_Prim binop dflags id_unf _ [xl, yl]+  | Just (LitNumber LitNumInteger x _) <- exprIsLiteral_maybe id_unf xl+  , Just (LitNumber LitNumInteger y _) <- exprIsLiteral_maybe id_unf yl+  = Just (if x `binop` y then trueValInt dflags else falseValInt dflags)+match_Integer_binop_Prim _ _ _ _ _ = Nothing++match_Integer_binop_Ordering :: (Integer -> Integer -> Ordering) -> RuleFun+match_Integer_binop_Ordering binop _ id_unf _ [xl, yl]+  | Just (LitNumber LitNumInteger x _) <- exprIsLiteral_maybe id_unf xl+  , Just (LitNumber LitNumInteger y _) <- exprIsLiteral_maybe id_unf yl+  = Just $ case x `binop` y of+             LT -> ltVal+             EQ -> eqVal+             GT -> gtVal+match_Integer_binop_Ordering _ _ _ _ _ = Nothing++match_Integer_Int_encodeFloat :: RealFloat a+                              => (a -> Expr CoreBndr)+                              -> RuleFun+match_Integer_Int_encodeFloat mkLit _ id_unf _ [xl,yl]+  | Just (LitNumber LitNumInteger x _) <- exprIsLiteral_maybe id_unf xl+  , Just (LitNumber LitNumInt y _)     <- exprIsLiteral_maybe id_unf yl+  = Just (mkLit $ encodeFloat x (fromInteger y))+match_Integer_Int_encodeFloat _ _ _ _ _ = Nothing++---------------------------------------------------+-- constant folding for Float/Double+--+-- This turns+--      rationalToFloat n d+-- into a literal Float, and similarly for Doubles.+--+-- it's important to not match d == 0, because that may represent a+-- literal "0/0" or similar, and we can't produce a literal value for+-- NaN or +-Inf+match_rationalTo :: RealFloat a+                 => (a -> Expr CoreBndr)+                 -> RuleFun+match_rationalTo mkLit _ id_unf _ [xl, yl]+  | Just (LitNumber LitNumInteger x _) <- exprIsLiteral_maybe id_unf xl+  , Just (LitNumber LitNumInteger y _) <- exprIsLiteral_maybe id_unf yl+  , y /= 0+  = Just (mkLit (fromRational (x % y)))+match_rationalTo _ _ _ _ _ = Nothing++match_decodeDouble :: RuleFun+match_decodeDouble dflags id_unf fn [xl]+  | Just (LitDouble x) <- exprIsLiteral_maybe id_unf xl+  = case splitFunTy_maybe (idType fn) of+    Just (_, res)+      | Just [_lev1, _lev2, integerTy, intHashTy] <- tyConAppArgs_maybe res+      -> case decodeFloat (fromRational x :: Double) of+           (y, z) ->+             Just $ mkCoreUbxTup [integerTy, intHashTy]+                                 [Lit (mkLitInteger y integerTy),+                                  Lit (mkLitInt dflags (toInteger z))]+    _ ->+        pprPanic "match_decodeDouble: Id has the wrong type"+          (ppr fn <+> dcolon <+> ppr (idType fn))+match_decodeDouble _ _ _ _ = Nothing++match_XToIntegerToX :: Name -> RuleFun+match_XToIntegerToX n _ _ _ [App (Var x) y]+  | idName x == n+  = Just y+match_XToIntegerToX _ _ _ _ _ = Nothing++match_smallIntegerTo :: PrimOp -> RuleFun+match_smallIntegerTo primOp _ _ _ [App (Var x) y]+  | idName x == smallIntegerName+  = Just $ App (Var (mkPrimOpId primOp)) y+match_smallIntegerTo _ _ _ _ _ = Nothing++++--------------------------------------------------------+-- Note [Constant folding through nested expressions]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- We use rewrites rules to perform constant folding. It means that we don't+-- have a global view of the expression we are trying to optimise. As a+-- consequence we only perform local (small-step) transformations that either:+--    1) reduce the number of operations+--    2) rearrange the expression to increase the odds that other rules will+--    match+--+-- We don't try to handle more complex expression optimisation cases that would+-- require a global view. For example, rewriting expressions to increase+-- sharing (e.g., Horner's method); optimisations that require local+-- transformations increasing the number of operations; rearrangements to+-- cancel/factorize terms (e.g., (a+b-a-b) isn't rearranged to reduce to 0).+--+-- We already have rules to perform constant folding on expressions with the+-- following shape (where a and/or b are literals):+--+--          D)    op+--                /\+--               /  \+--              /    \+--             a      b+--+-- To support nested expressions, we match three other shapes of expression+-- trees:+--+-- A)   op1          B)       op1       C)       op1+--      /\                    /\                 /\+--     /  \                  /  \               /  \+--    /    \                /    \             /    \+--   a     op2            op2     c          op2    op3+--          /\            /\                 /\      /\+--         /  \          /  \               /  \    /  \+--        b    c        a    b             a    b  c    d+--+--+-- R1) +/- simplification:+--    ops = + or -, two literals (not siblings)+--+--    Examples:+--       A: 5 + (10-x)  ==> 15-x+--       B: (10+x) + 5  ==> 15+x+--       C: (5+a)-(5-b) ==> 0+(a+b)+--+-- R2) * simplification+--    ops = *, two literals (not siblings)+--+--    Examples:+--       A: 5 * (10*x)  ==> 50*x+--       B: (10*x) * 5  ==> 50*x+--       C: (5*a)*(5*b) ==> 25*(a*b)+--+-- R3) * distribution over +/-+--    op1 = *, op2 = + or -, two literals (not siblings)+--+--    This transformation doesn't reduce the number of operations but switches+--    the outer and the inner operations so that the outer is (+) or (-) instead+--    of (*). It increases the odds that other rules will match after this one.+--+--    Examples:+--       A: 5 * (10-x)  ==> 50 - (5*x)+--       B: (10+x) * 5  ==> 50 + (5*x)+--       C: Not supported as it would increase the number of operations:+--          (5+a)*(5-b) ==> 25 - 5*b + 5*a - a*b+--+-- R4) Simple factorization+--+--    op1 = + or -, op2/op3 = *,+--    one literal for each innermost * operation (except in the D case),+--    the two other terms are equals+--+--    Examples:+--       A: x - (10*x)  ==> (-9)*x+--       B: (10*x) + x  ==> 11*x+--       C: (5*x)-(x*3) ==> 2*x+--       D: x+x         ==> 2*x+--+-- R5) +/- propagation+--+--    ops = + or -, one literal+--+--    This transformation doesn't reduce the number of operations but propagates+--    the constant to the outer level. It increases the odds that other rules+--    will match after this one.+--+--    Examples:+--       A: x - (10-y)  ==> (x+y) - 10+--       B: (10+x) - y  ==> 10 + (x-y)+--       C: N/A (caught by the A and B cases)+--+--------------------------------------------------------++-- | Rules to perform constant folding into nested expressions+--+--See Note [Constant folding through nested expressions]+numFoldingRules :: PrimOp -> (DynFlags -> PrimOps) -> RuleM CoreExpr+numFoldingRules op dict = do+  [e1,e2] <- getArgs+  dflags <- getDynFlags+  let PrimOps{..} = dict dflags+  if not (gopt Opt_NumConstantFolding dflags)+    then mzero+    else case BinOpApp e1 op e2 of+     -- R1) +/- simplification+     x    :++: (y :++: v)          -> return $ mkL (x+y)   `add` v+     x    :++: (L y :-: v)         -> return $ mkL (x+y)   `sub` v+     x    :++: (v   :-: L y)       -> return $ mkL (x-y)   `add` v+     L x  :-:  (y :++: v)          -> return $ mkL (x-y)   `sub` v+     L x  :-:  (L y :-: v)         -> return $ mkL (x-y)   `add` v+     L x  :-:  (v   :-: L y)       -> return $ mkL (x+y)   `sub` v++     (y :++: v)    :-: L x         -> return $ mkL (y-x)   `add` v+     (L y :-: v)   :-: L x         -> return $ mkL (y-x)   `sub` v+     (v   :-: L y) :-: L x         -> return $ mkL (0-y-x) `add` v++     (x :++: w)  :+: (y :++: v)    -> return $ mkL (x+y)   `add` (w `add` v)+     (w :-: L x) :+: (L y :-: v)   -> return $ mkL (y-x)   `add` (w `sub` v)+     (w :-: L x) :+: (v   :-: L y) -> return $ mkL (0-x-y) `add` (w `add` v)+     (L x :-: w) :+: (L y :-: v)   -> return $ mkL (x+y)   `sub` (w `add` v)+     (L x :-: w) :+: (v   :-: L y) -> return $ mkL (x-y)   `add` (v `sub` w)+     (w :-: L x) :+: (y :++: v)    -> return $ mkL (y-x)   `add` (w `add` v)+     (L x :-: w) :+: (y :++: v)    -> return $ mkL (x+y)   `add` (v `sub` w)+     (y :++: v)  :+: (w :-: L x)   -> return $ mkL (y-x)   `add` (w `add` v)+     (y :++: v)  :+: (L x :-: w)   -> return $ mkL (x+y)   `add` (v `sub` w)++     (v   :-: L y) :-: (w :-: L x) -> return $ mkL (x-y)   `add` (v `sub` w)+     (v   :-: L y) :-: (L x :-: w) -> return $ mkL (0-x-y) `add` (v `add` w)+     (L y :-:   v) :-: (w :-: L x) -> return $ mkL (x+y)   `sub` (v `add` w)+     (L y :-:   v) :-: (L x :-: w) -> return $ mkL (y-x)   `add` (w `sub` v)+     (x :++: w)    :-: (y :++: v)  -> return $ mkL (x-y)   `add` (w `sub` v)+     (w :-: L x)   :-: (y :++: v)  -> return $ mkL (0-y-x) `add` (w `sub` v)+     (L x :-: w)   :-: (y :++: v)  -> return $ mkL (x-y)   `sub` (v `add` w)+     (y :++: v)    :-: (w :-: L x) -> return $ mkL (y+x)   `add` (v `sub` w)+     (y :++: v)    :-: (L x :-: w) -> return $ mkL (y-x)   `add` (v `add` w)++     -- R2) * simplification+     x :**: (y :**: v)             -> return $ mkL (x*y)   `mul` v+     (x :**: w) :*: (y :**: v)     -> return $ mkL (x*y)   `mul` (w `mul` v)++     -- R3) * distribution over +/-+     x :**: (y :++: v)             -> return $ mkL (x*y)   `add` (mkL x `mul` v)+     x :**: (L y :-: v)            -> return $ mkL (x*y)   `sub` (mkL x `mul` v)+     x :**: (v   :-: L y)          -> return $ (mkL x `mul` v) `sub` mkL (x*y)++     -- R4) Simple factorization+     v :+: w+      | w `cheapEqExpr` v          -> return $ mkL 2       `mul` v+     w :+: (y :**: v)+      | w `cheapEqExpr` v          -> return $ mkL (1+y)   `mul` v+     w :-: (y :**: v)+      | w `cheapEqExpr` v          -> return $ mkL (1-y)   `mul` v+     (y :**: v) :+: w+      | w `cheapEqExpr` v          -> return $ mkL (y+1)   `mul` v+     (y :**: v) :-: w+      | w `cheapEqExpr` v          -> return $ mkL (y-1)   `mul` v+     (x :**: w) :+: (y :**: v)+      | w `cheapEqExpr` v          -> return $ mkL (x+y)   `mul` v+     (x :**: w) :-: (y :**: v)+      | w `cheapEqExpr` v          -> return $ mkL (x-y)   `mul` v++     -- R5) +/- propagation+     w  :+: (y :++: v)             -> return $ mkL y `add` (w `add` v)+     (y :++: v) :+: w              -> return $ mkL y       `add` (w `add` v)+     w  :-: (y :++: v)             -> return $ (w `sub` v) `sub` mkL y+     (y :++: v) :-: w              -> return $ mkL y       `add` (v `sub` w)+     w    :-: (L y :-: v)          -> return $ (w `add` v) `sub` mkL y+     (L y :-: v) :-: w             -> return $ mkL y       `sub` (w `add` v)+     w    :+: (L y :-: v)          -> return $ mkL y       `add` (w `sub` v)+     w    :+: (v :-: L y)          -> return $ (w `add` v) `sub` mkL y+     (L y :-: v) :+: w             -> return $ mkL y       `add` (w `sub` v)+     (v :-: L y) :+: w             -> return $ (w `add` v) `sub` mkL y++     _                             -> mzero++++-- | Match the application of a binary primop+pattern BinOpApp  :: Arg CoreBndr -> PrimOp -> Arg CoreBndr -> CoreExpr+pattern BinOpApp  x op y =  OpVal op `App` x `App` y++-- | Match a primop+pattern OpVal   :: PrimOp  -> Arg CoreBndr+pattern OpVal   op     <- Var (isPrimOpId_maybe -> Just op) where+   OpVal op = Var (mkPrimOpId op)++++-- | Match a literal+pattern L :: Integer -> Arg CoreBndr+pattern L l <- Lit (isLitValue_maybe -> Just l)++-- | Match an addition+pattern (:+:) :: Arg CoreBndr -> Arg CoreBndr -> CoreExpr+pattern x :+: y <- BinOpApp x (isAddOp -> True) y++-- | Match an addition with a literal (handle commutativity)+pattern (:++:) :: Integer -> Arg CoreBndr -> CoreExpr+pattern l :++: x <- (isAdd -> Just (l,x))++isAdd :: CoreExpr -> Maybe (Integer,CoreExpr)+isAdd e = case e of+   L l :+: x   -> Just (l,x)+   x   :+: L l -> Just (l,x)+   _           -> Nothing++-- | Match a multiplication+pattern (:*:) :: Arg CoreBndr -> Arg CoreBndr -> CoreExpr+pattern x :*: y <- BinOpApp x (isMulOp -> True) y++-- | Match a multiplication with a literal (handle commutativity)+pattern (:**:) :: Integer -> Arg CoreBndr -> CoreExpr+pattern l :**: x <- (isMul -> Just (l,x))++isMul :: CoreExpr -> Maybe (Integer,CoreExpr)+isMul e = case e of+   L l :*: x   -> Just (l,x)+   x   :*: L l -> Just (l,x)+   _           -> Nothing+++-- | Match a subtraction+pattern (:-:) :: Arg CoreBndr -> Arg CoreBndr -> CoreExpr+pattern x :-: y <- BinOpApp x (isSubOp -> True) y++isSubOp :: PrimOp -> Bool+isSubOp IntSubOp  = True+isSubOp WordSubOp = True+isSubOp _         = False++isAddOp :: PrimOp -> Bool+isAddOp IntAddOp  = True+isAddOp WordAddOp = True+isAddOp _         = False++isMulOp :: PrimOp -> Bool+isMulOp IntMulOp  = True+isMulOp WordMulOp = True+isMulOp _         = False++-- | Explicit "type-class"-like dictionary for numeric primops+--+-- Depends on DynFlags because creating a literal value depends on DynFlags+data PrimOps = PrimOps+   { add :: CoreExpr -> CoreExpr -> CoreExpr -- ^ Add two numbers+   , sub :: CoreExpr -> CoreExpr -> CoreExpr -- ^ Sub two numbers+   , mul :: CoreExpr -> CoreExpr -> CoreExpr -- ^ Multiply two numbers+   , mkL :: Integer -> CoreExpr              -- ^ Create a literal value+   }++intPrimOps :: DynFlags -> PrimOps+intPrimOps dflags = PrimOps+   { add = \x y -> BinOpApp x IntAddOp y+   , sub = \x y -> BinOpApp x IntSubOp y+   , mul = \x y -> BinOpApp x IntMulOp y+   , mkL = intResult' dflags+   }++wordPrimOps :: DynFlags -> PrimOps+wordPrimOps dflags = PrimOps+   { add = \x y -> BinOpApp x WordAddOp y+   , sub = \x y -> BinOpApp x WordSubOp y+   , mul = \x y -> BinOpApp x WordMulOp y+   , mkL = wordResult' dflags+   }+++--------------------------------------------------------+-- Constant folding through case-expressions+--+-- cf Scrutinee Constant Folding in simplCore/SimplUtils+--------------------------------------------------------++-- | Match the scrutinee of a case and potentially return a new scrutinee and a+-- function to apply to each literal alternative.+caseRules :: DynFlags+          -> CoreExpr                       -- Scrutinee+          -> Maybe ( CoreExpr               -- New scrutinee+                   , AltCon -> Maybe AltCon -- How to fix up the alt pattern+                                            --   Nothing <=> Unreachable+                                            -- See Note [Unreachable caseRules alternatives]+                   , Id -> CoreExpr)        -- How to reconstruct the original scrutinee+                                            -- from the new case-binder+-- e.g  case e of b {+--         ...;+--         con bs -> rhs;+--         ... }+--  ==>+--      case e' of b' {+--         ...;+--         fixup_altcon[con] bs -> let b = mk_orig[b] in rhs;+--         ... }++caseRules dflags (App (App (Var f) v) (Lit l))   -- v `op` x#+  | Just op <- isPrimOpId_maybe f+  , Just x  <- isLitValue_maybe l+  , Just adjust_lit <- adjustDyadicRight op x+  = Just (v, tx_lit_con dflags adjust_lit+           , \v -> (App (App (Var f) (Var v)) (Lit l)))++caseRules dflags (App (App (Var f) (Lit l)) v)   -- x# `op` v+  | Just op <- isPrimOpId_maybe f+  , Just x  <- isLitValue_maybe l+  , Just adjust_lit <- adjustDyadicLeft x op+  = Just (v, tx_lit_con dflags adjust_lit+           , \v -> (App (App (Var f) (Lit l)) (Var v)))+++caseRules dflags (App (Var f) v              )   -- op v+  | Just op <- isPrimOpId_maybe f+  , Just adjust_lit <- adjustUnary op+  = Just (v, tx_lit_con dflags adjust_lit+           , \v -> App (Var f) (Var v))++-- See Note [caseRules for tagToEnum]+caseRules dflags (App (App (Var f) type_arg) v)+  | Just TagToEnumOp <- isPrimOpId_maybe f+  = Just (v, tx_con_tte dflags+           , \v -> (App (App (Var f) type_arg) (Var v)))++-- See Note [caseRules for dataToTag]+caseRules _ (App (App (Var f) (Type ty)) v)       -- dataToTag x+  | Just DataToTagOp <- isPrimOpId_maybe f+  , Just (tc, _) <- tcSplitTyConApp_maybe ty+  , isAlgTyCon tc+  = Just (v, tx_con_dtt ty+           , \v -> App (App (Var f) (Type ty)) (Var v))++caseRules _ _ = Nothing+++tx_lit_con :: DynFlags -> (Integer -> Integer) -> AltCon -> Maybe AltCon+tx_lit_con _      _      DEFAULT    = Just DEFAULT+tx_lit_con dflags adjust (LitAlt l) = Just $ LitAlt (mapLitValue dflags adjust l)+tx_lit_con _      _      alt        = pprPanic "caseRules" (ppr alt)+   -- NB: mapLitValue uses mkLitIntWrap etc, to ensure that the+   -- literal alternatives remain in Word/Int target ranges+   -- (See Note [Word/Int underflow/overflow] in Literal and #13172).++adjustDyadicRight :: PrimOp -> Integer -> Maybe (Integer -> Integer)+-- Given (x `op` lit) return a function 'f' s.t.  f (x `op` lit) = x+adjustDyadicRight op lit+  = case op of+         WordAddOp -> Just (\y -> y-lit      )+         IntAddOp  -> Just (\y -> y-lit      )+         WordSubOp -> Just (\y -> y+lit      )+         IntSubOp  -> Just (\y -> y+lit      )+         XorOp     -> Just (\y -> y `xor` lit)+         XorIOp    -> Just (\y -> y `xor` lit)+         _         -> Nothing++adjustDyadicLeft :: Integer -> PrimOp -> Maybe (Integer -> Integer)+-- Given (lit `op` x) return a function 'f' s.t.  f (lit `op` x) = x+adjustDyadicLeft lit op+  = case op of+         WordAddOp -> Just (\y -> y-lit      )+         IntAddOp  -> Just (\y -> y-lit      )+         WordSubOp -> Just (\y -> lit-y      )+         IntSubOp  -> Just (\y -> lit-y      )+         XorOp     -> Just (\y -> y `xor` lit)+         XorIOp    -> Just (\y -> y `xor` lit)+         _         -> Nothing+++adjustUnary :: PrimOp -> Maybe (Integer -> Integer)+-- Given (op x) return a function 'f' s.t.  f (op x) = x+adjustUnary op+  = case op of+         NotOp     -> Just (\y -> complement y)+         NotIOp    -> Just (\y -> complement y)+         IntNegOp  -> Just (\y -> negate y    )+         _         -> Nothing++tx_con_tte :: DynFlags -> AltCon -> Maybe AltCon+tx_con_tte _      DEFAULT         = Just DEFAULT+tx_con_tte _      alt@(LitAlt {}) = pprPanic "caseRules" (ppr alt)+tx_con_tte dflags (DataAlt dc)  -- See Note [caseRules for tagToEnum]+  = Just $ LitAlt $ mkLitInt dflags $ toInteger $ dataConTagZ dc++tx_con_dtt :: Type -> AltCon -> Maybe AltCon+tx_con_dtt _  DEFAULT = Just DEFAULT+tx_con_dtt ty (LitAlt (LitNumber LitNumInt i _))+   | tag >= 0+   , tag < n_data_cons+   = Just (DataAlt (data_cons !! tag))   -- tag is zero-indexed, as is (!!)+   | otherwise+   = Nothing+   where+     tag         = fromInteger i :: ConTagZ+     tc          = tyConAppTyCon ty+     n_data_cons = tyConFamilySize tc+     data_cons   = tyConDataCons tc++tx_con_dtt _ alt = pprPanic "caseRules" (ppr alt)+++{- Note [caseRules for tagToEnum]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We want to transform+   case tagToEnum x of+     False -> e1+     True  -> e2+into+   case x of+     0# -> e1+     1# -> e2++This rule eliminates a lot of boilerplate. For+  if (x>y) then e2 else e1+we generate+  case tagToEnum (x ># y) of+    False -> e1+    True  -> e2+and it is nice to then get rid of the tagToEnum.++Beware (#14768): avoid the temptation to map constructor 0 to+DEFAULT, in the hope of getting this+  case (x ># y) of+    DEFAULT -> e1+    1#      -> e2+That fails utterly in the case of+   data Colour = Red | Green | Blue+   case tagToEnum x of+      DEFAULT -> e1+      Red     -> e2++We don't want to get this!+   case x of+      DEFAULT -> e1+      DEFAULT -> e2++Instead, we deal with turning one branch into DEFAULT in SimplUtils+(add_default in mkCase3).++Note [caseRules for dataToTag]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+See also Note [dataToTag#] in primpops.txt.pp++We want to transform+  case dataToTag x of+    DEFAULT -> e1+    1# -> e2+into+  case x of+    DEFAULT -> e1+    (:) _ _ -> e2++Note the need for some wildcard binders in+the 'cons' case.++For the time, we only apply this transformation when the type of `x` is a type+headed by a normal tycon. In particular, we do not apply this in the case of a+data family tycon, since that would require carefully applying coercion(s)+between the data family and the data family instance's representation type,+which caseRules isn't currently engineered to handle (#14680).++Note [Unreachable caseRules alternatives]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Take care if we see something like+  case dataToTag x of+    DEFAULT -> e1+    -1# -> e2+    100 -> e3+because there isn't a data constructor with tag -1 or 100. In this case the+out-of-range alterantive is dead code -- we know the range of tags for x.++Hence caseRules returns (AltCon -> Maybe AltCon), with Nothing indicating+an alternative that is unreachable.++You may wonder how this can happen: check out #15436.+-}
+ compiler/prelude/PrimOp.hs view
@@ -0,0 +1,633 @@+{-+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[PrimOp]{Primitive operations (machine-level)}+-}++{-# LANGUAGE CPP #-}++-- The default is a bit too low for the quite large primOpInfo definition+{-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-}++module PrimOp (+        PrimOp(..), PrimOpVecCat(..), allThePrimOps,+        primOpType, primOpSig,+        primOpTag, maxPrimOpTag, primOpOcc,++        tagToEnumKey,++        primOpOutOfLine, primOpCodeSize,+        primOpOkForSpeculation, primOpOkForSideEffects,+        primOpIsCheap, primOpFixity,++        getPrimOpResultInfo,  isComparisonPrimOp, PrimOpResultInfo(..),++        PrimCall(..)+    ) where++#include "HsVersions.h"++import GhcPrelude++import TysPrim+import TysWiredIn++import CmmType+import Demand+import OccName          ( OccName, pprOccName, mkVarOccFS )+import TyCon            ( TyCon, isPrimTyCon, PrimRep(..) )+import Type+import RepType          ( typePrimRep1, tyConPrimRep1 )+import BasicTypes       ( Arity, Fixity(..), FixityDirection(..), Boxity(..),+                          SourceText(..) )+import ForeignCall      ( CLabelString )+import Unique           ( Unique, mkPrimOpIdUnique )+import Outputable+import FastString+import Module           ( UnitId )++{-+************************************************************************+*                                                                      *+\subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}+*                                                                      *+************************************************************************++These are in \tr{state-interface.verb} order.+-}++-- supplies:+-- data PrimOp = ...+#include "primop-data-decl.hs-incl"++-- supplies+-- primOpTag :: PrimOp -> Int+#include "primop-tag.hs-incl"+primOpTag _ = error "primOpTag: unknown primop"+++instance Eq PrimOp where+    op1 == op2 = primOpTag op1 == primOpTag op2++instance Ord PrimOp where+    op1 <  op2 =  primOpTag op1 < primOpTag op2+    op1 <= op2 =  primOpTag op1 <= primOpTag op2+    op1 >= op2 =  primOpTag op1 >= primOpTag op2+    op1 >  op2 =  primOpTag op1 > primOpTag op2+    op1 `compare` op2 | op1 < op2  = LT+                      | op1 == op2 = EQ+                      | otherwise  = GT++instance Outputable PrimOp where+    ppr op = pprPrimOp op++data PrimOpVecCat = IntVec+                  | WordVec+                  | FloatVec++-- An @Enum@-derived list would be better; meanwhile... (ToDo)++allThePrimOps :: [PrimOp]+allThePrimOps =+#include "primop-list.hs-incl"++tagToEnumKey :: Unique+tagToEnumKey = mkPrimOpIdUnique (primOpTag TagToEnumOp)++{-+************************************************************************+*                                                                      *+\subsection[PrimOp-info]{The essential info about each @PrimOp@}+*                                                                      *+************************************************************************++The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may+refer to the primitive operation.  The conventional \tr{#}-for-+unboxed ops is added on later.++The reason for the funny characters in the names is so we do not+interfere with the programmer's Haskell name spaces.++We use @PrimKinds@ for the ``type'' information, because they're+(slightly) more convenient to use than @TyCons@.+-}++data PrimOpInfo+  = Dyadic      OccName         -- string :: T -> T -> T+                Type+  | Monadic     OccName         -- string :: T -> T+                Type+  | Compare     OccName         -- string :: T -> T -> Int#+                Type+  | GenPrimOp   OccName         -- string :: \/a1..an . T1 -> .. -> Tk -> T+                [TyVar]+                [Type]+                Type++mkDyadic, mkMonadic, mkCompare :: FastString -> Type -> PrimOpInfo+mkDyadic str  ty = Dyadic  (mkVarOccFS str) ty+mkMonadic str ty = Monadic (mkVarOccFS str) ty+mkCompare str ty = Compare (mkVarOccFS str) ty++mkGenPrimOp :: FastString -> [TyVar] -> [Type] -> Type -> PrimOpInfo+mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty++{-+************************************************************************+*                                                                      *+\subsubsection{Strictness}+*                                                                      *+************************************************************************++Not all primops are strict!+-}++primOpStrictness :: PrimOp -> Arity -> StrictSig+        -- See Demand.StrictnessInfo for discussion of what the results+        -- The arity should be the arity of the primop; that's why+        -- this function isn't exported.+#include "primop-strictness.hs-incl"++{-+************************************************************************+*                                                                      *+\subsubsection{Fixity}+*                                                                      *+************************************************************************+-}++primOpFixity :: PrimOp -> Maybe Fixity+#include "primop-fixity.hs-incl"++{-+************************************************************************+*                                                                      *+\subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}+*                                                                      *+************************************************************************++@primOpInfo@ gives all essential information (from which everything+else, notably a type, can be constructed) for each @PrimOp@.+-}++primOpInfo :: PrimOp -> PrimOpInfo+#include "primop-primop-info.hs-incl"+primOpInfo _ = error "primOpInfo: unknown primop"++{-+Here are a load of comments from the old primOp info:++A @Word#@ is an unsigned @Int#@.++@decodeFloat#@ is given w/ Integer-stuff (it's similar).++@decodeDouble#@ is given w/ Integer-stuff (it's similar).++Decoding of floating-point numbers is sorta Integer-related.  Encoding+is done with plain ccalls now (see PrelNumExtra.hs).++A @Weak@ Pointer is created by the @mkWeak#@ primitive:++        mkWeak# :: k -> v -> f -> State# RealWorld+                        -> (# State# RealWorld, Weak# v #)++In practice, you'll use the higher-level++        data Weak v = Weak# v+        mkWeak :: k -> v -> IO () -> IO (Weak v)++The following operation dereferences a weak pointer.  The weak pointer+may have been finalized, so the operation returns a result code which+must be inspected before looking at the dereferenced value.++        deRefWeak# :: Weak# v -> State# RealWorld ->+                        (# State# RealWorld, v, Int# #)++Only look at v if the Int# returned is /= 0 !!++The higher-level op is++        deRefWeak :: Weak v -> IO (Maybe v)++Weak pointers can be finalized early by using the finalize# operation:++        finalizeWeak# :: Weak# v -> State# RealWorld ->+                           (# State# RealWorld, Int#, IO () #)++The Int# returned is either++        0 if the weak pointer has already been finalized, or it has no+          finalizer (the third component is then invalid).++        1 if the weak pointer is still alive, with the finalizer returned+          as the third component.++A {\em stable name/pointer} is an index into a table of stable name+entries.  Since the garbage collector is told about stable pointers,+it is safe to pass a stable pointer to external systems such as C+routines.++\begin{verbatim}+makeStablePtr#  :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)+freeStablePtr   :: StablePtr# a -> State# RealWorld -> State# RealWorld+deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)+eqStablePtr#    :: StablePtr# a -> StablePtr# a -> Int#+\end{verbatim}++It may seem a bit surprising that @makeStablePtr#@ is a @IO@+operation since it doesn't (directly) involve IO operations.  The+reason is that if some optimisation pass decided to duplicate calls to+@makeStablePtr#@ and we only pass one of the stable pointers over, a+massive space leak can result.  Putting it into the IO monad+prevents this.  (Another reason for putting them in a monad is to+ensure correct sequencing wrt the side-effecting @freeStablePtr@+operation.)++An important property of stable pointers is that if you call+makeStablePtr# twice on the same object you get the same stable+pointer back.++Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,+besides, it's not likely to be used from Haskell) so it's not a+primop.++Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]++Stable Names+~~~~~~~~~~~~++A stable name is like a stable pointer, but with three important differences:++        (a) You can't deRef one to get back to the original object.+        (b) You can convert one to an Int.+        (c) You don't need to 'freeStableName'++The existence of a stable name doesn't guarantee to keep the object it+points to alive (unlike a stable pointer), hence (a).++Invariants:++        (a) makeStableName always returns the same value for a given+            object (same as stable pointers).++        (b) if two stable names are equal, it implies that the objects+            from which they were created were the same.++        (c) stableNameToInt always returns the same Int for a given+            stable name.+++These primops are pretty weird.++        tagToEnum# :: Int -> a    (result type must be an enumerated type)++The constraints aren't currently checked by the front end, but the+code generator will fall over if they aren't satisfied.++************************************************************************+*                                                                      *+            Which PrimOps are out-of-line+*                                                                      *+************************************************************************++Some PrimOps need to be called out-of-line because they either need to+perform a heap check or they block.+-}++primOpOutOfLine :: PrimOp -> Bool+#include "primop-out-of-line.hs-incl"++{-+************************************************************************+*                                                                      *+            Failure and side effects+*                                                                      *+************************************************************************++Note [PrimOp can_fail and has_side_effects]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Both can_fail and has_side_effects mean that the primop has+some effect that is not captured entirely by its result value.++----------  has_side_effects ---------------------+A primop "has_side_effects" if it has some *write* effect, visible+elsewhere+    - writing to the world (I/O)+    - writing to a mutable data structure (writeIORef)+    - throwing a synchronous Haskell exception++Often such primops have a type like+   State -> input -> (State, output)+so the state token guarantees ordering.  In general we rely *only* on+data dependencies of the state token to enforce write-effect ordering++ * NB1: if you inline unsafePerformIO, you may end up with+   side-effecting ops whose 'state' output is discarded.+   And programmers may do that by hand; see #9390.+   That is why we (conservatively) do not discard write-effecting+   primops even if both their state and result is discarded.++ * NB2: We consider primops, such as raiseIO#, that can raise a+   (Haskell) synchronous exception to "have_side_effects" but not+   "can_fail".  We must be careful about not discarding such things;+   see the paper "A semantics for imprecise exceptions".++ * NB3: *Read* effects (like reading an IORef) don't count here,+   because it doesn't matter if we don't do them, or do them more than+   once.  *Sequencing* is maintained by the data dependency of the state+   token.++----------  can_fail ----------------------------+A primop "can_fail" if it can fail with an *unchecked* exception on+some elements of its input domain. Main examples:+   division (fails on zero demoninator)+   array indexing (fails if the index is out of bounds)++An "unchecked exception" is one that is an outright error, (not+turned into a Haskell exception,) such as seg-fault or+divide-by-zero error.  Such can_fail primops are ALWAYS surrounded+with a test that checks for the bad cases, but we need to be+very careful about code motion that might move it out of+the scope of the test.++Note [Transformations affected by can_fail and has_side_effects]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The can_fail and has_side_effects properties have the following effect+on program transformations.  Summary table is followed by details.++            can_fail     has_side_effects+Discard        YES           NO+Float in       YES           YES+Float out      NO            NO+Duplicate      YES           NO++* Discarding.   case (a `op` b) of _ -> rhs  ===>   rhs+  You should not discard a has_side_effects primop; e.g.+     case (writeIntArray# a i v s of (# _, _ #) -> True+  Arguably you should be able to discard this, since the+  returned stat token is not used, but that relies on NEVER+  inlining unsafePerformIO, and programmers sometimes write+  this kind of stuff by hand (#9390).  So we (conservatively)+  never discard a has_side_effects primop.++  However, it's fine to discard a can_fail primop.  For example+     case (indexIntArray# a i) of _ -> True+  We can discard indexIntArray#; it has can_fail, but not+  has_side_effects; see #5658 which was all about this.+  Notice that indexIntArray# is (in a more general handling of+  effects) read effect, but we don't care about that here, and+  treat read effects as *not* has_side_effects.++  Similarly (a `/#` b) can be discarded.  It can seg-fault or+  cause a hardware exception, but not a synchronous Haskell+  exception.++++  Synchronous Haskell exceptions, e.g. from raiseIO#, are treated+  as has_side_effects and hence are not discarded.++* Float in.  You can float a can_fail or has_side_effects primop+  *inwards*, but not inside a lambda (see Duplication below).++* Float out.  You must not float a can_fail primop *outwards* lest+  you escape the dynamic scope of the test.  Example:+      case d ># 0# of+        True  -> case x /# d of r -> r +# 1+        False -> 0+  Here we must not float the case outwards to give+      case x/# d of r ->+      case d ># 0# of+        True  -> r +# 1+        False -> 0++  Nor can you float out a has_side_effects primop.  For example:+       if blah then case writeMutVar# v True s0 of (# s1 #) -> s1+               else s0+  Notice that s0 is mentioned in both branches of the 'if', but+  only one of these two will actually be consumed.  But if we+  float out to+      case writeMutVar# v True s0 of (# s1 #) ->+      if blah then s1 else s0+  the writeMutVar will be performed in both branches, which is+  utterly wrong.++* Duplication.  You cannot duplicate a has_side_effect primop.  You+  might wonder how this can occur given the state token threading, but+  just look at Control.Monad.ST.Lazy.Imp.strictToLazy!  We get+  something like this+        p = case readMutVar# s v of+              (# s', r #) -> (S# s', r)+        s' = case p of (s', r) -> s'+        r  = case p of (s', r) -> r++  (All these bindings are boxed.)  If we inline p at its two call+  sites, we get a catastrophe: because the read is performed once when+  s' is demanded, and once when 'r' is demanded, which may be much+  later.  Utterly wrong.  #3207 is real example of this happening.++  However, it's fine to duplicate a can_fail primop.  That is really+  the only difference between can_fail and has_side_effects.++Note [Implementation: how can_fail/has_side_effects affect transformations]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+How do we ensure that that floating/duplication/discarding are done right+in the simplifier?++Two main predicates on primpops test these flags:+  primOpOkForSideEffects <=> not has_side_effects+  primOpOkForSpeculation <=> not (has_side_effects || can_fail)++  * The "no-float-out" thing is achieved by ensuring that we never+    let-bind a can_fail or has_side_effects primop.  The RHS of a+    let-binding (which can float in and out freely) satisfies+    exprOkForSpeculation; this is the let/app invariant.  And+    exprOkForSpeculation is false of can_fail and has_side_effects.++  * So can_fail and has_side_effects primops will appear only as the+    scrutinees of cases, and that's why the FloatIn pass is capable+    of floating case bindings inwards.++  * The no-duplicate thing is done via primOpIsCheap, by making+    has_side_effects things (very very very) not-cheap!+-}++primOpHasSideEffects :: PrimOp -> Bool+#include "primop-has-side-effects.hs-incl"++primOpCanFail :: PrimOp -> Bool+#include "primop-can-fail.hs-incl"++primOpOkForSpeculation :: PrimOp -> Bool+  -- See Note [PrimOp can_fail and has_side_effects]+  -- See comments with CoreUtils.exprOkForSpeculation+  -- primOpOkForSpeculation => primOpOkForSideEffects+primOpOkForSpeculation op+  =  primOpOkForSideEffects op+  && not (primOpOutOfLine op || primOpCanFail op)+    -- I think the "out of line" test is because out of line things can+    -- be expensive (eg sine, cosine), and so we may not want to speculate them++primOpOkForSideEffects :: PrimOp -> Bool+primOpOkForSideEffects op+  = not (primOpHasSideEffects op)++{-+Note [primOpIsCheap]+~~~~~~~~~~~~~~~~~~~~+@primOpIsCheap@, as used in \tr{SimplUtils.hs}.  For now (HACK+WARNING), we just borrow some other predicates for a+what-should-be-good-enough test.  "Cheap" means willing to call it more+than once, and/or push it inside a lambda.  The latter could change the+behaviour of 'seq' for primops that can fail, so we don't treat them as cheap.+-}++primOpIsCheap :: PrimOp -> Bool+-- See Note [PrimOp can_fail and has_side_effects]+primOpIsCheap op = primOpOkForSpeculation op+-- In March 2001, we changed this to+--      primOpIsCheap op = False+-- thereby making *no* primops seem cheap.  But this killed eta+-- expansion on case (x ==# y) of True -> \s -> ...+-- which is bad.  In particular a loop like+--      doLoop n = loop 0+--     where+--         loop i | i == n    = return ()+--                | otherwise = bar i >> loop (i+1)+-- allocated a closure every time round because it doesn't eta expand.+--+-- The problem that originally gave rise to the change was+--      let x = a +# b *# c in x +# x+-- were we don't want to inline x. But primopIsCheap doesn't control+-- that (it's exprIsDupable that does) so the problem doesn't occur+-- even if primOpIsCheap sometimes says 'True'.++{-+************************************************************************+*                                                                      *+               PrimOp code size+*                                                                      *+************************************************************************++primOpCodeSize+~~~~~~~~~~~~~~+Gives an indication of the code size of a primop, for the purposes of+calculating unfolding sizes; see CoreUnfold.sizeExpr.+-}++primOpCodeSize :: PrimOp -> Int+#include "primop-code-size.hs-incl"++primOpCodeSizeDefault :: Int+primOpCodeSizeDefault = 1+  -- CoreUnfold.primOpSize already takes into account primOpOutOfLine+  -- and adds some further costs for the args in that case.++primOpCodeSizeForeignCall :: Int+primOpCodeSizeForeignCall = 4++{-+************************************************************************+*                                                                      *+               PrimOp types+*                                                                      *+************************************************************************+-}++primOpType :: PrimOp -> Type  -- you may want to use primOpSig instead+primOpType op+  = case primOpInfo op of+    Dyadic  _occ ty -> dyadic_fun_ty ty+    Monadic _occ ty -> monadic_fun_ty ty+    Compare _occ ty -> compare_fun_ty ty++    GenPrimOp _occ tyvars arg_tys res_ty ->+        mkSpecForAllTys tyvars (mkVisFunTys arg_tys res_ty)++primOpOcc :: PrimOp -> OccName+primOpOcc op = case primOpInfo op of+               Dyadic    occ _     -> occ+               Monadic   occ _     -> occ+               Compare   occ _     -> occ+               GenPrimOp occ _ _ _ -> occ++isComparisonPrimOp :: PrimOp -> Bool+isComparisonPrimOp op = case primOpInfo op of+                          Compare {} -> True+                          _          -> False++-- primOpSig is like primOpType but gives the result split apart:+-- (type variables, argument types, result type)+-- It also gives arity, strictness info++primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictSig)+primOpSig op+  = (tyvars, arg_tys, res_ty, arity, primOpStrictness op arity)+  where+    arity = length arg_tys+    (tyvars, arg_tys, res_ty)+      = case (primOpInfo op) of+        Monadic   _occ ty                    -> ([],     [ty],    ty       )+        Dyadic    _occ ty                    -> ([],     [ty,ty], ty       )+        Compare   _occ ty                    -> ([],     [ty,ty], intPrimTy)+        GenPrimOp _occ tyvars arg_tys res_ty -> (tyvars, arg_tys, res_ty   )++data PrimOpResultInfo+  = ReturnsPrim     PrimRep+  | ReturnsAlg      TyCon++-- Some PrimOps need not return a manifest primitive or algebraic value+-- (i.e. they might return a polymorphic value).  These PrimOps *must*+-- be out of line, or the code generator won't work.++getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo+getPrimOpResultInfo op+  = case (primOpInfo op) of+      Dyadic  _ ty                        -> ReturnsPrim (typePrimRep1 ty)+      Monadic _ ty                        -> ReturnsPrim (typePrimRep1 ty)+      Compare _ _                         -> ReturnsPrim (tyConPrimRep1 intPrimTyCon)+      GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep1 tc)+                         | otherwise      -> ReturnsAlg tc+                         where+                           tc = tyConAppTyCon ty+                        -- All primops return a tycon-app result+                        -- The tycon can be an unboxed tuple or sum, though,+                        -- which gives rise to a ReturnAlg++{-+We do not currently make use of whether primops are commutable.++We used to try to move constants to the right hand side for strength+reduction.+-}++{-+commutableOp :: PrimOp -> Bool+#include "primop-commutable.hs-incl"+-}++-- Utils:++dyadic_fun_ty, monadic_fun_ty, compare_fun_ty :: Type -> Type+dyadic_fun_ty  ty = mkVisFunTys [ty, ty] ty+monadic_fun_ty ty = mkVisFunTy  ty ty+compare_fun_ty ty = mkVisFunTys [ty, ty] intPrimTy++-- Output stuff:++pprPrimOp  :: PrimOp -> SDoc+pprPrimOp other_op = pprOccName (primOpOcc other_op)++{-+************************************************************************+*                                                                      *+\subsubsection[PrimCall]{User-imported primitive calls}+*                                                                      *+************************************************************************+-}++data PrimCall = PrimCall CLabelString UnitId++instance Outputable PrimCall where+  ppr (PrimCall lbl pkgId)+        = text "__primcall" <+> ppr pkgId <+> ppr lbl
+ compiler/prelude/PrimOp.hs-boot view
@@ -0,0 +1,5 @@+module PrimOp where++import GhcPrelude ()++data PrimOp
+ compiler/prelude/TysPrim.hs view
@@ -0,0 +1,1077 @@+{-+(c) The AQUA Project, Glasgow University, 1994-1998+++\section[TysPrim]{Wired-in knowledge about primitive types}+-}++{-# LANGUAGE CPP #-}++-- | This module defines TyCons that can't be expressed in Haskell.+--   They are all, therefore, wired-in TyCons.  C.f module TysWiredIn+module TysPrim(+        mkPrimTyConName, -- For implicit parameters in TysWiredIn only++        mkTemplateKindVars, mkTemplateTyVars, mkTemplateTyVarsFrom,+        mkTemplateKiTyVars,++        mkTemplateTyConBinders, mkTemplateKindTyConBinders,+        mkTemplateAnonTyConBinders,++        alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,+        alphaTys, alphaTy, betaTy, gammaTy, deltaTy,+        alphaTyVarsUnliftedRep, alphaTyVarUnliftedRep,+        alphaTysUnliftedRep, alphaTyUnliftedRep,+        runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep1Ty, runtimeRep2Ty,+        openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar,++        -- Kind constructors...+        tYPETyCon, tYPETyConName,++        -- Kinds+        tYPE, primRepToRuntimeRep,++        funTyCon, funTyConName,+        unexposedPrimTyCons, exposedPrimTyCons, primTyCons,++        charPrimTyCon,          charPrimTy, charPrimTyConName,+        intPrimTyCon,           intPrimTy, intPrimTyConName,+        wordPrimTyCon,          wordPrimTy, wordPrimTyConName,+        addrPrimTyCon,          addrPrimTy, addrPrimTyConName,+        floatPrimTyCon,         floatPrimTy, floatPrimTyConName,+        doublePrimTyCon,        doublePrimTy, doublePrimTyConName,++        voidPrimTyCon,          voidPrimTy,+        statePrimTyCon,         mkStatePrimTy,+        realWorldTyCon,         realWorldTy, realWorldStatePrimTy,++        proxyPrimTyCon,         mkProxyPrimTy,++        arrayPrimTyCon, mkArrayPrimTy,+        byteArrayPrimTyCon,     byteArrayPrimTy,+        arrayArrayPrimTyCon, mkArrayArrayPrimTy,+        smallArrayPrimTyCon, mkSmallArrayPrimTy,+        mutableArrayPrimTyCon, mkMutableArrayPrimTy,+        mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy,+        mutableArrayArrayPrimTyCon, mkMutableArrayArrayPrimTy,+        smallMutableArrayPrimTyCon, mkSmallMutableArrayPrimTy,+        mutVarPrimTyCon, mkMutVarPrimTy,++        mVarPrimTyCon,                  mkMVarPrimTy,+        tVarPrimTyCon,                  mkTVarPrimTy,+        stablePtrPrimTyCon,             mkStablePtrPrimTy,+        stableNamePrimTyCon,            mkStableNamePrimTy,+        compactPrimTyCon,               compactPrimTy,+        bcoPrimTyCon,                   bcoPrimTy,+        weakPrimTyCon,                  mkWeakPrimTy,+        threadIdPrimTyCon,              threadIdPrimTy,++        int8PrimTyCon,          int8PrimTy, int8PrimTyConName,+        word8PrimTyCon,         word8PrimTy, word8PrimTyConName,++        int16PrimTyCon,         int16PrimTy, int16PrimTyConName,+        word16PrimTyCon,        word16PrimTy, word16PrimTyConName,++        int32PrimTyCon,         int32PrimTy, int32PrimTyConName,+        word32PrimTyCon,        word32PrimTy, word32PrimTyConName,++        int64PrimTyCon,         int64PrimTy, int64PrimTyConName,+        word64PrimTyCon,        word64PrimTy, word64PrimTyConName,++        eqPrimTyCon,            -- ty1 ~# ty2+        eqReprPrimTyCon,        -- ty1 ~R# ty2  (at role Representational)+        eqPhantPrimTyCon,       -- ty1 ~P# ty2  (at role Phantom)++        -- * SIMD+#include "primop-vector-tys-exports.hs-incl"+  ) where++#include "HsVersions.h"++import GhcPrelude++import {-# SOURCE #-} TysWiredIn+  ( runtimeRepTy, unboxedTupleKind, liftedTypeKind+  , vecRepDataConTyCon, tupleRepDataConTyCon+  , liftedRepDataConTy, unliftedRepDataConTy, intRepDataConTy, int8RepDataConTy+  , int16RepDataConTy, word16RepDataConTy+  , wordRepDataConTy, int64RepDataConTy, word8RepDataConTy, word64RepDataConTy+  , addrRepDataConTy+  , floatRepDataConTy, doubleRepDataConTy+  , vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy+  , vec64DataConTy+  , int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy+  , int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy+  , word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy+  , doubleElemRepDataConTy+  , mkPromotedListTy )++import Var              ( TyVar, mkTyVar )+import Name+import TyCon+import SrcLoc+import Unique+import PrelNames+import FastString+import Outputable+import TyCoRep   -- Doesn't need special access, but this is easier to avoid+                 -- import loops which show up if you import Type instead++import Data.Char++{-+************************************************************************+*                                                                      *+\subsection{Primitive type constructors}+*                                                                      *+************************************************************************+-}++primTyCons :: [TyCon]+primTyCons = unexposedPrimTyCons ++ exposedPrimTyCons++-- | Primitive 'TyCon's that are defined in "GHC.Prim" but not exposed.+-- It's important to keep these separate as we don't want users to be able to+-- write them (see #15209) or see them in GHCi's @:browse@ output+-- (see #12023).+unexposedPrimTyCons :: [TyCon]+unexposedPrimTyCons+  = [ eqPrimTyCon+    , eqReprPrimTyCon+    , eqPhantPrimTyCon+    ]++-- | Primitive 'TyCon's that are defined in, and exported from, "GHC.Prim".+exposedPrimTyCons :: [TyCon]+exposedPrimTyCons+  = [ addrPrimTyCon+    , arrayPrimTyCon+    , byteArrayPrimTyCon+    , arrayArrayPrimTyCon+    , smallArrayPrimTyCon+    , charPrimTyCon+    , doublePrimTyCon+    , floatPrimTyCon+    , intPrimTyCon+    , int8PrimTyCon+    , int16PrimTyCon+    , int32PrimTyCon+    , int64PrimTyCon+    , bcoPrimTyCon+    , weakPrimTyCon+    , mutableArrayPrimTyCon+    , mutableByteArrayPrimTyCon+    , mutableArrayArrayPrimTyCon+    , smallMutableArrayPrimTyCon+    , mVarPrimTyCon+    , tVarPrimTyCon+    , mutVarPrimTyCon+    , realWorldTyCon+    , stablePtrPrimTyCon+    , stableNamePrimTyCon+    , compactPrimTyCon+    , statePrimTyCon+    , voidPrimTyCon+    , proxyPrimTyCon+    , threadIdPrimTyCon+    , wordPrimTyCon+    , word8PrimTyCon+    , word16PrimTyCon+    , word32PrimTyCon+    , word64PrimTyCon++    , tYPETyCon++#include "primop-vector-tycons.hs-incl"+    ]++mkPrimTc :: FastString -> Unique -> TyCon -> Name+mkPrimTc fs unique tycon+  = mkWiredInName gHC_PRIM (mkTcOccFS fs)+                  unique+                  (ATyCon tycon)        -- Relevant TyCon+                  UserSyntax++mkBuiltInPrimTc :: FastString -> Unique -> TyCon -> Name+mkBuiltInPrimTc fs unique tycon+  = mkWiredInName gHC_PRIM (mkTcOccFS fs)+                  unique+                  (ATyCon tycon)        -- Relevant TyCon+                  BuiltInSyntax+++charPrimTyConName, intPrimTyConName, int8PrimTyConName, int16PrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word8PrimTyConName, word16PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName, voidPrimTyConName :: Name+charPrimTyConName             = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon+intPrimTyConName              = mkPrimTc (fsLit "Int#") intPrimTyConKey  intPrimTyCon+int8PrimTyConName             = mkPrimTc (fsLit "Int8#") int8PrimTyConKey int8PrimTyCon+int16PrimTyConName            = mkPrimTc (fsLit "Int16#") int16PrimTyConKey int16PrimTyCon+int32PrimTyConName            = mkPrimTc (fsLit "Int32#") int32PrimTyConKey int32PrimTyCon+int64PrimTyConName            = mkPrimTc (fsLit "Int64#") int64PrimTyConKey int64PrimTyCon+wordPrimTyConName             = mkPrimTc (fsLit "Word#") wordPrimTyConKey wordPrimTyCon+word8PrimTyConName            = mkPrimTc (fsLit "Word8#") word8PrimTyConKey word8PrimTyCon+word16PrimTyConName           = mkPrimTc (fsLit "Word16#") word16PrimTyConKey word16PrimTyCon+word32PrimTyConName           = mkPrimTc (fsLit "Word32#") word32PrimTyConKey word32PrimTyCon+word64PrimTyConName           = mkPrimTc (fsLit "Word64#") word64PrimTyConKey word64PrimTyCon+addrPrimTyConName             = mkPrimTc (fsLit "Addr#") addrPrimTyConKey addrPrimTyCon+floatPrimTyConName            = mkPrimTc (fsLit "Float#") floatPrimTyConKey floatPrimTyCon+doublePrimTyConName           = mkPrimTc (fsLit "Double#") doublePrimTyConKey doublePrimTyCon+statePrimTyConName            = mkPrimTc (fsLit "State#") statePrimTyConKey statePrimTyCon+voidPrimTyConName             = mkPrimTc (fsLit "Void#") voidPrimTyConKey voidPrimTyCon+proxyPrimTyConName            = mkPrimTc (fsLit "Proxy#") proxyPrimTyConKey proxyPrimTyCon+eqPrimTyConName               = mkPrimTc (fsLit "~#") eqPrimTyConKey eqPrimTyCon+eqReprPrimTyConName           = mkBuiltInPrimTc (fsLit "~R#") eqReprPrimTyConKey eqReprPrimTyCon+eqPhantPrimTyConName          = mkBuiltInPrimTc (fsLit "~P#") eqPhantPrimTyConKey eqPhantPrimTyCon+realWorldTyConName            = mkPrimTc (fsLit "RealWorld") realWorldTyConKey realWorldTyCon+arrayPrimTyConName            = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon+byteArrayPrimTyConName        = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon+arrayArrayPrimTyConName           = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon+smallArrayPrimTyConName       = mkPrimTc (fsLit "SmallArray#") smallArrayPrimTyConKey smallArrayPrimTyCon+mutableArrayPrimTyConName     = mkPrimTc (fsLit "MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon+mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon+mutableArrayArrayPrimTyConName= mkPrimTc (fsLit "MutableArrayArray#") mutableArrayArrayPrimTyConKey mutableArrayArrayPrimTyCon+smallMutableArrayPrimTyConName= mkPrimTc (fsLit "SmallMutableArray#") smallMutableArrayPrimTyConKey smallMutableArrayPrimTyCon+mutVarPrimTyConName           = mkPrimTc (fsLit "MutVar#") mutVarPrimTyConKey mutVarPrimTyCon+mVarPrimTyConName             = mkPrimTc (fsLit "MVar#") mVarPrimTyConKey mVarPrimTyCon+tVarPrimTyConName             = mkPrimTc (fsLit "TVar#") tVarPrimTyConKey tVarPrimTyCon+stablePtrPrimTyConName        = mkPrimTc (fsLit "StablePtr#") stablePtrPrimTyConKey stablePtrPrimTyCon+stableNamePrimTyConName       = mkPrimTc (fsLit "StableName#") stableNamePrimTyConKey stableNamePrimTyCon+compactPrimTyConName          = mkPrimTc (fsLit "Compact#") compactPrimTyConKey compactPrimTyCon+bcoPrimTyConName              = mkPrimTc (fsLit "BCO#") bcoPrimTyConKey bcoPrimTyCon+weakPrimTyConName             = mkPrimTc (fsLit "Weak#") weakPrimTyConKey weakPrimTyCon+threadIdPrimTyConName         = mkPrimTc (fsLit "ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon++{-+************************************************************************+*                                                                      *+\subsection{Support code}+*                                                                      *+************************************************************************++alphaTyVars is a list of type variables for use in templates:+        ["a", "b", ..., "z", "t1", "t2", ... ]+-}++mkTemplateKindVars :: [Kind] -> [TyVar]+-- k0  with unique (mkAlphaTyVarUnique 0)+-- k1  with unique (mkAlphaTyVarUnique 1)+-- ... etc+mkTemplateKindVars [kind]+  = [mkTyVar (mk_tv_name 0 "k") kind]+    -- Special case for one kind: just "k"++mkTemplateKindVars kinds+  = [ mkTyVar (mk_tv_name u ('k' : show u)) kind+    | (kind, u) <- kinds `zip` [0..] ]+mk_tv_name :: Int -> String -> Name+mk_tv_name u s = mkInternalName (mkAlphaTyVarUnique u)+                                (mkTyVarOccFS (mkFastString s))+                                noSrcSpan++mkTemplateTyVarsFrom :: Int -> [Kind] -> [TyVar]+-- a  with unique (mkAlphaTyVarUnique n)+-- b  with unique (mkAlphaTyVarUnique n+1)+-- ... etc+-- Typically called as+--   mkTemplateTyVarsFrom (length kv_bndrs) kinds+-- where kv_bndrs are the kind-level binders of a TyCon+mkTemplateTyVarsFrom n kinds+  = [ mkTyVar name kind+    | (kind, index) <- zip kinds [0..],+      let ch_ord = index + ord 'a'+          name_str | ch_ord <= ord 'z' = [chr ch_ord]+                   | otherwise         = 't':show index+          name = mk_tv_name (index + n) name_str+    ]++mkTemplateTyVars :: [Kind] -> [TyVar]+mkTemplateTyVars = mkTemplateTyVarsFrom 1++mkTemplateTyConBinders+    :: [Kind]                -- [k1, .., kn]   Kinds of kind-forall'd vars+    -> ([Kind] -> [Kind])    -- Arg is [kv1:k1, ..., kvn:kn]+                             --     same length as first arg+                             -- Result is anon arg kinds+    -> [TyConBinder]+mkTemplateTyConBinders kind_var_kinds mk_anon_arg_kinds+  = kv_bndrs ++ tv_bndrs+  where+    kv_bndrs   = mkTemplateKindTyConBinders kind_var_kinds+    anon_kinds = mk_anon_arg_kinds (mkTyVarTys (binderVars kv_bndrs))+    tv_bndrs   = mkTemplateAnonTyConBindersFrom (length kv_bndrs) anon_kinds++mkTemplateKiTyVars+    :: [Kind]                -- [k1, .., kn]   Kinds of kind-forall'd vars+    -> ([Kind] -> [Kind])    -- Arg is [kv1:k1, ..., kvn:kn]+                             --     same length as first arg+                             -- Result is anon arg kinds [ak1, .., akm]+    -> [TyVar]   -- [kv1:k1, ..., kvn:kn, av1:ak1, ..., avm:akm]+-- Example: if you want the tyvars for+--   forall (r:RuntimeRep) (a:TYPE r) (b:*). blah+-- call mkTemplateKiTyVars [RuntimeRep] (\[r]. [TYPE r, *)+mkTemplateKiTyVars kind_var_kinds mk_arg_kinds+  = kv_bndrs ++ tv_bndrs+  where+    kv_bndrs   = mkTemplateKindVars kind_var_kinds+    anon_kinds = mk_arg_kinds (mkTyVarTys kv_bndrs)+    tv_bndrs   = mkTemplateTyVarsFrom (length kv_bndrs) anon_kinds++mkTemplateKindTyConBinders :: [Kind] -> [TyConBinder]+-- Makes named, Specified binders+mkTemplateKindTyConBinders kinds = [mkNamedTyConBinder Specified tv | tv <- mkTemplateKindVars kinds]++mkTemplateAnonTyConBinders :: [Kind] -> [TyConBinder]+mkTemplateAnonTyConBinders kinds = mkAnonTyConBinders VisArg (mkTemplateTyVars kinds)++mkTemplateAnonTyConBindersFrom :: Int -> [Kind] -> [TyConBinder]+mkTemplateAnonTyConBindersFrom n kinds = mkAnonTyConBinders VisArg (mkTemplateTyVarsFrom n kinds)++alphaTyVars :: [TyVar]+alphaTyVars = mkTemplateTyVars $ repeat liftedTypeKind++alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar :: TyVar+(alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars++alphaTys :: [Type]+alphaTys = mkTyVarTys alphaTyVars+alphaTy, betaTy, gammaTy, deltaTy :: Type+(alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys++alphaTyVarsUnliftedRep :: [TyVar]+alphaTyVarsUnliftedRep = mkTemplateTyVars $ repeat (tYPE unliftedRepDataConTy)++alphaTyVarUnliftedRep :: TyVar+(alphaTyVarUnliftedRep:_) = alphaTyVarsUnliftedRep++alphaTysUnliftedRep :: [Type]+alphaTysUnliftedRep = mkTyVarTys alphaTyVarsUnliftedRep+alphaTyUnliftedRep :: Type+(alphaTyUnliftedRep:_) = alphaTysUnliftedRep++runtimeRep1TyVar, runtimeRep2TyVar :: TyVar+(runtimeRep1TyVar : runtimeRep2TyVar : _)+  = drop 16 (mkTemplateTyVars (repeat runtimeRepTy))  -- selects 'q','r'++runtimeRep1Ty, runtimeRep2Ty :: Type+runtimeRep1Ty = mkTyVarTy runtimeRep1TyVar+runtimeRep2Ty = mkTyVarTy runtimeRep2TyVar++openAlphaTyVar, openBetaTyVar :: TyVar+[openAlphaTyVar,openBetaTyVar]+  = mkTemplateTyVars [tYPE runtimeRep1Ty, tYPE runtimeRep2Ty]++openAlphaTy, openBetaTy :: Type+openAlphaTy = mkTyVarTy openAlphaTyVar+openBetaTy  = mkTyVarTy openBetaTyVar++{-+************************************************************************+*                                                                      *+                FunTyCon+*                                                                      *+************************************************************************+-}++funTyConName :: Name+funTyConName = mkPrimTyConName (fsLit "->") funTyConKey funTyCon++-- | The @(->)@ type constructor.+--+-- @+-- (->) :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep).+--         TYPE rep1 -> TYPE rep2 -> *+-- @+funTyCon :: TyCon+funTyCon = mkFunTyCon funTyConName tc_bndrs tc_rep_nm+  where+    tc_bndrs = [ mkNamedTyConBinder Inferred runtimeRep1TyVar+               , mkNamedTyConBinder Inferred runtimeRep2TyVar ]+               ++ mkTemplateAnonTyConBinders [ tYPE runtimeRep1Ty+                                             , tYPE runtimeRep2Ty+                                             ]+    tc_rep_nm = mkPrelTyConRepName funTyConName++{-+************************************************************************+*                                                                      *+                Kinds+*                                                                      *+************************************************************************++Note [TYPE and RuntimeRep]+~~~~~~~~~~~~~~~~~~~~~~~~~~+All types that classify values have a kind of the form (TYPE rr), where++    data RuntimeRep     -- Defined in ghc-prim:GHC.Types+      = LiftedRep+      | UnliftedRep+      | IntRep+      | FloatRep+      .. etc ..++    rr :: RuntimeRep++    TYPE :: RuntimeRep -> TYPE 'LiftedRep  -- Built in++So for example:+    Int        :: TYPE 'LiftedRep+    Array# Int :: TYPE 'UnliftedRep+    Int#       :: TYPE 'IntRep+    Float#     :: TYPE 'FloatRep+    Maybe      :: TYPE 'LiftedRep -> TYPE 'LiftedRep+    (# , #)    :: TYPE r1 -> TYPE r2 -> TYPE (TupleRep [r1, r2])++We abbreviate '*' specially:+    type * = TYPE 'LiftedRep++The 'rr' parameter tells us how the value is represented at runime.++Generally speaking, you can't be polymorphic in 'rr'.  E.g+   f :: forall (rr:RuntimeRep) (a:TYPE rr). a -> [a]+   f = /\(rr:RuntimeRep) (a:rr) \(a:rr). ...+This is no good: we could not generate code code for 'f', because the+calling convention for 'f' varies depending on whether the argument is+a a Int, Int#, or Float#.  (You could imagine generating specialised+code, one for each instantiation of 'rr', but we don't do that.)++Certain functions CAN be runtime-rep-polymorphic, because the code+generator never has to manipulate a value of type 'a :: TYPE rr'.++* error :: forall (rr:RuntimeRep) (a:TYPE rr). String -> a+  Code generator never has to manipulate the return value.++* unsafeCoerce#, defined in MkId.unsafeCoerceId:+  Always inlined to be a no-op+     unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)+                             (a :: TYPE r1) (b :: TYPE r2).+                             a -> b++* Unboxed tuples, and unboxed sums, defined in TysWiredIn+  Always inlined, and hence specialised to the call site+     (#,#) :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)+                     (a :: TYPE r1) (b :: TYPE r2).+                     a -> b -> TYPE ('TupleRep '[r1, r2])++Note [PrimRep and kindPrimRep]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+As part of its source code, in TyCon, GHC has+  data PrimRep = LiftedRep | UnliftedRep | IntRep | FloatRep | ...etc...++Notice that+ * RuntimeRep is part of the syntax tree of the program being compiled+     (defined in a library: ghc-prim:GHC.Types)+ * PrimRep is part of GHC's source code.+     (defined in TyCon)++We need to get from one to the other; that is what kindPrimRep does.+Suppose we have a value+   (v :: t) where (t :: k)+Given this kind+    k = TyConApp "TYPE" [rep]+GHC needs to be able to figure out how 'v' is represented at runtime.+It expects 'rep' to be form+    TyConApp rr_dc args+where 'rr_dc' is a promoteed data constructor from RuntimeRep. So+now we need to go from 'dc' to the corresponding PrimRep.  We store this+PrimRep in the promoted data constructor itself: see TyCon.promDcRepInfo.++-}++tYPETyCon :: TyCon+tYPETyConName :: Name++tYPETyCon = mkKindTyCon tYPETyConName+                        (mkTemplateAnonTyConBinders [runtimeRepTy])+                        liftedTypeKind+                        [Nominal]+                        (mkPrelTyConRepName tYPETyConName)++--------------------------+-- ... and now their names++-- If you edit these, you may need to update the GHC formalism+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs+tYPETyConName             = mkPrimTyConName (fsLit "TYPE") tYPETyConKey tYPETyCon++mkPrimTyConName :: FastString -> Unique -> TyCon -> Name+mkPrimTyConName = mkPrimTcName BuiltInSyntax+  -- All of the super kinds and kinds are defined in Prim,+  -- and use BuiltInSyntax, because they are never in scope in the source++mkPrimTcName :: BuiltInSyntax -> FastString -> Unique -> TyCon -> Name+mkPrimTcName built_in_syntax occ key tycon+  = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (ATyCon tycon) built_in_syntax++-----------------------------+-- | Given a RuntimeRep, applies TYPE to it.+-- see Note [TYPE and RuntimeRep]+tYPE :: Type -> Type+tYPE rr = TyConApp tYPETyCon [rr]++{-+************************************************************************+*                                                                      *+\subsection[TysPrim-basic]{Basic primitive types (@Char#@, @Int#@, etc.)}+*                                                                      *+************************************************************************+-}++-- only used herein+pcPrimTyCon :: Name -> [Role] -> PrimRep -> TyCon+pcPrimTyCon name roles rep+  = mkPrimTyCon name binders result_kind roles+  where+    binders     = mkTemplateAnonTyConBinders (map (const liftedTypeKind) roles)+    result_kind = tYPE (primRepToRuntimeRep rep)++-- | Convert a 'PrimRep' to a 'Type' of kind RuntimeRep+-- Defined here to avoid (more) module loops+primRepToRuntimeRep :: PrimRep -> Type+primRepToRuntimeRep rep = case rep of+  VoidRep       -> TyConApp tupleRepDataConTyCon [mkPromotedListTy runtimeRepTy []]+  LiftedRep     -> liftedRepDataConTy+  UnliftedRep   -> unliftedRepDataConTy+  IntRep        -> intRepDataConTy+  Int8Rep       -> int8RepDataConTy+  Int16Rep      -> int16RepDataConTy+  WordRep       -> wordRepDataConTy+  Int64Rep      -> int64RepDataConTy+  Word8Rep      -> word8RepDataConTy+  Word16Rep     -> word16RepDataConTy+  Word64Rep     -> word64RepDataConTy+  AddrRep       -> addrRepDataConTy+  FloatRep      -> floatRepDataConTy+  DoubleRep     -> doubleRepDataConTy+  VecRep n elem -> TyConApp vecRepDataConTyCon [n', elem']+    where+      n' = case n of+        2  -> vec2DataConTy+        4  -> vec4DataConTy+        8  -> vec8DataConTy+        16 -> vec16DataConTy+        32 -> vec32DataConTy+        64 -> vec64DataConTy+        _  -> pprPanic "Disallowed VecCount" (ppr n)++      elem' = case elem of+        Int8ElemRep   -> int8ElemRepDataConTy+        Int16ElemRep  -> int16ElemRepDataConTy+        Int32ElemRep  -> int32ElemRepDataConTy+        Int64ElemRep  -> int64ElemRepDataConTy+        Word8ElemRep  -> word8ElemRepDataConTy+        Word16ElemRep -> word16ElemRepDataConTy+        Word32ElemRep -> word32ElemRepDataConTy+        Word64ElemRep -> word64ElemRepDataConTy+        FloatElemRep  -> floatElemRepDataConTy+        DoubleElemRep -> doubleElemRepDataConTy++pcPrimTyCon0 :: Name -> PrimRep -> TyCon+pcPrimTyCon0 name rep+  = pcPrimTyCon name [] rep++charPrimTy :: Type+charPrimTy      = mkTyConTy charPrimTyCon+charPrimTyCon :: TyCon+charPrimTyCon   = pcPrimTyCon0 charPrimTyConName WordRep++intPrimTy :: Type+intPrimTy       = mkTyConTy intPrimTyCon+intPrimTyCon :: TyCon+intPrimTyCon    = pcPrimTyCon0 intPrimTyConName IntRep++int8PrimTy :: Type+int8PrimTy     = mkTyConTy int8PrimTyCon+int8PrimTyCon :: TyCon+int8PrimTyCon  = pcPrimTyCon0 int8PrimTyConName Int8Rep++int16PrimTy :: Type+int16PrimTy    = mkTyConTy int16PrimTyCon+int16PrimTyCon :: TyCon+int16PrimTyCon = pcPrimTyCon0 int16PrimTyConName Int16Rep++int32PrimTy :: Type+int32PrimTy     = mkTyConTy int32PrimTyCon+int32PrimTyCon :: TyCon+int32PrimTyCon  = pcPrimTyCon0 int32PrimTyConName IntRep++int64PrimTy :: Type+int64PrimTy     = mkTyConTy int64PrimTyCon+int64PrimTyCon :: TyCon+int64PrimTyCon  = pcPrimTyCon0 int64PrimTyConName Int64Rep++wordPrimTy :: Type+wordPrimTy      = mkTyConTy wordPrimTyCon+wordPrimTyCon :: TyCon+wordPrimTyCon   = pcPrimTyCon0 wordPrimTyConName WordRep++word8PrimTy :: Type+word8PrimTy     = mkTyConTy word8PrimTyCon+word8PrimTyCon :: TyCon+word8PrimTyCon  = pcPrimTyCon0 word8PrimTyConName Word8Rep++word16PrimTy :: Type+word16PrimTy    = mkTyConTy word16PrimTyCon+word16PrimTyCon :: TyCon+word16PrimTyCon = pcPrimTyCon0 word16PrimTyConName Word16Rep++word32PrimTy :: Type+word32PrimTy    = mkTyConTy word32PrimTyCon+word32PrimTyCon :: TyCon+word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName WordRep++word64PrimTy :: Type+word64PrimTy    = mkTyConTy word64PrimTyCon+word64PrimTyCon :: TyCon+word64PrimTyCon = pcPrimTyCon0 word64PrimTyConName Word64Rep++addrPrimTy :: Type+addrPrimTy      = mkTyConTy addrPrimTyCon+addrPrimTyCon :: TyCon+addrPrimTyCon   = pcPrimTyCon0 addrPrimTyConName AddrRep++floatPrimTy     :: Type+floatPrimTy     = mkTyConTy floatPrimTyCon+floatPrimTyCon :: TyCon+floatPrimTyCon  = pcPrimTyCon0 floatPrimTyConName FloatRep++doublePrimTy :: Type+doublePrimTy    = mkTyConTy doublePrimTyCon+doublePrimTyCon :: TyCon+doublePrimTyCon = pcPrimTyCon0 doublePrimTyConName DoubleRep++{-+************************************************************************+*                                                                      *+\subsection[TysPrim-state]{The @State#@ type (and @_RealWorld@ types)}+*                                                                      *+************************************************************************++Note [The equality types story]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+GHC sports a veritable menagerie of equality types:++         Type or  Lifted?  Hetero?  Role      Built in         Defining module+         class?    L/U                        TyCon+-----------------------------------------------------------------------------------------+~#         T        U      hetero   nominal   eqPrimTyCon      GHC.Prim+~~         C        L      hetero   nominal   heqTyCon         GHC.Types+~          C        L      homo     nominal   eqTyCon          GHC.Types+:~:        T        L      homo     nominal   (not built-in)   Data.Type.Equality+:~~:       T        L      hetero   nominal   (not built-in)   Data.Type.Equality++~R#        T        U      hetero   repr      eqReprPrimTy     GHC.Prim+Coercible  C        L      homo     repr      coercibleTyCon   GHC.Types+Coercion   T        L      homo     repr      (not built-in)   Data.Type.Coercion+~P#        T        U      hetero   phantom   eqPhantPrimTyCon GHC.Prim++Recall that "hetero" means the equality can related types of different+kinds. Knowing that (t1 ~# t2) or (t1 ~R# t2) or even that (t1 ~P# t2)+also means that (k1 ~# k2), where (t1 :: k1) and (t2 :: k2).++To produce less confusion for end users, when not dumping and without+-fprint-equality-relations, each of these groups is printed as the bottommost+listed equality. That is, (~#) and (~~) are both rendered as (~) in+error messages, and (~R#) is rendered as Coercible.++Let's take these one at a time:++    --------------------------+    (~#) :: forall k1 k2. k1 -> k2 -> #+    --------------------------+This is The Type Of Equality in GHC. It classifies nominal coercions.+This type is used in the solver for recording equality constraints.+It responds "yes" to Type.isEqPrimPred and classifies as an EqPred in+Type.classifyPredType.++All wanted constraints of this type are built with coercion holes.+(See Note [Coercion holes] in TyCoRep.) But see also+Note [Deferred errors for coercion holes] in TcErrors to see how+equality constraints are deferred.++Within GHC, ~# is called eqPrimTyCon, and it is defined in TysPrim.+++    --------------------------+    (~~) :: forall k1 k2. k1 -> k2 -> Constraint+    --------------------------+This is (almost) an ordinary class, defined as if by+  class a ~# b => a ~~ b+  instance a ~# b => a ~~ b+Here's what's unusual about it:++ * We can't actually declare it that way because we don't have syntax for ~#.+   And ~# isn't a constraint, so even if we could write it, it wouldn't kind+   check.++ * Users cannot write instances of it.++ * It is "naturally coherent". This means that the solver won't hesitate to+   solve a goal of type (a ~~ b) even if there is, say (Int ~~ c) in the+   context. (Normally, it waits to learn more, just in case the given+   influences what happens next.) See Note [Naturally coherent classes]+   in TcInteract.++ * It always terminates. That is, in the UndecidableInstances checks, we+   don't worry if a (~~) constraint is too big, as we know that solving+   equality terminates.++On the other hand, this behaves just like any class w.r.t. eager superclass+unpacking in the solver. So a lifted equality given quickly becomes an unlifted+equality given. This is good, because the solver knows all about unlifted+equalities. There is some special-casing in TcInteract.matchClassInst to+pretend that there is an instance of this class, as we can't write the instance+in Haskell.++Within GHC, ~~ is called heqTyCon, and it is defined in TysWiredIn.+++    --------------------------+    (~) :: forall k. k -> k -> Constraint+    --------------------------+This is /exactly/ like (~~), except with a homogeneous kind.+It is an almost-ordinary class defined as if by+  class a ~# b => (a :: k) ~ (b :: k)+  instance a ~# b => a ~ b++ * All the bullets for (~~) apply++ * In addition (~) is magical syntax, as ~ is a reserved symbol.+   It cannot be exported or imported.++Within GHC, ~ is called eqTyCon, and it is defined in TysWiredIn.++Historical note: prior to July 18 (~) was defined as a+  more-ordinary class with (~~) as a superclass.  But that made it+  special in different ways; and the extra superclass selections to+  get from (~) to (~#) via (~~) were tiresome.  Now it's defined+  uniformly with (~~) and Coercible; much nicer.)+++    --------------------------+    (:~:) :: forall k. k -> k -> *+    (:~~:) :: forall k1 k2. k1 -> k2 -> *+    --------------------------+These are perfectly ordinary GADTs, wrapping (~) and (~~) resp.+They are not defined within GHC at all.+++    --------------------------+    (~R#) :: forall k1 k2. k1 -> k2 -> #+    --------------------------+The is the representational analogue of ~#. This is the type of representational+equalities that the solver works on. All wanted constraints of this type are+built with coercion holes.++Within GHC, ~R# is called eqReprPrimTyCon, and it is defined in TysPrim.+++    --------------------------+    Coercible :: forall k. k -> k -> Constraint+    --------------------------+This is quite like (~~) in the way it's defined and treated within GHC, but+it's homogeneous. Homogeneity helps with type inference (as GHC can solve one+kind from the other) and, in my (Richard's) estimation, will be more intuitive+for users.++An alternative design included HCoercible (like (~~)) and Coercible (like (~)).+One annoyance was that we want `coerce :: Coercible a b => a -> b`, and+we need the type of coerce to be fully wired-in. So the HCoercible/Coercible+split required that both types be fully wired-in. Instead of doing this,+I just got rid of HCoercible, as I'm not sure who would use it, anyway.++Within GHC, Coercible is called coercibleTyCon, and it is defined in+TysWiredIn.+++    --------------------------+    Coercion :: forall k. k -> k -> *+    --------------------------+This is a perfectly ordinary GADT, wrapping Coercible. It is not defined+within GHC at all.+++    --------------------------+    (~P#) :: forall k1 k2. k1 -> k2 -> #+    --------------------------+This is the phantom analogue of ~# and it is barely used at all.+(The solver has no idea about this one.) Here is the motivation:++    data Phant a = MkPhant+    type role Phant phantom++    Phant <Int, Bool>_P :: Phant Int ~P# Phant Bool++We just need to have something to put on that last line. You probably+don't need to worry about it.++++Note [The State# TyCon]+~~~~~~~~~~~~~~~~~~~~~~~+State# is the primitive, unlifted type of states.  It has one type parameter,+thus+        State# RealWorld+or+        State# s++where s is a type variable. The only purpose of the type parameter is to+keep different state threads separate.  It is represented by nothing at all.++The type parameter to State# is intended to keep separate threads separate.+Even though this parameter is not used in the definition of State#, it is+given role Nominal to enforce its intended use.+-}++mkStatePrimTy :: Type -> Type+mkStatePrimTy ty = TyConApp statePrimTyCon [ty]++statePrimTyCon :: TyCon   -- See Note [The State# TyCon]+statePrimTyCon   = pcPrimTyCon statePrimTyConName [Nominal] VoidRep++{-+RealWorld is deeply magical.  It is *primitive*, but it is not+*unlifted* (hence ptrArg).  We never manipulate values of type+RealWorld; it's only used in the type system, to parameterise State#.+-}++realWorldTyCon :: TyCon+realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName [] liftedTypeKind []+realWorldTy :: Type+realWorldTy          = mkTyConTy realWorldTyCon+realWorldStatePrimTy :: Type+realWorldStatePrimTy = mkStatePrimTy realWorldTy        -- State# RealWorld++-- Note: the ``state-pairing'' types are not truly primitive,+-- so they are defined in \tr{TysWiredIn.hs}, not here.+++voidPrimTy :: Type+voidPrimTy = TyConApp voidPrimTyCon []++voidPrimTyCon :: TyCon+voidPrimTyCon    = pcPrimTyCon voidPrimTyConName [] VoidRep++mkProxyPrimTy :: Type -> Type -> Type+mkProxyPrimTy k ty = TyConApp proxyPrimTyCon [k, ty]++proxyPrimTyCon :: TyCon+proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName binders res_kind [Nominal,Phantom]+  where+     -- Kind: forall k. k -> TYPE (Tuple '[])+     binders = mkTemplateTyConBinders [liftedTypeKind] id+     res_kind = unboxedTupleKind []+++{- *********************************************************************+*                                                                      *+                Primitive equality constraints+    See Note [The equality types story]+*                                                                      *+********************************************************************* -}++eqPrimTyCon :: TyCon  -- The representation type for equality predicates+                      -- See Note [The equality types story]+eqPrimTyCon  = mkPrimTyCon eqPrimTyConName binders res_kind roles+  where+    -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (Tuple '[])+    binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id+    res_kind = unboxedTupleKind []+    roles    = [Nominal, Nominal, Nominal, Nominal]++-- like eqPrimTyCon, but the type for *Representational* coercions+-- this should only ever appear as the type of a covar. Its role is+-- interpreted in coercionRole+eqReprPrimTyCon :: TyCon   -- See Note [The equality types story]+eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName binders res_kind roles+  where+    -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (Tuple '[])+    binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id+    res_kind = unboxedTupleKind []+    roles    = [Nominal, Nominal, Representational, Representational]++-- like eqPrimTyCon, but the type for *Phantom* coercions.+-- This is only used to make higher-order equalities. Nothing+-- should ever actually have this type!+eqPhantPrimTyCon :: TyCon+eqPhantPrimTyCon = mkPrimTyCon eqPhantPrimTyConName binders res_kind roles+  where+    -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (Tuple '[])+    binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id+    res_kind = unboxedTupleKind []+    roles    = [Nominal, Nominal, Phantom, Phantom]++{- *********************************************************************+*                                                                      *+             The primitive array types+*                                                                      *+********************************************************************* -}++arrayPrimTyCon, mutableArrayPrimTyCon, mutableByteArrayPrimTyCon,+    byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon,+    smallArrayPrimTyCon, smallMutableArrayPrimTyCon :: TyCon+arrayPrimTyCon             = pcPrimTyCon arrayPrimTyConName             [Representational] UnliftedRep+mutableArrayPrimTyCon      = pcPrimTyCon  mutableArrayPrimTyConName     [Nominal, Representational] UnliftedRep+mutableByteArrayPrimTyCon  = pcPrimTyCon mutableByteArrayPrimTyConName  [Nominal] UnliftedRep+byteArrayPrimTyCon         = pcPrimTyCon0 byteArrayPrimTyConName        UnliftedRep+arrayArrayPrimTyCon        = pcPrimTyCon0 arrayArrayPrimTyConName       UnliftedRep+mutableArrayArrayPrimTyCon = pcPrimTyCon mutableArrayArrayPrimTyConName [Nominal] UnliftedRep+smallArrayPrimTyCon        = pcPrimTyCon smallArrayPrimTyConName        [Representational] UnliftedRep+smallMutableArrayPrimTyCon = pcPrimTyCon smallMutableArrayPrimTyConName [Nominal, Representational] UnliftedRep++mkArrayPrimTy :: Type -> Type+mkArrayPrimTy elt           = TyConApp arrayPrimTyCon [elt]+byteArrayPrimTy :: Type+byteArrayPrimTy             = mkTyConTy byteArrayPrimTyCon+mkArrayArrayPrimTy :: Type+mkArrayArrayPrimTy = mkTyConTy arrayArrayPrimTyCon+mkSmallArrayPrimTy :: Type -> Type+mkSmallArrayPrimTy elt = TyConApp smallArrayPrimTyCon [elt]+mkMutableArrayPrimTy :: Type -> Type -> Type+mkMutableArrayPrimTy s elt  = TyConApp mutableArrayPrimTyCon [s, elt]+mkMutableByteArrayPrimTy :: Type -> Type+mkMutableByteArrayPrimTy s  = TyConApp mutableByteArrayPrimTyCon [s]+mkMutableArrayArrayPrimTy :: Type -> Type+mkMutableArrayArrayPrimTy s = TyConApp mutableArrayArrayPrimTyCon [s]+mkSmallMutableArrayPrimTy :: Type -> Type -> Type+mkSmallMutableArrayPrimTy s elt = TyConApp smallMutableArrayPrimTyCon [s, elt]+++{- *********************************************************************+*                                                                      *+                The mutable variable type+*                                                                      *+********************************************************************* -}++mutVarPrimTyCon :: TyCon+mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName [Nominal, Representational] UnliftedRep++mkMutVarPrimTy :: Type -> Type -> Type+mkMutVarPrimTy s elt        = TyConApp mutVarPrimTyCon [s, elt]++{-+************************************************************************+*                                                                      *+\subsection[TysPrim-synch-var]{The synchronizing variable type}+*                                                                      *+************************************************************************+-}++mVarPrimTyCon :: TyCon+mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName [Nominal, Representational] UnliftedRep++mkMVarPrimTy :: Type -> Type -> Type+mkMVarPrimTy s elt          = TyConApp mVarPrimTyCon [s, elt]++{-+************************************************************************+*                                                                      *+\subsection[TysPrim-stm-var]{The transactional variable type}+*                                                                      *+************************************************************************+-}++tVarPrimTyCon :: TyCon+tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName [Nominal, Representational] UnliftedRep++mkTVarPrimTy :: Type -> Type -> Type+mkTVarPrimTy s elt = TyConApp tVarPrimTyCon [s, elt]++{-+************************************************************************+*                                                                      *+\subsection[TysPrim-stable-ptrs]{The stable-pointer type}+*                                                                      *+************************************************************************+-}++stablePtrPrimTyCon :: TyCon+stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName [Representational] AddrRep++mkStablePtrPrimTy :: Type -> Type+mkStablePtrPrimTy ty = TyConApp stablePtrPrimTyCon [ty]++{-+************************************************************************+*                                                                      *+\subsection[TysPrim-stable-names]{The stable-name type}+*                                                                      *+************************************************************************+-}++stableNamePrimTyCon :: TyCon+stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName [Phantom] UnliftedRep++mkStableNamePrimTy :: Type -> Type+mkStableNamePrimTy ty = TyConApp stableNamePrimTyCon [ty]++{-+************************************************************************+*                                                                      *+\subsection[TysPrim-compact-nfdata]{The Compact NFData (CNF) type}+*                                                                      *+************************************************************************+-}++compactPrimTyCon :: TyCon+compactPrimTyCon = pcPrimTyCon0 compactPrimTyConName UnliftedRep++compactPrimTy :: Type+compactPrimTy = mkTyConTy compactPrimTyCon++{-+************************************************************************+*                                                                      *+\subsection[TysPrim-BCOs]{The ``bytecode object'' type}+*                                                                      *+************************************************************************+-}++bcoPrimTy    :: Type+bcoPrimTy    = mkTyConTy bcoPrimTyCon+bcoPrimTyCon :: TyCon+bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName UnliftedRep++{-+************************************************************************+*                                                                      *+\subsection[TysPrim-Weak]{The ``weak pointer'' type}+*                                                                      *+************************************************************************+-}++weakPrimTyCon :: TyCon+weakPrimTyCon = pcPrimTyCon weakPrimTyConName [Representational] UnliftedRep++mkWeakPrimTy :: Type -> Type+mkWeakPrimTy v = TyConApp weakPrimTyCon [v]++{-+************************************************************************+*                                                                      *+\subsection[TysPrim-thread-ids]{The ``thread id'' type}+*                                                                      *+************************************************************************++A thread id is represented by a pointer to the TSO itself, to ensure+that they are always unique and we can always find the TSO for a given+thread id.  However, this has the unfortunate consequence that a+ThreadId# for a given thread is treated as a root by the garbage+collector and can keep TSOs around for too long.++Hence the programmer API for thread manipulation uses a weak pointer+to the thread id internally.+-}++threadIdPrimTy :: Type+threadIdPrimTy    = mkTyConTy threadIdPrimTyCon+threadIdPrimTyCon :: TyCon+threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName UnliftedRep++{-+************************************************************************+*                                                                      *+\subsection{SIMD vector types}+*                                                                      *+************************************************************************+-}++#include "primop-vector-tys.hs-incl"
+ compiler/prelude/TysWiredIn.hs view
@@ -0,0 +1,1627 @@+{-+(c) The GRASP Project, Glasgow University, 1994-1998++\section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types}+-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++-- | This module is about types that can be defined in Haskell, but which+--   must be wired into the compiler nonetheless.  C.f module TysPrim+module TysWiredIn (+        -- * Helper functions defined here+        mkWiredInTyConName, -- This is used in TcTypeNats to define the+                            -- built-in functions for evaluation.++        mkWiredInIdName,    -- used in MkId++        -- * All wired in things+        wiredInTyCons, isBuiltInOcc_maybe,++        -- * Bool+        boolTy, boolTyCon, boolTyCon_RDR, boolTyConName,+        trueDataCon,  trueDataConId,  true_RDR,+        falseDataCon, falseDataConId, false_RDR,+        promotedFalseDataCon, promotedTrueDataCon,++        -- * Ordering+        orderingTyCon,+        ordLTDataCon, ordLTDataConId,+        ordEQDataCon, ordEQDataConId,+        ordGTDataCon, ordGTDataConId,+        promotedLTDataCon, promotedEQDataCon, promotedGTDataCon,++        -- * Boxing primitive types+        boxingDataCon_maybe,++        -- * Char+        charTyCon, charDataCon, charTyCon_RDR,+        charTy, stringTy, charTyConName,++        -- * Double+        doubleTyCon, doubleDataCon, doubleTy, doubleTyConName,++        -- * Float+        floatTyCon, floatDataCon, floatTy, floatTyConName,++        -- * Int+        intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName,+        intTy,++        -- * Word+        wordTyCon, wordDataCon, wordTyConName, wordTy,++        -- * Word8+        word8TyCon, word8DataCon, word8TyConName, word8Ty,++        -- * List+        listTyCon, listTyCon_RDR, listTyConName, listTyConKey,+        nilDataCon, nilDataConName, nilDataConKey,+        consDataCon_RDR, consDataCon, consDataConName,+        promotedNilDataCon, promotedConsDataCon,+        mkListTy, mkPromotedListTy,++        -- * Maybe+        maybeTyCon, maybeTyConName,+        nothingDataCon, nothingDataConName, promotedNothingDataCon,+        justDataCon, justDataConName, promotedJustDataCon,++        -- * Tuples+        mkTupleTy, mkBoxedTupleTy,+        tupleTyCon, tupleDataCon, tupleTyConName,+        promotedTupleDataCon,+        unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,+        pairTyCon,+        unboxedUnitTyCon, unboxedUnitDataCon,+        unboxedTupleKind, unboxedSumKind,++        -- ** Constraint tuples+        cTupleTyConName, cTupleTyConNames, isCTupleTyConName,+        cTupleTyConNameArity_maybe,+        cTupleDataConName, cTupleDataConNames,++        -- * Any+        anyTyCon, anyTy, anyTypeOfKind,++        -- * Recovery TyCon+        makeRecoveryTyCon,++        -- * Sums+        mkSumTy, sumTyCon, sumDataCon,++        -- * Kinds+        typeNatKindCon, typeNatKind, typeSymbolKindCon, typeSymbolKind,+        isLiftedTypeKindTyConName, liftedTypeKind, constraintKind,+        liftedTypeKindTyCon, constraintKindTyCon,+        liftedTypeKindTyConName,++        -- * Equality predicates+        heqTyCon, heqTyConName, heqClass, heqDataCon,+        eqTyCon, eqTyConName, eqClass, eqDataCon, eqTyCon_RDR,+        coercibleTyCon, coercibleTyConName, coercibleDataCon, coercibleClass,++        -- * RuntimeRep and friends+        runtimeRepTyCon, vecCountTyCon, vecElemTyCon,++        runtimeRepTy, liftedRepTy, liftedRepDataCon, liftedRepDataConTyCon,++        vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon,++        liftedRepDataConTy, unliftedRepDataConTy, intRepDataConTy, int8RepDataConTy,+        int16RepDataConTy, word16RepDataConTy,+        wordRepDataConTy, int64RepDataConTy, word8RepDataConTy, word64RepDataConTy,+        addrRepDataConTy,+        floatRepDataConTy, doubleRepDataConTy,++        vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,+        vec64DataConTy,++        int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,+        int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,+        word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,+        doubleElemRepDataConTy++    ) where++#include "HsVersions.h"+#include "MachDeps.h"++import GhcPrelude++import {-# SOURCE #-} MkId( mkDataConWorkId, mkDictSelId )++-- friends:+import PrelNames+import TysPrim+import {-# SOURCE #-} KnownUniques++-- others:+import CoAxiom+import Id+import Constants        ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE )+import Module           ( Module )+import Type+import RepType+import DataCon+import {-# SOURCE #-} ConLike+import TyCon+import Class            ( Class, mkClass )+import RdrName+import Name+import NameEnv          ( NameEnv, mkNameEnv, lookupNameEnv, lookupNameEnv_NF )+import NameSet          ( NameSet, mkNameSet, elemNameSet )+import BasicTypes       ( Arity, Boxity(..), TupleSort(..), ConTagZ,+                          SourceText(..) )+import ForeignCall+import SrcLoc           ( noSrcSpan )+import Unique+import Data.Array+import FastString+import Outputable+import Util+import BooleanFormula   ( mkAnd )++import qualified Data.ByteString.Char8 as BS++import Data.List        ( elemIndex )++alpha_tyvar :: [TyVar]+alpha_tyvar = [alphaTyVar]++alpha_ty :: [Type]+alpha_ty = [alphaTy]++{-+Note [Wiring in RuntimeRep]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+The RuntimeRep type (and friends) in GHC.Types has a bunch of constructors,+making it a pain to wire in. To ease the pain somewhat, we use lists of+the different bits, like Uniques, Names, DataCons. These lists must be+kept in sync with each other. The rule is this: use the order as declared+in GHC.Types. All places where such lists exist should contain a reference+to this Note, so a search for this Note's name should find all the lists.++************************************************************************+*                                                                      *+\subsection{Wired in type constructors}+*                                                                      *+************************************************************************++If you change which things are wired in, make sure you change their+names in PrelNames, so they use wTcQual, wDataQual, etc+-}++-- This list is used only to define PrelInfo.wiredInThings. That in turn+-- is used to initialise the name environment carried around by the renamer.+-- This means that if we look up the name of a TyCon (or its implicit binders)+-- that occurs in this list that name will be assigned the wired-in key we+-- define here.+--+-- Because of their infinite nature, this list excludes tuples, Any and implicit+-- parameter TyCons (see Note [Built-in syntax and the OrigNameCache]).+--+-- See also Note [Known-key names]+wiredInTyCons :: [TyCon]++wiredInTyCons = [ -- Units are not treated like other tuples, because then+                  -- are defined in GHC.Base, and there's only a few of them. We+                  -- put them in wiredInTyCons so that they will pre-populate+                  -- the name cache, so the parser in isBuiltInOcc_maybe doesn't+                  -- need to look out for them.+                  unitTyCon+                , unboxedUnitTyCon+                , anyTyCon+                , boolTyCon+                , charTyCon+                , doubleTyCon+                , floatTyCon+                , intTyCon+                , wordTyCon+                , word8TyCon+                , listTyCon+                , maybeTyCon+                , heqTyCon+                , eqTyCon+                , coercibleTyCon+                , typeNatKindCon+                , typeSymbolKindCon+                , runtimeRepTyCon+                , vecCountTyCon+                , vecElemTyCon+                , constraintKindTyCon+                , liftedTypeKindTyCon+                ]++mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name+mkWiredInTyConName built_in modu fs unique tycon+  = mkWiredInName modu (mkTcOccFS fs) unique+                  (ATyCon tycon)        -- Relevant TyCon+                  built_in++mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name+mkWiredInDataConName built_in modu fs unique datacon+  = mkWiredInName modu (mkDataOccFS fs) unique+                  (AConLike (RealDataCon datacon))    -- Relevant DataCon+                  built_in++mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name+mkWiredInIdName mod fs uniq id+ = mkWiredInName mod (mkOccNameFS Name.varName fs) uniq (AnId id) UserSyntax++-- See Note [Kind-changing of (~) and Coercible]+-- in libraries/ghc-prim/GHC/Types.hs+eqTyConName, eqDataConName, eqSCSelIdName :: Name+eqTyConName   = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "~")   eqTyConKey   eqTyCon+eqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Eq#") eqDataConKey eqDataCon+eqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "eq_sel") eqSCSelIdKey eqSCSelId++eqTyCon_RDR :: RdrName+eqTyCon_RDR = nameRdrName eqTyConName++-- See Note [Kind-changing of (~) and Coercible]+-- in libraries/ghc-prim/GHC/Types.hs+heqTyConName, heqDataConName, heqSCSelIdName :: Name+heqTyConName   = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "~~")   heqTyConKey      heqTyCon+heqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "HEq#") heqDataConKey heqDataCon+heqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "heq_sel") heqSCSelIdKey heqSCSelId++-- See Note [Kind-changing of (~) and Coercible] in libraries/ghc-prim/GHC/Types.hs+coercibleTyConName, coercibleDataConName, coercibleSCSelIdName :: Name+coercibleTyConName   = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Coercible")  coercibleTyConKey   coercibleTyCon+coercibleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "MkCoercible") coercibleDataConKey coercibleDataCon+coercibleSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "coercible_sel") coercibleSCSelIdKey coercibleSCSelId++charTyConName, charDataConName, intTyConName, intDataConName :: Name+charTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Char") charTyConKey charTyCon+charDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "C#") charDataConKey charDataCon+intTyConName      = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Int") intTyConKey   intTyCon+intDataConName    = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#") intDataConKey  intDataCon++boolTyConName, falseDataConName, trueDataConName :: Name+boolTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Bool") boolTyConKey boolTyCon+falseDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "False") falseDataConKey falseDataCon+trueDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "True")  trueDataConKey  trueDataCon++listTyConName, nilDataConName, consDataConName :: Name+listTyConName     = mkWiredInTyConName   BuiltInSyntax gHC_TYPES (fsLit "[]") listTyConKey listTyCon+nilDataConName    = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "[]") nilDataConKey nilDataCon+consDataConName   = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit ":") consDataConKey consDataCon++maybeTyConName, nothingDataConName, justDataConName :: Name+maybeTyConName     = mkWiredInTyConName   UserSyntax gHC_MAYBE (fsLit "Maybe")+                                          maybeTyConKey maybeTyCon+nothingDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Nothing")+                                          nothingDataConKey nothingDataCon+justDataConName    = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Just")+                                          justDataConKey justDataCon++wordTyConName, wordDataConName, word8TyConName, word8DataConName :: Name+wordTyConName      = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Word")   wordTyConKey     wordTyCon+wordDataConName    = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "W#")     wordDataConKey   wordDataCon+word8TyConName     = mkWiredInTyConName   UserSyntax gHC_WORD  (fsLit "Word8")  word8TyConKey    word8TyCon+word8DataConName   = mkWiredInDataConName UserSyntax gHC_WORD  (fsLit "W8#")    word8DataConKey  word8DataCon++floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name+floatTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Float")  floatTyConKey    floatTyCon+floatDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "F#")     floatDataConKey  floatDataCon+doubleTyConName    = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Double") doubleTyConKey   doubleTyCon+doubleDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#")     doubleDataConKey doubleDataCon++-- Any++{-+Note [Any types]+~~~~~~~~~~~~~~~~+The type constructor Any,++    type family Any :: k where { }++It has these properties:++  * Note that 'Any' is kind polymorphic since in some program we may+    need to use Any to fill in a type variable of some kind other than *+    (see #959 for examples).  Its kind is thus `forall k. k``.++  * It is defined in module GHC.Types, and exported so that it is+    available to users.  For this reason it's treated like any other+    wired-in type:+      - has a fixed unique, anyTyConKey,+      - lives in the global name cache++  * It is a *closed* type family, with no instances.  This means that+    if   ty :: '(k1, k2)  we add a given coercion+             g :: ty ~ (Fst ty, Snd ty)+    If Any was a *data* type, then we'd get inconsistency because 'ty'+    could be (Any '(k1,k2)) and then we'd have an equality with Any on+    one side and '(,) on the other. See also #9097 and #9636.++  * When instantiated at a lifted type it is inhabited by at least one value,+    namely bottom++  * You can safely coerce any /lifted/ type to Any, and back with unsafeCoerce.++  * It does not claim to be a *data* type, and that's important for+    the code generator, because the code gen may *enter* a data value+    but never enters a function value.++  * It is wired-in so we can easily refer to it where we don't have a name+    environment (e.g. see Rules.matchRule for one example)++  * If (Any k) is the type of a value, it must be a /lifted/ value. So+    if we have (Any @(TYPE rr)) then rr must be 'LiftedRep.  See+    Note [TYPE and RuntimeRep] in TysPrim.  This is a convenient+    invariant, and makes isUnliftedTyCon well-defined; otherwise what+    would (isUnliftedTyCon Any) be?++It's used to instantiate un-constrained type variables after type checking. For+example, 'length' has type++  length :: forall a. [a] -> Int++and the list datacon for the empty list has type++  [] :: forall a. [a]++In order to compose these two terms as @length []@ a type+application is required, but there is no constraint on the+choice.  In this situation GHC uses 'Any',++> length (Any *) ([] (Any *))++Above, we print kinds explicitly, as if with --fprint-explicit-kinds.++The Any tycon used to be quite magic, but we have since been able to+implement it merely with an empty kind polymorphic type family. See #10886 for a+bit of history.+-}+++anyTyConName :: Name+anyTyConName =+    mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Any") anyTyConKey anyTyCon++anyTyCon :: TyCon+anyTyCon = mkFamilyTyCon anyTyConName binders res_kind Nothing+                         (ClosedSynFamilyTyCon Nothing)+                         Nothing+                         NotInjective+  where+    binders@[kv] = mkTemplateKindTyConBinders [liftedTypeKind]+    res_kind = mkTyVarTy (binderVar kv)++anyTy :: Type+anyTy = mkTyConTy anyTyCon++anyTypeOfKind :: Kind -> Type+anyTypeOfKind kind = mkTyConApp anyTyCon [kind]++-- | Make a fake, recovery 'TyCon' from an existing one.+-- Used when recovering from errors in type declarations+makeRecoveryTyCon :: TyCon -> TyCon+makeRecoveryTyCon tc+  = mkTcTyCon (tyConName tc)+              bndrs res_kind+              []               -- No scoped vars+              True             -- Fully generalised+              flavour          -- Keep old flavour+  where+    flavour = tyConFlavour tc+    [kv] = mkTemplateKindVars [liftedTypeKind]+    (bndrs, res_kind)+       = case flavour of+           PromotedDataConFlavour -> ([mkNamedTyConBinder Inferred kv], mkTyVarTy kv)+           _ -> (tyConBinders tc, tyConResKind tc)+        -- For data types we have already validated their kind, so it+        -- makes sense to keep it. For promoted data constructors we haven't,+        -- so we recover with kind (forall k. k).  Otherwise consider+        --     data T a where { MkT :: Show a => T a }+        -- If T is for some reason invalid, we don't want to fall over+        -- at (promoted) use-sites of MkT.++-- Kinds+typeNatKindConName, typeSymbolKindConName :: Name+typeNatKindConName    = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Nat")    typeNatKindConNameKey    typeNatKindCon+typeSymbolKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Symbol") typeSymbolKindConNameKey typeSymbolKindCon++constraintKindTyConName :: Name+constraintKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Constraint") constraintKindTyConKey   constraintKindTyCon++liftedTypeKindTyConName :: Name+liftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Type") liftedTypeKindTyConKey liftedTypeKindTyCon++runtimeRepTyConName, vecRepDataConName, tupleRepDataConName, sumRepDataConName :: Name+runtimeRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "RuntimeRep") runtimeRepTyConKey runtimeRepTyCon+vecRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "VecRep") vecRepDataConKey vecRepDataCon+tupleRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TupleRep") tupleRepDataConKey tupleRepDataCon+sumRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "SumRep") sumRepDataConKey sumRepDataCon++-- See Note [Wiring in RuntimeRep]+runtimeRepSimpleDataConNames :: [Name]+runtimeRepSimpleDataConNames+  = zipWith3Lazy mk_special_dc_name+      [ fsLit "LiftedRep"+      , fsLit "UnliftedRep"+      , fsLit "IntRep"+      , fsLit "WordRep"+      , fsLit "Int8Rep"+      , fsLit "Int16Rep"+      , fsLit "Int64Rep"+      , fsLit "Word8Rep"+      , fsLit "Word16Rep"+      , fsLit "Word64Rep"+      , fsLit "AddrRep"+      , fsLit "FloatRep"+      , fsLit "DoubleRep"+      ]+      runtimeRepSimpleDataConKeys+      runtimeRepSimpleDataCons++vecCountTyConName :: Name+vecCountTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecCount") vecCountTyConKey vecCountTyCon++-- See Note [Wiring in RuntimeRep]+vecCountDataConNames :: [Name]+vecCountDataConNames = zipWith3Lazy mk_special_dc_name+                         [ fsLit "Vec2", fsLit "Vec4", fsLit "Vec8"+                         , fsLit "Vec16", fsLit "Vec32", fsLit "Vec64" ]+                         vecCountDataConKeys+                         vecCountDataCons++vecElemTyConName :: Name+vecElemTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecElem") vecElemTyConKey vecElemTyCon++-- See Note [Wiring in RuntimeRep]+vecElemDataConNames :: [Name]+vecElemDataConNames = zipWith3Lazy mk_special_dc_name+                        [ fsLit "Int8ElemRep", fsLit "Int16ElemRep", fsLit "Int32ElemRep"+                        , fsLit "Int64ElemRep", fsLit "Word8ElemRep", fsLit "Word16ElemRep"+                        , fsLit "Word32ElemRep", fsLit "Word64ElemRep"+                        , fsLit "FloatElemRep", fsLit "DoubleElemRep" ]+                        vecElemDataConKeys+                        vecElemDataCons++mk_special_dc_name :: FastString -> Unique -> DataCon -> Name+mk_special_dc_name fs u dc = mkWiredInDataConName UserSyntax gHC_TYPES fs u dc++boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR,+    intDataCon_RDR, listTyCon_RDR, consDataCon_RDR :: RdrName+boolTyCon_RDR   = nameRdrName boolTyConName+false_RDR       = nameRdrName falseDataConName+true_RDR        = nameRdrName trueDataConName+intTyCon_RDR    = nameRdrName intTyConName+charTyCon_RDR   = nameRdrName charTyConName+intDataCon_RDR  = nameRdrName intDataConName+listTyCon_RDR   = nameRdrName listTyConName+consDataCon_RDR = nameRdrName consDataConName++{-+************************************************************************+*                                                                      *+\subsection{mkWiredInTyCon}+*                                                                      *+************************************************************************+-}++-- This function assumes that the types it creates have all parameters at+-- Representational role, and that there is no kind polymorphism.+pcTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon+pcTyCon name cType tyvars cons+  = mkAlgTyCon name+                (mkAnonTyConBinders VisArg tyvars)+                liftedTypeKind+                (map (const Representational) tyvars)+                cType+                []              -- No stupid theta+                (mkDataTyConRhs cons)+                (VanillaAlgTyCon (mkPrelTyConRepName name))+                False           -- Not in GADT syntax++pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon+pcDataCon n univs = pcDataConWithFixity False n univs+                      []    -- no ex_tvs+                      univs -- the univs are precisely the user-written tyvars++pcDataConWithFixity :: Bool      -- ^ declared infix?+                    -> Name      -- ^ datacon name+                    -> [TyVar]   -- ^ univ tyvars+                    -> [TyCoVar] -- ^ ex tycovars+                    -> [TyCoVar] -- ^ user-written tycovars+                    -> [Type]    -- ^ args+                    -> TyCon+                    -> DataCon+pcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (nameUnique n))+                                                  NoRRI+-- The Name's unique is the first of two free uniques;+-- the first is used for the datacon itself,+-- the second is used for the "worker name"+--+-- To support this the mkPreludeDataConUnique function "allocates"+-- one DataCon unique per pair of Ints.++pcDataConWithFixity' :: Bool -> Name -> Unique -> RuntimeRepInfo+                     -> [TyVar] -> [TyCoVar] -> [TyCoVar]+                     -> [Type] -> TyCon -> DataCon+-- The Name should be in the DataName name space; it's the name+-- of the DataCon itself.++pcDataConWithFixity' declared_infix dc_name wrk_key rri+                     tyvars ex_tyvars user_tyvars arg_tys tycon+  = data_con+  where+    tag_map = mkTyConTagMap tycon+    -- This constructs the constructor Name to ConTag map once per+    -- constructor, which is quadratic. It's OK here, because it's+    -- only called for wired in data types that don't have a lot of+    -- constructors. It's also likely that GHC will lift tag_map, since+    -- we call pcDataConWithFixity' with static TyCons in the same module.+    -- See Note [Constructor tag allocation] and #14657+    data_con = mkDataCon dc_name declared_infix prom_info+                (map (const no_bang) arg_tys)+                []      -- No labelled fields+                tyvars ex_tyvars+                (mkTyCoVarBinders Specified user_tyvars)+                []      -- No equality spec+                []      -- No theta+                arg_tys (mkTyConApp tycon (mkTyVarTys tyvars))+                rri+                tycon+                (lookupNameEnv_NF tag_map dc_name)+                []      -- No stupid theta+                (mkDataConWorkId wrk_name data_con)+                NoDataConRep    -- Wired-in types are too simple to need wrappers++    no_bang = HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict++    wrk_name = mkDataConWorkerName data_con wrk_key++    prom_info = mkPrelTyConRepName dc_name++mkDataConWorkerName :: DataCon -> Unique -> Name+mkDataConWorkerName data_con wrk_key =+    mkWiredInName modu wrk_occ wrk_key+                  (AnId (dataConWorkId data_con)) UserSyntax+  where+    modu     = ASSERT( isExternalName dc_name )+               nameModule dc_name+    dc_name = dataConName data_con+    dc_occ  = nameOccName dc_name+    wrk_occ = mkDataConWorkerOcc dc_occ++-- used for RuntimeRep and friends+pcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon+pcSpecialDataCon dc_name arg_tys tycon rri+  = pcDataConWithFixity' False dc_name (dataConWorkerUnique (nameUnique dc_name)) rri+                         [] [] [] arg_tys tycon++{-+************************************************************************+*                                                                      *+      Kinds+*                                                                      *+************************************************************************+-}++typeNatKindCon, typeSymbolKindCon :: TyCon+-- data Nat+-- data Symbol+typeNatKindCon    = pcTyCon typeNatKindConName    Nothing [] []+typeSymbolKindCon = pcTyCon typeSymbolKindConName Nothing [] []++typeNatKind, typeSymbolKind :: Kind+typeNatKind    = mkTyConTy typeNatKindCon+typeSymbolKind = mkTyConTy typeSymbolKindCon++constraintKindTyCon :: TyCon+constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] []++liftedTypeKind, constraintKind :: Kind+liftedTypeKind   = tYPE liftedRepTy+constraintKind   = mkTyConApp constraintKindTyCon []++{-+************************************************************************+*                                                                      *+                Stuff for dealing with tuples+*                                                                      *+************************************************************************++Note [How tuples work]  See also Note [Known-key names] in PrelNames+~~~~~~~~~~~~~~~~~~~~~~+* There are three families of tuple TyCons and corresponding+  DataCons, expressed by the type BasicTypes.TupleSort:+    data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple++* All three families are AlgTyCons, whose AlgTyConRhs is TupleTyCon++* BoxedTuples+    - A wired-in type+    - Data type declarations in GHC.Tuple+    - The data constructors really have an info table++* UnboxedTuples+    - A wired-in type+    - Have a pretend DataCon, defined in GHC.Prim,+      but no actual declaration and no info table++* ConstraintTuples+    - Are known-key rather than wired-in. Reason: it's awkward to+      have all the superclass selectors wired-in.+    - Declared as classes in GHC.Classes, e.g.+         class (c1,c2) => (c1,c2)+    - Given constraints: the superclasses automatically become available+    - Wanted constraints: there is a built-in instance+         instance (c1,c2) => (c1,c2)+      See TcInteract.matchCTuple+    - Currently just go up to 62; beyond that+      you have to use manual nesting+    - Their OccNames look like (%,,,%), so they can easily be+      distinguished from term tuples.  But (following Haskell) we+      pretty-print saturated constraint tuples with round parens;+      see BasicTypes.tupleParens.++* In quite a lot of places things are restrcted just to+  BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish+  E.g. tupleTyCon has a Boxity argument++* When looking up an OccName in the original-name cache+  (IfaceEnv.lookupOrigNameCache), we spot the tuple OccName to make sure+  we get the right wired-in name.  This guy can't tell the difference+  between BoxedTuple and ConstraintTuple (same OccName!), so tuples+  are not serialised into interface files using OccNames at all.++* Serialization to interface files works via the usual mechanism for known-key+  things: instead of serializing the OccName we just serialize the key. During+  deserialization we lookup the Name associated with the unique with the logic+  in KnownUniques. See Note [Symbol table representation of names] for details.++Note [One-tuples]+~~~~~~~~~~~~~~~~~+GHC supports both boxed and unboxed one-tuples:+ - Unboxed one-tuples are sometimes useful when returning a+   single value after CPR analysis+ - A boxed one-tuple is used by DsUtils.mkSelectorBinds, when+   there is just one binder+Basically it keeps everythig uniform.++However the /naming/ of the type/data constructors for one-tuples is a+bit odd:+  3-tuples:  (,,)   (,,)#+  2-tuples:  (,)    (,)#+  1-tuples:  ??+  0-tuples:  ()     ()#++Zero-tuples have used up the logical name. So we use 'Unit' and 'Unit#'+for one-tuples.  So in ghc-prim:GHC.Tuple we see the declarations:+  data ()     = ()+  data Unit a = Unit a+  data (a,b)  = (a,b)++NB (Feb 16): for /constraint/ one-tuples I have 'Unit%' but no class+decl in GHC.Classes, so I think this part may not work properly. But+it's unused I think.+-}++-- | Built-in syntax isn't "in scope" so these OccNames map to wired-in Names+-- with BuiltInSyntax. However, this should only be necessary while resolving+-- names produced by Template Haskell splices since we take care to encode+-- built-in syntax names specially in interface files. See+-- Note [Symbol table representation of names].+--+-- Moreover, there is no need to include names of things that the user can't+-- write (e.g. type representation bindings like $tc(,,,)).+isBuiltInOcc_maybe :: OccName -> Maybe Name+isBuiltInOcc_maybe occ =+    case name of+      "[]" -> Just $ choose_ns listTyConName nilDataConName+      ":"    -> Just consDataConName++      -- equality tycon+      "~"    -> Just eqTyConName++      -- function tycon+      "->"   -> Just funTyConName++      -- boxed tuple data/tycon+      "()"    -> Just $ tup_name Boxed 0+      _ | Just rest <- "(" `BS.stripPrefix` name+        , (commas, rest') <- BS.span (==',') rest+        , ")" <- rest'+             -> Just $ tup_name Boxed (1+BS.length commas)++      -- unboxed tuple data/tycon+      "(##)"  -> Just $ tup_name Unboxed 0+      "Unit#" -> Just $ tup_name Unboxed 1+      _ | Just rest <- "(#" `BS.stripPrefix` name+        , (commas, rest') <- BS.span (==',') rest+        , "#)" <- rest'+             -> Just $ tup_name Unboxed (1+BS.length commas)++      -- unboxed sum tycon+      _ | Just rest <- "(#" `BS.stripPrefix` name+        , (pipes, rest') <- BS.span (=='|') rest+        , "#)" <- rest'+             -> Just $ tyConName $ sumTyCon (1+BS.length pipes)++      -- unboxed sum datacon+      _ | Just rest <- "(#" `BS.stripPrefix` name+        , (pipes1, rest') <- BS.span (=='|') rest+        , Just rest'' <- "_" `BS.stripPrefix` rest'+        , (pipes2, rest''') <- BS.span (=='|') rest''+        , "#)" <- rest'''+             -> let arity = BS.length pipes1 + BS.length pipes2 + 1+                    alt = BS.length pipes1 + 1+                in Just $ dataConName $ sumDataCon alt arity+      _ -> Nothing+  where+    name = bytesFS $ occNameFS occ++    choose_ns :: Name -> Name -> Name+    choose_ns tc dc+      | isTcClsNameSpace ns   = tc+      | isDataConNameSpace ns = dc+      | otherwise             = pprPanic "tup_name" (ppr occ)+      where ns = occNameSpace occ++    tup_name boxity arity+      = choose_ns (getName (tupleTyCon   boxity arity))+                  (getName (tupleDataCon boxity arity))++mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName+-- No need to cache these, the caching is done in mk_tuple+mkTupleOcc ns Boxed   ar = mkOccName ns (mkBoxedTupleStr   ar)+mkTupleOcc ns Unboxed ar = mkOccName ns (mkUnboxedTupleStr ar)++mkCTupleOcc :: NameSpace -> Arity -> OccName+mkCTupleOcc ns ar = mkOccName ns (mkConstraintTupleStr ar)++mkBoxedTupleStr :: Arity -> String+mkBoxedTupleStr 0  = "()"+mkBoxedTupleStr 1  = "Unit"   -- See Note [One-tuples]+mkBoxedTupleStr ar = '(' : commas ar ++ ")"++mkUnboxedTupleStr :: Arity -> String+mkUnboxedTupleStr 0  = "(##)"+mkUnboxedTupleStr 1  = "Unit#"  -- See Note [One-tuples]+mkUnboxedTupleStr ar = "(#" ++ commas ar ++ "#)"++mkConstraintTupleStr :: Arity -> String+mkConstraintTupleStr 0  = "(%%)"+mkConstraintTupleStr 1  = "Unit%"   -- See Note [One-tuples]+mkConstraintTupleStr ar = "(%" ++ commas ar ++ "%)"++commas :: Arity -> String+commas ar = take (ar-1) (repeat ',')++cTupleTyConName :: Arity -> Name+cTupleTyConName arity+  = mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES+                   (mkCTupleOcc tcName arity) noSrcSpan++cTupleTyConNames :: [Name]+cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE])++cTupleTyConNameSet :: NameSet+cTupleTyConNameSet = mkNameSet cTupleTyConNames++isCTupleTyConName :: Name -> Bool+-- Use Type.isCTupleClass where possible+isCTupleTyConName n+ = ASSERT2( isExternalName n, ppr n )+   nameModule n == gHC_CLASSES+   && n `elemNameSet` cTupleTyConNameSet++-- | If the given name is that of a constraint tuple, return its arity.+-- Note that this is inefficient.+cTupleTyConNameArity_maybe :: Name -> Maybe Arity+cTupleTyConNameArity_maybe n+  | not (isCTupleTyConName n) = Nothing+  | otherwise = fmap adjustArity (n `elemIndex` cTupleTyConNames)+  where+    -- Since `cTupleTyConNames` jumps straight from the `0` to the `2`+    -- case, we have to adjust accordingly our calculated arity.+    adjustArity a = if a > 0 then a + 1 else a++cTupleDataConName :: Arity -> Name+cTupleDataConName arity+  = mkExternalName (mkCTupleDataConUnique arity) gHC_CLASSES+                   (mkCTupleOcc dataName arity) noSrcSpan++cTupleDataConNames :: [Name]+cTupleDataConNames = map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE])++tupleTyCon :: Boxity -> Arity -> TyCon+tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i)  -- Build one specially+tupleTyCon Boxed   i = fst (boxedTupleArr   ! i)+tupleTyCon Unboxed i = fst (unboxedTupleArr ! i)++tupleTyConName :: TupleSort -> Arity -> Name+tupleTyConName ConstraintTuple a = cTupleTyConName a+tupleTyConName BoxedTuple      a = tyConName (tupleTyCon Boxed a)+tupleTyConName UnboxedTuple    a = tyConName (tupleTyCon Unboxed a)++promotedTupleDataCon :: Boxity -> Arity -> TyCon+promotedTupleDataCon boxity i = promoteDataCon (tupleDataCon boxity i)++tupleDataCon :: Boxity -> Arity -> DataCon+tupleDataCon sort i | i > mAX_TUPLE_SIZE = snd (mk_tuple sort i)    -- Build one specially+tupleDataCon Boxed   i = snd (boxedTupleArr   ! i)+tupleDataCon Unboxed i = snd (unboxedTupleArr ! i)++boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon)+boxedTupleArr   = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed   i | i <- [0..mAX_TUPLE_SIZE]]+unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]]++-- | Given the TupleRep/SumRep tycon and list of RuntimeReps of the unboxed+-- tuple/sum arguments, produces the return kind of an unboxed tuple/sum type+-- constructor. @unboxedTupleSumKind [IntRep, LiftedRep] --> TYPE (TupleRep/SumRep+-- [IntRep, LiftedRep])@+unboxedTupleSumKind :: TyCon -> [Type] -> Kind+unboxedTupleSumKind tc rr_tys+  = tYPE (mkTyConApp tc [mkPromotedListTy runtimeRepTy rr_tys])++-- | Specialization of 'unboxedTupleSumKind' for tuples+unboxedTupleKind :: [Type] -> Kind+unboxedTupleKind = unboxedTupleSumKind tupleRepDataConTyCon++mk_tuple :: Boxity -> Int -> (TyCon,DataCon)+mk_tuple Boxed arity = (tycon, tuple_con)+  where+    tycon = mkTupleTyCon tc_name tc_binders tc_res_kind tc_arity tuple_con+                         BoxedTuple flavour++    tc_binders  = mkTemplateAnonTyConBinders (replicate arity liftedTypeKind)+    tc_res_kind = liftedTypeKind+    tc_arity    = arity+    flavour     = VanillaAlgTyCon (mkPrelTyConRepName tc_name)++    dc_tvs     = binderVars tc_binders+    dc_arg_tys = mkTyVarTys dc_tvs+    tuple_con  = pcDataCon dc_name dc_tvs dc_arg_tys tycon++    boxity  = Boxed+    modu    = gHC_TUPLE+    tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq+                         (ATyCon tycon) BuiltInSyntax+    dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq+                            (AConLike (RealDataCon tuple_con)) BuiltInSyntax+    tc_uniq = mkTupleTyConUnique   boxity arity+    dc_uniq = mkTupleDataConUnique boxity arity++mk_tuple Unboxed arity = (tycon, tuple_con)+  where+    tycon = mkTupleTyCon tc_name tc_binders tc_res_kind tc_arity tuple_con+                         UnboxedTuple flavour++    -- See Note [Unboxed tuple RuntimeRep vars] in TyCon+    -- Kind:  forall (k1:RuntimeRep) (k2:RuntimeRep). TYPE k1 -> TYPE k2 -> #+    tc_binders = mkTemplateTyConBinders (replicate arity runtimeRepTy)+                                        (\ks -> map tYPE ks)++    tc_res_kind = unboxedTupleKind rr_tys++    tc_arity    = arity * 2+    flavour     = UnboxedAlgTyCon $ Just (mkPrelTyConRepName tc_name)++    dc_tvs               = binderVars tc_binders+    (rr_tys, dc_arg_tys) = splitAt arity (mkTyVarTys dc_tvs)+    tuple_con            = pcDataCon dc_name dc_tvs dc_arg_tys tycon++    boxity  = Unboxed+    modu    = gHC_PRIM+    tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq+                         (ATyCon tycon) BuiltInSyntax+    dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq+                            (AConLike (RealDataCon tuple_con)) BuiltInSyntax+    tc_uniq = mkTupleTyConUnique   boxity arity+    dc_uniq = mkTupleDataConUnique boxity arity++unitTyCon :: TyCon+unitTyCon = tupleTyCon Boxed 0++unitTyConKey :: Unique+unitTyConKey = getUnique unitTyCon++unitDataCon :: DataCon+unitDataCon   = head (tyConDataCons unitTyCon)++unitDataConId :: Id+unitDataConId = dataConWorkId unitDataCon++pairTyCon :: TyCon+pairTyCon = tupleTyCon Boxed 2++unboxedUnitTyCon :: TyCon+unboxedUnitTyCon = tupleTyCon Unboxed 0++unboxedUnitDataCon :: DataCon+unboxedUnitDataCon = tupleDataCon   Unboxed 0+++{- *********************************************************************+*                                                                      *+      Unboxed sums+*                                                                      *+********************************************************************* -}++-- | OccName for n-ary unboxed sum type constructor.+mkSumTyConOcc :: Arity -> OccName+mkSumTyConOcc n = mkOccName tcName str+  where+    -- No need to cache these, the caching is done in mk_sum+    str = '(' : '#' : bars ++ "#)"+    bars = replicate (n-1) '|'++-- | OccName for i-th alternative of n-ary unboxed sum data constructor.+mkSumDataConOcc :: ConTag -> Arity -> OccName+mkSumDataConOcc alt n = mkOccName dataName str+  where+    -- No need to cache these, the caching is done in mk_sum+    str = '(' : '#' : bars alt ++ '_' : bars (n - alt - 1) ++ "#)"+    bars i = replicate i '|'++-- | Type constructor for n-ary unboxed sum.+sumTyCon :: Arity -> TyCon+sumTyCon arity+  | arity > mAX_SUM_SIZE+  = fst (mk_sum arity)  -- Build one specially++  | arity < 2+  = panic ("sumTyCon: Arity starts from 2. (arity: " ++ show arity ++ ")")++  | otherwise+  = fst (unboxedSumArr ! arity)++-- | Data constructor for i-th alternative of a n-ary unboxed sum.+sumDataCon :: ConTag -- Alternative+           -> Arity  -- Arity+           -> DataCon+sumDataCon alt arity+  | alt > arity+  = panic ("sumDataCon: index out of bounds: alt: "+           ++ show alt ++ " > arity " ++ show arity)++  | alt <= 0+  = panic ("sumDataCon: Alts start from 1. (alt: " ++ show alt+           ++ ", arity: " ++ show arity ++ ")")++  | arity < 2+  = panic ("sumDataCon: Arity starts from 2. (alt: " ++ show alt+           ++ ", arity: " ++ show arity ++ ")")++  | arity > mAX_SUM_SIZE+  = snd (mk_sum arity) ! (alt - 1)  -- Build one specially++  | otherwise+  = snd (unboxedSumArr ! arity) ! (alt - 1)++-- | Cached type and data constructors for sums. The outer array is+-- indexed by the arity of the sum and the inner array is indexed by+-- the alternative.+unboxedSumArr :: Array Int (TyCon, Array Int DataCon)+unboxedSumArr = listArray (2,mAX_SUM_SIZE) [mk_sum i | i <- [2..mAX_SUM_SIZE]]++-- | Specialization of 'unboxedTupleSumKind' for sums+unboxedSumKind :: [Type] -> Kind+unboxedSumKind = unboxedTupleSumKind sumRepDataConTyCon++-- | Create type constructor and data constructors for n-ary unboxed sum.+mk_sum :: Arity -> (TyCon, Array ConTagZ DataCon)+mk_sum arity = (tycon, sum_cons)+  where+    tycon   = mkSumTyCon tc_name tc_binders tc_res_kind (arity * 2) tyvars (elems sum_cons)+                         (UnboxedAlgTyCon rep_name)++    -- Unboxed sums are currently not Typeable due to efficiency concerns. See #13276.+    rep_name = Nothing -- Just $ mkPrelTyConRepName tc_name++    tc_binders = mkTemplateTyConBinders (replicate arity runtimeRepTy)+                                        (\ks -> map tYPE ks)++    tyvars = binderVars tc_binders++    tc_res_kind = unboxedSumKind rr_tys++    (rr_tys, tyvar_tys) = splitAt arity (mkTyVarTys tyvars)++    tc_name = mkWiredInName gHC_PRIM (mkSumTyConOcc arity) tc_uniq+                            (ATyCon tycon) BuiltInSyntax++    sum_cons = listArray (0,arity-1) [sum_con i | i <- [0..arity-1]]+    sum_con i = let dc = pcDataCon dc_name+                                   tyvars -- univ tyvars+                                   [tyvar_tys !! i] -- arg types+                                   tycon++                    dc_name = mkWiredInName gHC_PRIM+                                            (mkSumDataConOcc i arity)+                                            (dc_uniq i)+                                            (AConLike (RealDataCon dc))+                                            BuiltInSyntax+                in dc++    tc_uniq   = mkSumTyConUnique   arity+    dc_uniq i = mkSumDataConUnique i arity++{-+************************************************************************+*                                                                      *+              Equality types and classes+*                                                                      *+********************************************************************* -}++-- See Note [The equality types story] in TysPrim+-- ((~~) :: forall k1 k2 (a :: k1) (b :: k2). a -> b -> Constraint)+--+-- It's tempting to put functional dependencies on (~~), but it's not+-- necessary because the functional-dependency coverage check looks+-- through superclasses, and (~#) is handled in that check.++eqTyCon,   heqTyCon,   coercibleTyCon   :: TyCon+eqClass,   heqClass,   coercibleClass   :: Class+eqDataCon, heqDataCon, coercibleDataCon :: DataCon+eqSCSelId, heqSCSelId, coercibleSCSelId :: Id++(eqTyCon, eqClass, eqDataCon, eqSCSelId)+  = (tycon, klass, datacon, sc_sel_id)+  where+    tycon     = mkClassTyCon eqTyConName binders roles+                             rhs klass+                             (mkPrelTyConRepName eqTyConName)+    klass     = mk_class tycon sc_pred sc_sel_id+    datacon   = pcDataCon eqDataConName tvs [sc_pred] tycon++    -- Kind: forall k. k -> k -> Constraint+    binders   = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k])+    roles     = [Nominal, Nominal, Nominal]+    rhs       = mkDataTyConRhs [datacon]++    tvs@[k,a,b] = binderVars binders+    sc_pred     = mkTyConApp eqPrimTyCon (mkTyVarTys [k,k,a,b])+    sc_sel_id   = mkDictSelId eqSCSelIdName klass++(heqTyCon, heqClass, heqDataCon, heqSCSelId)+  = (tycon, klass, datacon, sc_sel_id)+  where+    tycon     = mkClassTyCon heqTyConName binders roles+                             rhs klass+                             (mkPrelTyConRepName heqTyConName)+    klass     = mk_class tycon sc_pred sc_sel_id+    datacon   = pcDataCon heqDataConName tvs [sc_pred] tycon++    -- Kind: forall k1 k2. k1 -> k2 -> Constraint+    binders   = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id+    roles     = [Nominal, Nominal, Nominal, Nominal]+    rhs       = mkDataTyConRhs [datacon]++    tvs       = binderVars binders+    sc_pred   = mkTyConApp eqPrimTyCon (mkTyVarTys tvs)+    sc_sel_id = mkDictSelId heqSCSelIdName klass++(coercibleTyCon, coercibleClass, coercibleDataCon, coercibleSCSelId)+  = (tycon, klass, datacon, sc_sel_id)+  where+    tycon     = mkClassTyCon coercibleTyConName binders roles+                             rhs klass+                             (mkPrelTyConRepName coercibleTyConName)+    klass     = mk_class tycon sc_pred sc_sel_id+    datacon   = pcDataCon coercibleDataConName tvs [sc_pred] tycon++    -- Kind: forall k. k -> k -> Constraint+    binders   = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k])+    roles     = [Nominal, Representational, Representational]+    rhs       = mkDataTyConRhs [datacon]++    tvs@[k,a,b] = binderVars binders+    sc_pred     = mkTyConApp eqReprPrimTyCon (mkTyVarTys [k, k, a, b])+    sc_sel_id   = mkDictSelId coercibleSCSelIdName klass++mk_class :: TyCon -> PredType -> Id -> Class+mk_class tycon sc_pred sc_sel_id+  = mkClass (tyConName tycon) (tyConTyVars tycon) [] [sc_pred] [sc_sel_id]+            [] [] (mkAnd []) tycon++++{- *********************************************************************+*                                                                      *+                Kinds and RuntimeRep+*                                                                      *+********************************************************************* -}++-- For information about the usage of the following type,+-- see Note [TYPE and RuntimeRep] in module TysPrim+runtimeRepTy :: Type+runtimeRepTy = mkTyConTy runtimeRepTyCon++-- Type synonyms; see Note [TYPE and RuntimeRep] in TysPrim+-- type Type = tYPE 'LiftedRep+liftedTypeKindTyCon :: TyCon+liftedTypeKindTyCon   = buildSynTyCon liftedTypeKindTyConName+                                       [] liftedTypeKind []+                                       (tYPE liftedRepTy)++runtimeRepTyCon :: TyCon+runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing []+                          (vecRepDataCon : tupleRepDataCon :+                           sumRepDataCon : runtimeRepSimpleDataCons)++vecRepDataCon :: DataCon+vecRepDataCon = pcSpecialDataCon vecRepDataConName [ mkTyConTy vecCountTyCon+                                                   , mkTyConTy vecElemTyCon ]+                                 runtimeRepTyCon+                                 (RuntimeRep prim_rep_fun)+  where+    prim_rep_fun [count, elem]+      | VecCount n <- tyConRuntimeRepInfo (tyConAppTyCon count)+      , VecElem  e <- tyConRuntimeRepInfo (tyConAppTyCon elem)+      = [VecRep n e]+    prim_rep_fun args+      = pprPanic "vecRepDataCon" (ppr args)++vecRepDataConTyCon :: TyCon+vecRepDataConTyCon = promoteDataCon vecRepDataCon++tupleRepDataCon :: DataCon+tupleRepDataCon = pcSpecialDataCon tupleRepDataConName [ mkListTy runtimeRepTy ]+                                   runtimeRepTyCon (RuntimeRep prim_rep_fun)+  where+    prim_rep_fun [rr_ty_list]+      = concatMap (runtimeRepPrimRep doc) rr_tys+      where+        rr_tys = extractPromotedList rr_ty_list+        doc    = text "tupleRepDataCon" <+> ppr rr_tys+    prim_rep_fun args+      = pprPanic "tupleRepDataCon" (ppr args)++tupleRepDataConTyCon :: TyCon+tupleRepDataConTyCon = promoteDataCon tupleRepDataCon++sumRepDataCon :: DataCon+sumRepDataCon = pcSpecialDataCon sumRepDataConName [ mkListTy runtimeRepTy ]+                                 runtimeRepTyCon (RuntimeRep prim_rep_fun)+  where+    prim_rep_fun [rr_ty_list]+      = map slotPrimRep (ubxSumRepType prim_repss)+      where+        rr_tys     = extractPromotedList rr_ty_list+        doc        = text "sumRepDataCon" <+> ppr rr_tys+        prim_repss = map (runtimeRepPrimRep doc) rr_tys+    prim_rep_fun args+      = pprPanic "sumRepDataCon" (ppr args)++sumRepDataConTyCon :: TyCon+sumRepDataConTyCon = promoteDataCon sumRepDataCon++-- See Note [Wiring in RuntimeRep]+runtimeRepSimpleDataCons :: [DataCon]+liftedRepDataCon :: DataCon+runtimeRepSimpleDataCons@(liftedRepDataCon : _)+  = zipWithLazy mk_runtime_rep_dc+    [ LiftedRep, UnliftedRep, IntRep, WordRep, Int8Rep, Int16Rep, Int64Rep+    , Word8Rep, Word16Rep, Word64Rep, AddrRep, FloatRep, DoubleRep ]+    runtimeRepSimpleDataConNames+  where+    mk_runtime_rep_dc primrep name+      = pcSpecialDataCon name [] runtimeRepTyCon (RuntimeRep (\_ -> [primrep]))++-- See Note [Wiring in RuntimeRep]+liftedRepDataConTy, unliftedRepDataConTy,+  intRepDataConTy, int8RepDataConTy, int16RepDataConTy, wordRepDataConTy, int64RepDataConTy,+  word8RepDataConTy, word16RepDataConTy, word64RepDataConTy, addrRepDataConTy,+  floatRepDataConTy, doubleRepDataConTy :: Type+[liftedRepDataConTy, unliftedRepDataConTy,+   intRepDataConTy, wordRepDataConTy, int8RepDataConTy, int16RepDataConTy, int64RepDataConTy,+   word8RepDataConTy, word16RepDataConTy, word64RepDataConTy,+   addrRepDataConTy, floatRepDataConTy, doubleRepDataConTy]+  = map (mkTyConTy . promoteDataCon) runtimeRepSimpleDataCons++vecCountTyCon :: TyCon+vecCountTyCon = pcTyCon vecCountTyConName Nothing [] vecCountDataCons++-- See Note [Wiring in RuntimeRep]+vecCountDataCons :: [DataCon]+vecCountDataCons = zipWithLazy mk_vec_count_dc+                     [ 2, 4, 8, 16, 32, 64 ]+                     vecCountDataConNames+  where+    mk_vec_count_dc n name+      = pcSpecialDataCon name [] vecCountTyCon (VecCount n)++-- See Note [Wiring in RuntimeRep]+vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,+  vec64DataConTy :: Type+[vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,+  vec64DataConTy] = map (mkTyConTy . promoteDataCon) vecCountDataCons++vecElemTyCon :: TyCon+vecElemTyCon = pcTyCon vecElemTyConName Nothing [] vecElemDataCons++-- See Note [Wiring in RuntimeRep]+vecElemDataCons :: [DataCon]+vecElemDataCons = zipWithLazy mk_vec_elem_dc+                    [ Int8ElemRep, Int16ElemRep, Int32ElemRep, Int64ElemRep+                    , Word8ElemRep, Word16ElemRep, Word32ElemRep, Word64ElemRep+                    , FloatElemRep, DoubleElemRep ]+                    vecElemDataConNames+  where+    mk_vec_elem_dc elem name+      = pcSpecialDataCon name [] vecElemTyCon (VecElem elem)++-- See Note [Wiring in RuntimeRep]+int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,+  int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,+  word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,+  doubleElemRepDataConTy :: Type+[int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,+  int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,+  word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,+  doubleElemRepDataConTy] = map (mkTyConTy . promoteDataCon)+                                vecElemDataCons++liftedRepDataConTyCon :: TyCon+liftedRepDataConTyCon = promoteDataCon liftedRepDataCon++-- The type ('LiftedRep)+liftedRepTy :: Type+liftedRepTy = liftedRepDataConTy++{- *********************************************************************+*                                                                      *+     The boxed primitive types: Char, Int, etc+*                                                                      *+********************************************************************* -}++boxingDataCon_maybe :: TyCon -> Maybe DataCon+--    boxingDataCon_maybe Char# = C#+--    boxingDataCon_maybe Int#  = I#+--    ... etc ...+-- See Note [Boxing primitive types]+boxingDataCon_maybe tc+  = lookupNameEnv boxing_constr_env (tyConName tc)++boxing_constr_env :: NameEnv DataCon+boxing_constr_env+  = mkNameEnv [(charPrimTyConName  , charDataCon  )+              ,(intPrimTyConName   , intDataCon   )+              ,(wordPrimTyConName  , wordDataCon  )+              ,(floatPrimTyConName , floatDataCon )+              ,(doublePrimTyConName, doubleDataCon) ]++{- Note [Boxing primitive types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For a handful of primitive types (Int, Char, Word, Flaot, Double),+we can readily box and an unboxed version (Int#, Char# etc) using+the corresponding data constructor.  This is useful in a couple+of places, notably let-floating -}+++charTy :: Type+charTy = mkTyConTy charTyCon++charTyCon :: TyCon+charTyCon   = pcTyCon charTyConName+                   (Just (CType NoSourceText Nothing+                                  (NoSourceText,fsLit "HsChar")))+                   [] [charDataCon]+charDataCon :: DataCon+charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon++stringTy :: Type+stringTy = mkListTy charTy -- convenience only++intTy :: Type+intTy = mkTyConTy intTyCon++intTyCon :: TyCon+intTyCon = pcTyCon intTyConName+               (Just (CType NoSourceText Nothing (NoSourceText,fsLit "HsInt")))+                 [] [intDataCon]+intDataCon :: DataCon+intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon++wordTy :: Type+wordTy = mkTyConTy wordTyCon++wordTyCon :: TyCon+wordTyCon = pcTyCon wordTyConName+            (Just (CType NoSourceText Nothing (NoSourceText, fsLit "HsWord")))+               [] [wordDataCon]+wordDataCon :: DataCon+wordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon++word8Ty :: Type+word8Ty = mkTyConTy word8TyCon++word8TyCon :: TyCon+word8TyCon = pcTyCon word8TyConName+                     (Just (CType NoSourceText Nothing+                            (NoSourceText, fsLit "HsWord8"))) []+                     [word8DataCon]+word8DataCon :: DataCon+word8DataCon = pcDataCon word8DataConName [] [wordPrimTy] word8TyCon++floatTy :: Type+floatTy = mkTyConTy floatTyCon++floatTyCon :: TyCon+floatTyCon   = pcTyCon floatTyConName+                      (Just (CType NoSourceText Nothing+                             (NoSourceText, fsLit "HsFloat"))) []+                      [floatDataCon]+floatDataCon :: DataCon+floatDataCon = pcDataCon         floatDataConName [] [floatPrimTy] floatTyCon++doubleTy :: Type+doubleTy = mkTyConTy doubleTyCon++doubleTyCon :: TyCon+doubleTyCon = pcTyCon doubleTyConName+                      (Just (CType NoSourceText Nothing+                             (NoSourceText,fsLit "HsDouble"))) []+                      [doubleDataCon]++doubleDataCon :: DataCon+doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon++{-+************************************************************************+*                                                                      *+              The Bool type+*                                                                      *+************************************************************************++An ordinary enumeration type, but deeply wired in.  There are no+magical operations on @Bool@ (just the regular Prelude code).++{\em BEGIN IDLE SPECULATION BY SIMON}++This is not the only way to encode @Bool@.  A more obvious coding makes+@Bool@ just a boxed up version of @Bool#@, like this:+\begin{verbatim}+type Bool# = Int#+data Bool = MkBool Bool#+\end{verbatim}++Unfortunately, this doesn't correspond to what the Report says @Bool@+looks like!  Furthermore, we get slightly less efficient code (I+think) with this coding. @gtInt@ would look like this:++\begin{verbatim}+gtInt :: Int -> Int -> Bool+gtInt x y = case x of I# x# ->+            case y of I# y# ->+            case (gtIntPrim x# y#) of+                b# -> MkBool b#+\end{verbatim}++Notice that the result of the @gtIntPrim@ comparison has to be turned+into an integer (here called @b#@), and returned in a @MkBool@ box.++The @if@ expression would compile to this:+\begin{verbatim}+case (gtInt x y) of+  MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }+\end{verbatim}++I think this code is a little less efficient than the previous code,+but I'm not certain.  At all events, corresponding with the Report is+important.  The interesting thing is that the language is expressive+enough to describe more than one alternative; and that a type doesn't+necessarily need to be a straightforwardly boxed version of its+primitive counterpart.++{\em END IDLE SPECULATION BY SIMON}+-}++boolTy :: Type+boolTy = mkTyConTy boolTyCon++boolTyCon :: TyCon+boolTyCon = pcTyCon boolTyConName+                    (Just (CType NoSourceText Nothing+                           (NoSourceText, fsLit "HsBool")))+                    [] [falseDataCon, trueDataCon]++falseDataCon, trueDataCon :: DataCon+falseDataCon = pcDataCon falseDataConName [] [] boolTyCon+trueDataCon  = pcDataCon trueDataConName  [] [] boolTyCon++falseDataConId, trueDataConId :: Id+falseDataConId = dataConWorkId falseDataCon+trueDataConId  = dataConWorkId trueDataCon++orderingTyCon :: TyCon+orderingTyCon = pcTyCon orderingTyConName Nothing+                        [] [ordLTDataCon, ordEQDataCon, ordGTDataCon]++ordLTDataCon, ordEQDataCon, ordGTDataCon :: DataCon+ordLTDataCon = pcDataCon ordLTDataConName  [] [] orderingTyCon+ordEQDataCon = pcDataCon ordEQDataConName  [] [] orderingTyCon+ordGTDataCon = pcDataCon ordGTDataConName  [] [] orderingTyCon++ordLTDataConId, ordEQDataConId, ordGTDataConId :: Id+ordLTDataConId = dataConWorkId ordLTDataCon+ordEQDataConId = dataConWorkId ordEQDataCon+ordGTDataConId = dataConWorkId ordGTDataCon++{-+************************************************************************+*                                                                      *+            The List type+   Special syntax, deeply wired in,+   but otherwise an ordinary algebraic data type+*                                                                      *+************************************************************************++       data [] a = [] | a : (List a)+-}++mkListTy :: Type -> Type+mkListTy ty = mkTyConApp listTyCon [ty]++listTyCon :: TyCon+listTyCon =+  buildAlgTyCon listTyConName alpha_tyvar [Representational]+                Nothing []+                (mkDataTyConRhs [nilDataCon, consDataCon])+                False+                (VanillaAlgTyCon $ mkPrelTyConRepName listTyConName)++nilDataCon :: DataCon+nilDataCon  = pcDataCon nilDataConName alpha_tyvar [] listTyCon++consDataCon :: DataCon+consDataCon = pcDataConWithFixity True {- Declared infix -}+               consDataConName+               alpha_tyvar [] alpha_tyvar+               [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon+-- Interesting: polymorphic recursion would help here.+-- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy+-- gets the over-specific type (Type -> Type)++-- Wired-in type Maybe++maybeTyCon :: TyCon+maybeTyCon = pcTyCon maybeTyConName Nothing alpha_tyvar+                     [nothingDataCon, justDataCon]++nothingDataCon :: DataCon+nothingDataCon = pcDataCon nothingDataConName alpha_tyvar [] maybeTyCon++justDataCon :: DataCon+justDataCon = pcDataCon justDataConName alpha_tyvar [alphaTy] maybeTyCon++{-+** *********************************************************************+*                                                                      *+            The tuple types+*                                                                      *+************************************************************************++The tuple types are definitely magic, because they form an infinite+family.++\begin{itemize}+\item+They have a special family of type constructors, of type @TyCon@+These contain the tycon arity, but don't require a Unique.++\item+They have a special family of constructors, of type+@Id@. Again these contain their arity but don't need a Unique.++\item+There should be a magic way of generating the info tables and+entry code for all tuples.++But at the moment we just compile a Haskell source+file\srcloc{lib/prelude/...} containing declarations like:+\begin{verbatim}+data Tuple0             = Tup0+data Tuple2  a b        = Tup2  a b+data Tuple3  a b c      = Tup3  a b c+data Tuple4  a b c d    = Tup4  a b c d+...+\end{verbatim}+The print-names associated with the magic @Id@s for tuple constructors+``just happen'' to be the same as those generated by these+declarations.++\item+The instance environment should have a magic way to know+that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and+so on. \ToDo{Not implemented yet.}++\item+There should also be a way to generate the appropriate code for each+of these instances, but (like the info tables and entry code) it is+done by enumeration\srcloc{lib/prelude/InTup?.hs}.+\end{itemize}+-}++-- | Make a tuple type. The list of types should /not/ include any+-- RuntimeRep specifications.+mkTupleTy :: Boxity -> [Type] -> Type+-- Special case for *boxed* 1-tuples, which are represented by the type itself+mkTupleTy Boxed   [ty] = ty+mkTupleTy Boxed   tys  = mkTyConApp (tupleTyCon Boxed (length tys)) tys+mkTupleTy Unboxed tys  = mkTyConApp (tupleTyCon Unboxed (length tys))+                                        (map getRuntimeRep tys ++ tys)++-- | Build the type of a small tuple that holds the specified type of thing+mkBoxedTupleTy :: [Type] -> Type+mkBoxedTupleTy tys = mkTupleTy Boxed tys++unitTy :: Type+unitTy = mkTupleTy Boxed []++{- *********************************************************************+*                                                                      *+            The sum types+*                                                                      *+************************************************************************+-}++mkSumTy :: [Type] -> Type+mkSumTy tys = mkTyConApp (sumTyCon (length tys))+                         (map getRuntimeRep tys ++ tys)++-- Promoted Booleans++promotedFalseDataCon, promotedTrueDataCon :: TyCon+promotedTrueDataCon   = promoteDataCon trueDataCon+promotedFalseDataCon  = promoteDataCon falseDataCon++-- Promoted Maybe+promotedNothingDataCon, promotedJustDataCon :: TyCon+promotedNothingDataCon = promoteDataCon nothingDataCon+promotedJustDataCon    = promoteDataCon justDataCon++-- Promoted Ordering++promotedLTDataCon+  , promotedEQDataCon+  , promotedGTDataCon+  :: TyCon+promotedLTDataCon     = promoteDataCon ordLTDataCon+promotedEQDataCon     = promoteDataCon ordEQDataCon+promotedGTDataCon     = promoteDataCon ordGTDataCon++-- Promoted List+promotedConsDataCon, promotedNilDataCon :: TyCon+promotedConsDataCon   = promoteDataCon consDataCon+promotedNilDataCon    = promoteDataCon nilDataCon++-- | Make a *promoted* list.+mkPromotedListTy :: Kind   -- ^ of the elements of the list+                 -> [Type] -- ^ elements+                 -> Type+mkPromotedListTy k tys+  = foldr cons nil tys+  where+    cons :: Type  -- element+         -> Type  -- list+         -> Type+    cons elt list = mkTyConApp promotedConsDataCon [k, elt, list]++    nil :: Type+    nil = mkTyConApp promotedNilDataCon [k]++-- | Extract the elements of a promoted list. Panics if the type is not a+-- promoted list+extractPromotedList :: Type    -- ^ The promoted list+                    -> [Type]+extractPromotedList tys = go tys+  where+    go list_ty+      | Just (tc, [_k, t, ts]) <- splitTyConApp_maybe list_ty+      = ASSERT( tc `hasKey` consDataConKey )+        t : go ts++      | Just (tc, [_k]) <- splitTyConApp_maybe list_ty+      = ASSERT( tc `hasKey` nilDataConKey )+        []++      | otherwise+      = pprPanic "extractPromotedList" (ppr tys)
+ compiler/prelude/TysWiredIn.hs-boot view
@@ -0,0 +1,37 @@+module TysWiredIn where++import {-# SOURCE #-} TyCon      ( TyCon )+import {-# SOURCE #-} TyCoRep    (Type, Kind)++listTyCon :: TyCon+typeNatKind, typeSymbolKind :: Type+mkBoxedTupleTy :: [Type] -> Type++coercibleTyCon, heqTyCon :: TyCon++unitTy :: Type++liftedTypeKind :: Kind+constraintKind :: Kind++runtimeRepTyCon, vecCountTyCon, vecElemTyCon :: TyCon+runtimeRepTy :: Type++liftedRepDataConTyCon, vecRepDataConTyCon, tupleRepDataConTyCon :: TyCon++liftedRepDataConTy, unliftedRepDataConTy, intRepDataConTy, int8RepDataConTy,+  int16RepDataConTy, word16RepDataConTy,+  wordRepDataConTy, int64RepDataConTy, word8RepDataConTy, word64RepDataConTy,+  addrRepDataConTy, floatRepDataConTy, doubleRepDataConTy :: Type++vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,+  vec64DataConTy :: Type++int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,+  int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,+  word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,+  doubleElemRepDataConTy :: Type++anyTypeOfKind :: Kind -> Type+unboxedTupleKind :: [Type] -> Type+mkPromotedListTy :: Type -> [Type] -> Type
+ compiler/profiling/CostCentre.hs view
@@ -0,0 +1,359 @@+{-# LANGUAGE DeriveDataTypeable #-}+module CostCentre (+        CostCentre(..), CcName, CCFlavour(..),+                -- All abstract except to friend: ParseIface.y++        CostCentreStack,+        CollectedCCs, emptyCollectedCCs, collectCC,+        currentCCS, dontCareCCS,+        isCurrentCCS,+        maybeSingletonCCS,++        mkUserCC, mkAutoCC, mkAllCafsCC,+        mkSingletonCCS,+        isCafCCS, isCafCC, isSccCountCC, sccAbleCC, ccFromThisModule,++        pprCostCentreCore,+        costCentreUserName, costCentreUserNameFS,+        costCentreSrcSpan,++        cmpCostCentre   -- used for removing dups in a list+    ) where++import GhcPrelude++import Binary+import Var+import Name+import Module+import Unique+import Outputable+import SrcLoc+import FastString+import Util+import CostCentreState++import Data.Data++-----------------------------------------------------------------------------+-- Cost Centres++-- | A Cost Centre is a single @{-# SCC #-}@ annotation.++data CostCentre+  = NormalCC {+                cc_flavour  :: CCFlavour,+                 -- ^ Two cost centres may have the same name and+                 -- module but different SrcSpans, so we need a way to+                 -- distinguish them easily and give them different+                 -- object-code labels.  So every CostCentre has an+                 -- associated flavour that indicates how it was+                 -- generated, and flavours that allow multiple instances+                 -- of the same name and module have a deterministic 0-based+                 -- index.+                cc_name :: CcName,      -- ^ Name of the cost centre itself+                cc_mod  :: Module,      -- ^ Name of module defining this CC.+                cc_loc  :: SrcSpan+    }++  | AllCafsCC {+                cc_mod  :: Module,      -- Name of module defining this CC.+                cc_loc  :: SrcSpan+    }+  deriving Data++type CcName = FastString++-- | The flavour of a cost centre.+--+-- Index fields represent 0-based indices giving source-code ordering of+-- centres with the same module, name, and flavour.+data CCFlavour = CafCC -- ^ Auto-generated top-level thunk+               | ExprCC !CostCentreIndex -- ^ Explicitly annotated expression+               | DeclCC !CostCentreIndex -- ^ Explicitly annotated declaration+               | HpcCC !CostCentreIndex -- ^ Generated by HPC for coverage+               deriving (Eq, Ord, Data)++-- | Extract the index from a flavour+flavourIndex :: CCFlavour -> Int+flavourIndex CafCC = 0+flavourIndex (ExprCC x) = unCostCentreIndex x+flavourIndex (DeclCC x) = unCostCentreIndex x+flavourIndex (HpcCC x) = unCostCentreIndex x++instance Eq CostCentre where+        c1 == c2 = case c1 `cmpCostCentre` c2 of { EQ -> True; _ -> False }++instance Ord CostCentre where+        compare = cmpCostCentre++cmpCostCentre :: CostCentre -> CostCentre -> Ordering++cmpCostCentre (AllCafsCC  {cc_mod = m1}) (AllCafsCC  {cc_mod = m2})+  = m1 `compare` m2++cmpCostCentre NormalCC {cc_flavour = f1, cc_mod =  m1, cc_name = n1}+              NormalCC {cc_flavour = f2, cc_mod =  m2, cc_name = n2}+    -- first key is module name, then centre name, then flavour+  = (m1 `compare` m2) `thenCmp` (n1 `compare` n2) `thenCmp` (f1 `compare` f2)++cmpCostCentre other_1 other_2+  = let+        tag1 = tag_CC other_1+        tag2 = tag_CC other_2+    in+    if tag1 < tag2 then LT else GT+  where+    tag_CC :: CostCentre -> Int+    tag_CC (NormalCC   {}) = 0+    tag_CC (AllCafsCC  {}) = 1+++-----------------------------------------------------------------------------+-- Predicates on CostCentre++isCafCC :: CostCentre -> Bool+isCafCC (AllCafsCC {})                  = True+isCafCC (NormalCC {cc_flavour = CafCC}) = True+isCafCC _                               = False++-- | Is this a cost-centre which records scc counts+isSccCountCC :: CostCentre -> Bool+isSccCountCC cc | isCafCC cc  = False+                | otherwise   = True++-- | Is this a cost-centre which can be sccd ?+sccAbleCC :: CostCentre -> Bool+sccAbleCC cc | isCafCC cc = False+             | otherwise  = True++ccFromThisModule :: CostCentre -> Module -> Bool+ccFromThisModule cc m = cc_mod cc == m+++-----------------------------------------------------------------------------+-- Building cost centres++mkUserCC :: FastString -> Module -> SrcSpan -> CCFlavour -> CostCentre+mkUserCC cc_name mod loc flavour+  = NormalCC { cc_name = cc_name, cc_mod =  mod, cc_loc = loc,+               cc_flavour = flavour+    }++mkAutoCC :: Id -> Module -> CostCentre+mkAutoCC id mod+  = NormalCC { cc_name = str, cc_mod =  mod,+               cc_loc = nameSrcSpan (getName id),+               cc_flavour = CafCC+    }+  where+        name = getName id+        -- beware: only external names are guaranteed to have unique+        -- Occnames.  If the name is not external, we must append its+        -- Unique.+        -- See bug #249, tests prof001, prof002,  also #2411+        str | isExternalName name = occNameFS (getOccName id)+            | otherwise           = occNameFS (getOccName id)+                                    `appendFS`+                                    mkFastString ('_' : show (getUnique name))+mkAllCafsCC :: Module -> SrcSpan -> CostCentre+mkAllCafsCC m loc = AllCafsCC { cc_mod = m, cc_loc = loc }++-----------------------------------------------------------------------------+-- Cost Centre Stacks++-- | A Cost Centre Stack is something that can be attached to a closure.+-- This is either:+--+--      * the current cost centre stack (CCCS)+--      * a pre-defined cost centre stack (there are several+--        pre-defined CCSs, see below).++data CostCentreStack+  = CurrentCCS          -- Pinned on a let(rec)-bound+                        -- thunk/function/constructor, this says that the+                        -- cost centre to be attached to the object, when it+                        -- is allocated, is whatever is in the+                        -- current-cost-centre-stack register.++  | DontCareCCS         -- We need a CCS to stick in static closures+                        -- (for data), but we *don't* expect them to+                        -- accumulate any costs.  But we still need+                        -- the placeholder.  This CCS is it.++  | SingletonCCS CostCentre++  deriving (Eq, Ord)    -- needed for Ord on CLabel+++-- synonym for triple which describes the cost centre info in the generated+-- code for a module.+type CollectedCCs+  = ( [CostCentre]       -- local cost-centres that need to be decl'd+    , [CostCentreStack]  -- pre-defined "singleton" cost centre stacks+    )++emptyCollectedCCs :: CollectedCCs+emptyCollectedCCs = ([], [])++collectCC :: CostCentre -> CostCentreStack -> CollectedCCs -> CollectedCCs+collectCC cc ccs (c, cs) = (cc : c, ccs : cs)++currentCCS, dontCareCCS :: CostCentreStack++currentCCS              = CurrentCCS+dontCareCCS             = DontCareCCS++-----------------------------------------------------------------------------+-- Predicates on Cost-Centre Stacks++isCurrentCCS :: CostCentreStack -> Bool+isCurrentCCS CurrentCCS                 = True+isCurrentCCS _                          = False++isCafCCS :: CostCentreStack -> Bool+isCafCCS (SingletonCCS cc)              = isCafCC cc+isCafCCS _                              = False++maybeSingletonCCS :: CostCentreStack -> Maybe CostCentre+maybeSingletonCCS (SingletonCCS cc)     = Just cc+maybeSingletonCCS _                     = Nothing++mkSingletonCCS :: CostCentre -> CostCentreStack+mkSingletonCCS cc = SingletonCCS cc+++-----------------------------------------------------------------------------+-- Printing Cost Centre Stacks.++-- The outputable instance for CostCentreStack prints the CCS as a C+-- expression.++instance Outputable CostCentreStack where+  ppr CurrentCCS        = text "CCCS"+  ppr DontCareCCS       = text "CCS_DONT_CARE"+  ppr (SingletonCCS cc) = ppr cc <> text "_ccs"+++-----------------------------------------------------------------------------+-- Printing Cost Centres+--+-- There are several different ways in which we might want to print a+-- cost centre:+--+--      - the name of the cost centre, for profiling output (a C string)+--      - the label, i.e. C label for cost centre in .hc file.+--      - the debugging name, for output in -ddump things+--      - the interface name, for printing in _scc_ exprs in iface files.+--+-- The last 3 are derived from costCentreStr below.  The first is given+-- by costCentreName.++instance Outputable CostCentre where+  ppr cc = getPprStyle $ \ sty ->+           if codeStyle sty+           then ppCostCentreLbl cc+           else text (costCentreUserName cc)++-- Printing in Core+pprCostCentreCore :: CostCentre -> SDoc+pprCostCentreCore (AllCafsCC {cc_mod = m})+  = text "__sccC" <+> braces (ppr m)+pprCostCentreCore (NormalCC {cc_flavour = flavour, cc_name = n,+                             cc_mod = m, cc_loc = loc})+  = text "__scc" <+> braces (hsep [+        ppr m <> char '.' <> ftext n,+        pprFlavourCore flavour,+        whenPprDebug (ppr loc)+    ])++-- ^ Print a flavour in Core+pprFlavourCore :: CCFlavour -> SDoc+pprFlavourCore CafCC = text "__C"+pprFlavourCore f     = pprIdxCore $ flavourIndex f++-- ^ Print a flavour's index in Core+pprIdxCore :: Int -> SDoc+pprIdxCore 0 = empty+pprIdxCore idx = whenPprDebug $ ppr idx++-- Printing as a C label+ppCostCentreLbl :: CostCentre -> SDoc+ppCostCentreLbl (AllCafsCC  {cc_mod = m}) = ppr m <> text "_CAFs_cc"+ppCostCentreLbl (NormalCC {cc_flavour = f, cc_name = n, cc_mod = m})+  = ppr m <> char '_' <> ztext (zEncodeFS n) <> char '_' <>+        ppFlavourLblComponent f <> text "_cc"++-- ^ Print the flavour component of a C label+ppFlavourLblComponent :: CCFlavour -> SDoc+ppFlavourLblComponent CafCC = text "CAF"+ppFlavourLblComponent (ExprCC i) = text "EXPR" <> ppIdxLblComponent i+ppFlavourLblComponent (DeclCC i) = text "DECL" <> ppIdxLblComponent i+ppFlavourLblComponent (HpcCC i) = text "HPC" <> ppIdxLblComponent i++-- ^ Print the flavour index component of a C label+ppIdxLblComponent :: CostCentreIndex -> SDoc+ppIdxLblComponent n =+  case unCostCentreIndex n of+    0 -> empty+    n -> ppr n++-- This is the name to go in the user-displayed string,+-- recorded in the cost centre declaration+costCentreUserName :: CostCentre -> String+costCentreUserName = unpackFS . costCentreUserNameFS++costCentreUserNameFS :: CostCentre -> FastString+costCentreUserNameFS (AllCafsCC {})  = mkFastString "CAF"+costCentreUserNameFS (NormalCC {cc_name = name, cc_flavour = is_caf})+  =  case is_caf of+      CafCC -> mkFastString "CAF:" `appendFS` name+      _     -> name++costCentreSrcSpan :: CostCentre -> SrcSpan+costCentreSrcSpan = cc_loc++instance Binary CCFlavour where+    put_ bh CafCC = do+            putByte bh 0+    put_ bh (ExprCC i) = do+            putByte bh 1+            put_ bh i+    put_ bh (DeclCC i) = do+            putByte bh 2+            put_ bh i+    put_ bh (HpcCC i) = do+            putByte bh 3+            put_ bh i+    get bh = do+            h <- getByte bh+            case h of+              0 -> do return CafCC+              1 -> ExprCC <$> get bh+              2 -> DeclCC <$> get bh+              _ -> HpcCC <$> get bh++instance Binary CostCentre where+    put_ bh (NormalCC aa ab ac _ad) = do+            putByte bh 0+            put_ bh aa+            put_ bh ab+            put_ bh ac+    put_ bh (AllCafsCC ae _af) = do+            putByte bh 1+            put_ bh ae+    get bh = do+            h <- getByte bh+            case h of+              0 -> do aa <- get bh+                      ab <- get bh+                      ac <- get bh+                      return (NormalCC aa ab ac noSrcSpan)+              _ -> do ae <- get bh+                      return (AllCafsCC ae noSrcSpan)++    -- We ignore the SrcSpans in CostCentres when we serialise them,+    -- and set the SrcSpans to noSrcSpan when deserialising.  This is+    -- ok, because we only need the SrcSpan when declaring the+    -- CostCentre in the original module, it is not used by importing+    -- modules.
+ compiler/profiling/CostCentreState.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module CostCentreState ( CostCentreState, newCostCentreState+                       , CostCentreIndex, unCostCentreIndex, getCCIndex+                       ) where++import GhcPrelude+import FastString+import FastStringEnv++import Data.Data+import Binary++-- | Per-module state for tracking cost centre indices.+--+-- See documentation of 'CostCentre.cc_flavour' for more details.+newtype CostCentreState = CostCentreState (FastStringEnv Int)++-- | Initialize cost centre state.+newCostCentreState :: CostCentreState+newCostCentreState = CostCentreState emptyFsEnv++-- | An index into a given cost centre module,name,flavour set+newtype CostCentreIndex = CostCentreIndex { unCostCentreIndex :: Int }+  deriving (Eq, Ord, Data, Binary)++-- | Get a new index for a given cost centre name.+getCCIndex :: FastString+           -> CostCentreState+           -> (CostCentreIndex, CostCentreState)+getCCIndex nm (CostCentreState m) =+    (CostCentreIndex idx, CostCentreState m')+  where+    m_idx = lookupFsEnv m nm+    idx = maybe 0 id m_idx+    m' = extendFsEnv m nm (idx + 1)
+ compiler/simplCore/CoreMonad.hs view
@@ -0,0 +1,837 @@+{-+(c) The AQUA Project, Glasgow University, 1993-1998++\section[CoreMonad]{The core pipeline monad}+-}++{-# LANGUAGE CPP #-}++module CoreMonad (+    -- * Configuration of the core-to-core passes+    CoreToDo(..), runWhen, runMaybe,+    SimplMode(..),+    FloatOutSwitches(..),+    pprPassDetails,++    -- * Plugins+    CorePluginPass, bindsOnlyPass,++    -- * Counting+    SimplCount, doSimplTick, doFreeSimplTick, simplCountN,+    pprSimplCount, plusSimplCount, zeroSimplCount,+    isZeroSimplCount, hasDetailedCounts, Tick(..),++    -- * The monad+    CoreM, runCoreM,++    -- ** Reading from the monad+    getHscEnv, getRuleBase, getModule,+    getDynFlags, getOrigNameCache, getPackageFamInstEnv,+    getVisibleOrphanMods,+    getPrintUnqualified, getSrcSpanM,++    -- ** Writing to the monad+    addSimplCount,++    -- ** Lifting into the monad+    liftIO, liftIOWithCount,+    liftIO1, liftIO2, liftIO3, liftIO4,++    -- ** Dealing with annotations+    getAnnotations, getFirstAnnotations,++    -- ** Screen output+    putMsg, putMsgS, errorMsg, errorMsgS, warnMsg,+    fatalErrorMsg, fatalErrorMsgS,+    debugTraceMsg, debugTraceMsgS,+    dumpIfSet_dyn+  ) where++import GhcPrelude hiding ( read )++import CoreSyn+import HscTypes+import Module+import DynFlags+import BasicTypes       ( CompilerPhase(..) )+import Annotations++import IOEnv hiding     ( liftIO, failM, failWithM )+import qualified IOEnv  ( liftIO )+import Var+import Outputable+import FastString+import qualified ErrUtils as Err+import ErrUtils( Severity(..) )+import UniqSupply+import UniqFM       ( UniqFM, mapUFM, filterUFM )+import MonadUtils+import NameCache+import SrcLoc+import Data.List+import Data.Ord+import Data.Dynamic+import Data.IORef+import Data.Map (Map)+import qualified Data.Map as Map+import qualified Data.Map.Strict as MapStrict+import Data.Word+import Control.Monad+import Control.Applicative ( Alternative(..) )++{-+************************************************************************+*                                                                      *+              The CoreToDo type and related types+          Abstraction of core-to-core passes to run.+*                                                                      *+************************************************************************+-}++data CoreToDo           -- These are diff core-to-core passes,+                        -- which may be invoked in any order,+                        -- as many times as you like.++  = CoreDoSimplify      -- The core-to-core simplifier.+        Int                    -- Max iterations+        SimplMode+  | CoreDoPluginPass String CorePluginPass+  | CoreDoFloatInwards+  | CoreDoFloatOutwards FloatOutSwitches+  | CoreLiberateCase+  | CoreDoPrintCore+  | CoreDoStaticArgs+  | CoreDoCallArity+  | CoreDoExitify+  | CoreDoStrictness+  | CoreDoWorkerWrapper+  | CoreDoSpecialising+  | CoreDoSpecConstr+  | CoreCSE+  | CoreDoRuleCheck CompilerPhase String   -- Check for non-application of rules+                                           -- matching this string+  | CoreDoNothing                -- Useful when building up+  | CoreDoPasses [CoreToDo]      -- lists of these things++  | CoreDesugar    -- Right after desugaring, no simple optimisation yet!+  | CoreDesugarOpt -- CoreDesugarXXX: Not strictly a core-to-core pass, but produces+                       --                 Core output, and hence useful to pass to endPass++  | CoreTidy+  | CorePrep+  | CoreOccurAnal++instance Outputable CoreToDo where+  ppr (CoreDoSimplify _ _)     = text "Simplifier"+  ppr (CoreDoPluginPass s _)   = text "Core plugin: " <+> text s+  ppr CoreDoFloatInwards       = text "Float inwards"+  ppr (CoreDoFloatOutwards f)  = text "Float out" <> parens (ppr f)+  ppr CoreLiberateCase         = text "Liberate case"+  ppr CoreDoStaticArgs         = text "Static argument"+  ppr CoreDoCallArity          = text "Called arity analysis"+  ppr CoreDoExitify            = text "Exitification transformation"+  ppr CoreDoStrictness         = text "Demand analysis"+  ppr CoreDoWorkerWrapper      = text "Worker Wrapper binds"+  ppr CoreDoSpecialising       = text "Specialise"+  ppr CoreDoSpecConstr         = text "SpecConstr"+  ppr CoreCSE                  = text "Common sub-expression"+  ppr CoreDesugar              = text "Desugar (before optimization)"+  ppr CoreDesugarOpt           = text "Desugar (after optimization)"+  ppr CoreTidy                 = text "Tidy Core"+  ppr CorePrep                 = text "CorePrep"+  ppr CoreOccurAnal            = text "Occurrence analysis"+  ppr CoreDoPrintCore          = text "Print core"+  ppr (CoreDoRuleCheck {})     = text "Rule check"+  ppr CoreDoNothing            = text "CoreDoNothing"+  ppr (CoreDoPasses passes)    = text "CoreDoPasses" <+> ppr passes++pprPassDetails :: CoreToDo -> SDoc+pprPassDetails (CoreDoSimplify n md) = vcat [ text "Max iterations =" <+> int n+                                            , ppr md ]+pprPassDetails _ = Outputable.empty++data SimplMode             -- See comments in SimplMonad+  = SimplMode+        { sm_names      :: [String] -- Name(s) of the phase+        , sm_phase      :: CompilerPhase+        , sm_dflags     :: DynFlags -- Just for convenient non-monadic+                                    -- access; we don't override these+        , sm_rules      :: Bool     -- Whether RULES are enabled+        , sm_inline     :: Bool     -- Whether inlining is enabled+        , sm_case_case  :: Bool     -- Whether case-of-case is enabled+        , sm_eta_expand :: Bool     -- Whether eta-expansion is enabled+        }++instance Outputable SimplMode where+    ppr (SimplMode { sm_phase = p, sm_names = ss+                   , sm_rules = r, sm_inline = i+                   , sm_eta_expand = eta, sm_case_case = cc })+       = text "SimplMode" <+> braces (+         sep [ text "Phase =" <+> ppr p <+>+               brackets (text (concat $ intersperse "," ss)) <> comma+             , pp_flag i   (sLit "inline") <> comma+             , pp_flag r   (sLit "rules") <> comma+             , pp_flag eta (sLit "eta-expand") <> comma+             , pp_flag cc  (sLit "case-of-case") ])+         where+           pp_flag f s = ppUnless f (text "no") <+> ptext s++data FloatOutSwitches = FloatOutSwitches {+  floatOutLambdas   :: Maybe Int,  -- ^ Just n <=> float lambdas to top level, if+                                   -- doing so will abstract over n or fewer+                                   -- value variables+                                   -- Nothing <=> float all lambdas to top level,+                                   --             regardless of how many free variables+                                   -- Just 0 is the vanilla case: float a lambda+                                   --    iff it has no free vars++  floatOutConstants :: Bool,       -- ^ True <=> float constants to top level,+                                   --            even if they do not escape a lambda+  floatOutOverSatApps :: Bool,+                             -- ^ True <=> float out over-saturated applications+                             --            based on arity information.+                             -- See Note [Floating over-saturated applications]+                             -- in SetLevels+  floatToTopLevelOnly :: Bool      -- ^ Allow floating to the top level only.+  }+instance Outputable FloatOutSwitches where+    ppr = pprFloatOutSwitches++pprFloatOutSwitches :: FloatOutSwitches -> SDoc+pprFloatOutSwitches sw+  = text "FOS" <+> (braces $+     sep $ punctuate comma $+     [ text "Lam ="    <+> ppr (floatOutLambdas sw)+     , text "Consts =" <+> ppr (floatOutConstants sw)+     , text "OverSatApps ="   <+> ppr (floatOutOverSatApps sw) ])++-- The core-to-core pass ordering is derived from the DynFlags:+runWhen :: Bool -> CoreToDo -> CoreToDo+runWhen True  do_this = do_this+runWhen False _       = CoreDoNothing++runMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo+runMaybe (Just x) f = f x+runMaybe Nothing  _ = CoreDoNothing++{-++************************************************************************+*                                                                      *+             Types for Plugins+*                                                                      *+************************************************************************+-}++-- | A description of the plugin pass itself+type CorePluginPass = ModGuts -> CoreM ModGuts++bindsOnlyPass :: (CoreProgram -> CoreM CoreProgram) -> ModGuts -> CoreM ModGuts+bindsOnlyPass pass guts+  = do { binds' <- pass (mg_binds guts)+       ; return (guts { mg_binds = binds' }) }++{-+************************************************************************+*                                                                      *+             Counting and logging+*                                                                      *+************************************************************************+-}++getVerboseSimplStats :: (Bool -> SDoc) -> SDoc+getVerboseSimplStats = getPprDebug          -- For now, anyway++zeroSimplCount     :: DynFlags -> SimplCount+isZeroSimplCount   :: SimplCount -> Bool+hasDetailedCounts  :: SimplCount -> Bool+pprSimplCount      :: SimplCount -> SDoc+doSimplTick        :: DynFlags -> Tick -> SimplCount -> SimplCount+doFreeSimplTick    ::             Tick -> SimplCount -> SimplCount+plusSimplCount     :: SimplCount -> SimplCount -> SimplCount++data SimplCount+   = VerySimplCount !Int        -- Used when don't want detailed stats++   | SimplCount {+        ticks   :: !Int,        -- Total ticks+        details :: !TickCounts, -- How many of each type++        n_log   :: !Int,        -- N+        log1    :: [Tick],      -- Last N events; <= opt_HistorySize,+                                --   most recent first+        log2    :: [Tick]       -- Last opt_HistorySize events before that+                                -- Having log1, log2 lets us accumulate the+                                -- recent history reasonably efficiently+     }++type TickCounts = Map Tick Int++simplCountN :: SimplCount -> Int+simplCountN (VerySimplCount n)         = n+simplCountN (SimplCount { ticks = n }) = n++zeroSimplCount dflags+                -- This is where we decide whether to do+                -- the VerySimpl version or the full-stats version+  | dopt Opt_D_dump_simpl_stats dflags+  = SimplCount {ticks = 0, details = Map.empty,+                n_log = 0, log1 = [], log2 = []}+  | otherwise+  = VerySimplCount 0++isZeroSimplCount (VerySimplCount n)         = n==0+isZeroSimplCount (SimplCount { ticks = n }) = n==0++hasDetailedCounts (VerySimplCount {}) = False+hasDetailedCounts (SimplCount {})     = True++doFreeSimplTick tick sc@SimplCount { details = dts }+  = sc { details = dts `addTick` tick }+doFreeSimplTick _ sc = sc++doSimplTick dflags tick+    sc@(SimplCount { ticks = tks, details = dts, n_log = nl, log1 = l1 })+  | nl >= historySize dflags = sc1 { n_log = 1, log1 = [tick], log2 = l1 }+  | otherwise                = sc1 { n_log = nl+1, log1 = tick : l1 }+  where+    sc1 = sc { ticks = tks+1, details = dts `addTick` tick }++doSimplTick _ _ (VerySimplCount n) = VerySimplCount (n+1)+++addTick :: TickCounts -> Tick -> TickCounts+addTick fm tick = MapStrict.insertWith (+) tick 1 fm++plusSimplCount sc1@(SimplCount { ticks = tks1, details = dts1 })+               sc2@(SimplCount { ticks = tks2, details = dts2 })+  = log_base { ticks = tks1 + tks2+             , details = MapStrict.unionWith (+) dts1 dts2 }+  where+        -- A hackish way of getting recent log info+    log_base | null (log1 sc2) = sc1    -- Nothing at all in sc2+             | null (log2 sc2) = sc2 { log2 = log1 sc1 }+             | otherwise       = sc2++plusSimplCount (VerySimplCount n) (VerySimplCount m) = VerySimplCount (n+m)+plusSimplCount _                  _                  = panic "plusSimplCount"+       -- We use one or the other consistently++pprSimplCount (VerySimplCount n) = text "Total ticks:" <+> int n+pprSimplCount (SimplCount { ticks = tks, details = dts, log1 = l1, log2 = l2 })+  = vcat [text "Total ticks:    " <+> int tks,+          blankLine,+          pprTickCounts dts,+          getVerboseSimplStats $ \dbg -> if dbg+          then+                vcat [blankLine,+                      text "Log (most recent first)",+                      nest 4 (vcat (map ppr l1) $$ vcat (map ppr l2))]+          else Outputable.empty+    ]++{- Note [Which transformations are innocuous]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+At one point (Jun 18) I wondered if some transformations (ticks)+might be  "innocuous", in the sense that they do not unlock a later+transformation that does not occur in the same pass.  If so, we could+refrain from bumping the overall tick-count for such innocuous+transformations, and perhaps terminate the simplifier one pass+earlier.++BUt alas I found that virtually nothing was innocuous!  This Note+just records what I learned, in case anyone wants to try again.++These transformations are not innocuous:++*** NB: I think these ones could be made innocuous+          EtaExpansion+          LetFloatFromLet++LetFloatFromLet+    x = K (let z = e2 in Just z)+  prepareRhs transforms to+    x2 = let z=e2 in Just z+    x  = K xs+  And now more let-floating can happen in the+  next pass, on x2++PreInlineUnconditionally+  Example in spectral/cichelli/Auxil+     hinsert = ...let lo = e in+                  let j = ...lo... in+                  case x of+                    False -> ()+                    True -> case lo of I# lo' ->+                              ...j...+  When we PreInlineUnconditionally j, lo's occ-info changes to once,+  so it can be PreInlineUnconditionally in the next pass, and a+  cascade of further things can happen.++PostInlineUnconditionally+  let x = e in+  let y = ...x.. in+  case .. of { A -> ...x...y...+               B -> ...x...y... }+  Current postinlineUnconditinaly will inline y, and then x; sigh.++  But PostInlineUnconditionally might also unlock subsequent+  transformations for the same reason as PreInlineUnconditionally,+  so it's probably not innocuous anyway.++KnownBranch, BetaReduction:+  May drop chunks of code, and thereby enable PreInlineUnconditionally+  for some let-binding which now occurs once++EtaExpansion:+  Example in imaginary/digits-of-e1+    fail = \void. e          where e :: IO ()+  --> etaExpandRhs+    fail = \void. (\s. (e |> g) s) |> sym g      where g :: IO () ~ S -> (S,())+  --> Next iteration of simplify+    fail1 = \void. \s. (e |> g) s+    fail = fail1 |> Void#->sym g+  And now inline 'fail'++CaseMerge:+  case x of y {+    DEFAULT -> case y of z { pi -> ei }+    alts2 }+  ---> CaseMerge+    case x of { pi -> let z = y in ei+              ; alts2 }+  The "let z=y" case-binder-swap gets dealt with in the next pass+-}++pprTickCounts :: Map Tick Int -> SDoc+pprTickCounts counts+  = vcat (map pprTickGroup groups)+  where+    groups :: [[(Tick,Int)]]    -- Each group shares a comon tag+                                -- toList returns common tags adjacent+    groups = groupBy same_tag (Map.toList counts)+    same_tag (tick1,_) (tick2,_) = tickToTag tick1 == tickToTag tick2++pprTickGroup :: [(Tick, Int)] -> SDoc+pprTickGroup group@((tick1,_):_)+  = hang (int (sum [n | (_,n) <- group]) <+> text (tickString tick1))+       2 (vcat [ int n <+> pprTickCts tick+                                    -- flip as we want largest first+               | (tick,n) <- sortBy (flip (comparing snd)) group])+pprTickGroup [] = panic "pprTickGroup"++data Tick  -- See Note [Which transformations are innocuous]+  = PreInlineUnconditionally    Id+  | PostInlineUnconditionally   Id++  | UnfoldingDone               Id+  | RuleFired                   FastString      -- Rule name++  | LetFloatFromLet+  | EtaExpansion                Id      -- LHS binder+  | EtaReduction                Id      -- Binder on outer lambda+  | BetaReduction               Id      -- Lambda binder+++  | CaseOfCase                  Id      -- Bndr on *inner* case+  | KnownBranch                 Id      -- Case binder+  | CaseMerge                   Id      -- Binder on outer case+  | AltMerge                    Id      -- Case binder+  | CaseElim                    Id      -- Case binder+  | CaseIdentity                Id      -- Case binder+  | FillInCaseDefault           Id      -- Case binder++  | SimplifierDone              -- Ticked at each iteration of the simplifier++instance Outputable Tick where+  ppr tick = text (tickString tick) <+> pprTickCts tick++instance Eq Tick where+  a == b = case a `cmpTick` b of+           EQ -> True+           _ -> False++instance Ord Tick where+  compare = cmpTick++tickToTag :: Tick -> Int+tickToTag (PreInlineUnconditionally _)  = 0+tickToTag (PostInlineUnconditionally _) = 1+tickToTag (UnfoldingDone _)             = 2+tickToTag (RuleFired _)                 = 3+tickToTag LetFloatFromLet               = 4+tickToTag (EtaExpansion _)              = 5+tickToTag (EtaReduction _)              = 6+tickToTag (BetaReduction _)             = 7+tickToTag (CaseOfCase _)                = 8+tickToTag (KnownBranch _)               = 9+tickToTag (CaseMerge _)                 = 10+tickToTag (CaseElim _)                  = 11+tickToTag (CaseIdentity _)              = 12+tickToTag (FillInCaseDefault _)         = 13+tickToTag SimplifierDone                = 16+tickToTag (AltMerge _)                  = 17++tickString :: Tick -> String+tickString (PreInlineUnconditionally _) = "PreInlineUnconditionally"+tickString (PostInlineUnconditionally _)= "PostInlineUnconditionally"+tickString (UnfoldingDone _)            = "UnfoldingDone"+tickString (RuleFired _)                = "RuleFired"+tickString LetFloatFromLet              = "LetFloatFromLet"+tickString (EtaExpansion _)             = "EtaExpansion"+tickString (EtaReduction _)             = "EtaReduction"+tickString (BetaReduction _)            = "BetaReduction"+tickString (CaseOfCase _)               = "CaseOfCase"+tickString (KnownBranch _)              = "KnownBranch"+tickString (CaseMerge _)                = "CaseMerge"+tickString (AltMerge _)                 = "AltMerge"+tickString (CaseElim _)                 = "CaseElim"+tickString (CaseIdentity _)             = "CaseIdentity"+tickString (FillInCaseDefault _)        = "FillInCaseDefault"+tickString SimplifierDone               = "SimplifierDone"++pprTickCts :: Tick -> SDoc+pprTickCts (PreInlineUnconditionally v) = ppr v+pprTickCts (PostInlineUnconditionally v)= ppr v+pprTickCts (UnfoldingDone v)            = ppr v+pprTickCts (RuleFired v)                = ppr v+pprTickCts LetFloatFromLet              = Outputable.empty+pprTickCts (EtaExpansion v)             = ppr v+pprTickCts (EtaReduction v)             = ppr v+pprTickCts (BetaReduction v)            = ppr v+pprTickCts (CaseOfCase v)               = ppr v+pprTickCts (KnownBranch v)              = ppr v+pprTickCts (CaseMerge v)                = ppr v+pprTickCts (AltMerge v)                 = ppr v+pprTickCts (CaseElim v)                 = ppr v+pprTickCts (CaseIdentity v)             = ppr v+pprTickCts (FillInCaseDefault v)        = ppr v+pprTickCts _                            = Outputable.empty++cmpTick :: Tick -> Tick -> Ordering+cmpTick a b = case (tickToTag a `compare` tickToTag b) of+                GT -> GT+                EQ -> cmpEqTick a b+                LT -> LT++cmpEqTick :: Tick -> Tick -> Ordering+cmpEqTick (PreInlineUnconditionally a)  (PreInlineUnconditionally b)    = a `compare` b+cmpEqTick (PostInlineUnconditionally a) (PostInlineUnconditionally b)   = a `compare` b+cmpEqTick (UnfoldingDone a)             (UnfoldingDone b)               = a `compare` b+cmpEqTick (RuleFired a)                 (RuleFired b)                   = a `compare` b+cmpEqTick (EtaExpansion a)              (EtaExpansion b)                = a `compare` b+cmpEqTick (EtaReduction a)              (EtaReduction b)                = a `compare` b+cmpEqTick (BetaReduction a)             (BetaReduction b)               = a `compare` b+cmpEqTick (CaseOfCase a)                (CaseOfCase b)                  = a `compare` b+cmpEqTick (KnownBranch a)               (KnownBranch b)                 = a `compare` b+cmpEqTick (CaseMerge a)                 (CaseMerge b)                   = a `compare` b+cmpEqTick (AltMerge a)                  (AltMerge b)                    = a `compare` b+cmpEqTick (CaseElim a)                  (CaseElim b)                    = a `compare` b+cmpEqTick (CaseIdentity a)              (CaseIdentity b)                = a `compare` b+cmpEqTick (FillInCaseDefault a)         (FillInCaseDefault b)           = a `compare` b+cmpEqTick _                             _                               = EQ++{-+************************************************************************+*                                                                      *+             Monad and carried data structure definitions+*                                                                      *+************************************************************************+-}++newtype CoreState = CoreState {+        cs_uniq_supply :: UniqSupply+}++data CoreReader = CoreReader {+        cr_hsc_env             :: HscEnv,+        cr_rule_base           :: RuleBase,+        cr_module              :: Module,+        cr_print_unqual        :: PrintUnqualified,+        cr_loc                 :: SrcSpan,   -- Use this for log/error messages so they+                                             -- are at least tagged with the right source file+        cr_visible_orphan_mods :: !ModuleSet+}++-- Note: CoreWriter used to be defined with data, rather than newtype.  If it+-- is defined that way again, the cw_simpl_count field, at least, must be+-- strict to avoid a space leak (#7702).+newtype CoreWriter = CoreWriter {+        cw_simpl_count :: SimplCount+}++emptyWriter :: DynFlags -> CoreWriter+emptyWriter dflags = CoreWriter {+        cw_simpl_count = zeroSimplCount dflags+    }++plusWriter :: CoreWriter -> CoreWriter -> CoreWriter+plusWriter w1 w2 = CoreWriter {+        cw_simpl_count = (cw_simpl_count w1) `plusSimplCount` (cw_simpl_count w2)+    }++type CoreIOEnv = IOEnv CoreReader++-- | The monad used by Core-to-Core passes to access common state, register simplification+-- statistics and so on+newtype CoreM a = CoreM { unCoreM :: CoreState -> CoreIOEnv (a, CoreState, CoreWriter) }++instance Functor CoreM where+    fmap = liftM++instance Monad CoreM where+    mx >>= f = CoreM $ \s -> do+            (x, s', w1) <- unCoreM mx s+            (y, s'', w2) <- unCoreM (f x) s'+            let w = w1 `plusWriter` w2+            return $ seq w (y, s'', w)+            -- forcing w before building the tuple avoids a space leak+            -- (#7702)++instance Applicative CoreM where+    pure x = CoreM $ \s -> nop s x+    (<*>) = ap+    m *> k = m >>= \_ -> k++instance Alternative CoreM where+    empty   = CoreM (const Control.Applicative.empty)+    m <|> n = CoreM (\rs -> unCoreM m rs <|> unCoreM n rs)++instance MonadPlus CoreM++instance MonadUnique CoreM where+    getUniqueSupplyM = do+        us <- getS cs_uniq_supply+        let (us1, us2) = splitUniqSupply us+        modifyS (\s -> s { cs_uniq_supply = us2 })+        return us1++    getUniqueM = do+        us <- getS cs_uniq_supply+        let (u,us') = takeUniqFromSupply us+        modifyS (\s -> s { cs_uniq_supply = us' })+        return u++runCoreM :: HscEnv+         -> RuleBase+         -> UniqSupply+         -> Module+         -> ModuleSet+         -> PrintUnqualified+         -> SrcSpan+         -> CoreM a+         -> IO (a, SimplCount)+runCoreM hsc_env rule_base us mod orph_imps print_unqual loc m+  = liftM extract $ runIOEnv reader $ unCoreM m state+  where+    reader = CoreReader {+            cr_hsc_env = hsc_env,+            cr_rule_base = rule_base,+            cr_module = mod,+            cr_visible_orphan_mods = orph_imps,+            cr_print_unqual = print_unqual,+            cr_loc = loc+        }+    state = CoreState {+            cs_uniq_supply = us+        }++    extract :: (a, CoreState, CoreWriter) -> (a, SimplCount)+    extract (value, _, writer) = (value, cw_simpl_count writer)++{-+************************************************************************+*                                                                      *+             Core combinators, not exported+*                                                                      *+************************************************************************+-}++nop :: CoreState -> a -> CoreIOEnv (a, CoreState, CoreWriter)+nop s x = do+    r <- getEnv+    return (x, s, emptyWriter $ (hsc_dflags . cr_hsc_env) r)++read :: (CoreReader -> a) -> CoreM a+read f = CoreM (\s -> getEnv >>= (\r -> nop s (f r)))++getS :: (CoreState -> a) -> CoreM a+getS f = CoreM (\s -> nop s (f s))++modifyS :: (CoreState -> CoreState) -> CoreM ()+modifyS f = CoreM (\s -> nop (f s) ())++write :: CoreWriter -> CoreM ()+write w = CoreM (\s -> return ((), s, w))++-- \subsection{Lifting IO into the monad}++-- | Lift an 'IOEnv' operation into 'CoreM'+liftIOEnv :: CoreIOEnv a -> CoreM a+liftIOEnv mx = CoreM (\s -> mx >>= (\x -> nop s x))++instance MonadIO CoreM where+    liftIO = liftIOEnv . IOEnv.liftIO++-- | Lift an 'IO' operation into 'CoreM' while consuming its 'SimplCount'+liftIOWithCount :: IO (SimplCount, a) -> CoreM a+liftIOWithCount what = liftIO what >>= (\(count, x) -> addSimplCount count >> return x)++{-+************************************************************************+*                                                                      *+             Reader, writer and state accessors+*                                                                      *+************************************************************************+-}++getHscEnv :: CoreM HscEnv+getHscEnv = read cr_hsc_env++getRuleBase :: CoreM RuleBase+getRuleBase = read cr_rule_base++getVisibleOrphanMods :: CoreM ModuleSet+getVisibleOrphanMods = read cr_visible_orphan_mods++getPrintUnqualified :: CoreM PrintUnqualified+getPrintUnqualified = read cr_print_unqual++getSrcSpanM :: CoreM SrcSpan+getSrcSpanM = read cr_loc++addSimplCount :: SimplCount -> CoreM ()+addSimplCount count = write (CoreWriter { cw_simpl_count = count })++-- Convenience accessors for useful fields of HscEnv++instance HasDynFlags CoreM where+    getDynFlags = fmap hsc_dflags getHscEnv++instance HasModule CoreM where+    getModule = read cr_module++-- | The original name cache is the current mapping from 'Module' and+-- 'OccName' to a compiler-wide unique 'Name'+getOrigNameCache :: CoreM OrigNameCache+getOrigNameCache = do+    nameCacheRef <- fmap hsc_NC getHscEnv+    liftIO $ fmap nsNames $ readIORef nameCacheRef++getPackageFamInstEnv :: CoreM PackageFamInstEnv+getPackageFamInstEnv = do+    hsc_env <- getHscEnv+    eps <- liftIO $ hscEPS hsc_env+    return $ eps_fam_inst_env eps++{-+************************************************************************+*                                                                      *+             Dealing with annotations+*                                                                      *+************************************************************************+-}++-- | Get all annotations of a given type. This happens lazily, that is+-- no deserialization will take place until the [a] is actually demanded and+-- the [a] can also be empty (the UniqFM is not filtered).+--+-- This should be done once at the start of a Core-to-Core pass that uses+-- annotations.+--+-- See Note [Annotations]+getAnnotations :: Typeable a => ([Word8] -> a) -> ModGuts -> CoreM (UniqFM [a])+getAnnotations deserialize guts = do+     hsc_env <- getHscEnv+     ann_env <- liftIO $ prepareAnnotations hsc_env (Just guts)+     return (deserializeAnns deserialize ann_env)++-- | Get at most one annotation of a given type per Unique.+getFirstAnnotations :: Typeable a => ([Word8] -> a) -> ModGuts -> CoreM (UniqFM a)+getFirstAnnotations deserialize guts+  = liftM (mapUFM head . filterUFM (not . null))+  $ getAnnotations deserialize guts++{-+Note [Annotations]+~~~~~~~~~~~~~~~~~~+A Core-to-Core pass that wants to make use of annotations calls+getAnnotations or getFirstAnnotations at the beginning to obtain a UniqFM with+annotations of a specific type. This produces all annotations from interface+files read so far. However, annotations from interface files read during the+pass will not be visible until getAnnotations is called again. This is similar+to how rules work and probably isn't too bad.++The current implementation could be optimised a bit: when looking up+annotations for a thing from the HomePackageTable, we could search directly in+the module where the thing is defined rather than building one UniqFM which+contains all annotations we know of. This would work because annotations can+only be given to things defined in the same module. However, since we would+only want to deserialise every annotation once, we would have to build a cache+for every module in the HTP. In the end, it's probably not worth it as long as+we aren't using annotations heavily.++************************************************************************+*                                                                      *+                Direct screen output+*                                                                      *+************************************************************************+-}++msg :: Severity -> SDoc -> CoreM ()+msg sev doc+  = do { dflags <- getDynFlags+       ; loc    <- getSrcSpanM+       ; unqual <- getPrintUnqualified+       ; let sty = case sev of+                     SevError   -> err_sty+                     SevWarning -> err_sty+                     SevDump    -> dump_sty+                     _          -> user_sty+             err_sty  = mkErrStyle dflags unqual+             user_sty = mkUserStyle dflags unqual AllTheWay+             dump_sty = mkDumpStyle dflags unqual+       ; liftIO $ putLogMsg dflags NoReason sev loc sty doc }++-- | Output a String message to the screen+putMsgS :: String -> CoreM ()+putMsgS = putMsg . text++-- | Output a message to the screen+putMsg :: SDoc -> CoreM ()+putMsg = msg SevInfo++-- | Output an error to the screen. Does not cause the compiler to die.+errorMsgS :: String -> CoreM ()+errorMsgS = errorMsg . text++-- | Output an error to the screen. Does not cause the compiler to die.+errorMsg :: SDoc -> CoreM ()+errorMsg = msg SevError++warnMsg :: SDoc -> CoreM ()+warnMsg = msg SevWarning++-- | Output a fatal error to the screen. Does not cause the compiler to die.+fatalErrorMsgS :: String -> CoreM ()+fatalErrorMsgS = fatalErrorMsg . text++-- | Output a fatal error to the screen. Does not cause the compiler to die.+fatalErrorMsg :: SDoc -> CoreM ()+fatalErrorMsg = msg SevFatal++-- | Output a string debugging message at verbosity level of @-v@ or higher+debugTraceMsgS :: String -> CoreM ()+debugTraceMsgS = debugTraceMsg . text++-- | Outputs a debugging message at verbosity level of @-v@ or higher+debugTraceMsg :: SDoc -> CoreM ()+debugTraceMsg = msg SevDump++-- | Show some labelled 'SDoc' if a particular flag is set or at a verbosity level of @-v -ddump-most@ or higher+dumpIfSet_dyn :: DumpFlag -> String -> SDoc -> CoreM ()+dumpIfSet_dyn flag str doc+  = do { dflags <- getDynFlags+       ; unqual <- getPrintUnqualified+       ; when (dopt flag dflags) $ liftIO $+         Err.dumpSDoc dflags unqual flag str doc }
+ compiler/simplCore/CoreMonad.hs-boot view
@@ -0,0 +1,37 @@+-- Created this hs-boot file to remove circular dependencies from the use of+-- Plugins. Plugins needs CoreToDo and CoreM types to define core-to-core+-- transformations.+-- However CoreMonad does much more than defining these, and because Plugins are+-- activated in various modules, the imports become circular. To solve this I+-- extracted CoreToDo and CoreM into this file.+-- I needed to write the whole definition of these types, otherwise it created+-- a data-newtype conflict.++module CoreMonad ( CoreToDo, CoreM ) where++import GhcPrelude++import IOEnv ( IOEnv )+import UniqSupply ( UniqSupply )++newtype CoreState = CoreState {+        cs_uniq_supply :: UniqSupply+}++type CoreIOEnv = IOEnv CoreReader++data CoreReader++newtype CoreWriter = CoreWriter {+        cw_simpl_count :: SimplCount+}++data SimplCount++newtype CoreM a+          = CoreM { unCoreM :: CoreState+                                 -> CoreIOEnv (a, CoreState, CoreWriter) }++instance Monad CoreM++data CoreToDo
+ compiler/simplCore/OccurAnal.hs view
@@ -0,0 +1,2891 @@+{-+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++************************************************************************+*                                                                      *+\section[OccurAnal]{Occurrence analysis pass}+*                                                                      *+************************************************************************++The occurrence analyser re-typechecks a core expression, returning a new+core expression with (hopefully) improved usage information.+-}++{-# LANGUAGE CPP, BangPatterns, MultiWayIf, ViewPatterns  #-}++module OccurAnal (+        occurAnalysePgm, occurAnalyseExpr, occurAnalyseExpr_NoBinderSwap+    ) where++#include "HsVersions.h"++import GhcPrelude++import CoreSyn+import CoreFVs+import CoreUtils        ( exprIsTrivial, isDefaultAlt, isExpandableApp,+                          stripTicksTopE, mkTicks )+import CoreArity        ( joinRhsArity )+import Id+import IdInfo+import Name( localiseName )+import BasicTypes+import Module( Module )+import Coercion+import Type++import VarSet+import VarEnv+import Var+import Demand           ( argOneShots, argsOneShots )+import Digraph          ( SCC(..), Node(..)+                        , stronglyConnCompFromEdgedVerticesUniq+                        , stronglyConnCompFromEdgedVerticesUniqR )+import Unique+import UniqFM+import UniqSet+import Util+import Outputable+import Data.List+import Control.Arrow    ( second )++{-+************************************************************************+*                                                                      *+    occurAnalysePgm, occurAnalyseExpr, occurAnalyseExpr_NoBinderSwap+*                                                                      *+************************************************************************++Here's the externally-callable interface:+-}++occurAnalysePgm :: Module         -- Used only in debug output+                -> (Id -> Bool)         -- Active unfoldings+                -> (Activation -> Bool) -- Active rules+                -> [CoreRule]+                -> CoreProgram -> CoreProgram+occurAnalysePgm this_mod active_unf active_rule imp_rules binds+  | isEmptyDetails final_usage+  = occ_anald_binds++  | otherwise   -- See Note [Glomming]+  = WARN( True, hang (text "Glomming in" <+> ppr this_mod <> colon)+                   2 (ppr final_usage ) )+    occ_anald_glommed_binds+  where+    init_env = initOccEnv { occ_rule_act = active_rule+                          , occ_unf_act  = active_unf }++    (final_usage, occ_anald_binds) = go init_env binds+    (_, occ_anald_glommed_binds)   = occAnalRecBind init_env TopLevel+                                                    imp_rule_edges+                                                    (flattenBinds occ_anald_binds)+                                                    initial_uds+          -- It's crucial to re-analyse the glommed-together bindings+          -- so that we establish the right loop breakers. Otherwise+          -- we can easily create an infinite loop (#9583 is an example)++    initial_uds = addManyOccsSet emptyDetails+                            (rulesFreeVars imp_rules)+    -- The RULES declarations keep things alive!++    -- Note [Preventing loops due to imported functions rules]+    imp_rule_edges = foldr (plusVarEnv_C unionVarSet) emptyVarEnv+                            [ mapVarEnv (const maps_to) $+                                getUniqSet (exprFreeIds arg `delVarSetList` ru_bndrs imp_rule)+                            | imp_rule <- imp_rules+                            , not (isBuiltinRule imp_rule)  -- See Note [Plugin rules]+                            , let maps_to = exprFreeIds (ru_rhs imp_rule)+                                             `delVarSetList` ru_bndrs imp_rule+                            , arg <- ru_args imp_rule ]++    go :: OccEnv -> [CoreBind] -> (UsageDetails, [CoreBind])+    go _ []+        = (initial_uds, [])+    go env (bind:binds)+        = (final_usage, bind' ++ binds')+        where+           (bs_usage, binds')   = go env binds+           (final_usage, bind') = occAnalBind env TopLevel imp_rule_edges bind+                                              bs_usage++occurAnalyseExpr :: CoreExpr -> CoreExpr+        -- Do occurrence analysis, and discard occurrence info returned+occurAnalyseExpr = occurAnalyseExpr' True -- do binder swap++occurAnalyseExpr_NoBinderSwap :: CoreExpr -> CoreExpr+occurAnalyseExpr_NoBinderSwap = occurAnalyseExpr' False -- do not do binder swap++occurAnalyseExpr' :: Bool -> CoreExpr -> CoreExpr+occurAnalyseExpr' enable_binder_swap expr+  = snd (occAnal env expr)+  where+    env = initOccEnv { occ_binder_swap = enable_binder_swap }++{- Note [Plugin rules]+~~~~~~~~~~~~~~~~~~~~~~+Conal Elliott (#11651) built a GHC plugin that added some+BuiltinRules (for imported Ids) to the mg_rules field of ModGuts, to+do some domain-specific transformations that could not be expressed+with an ordinary pattern-matching CoreRule.  But then we can't extract+the dependencies (in imp_rule_edges) from ru_rhs etc, because a+BuiltinRule doesn't have any of that stuff.++So we simply assume that BuiltinRules have no dependencies, and filter+them out from the imp_rule_edges comprehension.+-}++{-+************************************************************************+*                                                                      *+                Bindings+*                                                                      *+************************************************************************++Note [Recursive bindings: the grand plan]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When we come across a binding group+  Rec { x1 = r1; ...; xn = rn }+we treat it like this (occAnalRecBind):++1. Occurrence-analyse each right hand side, and build a+   "Details" for each binding to capture the results.++   Wrap the details in a Node (details, node-id, dep-node-ids),+   where node-id is just the unique of the binder, and+   dep-node-ids lists all binders on which this binding depends.+   We'll call these the "scope edges".+   See Note [Forming the Rec groups].++   All this is done by makeNode.++2. Do SCC-analysis on these Nodes.  Each SCC will become a new Rec or+   NonRec.  The key property is that every free variable of a binding+   is accounted for by the scope edges, so that when we are done+   everything is still in scope.++3. For each Cyclic SCC of the scope-edge SCC-analysis in (2), we+   identify suitable loop-breakers to ensure that inlining terminates.+   This is done by occAnalRec.++4. To do so we form a new set of Nodes, with the same details, but+   different edges, the "loop-breaker nodes". The loop-breaker nodes+   have both more and fewer dependencies than the scope edges+   (see Note [Choosing loop breakers])++   More edges: if f calls g, and g has an active rule that mentions h+               then we add an edge from f -> h++   Fewer edges: we only include dependencies on active rules, on rule+                RHSs (not LHSs) and if there is an INLINE pragma only+                on the stable unfolding (and vice versa).  The scope+                edges must be much more inclusive.++5.  The "weak fvs" of a node are, by definition:+       the scope fvs - the loop-breaker fvs+    See Note [Weak loop breakers], and the nd_weak field of Details++6.  Having formed the loop-breaker nodes++Note [Dead code]+~~~~~~~~~~~~~~~~+Dropping dead code for a cyclic Strongly Connected Component is done+in a very simple way:++        the entire SCC is dropped if none of its binders are mentioned+        in the body; otherwise the whole thing is kept.++The key observation is that dead code elimination happens after+dependency analysis: so 'occAnalBind' processes SCCs instead of the+original term's binding groups.++Thus 'occAnalBind' does indeed drop 'f' in an example like++        letrec f = ...g...+               g = ...(...g...)...+        in+           ...g...++when 'g' no longer uses 'f' at all (eg 'f' does not occur in a RULE in+'g'). 'occAnalBind' first consumes 'CyclicSCC g' and then it consumes+'AcyclicSCC f', where 'body_usage' won't contain 'f'.++------------------------------------------------------------+Note [Forming Rec groups]+~~~~~~~~~~~~~~~~~~~~~~~~~+We put bindings {f = ef; g = eg } in a Rec group if "f uses g"+and "g uses f", no matter how indirectly.  We do a SCC analysis+with an edge f -> g if "f uses g".++More precisely, "f uses g" iff g should be in scope wherever f is.+That is, g is free in:+  a) the rhs 'ef'+  b) or the RHS of a rule for f (Note [Rules are extra RHSs])+  c) or the LHS or a rule for f (Note [Rule dependency info])++These conditions apply regardless of the activation of the RULE (eg it might be+inactive in this phase but become active later).  Once a Rec is broken up+it can never be put back together, so we must be conservative.++The principle is that, regardless of rule firings, every variable is+always in scope.++  * Note [Rules are extra RHSs]+    ~~~~~~~~~~~~~~~~~~~~~~~~~~~+    A RULE for 'f' is like an extra RHS for 'f'. That way the "parent"+    keeps the specialised "children" alive.  If the parent dies+    (because it isn't referenced any more), then the children will die+    too (unless they are already referenced directly).++    To that end, we build a Rec group for each cyclic strongly+    connected component,+        *treating f's rules as extra RHSs for 'f'*.+    More concretely, the SCC analysis runs on a graph with an edge+    from f -> g iff g is mentioned in+        (a) f's rhs+        (b) f's RULES+    These are rec_edges.++    Under (b) we include variables free in *either* LHS *or* RHS of+    the rule.  The former might seems silly, but see Note [Rule+    dependency info].  So in Example [eftInt], eftInt and eftIntFB+    will be put in the same Rec, even though their 'main' RHSs are+    both non-recursive.++  * Note [Rule dependency info]+    ~~~~~~~~~~~~~~~~~~~~~~~~~~~+    The VarSet in a RuleInfo is used for dependency analysis in the+    occurrence analyser.  We must track free vars in *both* lhs and rhs.+    Hence use of idRuleVars, rather than idRuleRhsVars in occAnalBind.+    Why both? Consider+        x = y+        RULE f x = v+4+    Then if we substitute y for x, we'd better do so in the+    rule's LHS too, so we'd better ensure the RULE appears to mention 'x'+    as well as 'v'++  * Note [Rules are visible in their own rec group]+    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+    We want the rules for 'f' to be visible in f's right-hand side.+    And we'd like them to be visible in other functions in f's Rec+    group.  E.g. in Note [Specialisation rules] we want f' rule+    to be visible in both f's RHS, and fs's RHS.++    This means that we must simplify the RULEs first, before looking+    at any of the definitions.  This is done by Simplify.simplRecBind,+    when it calls addLetIdInfo.++------------------------------------------------------------+Note [Choosing loop breakers]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Loop breaking is surprisingly subtle.  First read the section 4 of+"Secrets of the GHC inliner".  This describes our basic plan.+We avoid infinite inlinings by choosing loop breakers, and+ensuring that a loop breaker cuts each loop.++See also Note [Inlining and hs-boot files] in ToIface, which deals+with a closely related source of infinite loops.++Fundamentally, we do SCC analysis on a graph.  For each recursive+group we choose a loop breaker, delete all edges to that node,+re-analyse the SCC, and iterate.++But what is the graph?  NOT the same graph as was used for Note+[Forming Rec groups]!  In particular, a RULE is like an equation for+'f' that is *always* inlined if it is applicable.  We do *not* disable+rules for loop-breakers.  It's up to whoever makes the rules to make+sure that the rules themselves always terminate.  See Note [Rules for+recursive functions] in Simplify.hs++Hence, if+    f's RHS (or its INLINE template if it has one) mentions g, and+    g has a RULE that mentions h, and+    h has a RULE that mentions f++then we *must* choose f to be a loop breaker.  Example: see Note+[Specialisation rules].++In general, take the free variables of f's RHS, and augment it with+all the variables reachable by RULES from those starting points.  That+is the whole reason for computing rule_fv_env in occAnalBind.  (Of+course we only consider free vars that are also binders in this Rec+group.)  See also Note [Finding rule RHS free vars]++Note that when we compute this rule_fv_env, we only consider variables+free in the *RHS* of the rule, in contrast to the way we build the+Rec group in the first place (Note [Rule dependency info])++Note that if 'g' has RHS that mentions 'w', we should add w to+g's loop-breaker edges.  More concretely there is an edge from f -> g+iff+        (a) g is mentioned in f's RHS `xor` f's INLINE rhs+            (see Note [Inline rules])+        (b) or h is mentioned in f's RHS, and+            g appears in the RHS of an active RULE of h+            or a transitive sequence of active rules starting with h++Why "active rules"?  See Note [Finding rule RHS free vars]++Note that in Example [eftInt], *neither* eftInt *nor* eftIntFB is+chosen as a loop breaker, because their RHSs don't mention each other.+And indeed both can be inlined safely.++Note again that the edges of the graph we use for computing loop breakers+are not the same as the edges we use for computing the Rec blocks.+That's why we compute++- rec_edges          for the Rec block analysis+- loop_breaker_nodes for the loop breaker analysis++  * Note [Finding rule RHS free vars]+    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+    Consider this real example from Data Parallel Haskell+         tagZero :: Array Int -> Array Tag+         {-# INLINE [1] tagZeroes #-}+         tagZero xs = pmap (\x -> fromBool (x==0)) xs++         {-# RULES "tagZero" [~1] forall xs n.+             pmap fromBool <blah blah> = tagZero xs #-}+    So tagZero's RHS mentions pmap, and pmap's RULE mentions tagZero.+    However, tagZero can only be inlined in phase 1 and later, while+    the RULE is only active *before* phase 1.  So there's no problem.++    To make this work, we look for the RHS free vars only for+    *active* rules. That's the reason for the occ_rule_act field+    of the OccEnv.++  * Note [Weak loop breakers]+    ~~~~~~~~~~~~~~~~~~~~~~~~~+    There is a last nasty wrinkle.  Suppose we have++        Rec { f = f_rhs+              RULE f [] = g++              h = h_rhs+              g = h+              ...more...+        }++    Remember that we simplify the RULES before any RHS (see Note+    [Rules are visible in their own rec group] above).++    So we must *not* postInlineUnconditionally 'g', even though+    its RHS turns out to be trivial.  (I'm assuming that 'g' is+    not choosen as a loop breaker.)  Why not?  Because then we+    drop the binding for 'g', which leaves it out of scope in the+    RULE!++    Here's a somewhat different example of the same thing+        Rec { g = h+            ; h = ...f...+            ; f = f_rhs+              RULE f [] = g }+    Here the RULE is "below" g, but we *still* can't postInlineUnconditionally+    g, because the RULE for f is active throughout.  So the RHS of h+    might rewrite to     h = ...g...+    So g must remain in scope in the output program!++    We "solve" this by:++        Make g a "weak" loop breaker (OccInfo = IAmLoopBreaker True)+        iff g is a "missing free variable" of the Rec group++    A "missing free variable" x is one that is mentioned in an RHS or+    INLINE or RULE of a binding in the Rec group, but where the+    dependency on x may not show up in the loop_breaker_nodes (see+    note [Choosing loop breakers} above).++    A normal "strong" loop breaker has IAmLoopBreaker False.  So++                                    Inline  postInlineUnconditionally+   strong   IAmLoopBreaker False    no      no+   weak     IAmLoopBreaker True     yes     no+            other                   yes     yes++    The **sole** reason for this kind of loop breaker is so that+    postInlineUnconditionally does not fire.  Ugh.  (Typically it'll+    inline via the usual callSiteInline stuff, so it'll be dead in the+    next pass, so the main Ugh is the tiresome complication.)++Note [Rules for imported functions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider this+   f = /\a. B.g a+   RULE B.g Int = 1 + f Int+Note that+  * The RULE is for an imported function.+  * f is non-recursive+Now we+can get+   f Int --> B.g Int      Inlining f+         --> 1 + f Int    Firing RULE+and so the simplifier goes into an infinite loop. This+would not happen if the RULE was for a local function,+because we keep track of dependencies through rules.  But+that is pretty much impossible to do for imported Ids.  Suppose+f's definition had been+   f = /\a. C.h a+where (by some long and devious process), C.h eventually inlines to+B.g.  We could only spot such loops by exhaustively following+unfoldings of C.h etc, in case we reach B.g, and hence (via the RULE)+f.++Note that RULES for imported functions are important in practice; they+occur a lot in the libraries.++We regard this potential infinite loop as a *programmer* error.+It's up the programmer not to write silly rules like+     RULE f x = f x+and the example above is just a more complicated version.++Note [Preventing loops due to imported functions rules]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider:+  import GHC.Base (foldr)++  {-# RULES "filterList" forall p. foldr (filterFB (:) p) [] = filter p #-}+  filter p xs = build (\c n -> foldr (filterFB c p) n xs)+  filterFB c p = ...++  f = filter p xs++Note that filter is not a loop-breaker, so what happens is:+  f =          filter p xs+    = {inline} build (\c n -> foldr (filterFB c p) n xs)+    = {inline} foldr (filterFB (:) p) [] xs+    = {RULE}   filter p xs++We are in an infinite loop.++A more elaborate example (that I actually saw in practice when I went to+mark GHC.List.filter as INLINABLE) is as follows. Say I have this module:+  {-# LANGUAGE RankNTypes #-}+  module GHCList where++  import Prelude hiding (filter)+  import GHC.Base (build)++  {-# INLINABLE filter #-}+  filter :: (a -> Bool) -> [a] -> [a]+  filter p [] = []+  filter p (x:xs) = if p x then x : filter p xs else filter p xs++  {-# NOINLINE [0] filterFB #-}+  filterFB :: (a -> b -> b) -> (a -> Bool) -> a -> b -> b+  filterFB c p x r | p x       = x `c` r+                   | otherwise = r++  {-# RULES+  "filter"     [~1] forall p xs.  filter p xs = build (\c n -> foldr+  (filterFB c p) n xs)+  "filterList" [1]  forall p.     foldr (filterFB (:) p) [] = filter p+   #-}++Then (because RULES are applied inside INLINABLE unfoldings, but inlinings+are not), the unfolding given to "filter" in the interface file will be:+  filter p []     = []+  filter p (x:xs) = if p x then x : build (\c n -> foldr (filterFB c p) n xs)+                           else     build (\c n -> foldr (filterFB c p) n xs++Note that because this unfolding does not mention "filter", filter is not+marked as a strong loop breaker. Therefore at a use site in another module:+  filter p xs+    = {inline}+      case xs of []     -> []+                 (x:xs) -> if p x then x : build (\c n -> foldr (filterFB c p) n xs)+                                  else     build (\c n -> foldr (filterFB c p) n xs)++  build (\c n -> foldr (filterFB c p) n xs)+    = {inline} foldr (filterFB (:) p) [] xs+    = {RULE}   filter p xs++And we are in an infinite loop again, except that this time the loop is producing an+infinitely large *term* (an unrolling of filter) and so the simplifier finally+dies with "ticks exhausted"++Because of this problem, we make a small change in the occurrence analyser+designed to mark functions like "filter" as strong loop breakers on the basis that:+  1. The RHS of filter mentions the local function "filterFB"+  2. We have a rule which mentions "filterFB" on the LHS and "filter" on the RHS++So for each RULE for an *imported* function we are going to add+dependency edges between the *local* FVS of the rule LHS and the+*local* FVS of the rule RHS. We don't do anything special for RULES on+local functions because the standard occurrence analysis stuff is+pretty good at getting loop-breakerness correct there.++It is important to note that even with this extra hack we aren't always going to get+things right. For example, it might be that the rule LHS mentions an imported Id,+and another module has a RULE that can rewrite that imported Id to one of our local+Ids.++Note [Specialising imported functions] (referred to from Specialise)+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+BUT for *automatically-generated* rules, the programmer can't be+responsible for the "programmer error" in Note [Rules for imported+functions].  In paricular, consider specialising a recursive function+defined in another module.  If we specialise a recursive function B.g,+we get+         g_spec = .....(B.g Int).....+         RULE B.g Int = g_spec+Here, g_spec doesn't look recursive, but when the rule fires, it+becomes so.  And if B.g was mutually recursive, the loop might+not be as obvious as it is here.++To avoid this,+ * When specialising a function that is a loop breaker,+   give a NOINLINE pragma to the specialised function++Note [Glomming]+~~~~~~~~~~~~~~~+RULES for imported Ids can make something at the top refer to something at the bottom:+        f = \x -> B.g (q x)+        h = \y -> 3++        RULE:  B.g (q x) = h x++Applying this rule makes f refer to h, although f doesn't appear to+depend on h.  (And, as in Note [Rules for imported functions], the+dependency might be more indirect. For example, f might mention C.t+rather than B.g, where C.t eventually inlines to B.g.)++NOTICE that this cannot happen for rules whose head is a+locally-defined function, because we accurately track dependencies+through RULES.  It only happens for rules whose head is an imported+function (B.g in the example above).++Solution:+  - When simplifying, bring all top level identifiers into+    scope at the start, ignoring the Rec/NonRec structure, so+    that when 'h' pops up in f's rhs, we find it in the in-scope set+    (as the simplifier generally expects). This happens in simplTopBinds.++  - In the occurrence analyser, if there are any out-of-scope+    occurrences that pop out of the top, which will happen after+    firing the rule:      f = \x -> h x+                          h = \y -> 3+    then just glom all the bindings into a single Rec, so that+    the *next* iteration of the occurrence analyser will sort+    them all out.   This part happens in occurAnalysePgm.++------------------------------------------------------------+Note [Inline rules]+~~~~~~~~~~~~~~~~~~~+None of the above stuff about RULES applies to Inline Rules,+stored in a CoreUnfolding.  The unfolding, if any, is simplified+at the same time as the regular RHS of the function (ie *not* like+Note [Rules are visible in their own rec group]), so it should be+treated *exactly* like an extra RHS.++Or, rather, when computing loop-breaker edges,+  * If f has an INLINE pragma, and it is active, we treat the+    INLINE rhs as f's rhs+  * If it's inactive, we treat f as having no rhs+  * If it has no INLINE pragma, we look at f's actual rhs+++There is a danger that we'll be sub-optimal if we see this+     f = ...f...+     [INLINE f = ..no f...]+where f is recursive, but the INLINE is not. This can just about+happen with a sufficiently odd set of rules; eg++        foo :: Int -> Int+        {-# INLINE [1] foo #-}+        foo x = x+1++        bar :: Int -> Int+        {-# INLINE [1] bar #-}+        bar x = foo x + 1++        {-# RULES "foo" [~1] forall x. foo x = bar x #-}++Here the RULE makes bar recursive; but it's INLINE pragma remains+non-recursive. It's tempting to then say that 'bar' should not be+a loop breaker, but an attempt to do so goes wrong in two ways:+   a) We may get+         $df = ...$cfoo...+         $cfoo = ...$df....+         [INLINE $cfoo = ...no-$df...]+      But we want $cfoo to depend on $df explicitly so that we+      put the bindings in the right order to inline $df in $cfoo+      and perhaps break the loop altogether.  (Maybe this+   b)+++Example [eftInt]+~~~~~~~~~~~~~~~+Example (from GHC.Enum):++  eftInt :: Int# -> Int# -> [Int]+  eftInt x y = ...(non-recursive)...++  {-# INLINE [0] eftIntFB #-}+  eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r+  eftIntFB c n x y = ...(non-recursive)...++  {-# RULES+  "eftInt"  [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y)+  "eftIntList"  [1] eftIntFB  (:) [] = eftInt+   #-}++Note [Specialisation rules]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider this group, which is typical of what SpecConstr builds:++   fs a = ....f (C a)....+   f  x = ....f (C a)....+   {-# RULE f (C a) = fs a #-}++So 'f' and 'fs' are in the same Rec group (since f refers to fs via its RULE).++But watch out!  If 'fs' is not chosen as a loop breaker, we may get an infinite loop:+  - the RULE is applied in f's RHS (see Note [Self-recursive rules] in Simplify+  - fs is inlined (say it's small)+  - now there's another opportunity to apply the RULE++This showed up when compiling Control.Concurrent.Chan.getChanContents.++------------------------------------------------------------+Note [Finding join points]+~~~~~~~~~~~~~~~~~~~~~~~~~~+It's the occurrence analyser's job to find bindings that we can turn into join+points, but it doesn't perform that transformation right away. Rather, it marks+the eligible bindings as part of their occurrence data, leaving it to the+simplifier (or to simpleOptPgm) to actually change the binder's 'IdDetails'.+The simplifier then eta-expands the RHS if needed and then updates the+occurrence sites. Dividing the work this way means that the occurrence analyser+still only takes one pass, yet one can always tell the difference between a+function call and a jump by looking at the occurrence (because the same pass+changes the 'IdDetails' and propagates the binders to their occurrence sites).++To track potential join points, we use the 'occ_tail' field of OccInfo. A value+of `AlwaysTailCalled n` indicates that every occurrence of the variable is a+tail call with `n` arguments (counting both value and type arguments). Otherwise+'occ_tail' will be 'NoTailCallInfo'. The tail call info flows bottom-up with the+rest of 'OccInfo' until it goes on the binder.++Note [Rules and join points]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Things get fiddly with rules. Suppose we have:++  let j :: Int -> Int+      j y = 2 * y+      k :: Int -> Int -> Int+      {-# RULES "SPEC k 0" k 0 = j #-}+      k x y = x + 2 * y+  in ...++Now suppose that both j and k appear only as saturated tail calls in the body.+Thus we would like to make them both join points. The rule complicates matters,+though, as its RHS has an unapplied occurrence of j. *However*, if we were to+eta-expand the rule, all would be well:++  {-# RULES "SPEC k 0" forall a. k 0 a = j a #-}++So conceivably we could notice that a potential join point would have an+"undersaturated" rule and account for it. This would mean we could make+something that's been specialised a join point, for instance. But local bindings+are rarely specialised, and being overly cautious about rules only+costs us anything when, for some `j`:++  * Before specialisation, `j` has non-tail calls, so it can't be a join point.+  * During specialisation, `j` gets specialised and thus acquires rules.+  * Sometime afterward, the non-tail calls to `j` disappear (as dead code, say),+    and so now `j` *could* become a join point.++This appears to be very rare in practice. TODO Perhaps we should gather+statistics to be sure.++------------------------------------------------------------+Note [Adjusting right-hand sides]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+There's a bit of a dance we need to do after analysing a lambda expression or+a right-hand side. In particular, we need to++  a) call 'markAllInsideLam' *unless* the binding is for a thunk, a one-shot+     lambda, or a non-recursive join point; and+  b) call 'markAllNonTailCalled' *unless* the binding is for a join point.++Some examples, with how the free occurrences in e (assumed not to be a value+lambda) get marked:++                             inside lam    non-tail-called+  ------------------------------------------------------------+  let x = e                  No            Yes+  let f = \x -> e            Yes           Yes+  let f = \x{OneShot} -> e   No            Yes+  \x -> e                    Yes           Yes+  join j x = e               No            No+  joinrec j x = e            Yes           No++There are a few other caveats; most importantly, if we're marking a binding as+'AlwaysTailCalled', it's *going* to be a join point, so we treat it as one so+that the effect cascades properly. Consequently, at the time the RHS is+analysed, we won't know what adjustments to make; thus 'occAnalLamOrRhs' must+return the unadjusted 'UsageDetails', to be adjusted by 'adjustRhsUsage' once+join-point-hood has been decided.++Thus the overall sequence taking place in 'occAnalNonRecBind' and+'occAnalRecBind' is as follows:++  1. Call 'occAnalLamOrRhs' to find usage information for the RHS.+  2. Call 'tagNonRecBinder' or 'tagRecBinders', which decides whether to make+     the binding a join point.+  3. Call 'adjustRhsUsage' accordingly. (Done as part of 'tagRecBinders' when+     recursive.)++(In the recursive case, this logic is spread between 'makeNode' and+'occAnalRec'.)+-}++------------------------------------------------------------------+--                 occAnalBind+------------------------------------------------------------------++occAnalBind :: OccEnv           -- The incoming OccEnv+            -> TopLevelFlag+            -> ImpRuleEdges+            -> CoreBind+            -> UsageDetails             -- Usage details of scope+            -> (UsageDetails,           -- Of the whole let(rec)+                [CoreBind])++occAnalBind env lvl top_env (NonRec binder rhs) body_usage+  = occAnalNonRecBind env lvl top_env binder rhs body_usage+occAnalBind env lvl top_env (Rec pairs) body_usage+  = occAnalRecBind env lvl top_env pairs body_usage++-----------------+occAnalNonRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> Var -> CoreExpr+                  -> UsageDetails -> (UsageDetails, [CoreBind])+occAnalNonRecBind env lvl imp_rule_edges binder rhs body_usage+  | isTyVar binder      -- A type let; we don't gather usage info+  = (body_usage, [NonRec binder rhs])++  | not (binder `usedIn` body_usage)    -- It's not mentioned+  = (body_usage, [])++  | otherwise                   -- It's mentioned in the body+  = (body_usage' `andUDs` rhs_usage', [NonRec tagged_binder rhs'])+  where+    (body_usage', tagged_binder) = tagNonRecBinder lvl body_usage binder+    mb_join_arity = willBeJoinId_maybe tagged_binder++    (bndrs, body) = collectBinders rhs++    (rhs_usage1, bndrs', body') = occAnalNonRecRhs env tagged_binder bndrs body+    rhs' = mkLams (markJoinOneShots mb_join_arity bndrs') body'+           -- For a /non-recursive/ join point we can mark all+           -- its join-lambda as one-shot; and it's a good idea to do so++    -- Unfoldings+    -- See Note [Unfoldings and join points]+    rhs_usage2 = case occAnalUnfolding env NonRecursive binder of+                   Just unf_usage -> rhs_usage1 `andUDs` unf_usage+                   Nothing        -> rhs_usage1++    -- Rules+    -- See Note [Rules are extra RHSs] and Note [Rule dependency info]+    rules_w_uds = occAnalRules env mb_join_arity NonRecursive tagged_binder+    rule_uds    = map (\(_, l, r) -> l `andUDs` r) rules_w_uds+    rhs_usage3 = foldr andUDs rhs_usage2 rule_uds+    rhs_usage4 = case lookupVarEnv imp_rule_edges binder of+                   Nothing -> rhs_usage3+                   Just vs -> addManyOccsSet rhs_usage3 vs+       -- See Note [Preventing loops due to imported functions rules]++    -- Final adjustment+    rhs_usage' = adjustRhsUsage mb_join_arity NonRecursive bndrs' rhs_usage4++-----------------+occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)]+               -> UsageDetails -> (UsageDetails, [CoreBind])+occAnalRecBind env lvl imp_rule_edges pairs body_usage+  = foldr (occAnalRec env lvl) (body_usage, []) sccs+        -- For a recursive group, we+        --      * occ-analyse all the RHSs+        --      * compute strongly-connected components+        --      * feed those components to occAnalRec+        -- See Note [Recursive bindings: the grand plan]+  where+    sccs :: [SCC Details]+    sccs = {-# SCC "occAnalBind.scc" #-}+           stronglyConnCompFromEdgedVerticesUniq nodes++    nodes :: [LetrecNode]+    nodes = {-# SCC "occAnalBind.assoc" #-}+            map (makeNode env imp_rule_edges bndr_set) pairs++    bndr_set = mkVarSet (map fst pairs)++{-+Note [Unfoldings and join points]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++We assume that anything in an unfolding occurs multiple times, since unfoldings+are often copied (that's the whole point!). But we still need to track tail+calls for the purpose of finding join points.+-}++-----------------------------+occAnalRec :: OccEnv -> TopLevelFlag+           -> SCC Details+           -> (UsageDetails, [CoreBind])+           -> (UsageDetails, [CoreBind])++        -- The NonRec case is just like a Let (NonRec ...) above+occAnalRec _ lvl (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = rhs+                                 , nd_uds = rhs_uds, nd_rhs_bndrs = rhs_bndrs }))+           (body_uds, binds)+  | not (bndr `usedIn` body_uds)+  = (body_uds, binds)           -- See Note [Dead code]++  | otherwise                   -- It's mentioned in the body+  = (body_uds' `andUDs` rhs_uds',+     NonRec tagged_bndr rhs : binds)+  where+    (body_uds', tagged_bndr) = tagNonRecBinder lvl body_uds bndr+    rhs_uds' = adjustRhsUsage (willBeJoinId_maybe tagged_bndr) NonRecursive+                              rhs_bndrs rhs_uds++        -- The Rec case is the interesting one+        -- See Note [Recursive bindings: the grand plan]+        -- See Note [Loop breaking]+occAnalRec env lvl (CyclicSCC details_s) (body_uds, binds)+  | not (any (`usedIn` body_uds) bndrs) -- NB: look at body_uds, not total_uds+  = (body_uds, binds)                   -- See Note [Dead code]++  | otherwise   -- At this point we always build a single Rec+  = -- pprTrace "occAnalRec" (vcat+    --  [ text "weak_fvs" <+> ppr weak_fvs+    --  , text "lb nodes" <+> ppr loop_breaker_nodes])+    (final_uds, Rec pairs : binds)++  where+    bndrs    = map nd_bndr details_s+    bndr_set = mkVarSet bndrs++    ------------------------------+        -- See Note [Choosing loop breakers] for loop_breaker_nodes+    final_uds :: UsageDetails+    loop_breaker_nodes :: [LetrecNode]+    (final_uds, loop_breaker_nodes)+      = mkLoopBreakerNodes env lvl bndr_set body_uds details_s++    ------------------------------+    weak_fvs :: VarSet+    weak_fvs = mapUnionVarSet nd_weak details_s++    ---------------------------+    -- Now reconstruct the cycle+    pairs :: [(Id,CoreExpr)]+    pairs | isEmptyVarSet weak_fvs = reOrderNodes   0 bndr_set weak_fvs loop_breaker_nodes []+          | otherwise              = loopBreakNodes 0 bndr_set weak_fvs loop_breaker_nodes []+          -- If weak_fvs is empty, the loop_breaker_nodes will include+          -- all the edges in the original scope edges [remember,+          -- weak_fvs is the difference between scope edges and+          -- lb-edges], so a fresh SCC computation would yield a+          -- single CyclicSCC result; and reOrderNodes deals with+          -- exactly that case+++------------------------------------------------------------------+--                 Loop breaking+------------------------------------------------------------------++type Binding = (Id,CoreExpr)++loopBreakNodes :: Int+               -> VarSet        -- All binders+               -> VarSet        -- Binders whose dependencies may be "missing"+                                -- See Note [Weak loop breakers]+               -> [LetrecNode]+               -> [Binding]             -- Append these to the end+               -> [Binding]+{-+loopBreakNodes is applied to the list of nodes for a cyclic strongly+connected component (there's guaranteed to be a cycle).  It returns+the same nodes, but+        a) in a better order,+        b) with some of the Ids having a IAmALoopBreaker pragma++The "loop-breaker" Ids are sufficient to break all cycles in the SCC.  This means+that the simplifier can guarantee not to loop provided it never records an inlining+for these no-inline guys.++Furthermore, the order of the binds is such that if we neglect dependencies+on the no-inline Ids then the binds are topologically sorted.  This means+that the simplifier will generally do a good job if it works from top bottom,+recording inlinings for any Ids which aren't marked as "no-inline" as it goes.+-}++-- Return the bindings sorted into a plausible order, and marked with loop breakers.+loopBreakNodes depth bndr_set weak_fvs nodes binds+  = -- pprTrace "loopBreakNodes" (ppr nodes) $+    go (stronglyConnCompFromEdgedVerticesUniqR nodes) binds+  where+    go []         binds = binds+    go (scc:sccs) binds = loop_break_scc scc (go sccs binds)++    loop_break_scc scc binds+      = case scc of+          AcyclicSCC node  -> mk_non_loop_breaker weak_fvs node : binds+          CyclicSCC nodes  -> reOrderNodes depth bndr_set weak_fvs nodes binds++----------------------------------+reOrderNodes :: Int -> VarSet -> VarSet -> [LetrecNode] -> [Binding] -> [Binding]+    -- Choose a loop breaker, mark it no-inline,+    -- and call loopBreakNodes on the rest+reOrderNodes _ _ _ []     _     = panic "reOrderNodes"+reOrderNodes _ _ _ [node] binds = mk_loop_breaker node : binds+reOrderNodes depth bndr_set weak_fvs (node : nodes) binds+  = -- pprTrace "reOrderNodes" (vcat [ text "unchosen" <+> ppr unchosen+    --                              , text "chosen" <+> ppr chosen_nodes ]) $+    loopBreakNodes new_depth bndr_set weak_fvs unchosen $+    (map mk_loop_breaker chosen_nodes ++ binds)+  where+    (chosen_nodes, unchosen) = chooseLoopBreaker approximate_lb+                                                 (nd_score (node_payload node))+                                                 [node] [] nodes++    approximate_lb = depth >= 2+    new_depth | approximate_lb = 0+              | otherwise      = depth+1+        -- After two iterations (d=0, d=1) give up+        -- and approximate, returning to d=0++mk_loop_breaker :: LetrecNode -> Binding+mk_loop_breaker (node_payload -> ND { nd_bndr = bndr, nd_rhs = rhs})+  = (bndr `setIdOccInfo` strongLoopBreaker { occ_tail = tail_info }, rhs)+  where+    tail_info = tailCallInfo (idOccInfo bndr)++mk_non_loop_breaker :: VarSet -> LetrecNode -> Binding+-- See Note [Weak loop breakers]+mk_non_loop_breaker weak_fvs (node_payload -> ND { nd_bndr = bndr+                                                 , nd_rhs = rhs})+  | bndr `elemVarSet` weak_fvs = (setIdOccInfo bndr occ', rhs)+  | otherwise                  = (bndr, rhs)+  where+    occ' = weakLoopBreaker { occ_tail = tail_info }+    tail_info = tailCallInfo (idOccInfo bndr)++----------------------------------+chooseLoopBreaker :: Bool             -- True <=> Too many iterations,+                                      --          so approximate+                  -> NodeScore            -- Best score so far+                  -> [LetrecNode]       -- Nodes with this score+                  -> [LetrecNode]       -- Nodes with higher scores+                  -> [LetrecNode]       -- Unprocessed nodes+                  -> ([LetrecNode], [LetrecNode])+    -- This loop looks for the bind with the lowest score+    -- to pick as the loop  breaker.  The rest accumulate in+chooseLoopBreaker _ _ loop_nodes acc []+  = (loop_nodes, acc)        -- Done++    -- If approximate_loop_breaker is True, we pick *all*+    -- nodes with lowest score, else just one+    -- See Note [Complexity of loop breaking]+chooseLoopBreaker approx_lb loop_sc loop_nodes acc (node : nodes)+  | approx_lb+  , rank sc == rank loop_sc+  = chooseLoopBreaker approx_lb loop_sc (node : loop_nodes) acc nodes++  | sc `betterLB` loop_sc  -- Better score so pick this new one+  = chooseLoopBreaker approx_lb sc [node] (loop_nodes ++ acc) nodes++  | otherwise              -- Worse score so don't pick it+  = chooseLoopBreaker approx_lb loop_sc loop_nodes (node : acc) nodes+  where+    sc = nd_score (node_payload node)++{-+Note [Complexity of loop breaking]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The loop-breaking algorithm knocks out one binder at a time, and+performs a new SCC analysis on the remaining binders.  That can+behave very badly in tightly-coupled groups of bindings; in the+worst case it can be (N**2)*log N, because it does a full SCC+on N, then N-1, then N-2 and so on.++To avoid this, we switch plans after 2 (or whatever) attempts:+  Plan A: pick one binder with the lowest score, make it+          a loop breaker, and try again+  Plan B: pick *all* binders with the lowest score, make them+          all loop breakers, and try again+Since there are only a small finite number of scores, this will+terminate in a constant number of iterations, rather than O(N)+iterations.++You might thing that it's very unlikely, but RULES make it much+more likely.  Here's a real example from #1969:+  Rec { $dm = \d.\x. op d+        {-# RULES forall d. $dm Int d  = $s$dm1+                  forall d. $dm Bool d = $s$dm2 #-}++        dInt = MkD .... opInt ...+        dInt = MkD .... opBool ...+        opInt  = $dm dInt+        opBool = $dm dBool++        $s$dm1 = \x. op dInt+        $s$dm2 = \x. op dBool }+The RULES stuff means that we can't choose $dm as a loop breaker+(Note [Choosing loop breakers]), so we must choose at least (say)+opInt *and* opBool, and so on.  The number of loop breakders is+linear in the number of instance declarations.++Note [Loop breakers and INLINE/INLINABLE pragmas]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Avoid choosing a function with an INLINE pramga as the loop breaker!+If such a function is mutually-recursive with a non-INLINE thing,+then the latter should be the loop-breaker.++It's vital to distinguish between INLINE and INLINABLE (the+Bool returned by hasStableCoreUnfolding_maybe).  If we start with+   Rec { {-# INLINABLE f #-}+         f x = ...f... }+and then worker/wrapper it through strictness analysis, we'll get+   Rec { {-# INLINABLE $wf #-}+         $wf p q = let x = (p,q) in ...f...++         {-# INLINE f #-}+         f x = case x of (p,q) -> $wf p q }++Now it is vital that we choose $wf as the loop breaker, so we can+inline 'f' in '$wf'.++Note [DFuns should not be loop breakers]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+It's particularly bad to make a DFun into a loop breaker.  See+Note [How instance declarations are translated] in TcInstDcls++We give DFuns a higher score than ordinary CONLIKE things because+if there's a choice we want the DFun to be the non-loop breaker. Eg++rec { sc = /\ a \$dC. $fBWrap (T a) ($fCT @ a $dC)++      $fCT :: forall a_afE. (Roman.C a_afE) => Roman.C (Roman.T a_afE)+      {-# DFUN #-}+      $fCT = /\a \$dC. MkD (T a) ((sc @ a $dC) |> blah) ($ctoF @ a $dC)+    }++Here 'sc' (the superclass) looks CONLIKE, but we'll never get to it+if we can't unravel the DFun first.++Note [Constructor applications]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+It's really really important to inline dictionaries.  Real+example (the Enum Ordering instance from GHC.Base):++     rec     f = \ x -> case d of (p,q,r) -> p x+             g = \ x -> case d of (p,q,r) -> q x+             d = (v, f, g)++Here, f and g occur just once; but we can't inline them into d.+On the other hand we *could* simplify those case expressions if+we didn't stupidly choose d as the loop breaker.+But we won't because constructor args are marked "Many".+Inlining dictionaries is really essential to unravelling+the loops in static numeric dictionaries, see GHC.Float.++Note [Closure conversion]+~~~~~~~~~~~~~~~~~~~~~~~~~+We treat (\x. C p q) as a high-score candidate in the letrec scoring algorithm.+The immediate motivation came from the result of a closure-conversion transformation+which generated code like this:++    data Clo a b = forall c. Clo (c -> a -> b) c++    ($:) :: Clo a b -> a -> b+    Clo f env $: x = f env x++    rec { plus = Clo plus1 ()++        ; plus1 _ n = Clo plus2 n++        ; plus2 Zero     n = n+        ; plus2 (Succ m) n = Succ (plus $: m $: n) }++If we inline 'plus' and 'plus1', everything unravels nicely.  But if+we choose 'plus1' as the loop breaker (which is entirely possible+otherwise), the loop does not unravel nicely.+++@occAnalUnfolding@ deals with the question of bindings where the Id is marked+by an INLINE pragma.  For these we record that anything which occurs+in its RHS occurs many times.  This pessimistically assumes that this+inlined binder also occurs many times in its scope, but if it doesn't+we'll catch it next time round.  At worst this costs an extra simplifier pass.+ToDo: try using the occurrence info for the inline'd binder.++[March 97] We do the same for atomic RHSs.  Reason: see notes with loopBreakSCC.+[June 98, SLPJ]  I've undone this change; I don't understand it.  See notes with loopBreakSCC.+++************************************************************************+*                                                                      *+                   Making nodes+*                                                                      *+************************************************************************+-}++type ImpRuleEdges = IdEnv IdSet     -- Mapping from FVs of imported RULE LHSs to RHS FVs++noImpRuleEdges :: ImpRuleEdges+noImpRuleEdges = emptyVarEnv++type LetrecNode = Node Unique Details  -- Node comes from Digraph+                                       -- The Unique key is gotten from the Id+data Details+  = ND { nd_bndr :: Id          -- Binder+       , nd_rhs  :: CoreExpr    -- RHS, already occ-analysed+       , nd_rhs_bndrs :: [CoreBndr] -- Outer lambdas of RHS+                                    -- INVARIANT: (nd_rhs_bndrs nd, _) ==+                                    --              collectBinders (nd_rhs nd)++       , nd_uds  :: UsageDetails  -- Usage from RHS, and RULES, and stable unfoldings+                                  -- ignoring phase (ie assuming all are active)+                                  -- See Note [Forming Rec groups]++       , nd_inl  :: IdSet       -- Free variables of+                                --   the stable unfolding (if present and active)+                                --   or the RHS (if not)+                                -- but excluding any RULES+                                -- This is the IdSet that may be used if the Id is inlined++       , nd_weak :: IdSet       -- Binders of this Rec that are mentioned in nd_uds+                                -- but are *not* in nd_inl.  These are the ones whose+                                -- dependencies might not be respected by loop_breaker_nodes+                                -- See Note [Weak loop breakers]++       , nd_active_rule_fvs :: IdSet   -- Free variables of the RHS of active RULES++       , nd_score :: NodeScore+  }++instance Outputable Details where+   ppr nd = text "ND" <> braces+             (sep [ text "bndr =" <+> ppr (nd_bndr nd)+                  , text "uds =" <+> ppr (nd_uds nd)+                  , text "inl =" <+> ppr (nd_inl nd)+                  , text "weak =" <+> ppr (nd_weak nd)+                  , text "rule =" <+> ppr (nd_active_rule_fvs nd)+                  , text "score =" <+> ppr (nd_score nd)+             ])++-- The NodeScore is compared lexicographically;+--      e.g. lower rank wins regardless of size+type NodeScore = ( Int     -- Rank: lower => more likely to be picked as loop breaker+                 , Int     -- Size of rhs: higher => more likely to be picked as LB+                           -- Maxes out at maxExprSize; we just use it to prioritise+                           -- small functions+                 , Bool )  -- Was it a loop breaker before?+                           -- True => more likely to be picked+                           -- Note [Loop breakers, node scoring, and stability]++rank :: NodeScore -> Int+rank (r, _, _) = r++makeNode :: OccEnv -> ImpRuleEdges -> VarSet+         -> (Var, CoreExpr) -> LetrecNode+-- See Note [Recursive bindings: the grand plan]+makeNode env imp_rule_edges bndr_set (bndr, rhs)+  = DigraphNode details (varUnique bndr) (nonDetKeysUniqSet node_fvs)+    -- It's OK to use nonDetKeysUniqSet here as stronglyConnCompFromEdgedVerticesR+    -- is still deterministic with edges in nondeterministic order as+    -- explained in Note [Deterministic SCC] in Digraph.+  where+    details = ND { nd_bndr            = bndr+                 , nd_rhs             = rhs'+                 , nd_rhs_bndrs       = bndrs'+                 , nd_uds             = rhs_usage3+                 , nd_inl             = inl_fvs+                 , nd_weak            = node_fvs `minusVarSet` inl_fvs+                 , nd_active_rule_fvs = active_rule_fvs+                 , nd_score           = pprPanic "makeNodeDetails" (ppr bndr) }++    -- Constructing the edges for the main Rec computation+    -- See Note [Forming Rec groups]+    (bndrs, body) = collectBinders rhs+    (rhs_usage1, bndrs', body') = occAnalRecRhs env bndrs body+    rhs' = mkLams bndrs' body'+    rhs_usage2 = foldr andUDs rhs_usage1 rule_uds+                   -- Note [Rules are extra RHSs]+                   -- Note [Rule dependency info]+    rhs_usage3 = case mb_unf_uds of+                   Just unf_uds -> rhs_usage2 `andUDs` unf_uds+                   Nothing      -> rhs_usage2+    node_fvs = udFreeVars bndr_set rhs_usage3++    -- Finding the free variables of the rules+    is_active = occ_rule_act env :: Activation -> Bool++    rules_w_uds :: [(CoreRule, UsageDetails, UsageDetails)]+    rules_w_uds = occAnalRules env (Just (length bndrs)) Recursive bndr++    rules_w_rhs_fvs :: [(Activation, VarSet)]    -- Find the RHS fvs+    rules_w_rhs_fvs = maybe id (\ids -> ((AlwaysActive, ids):))+                               (lookupVarEnv imp_rule_edges bndr)+      -- See Note [Preventing loops due to imported functions rules]+                      [ (ru_act rule, udFreeVars bndr_set rhs_uds)+                      | (rule, _, rhs_uds) <- rules_w_uds ]+    rule_uds = map (\(_, l, r) -> l `andUDs` r) rules_w_uds+    active_rule_fvs = unionVarSets [fvs | (a,fvs) <- rules_w_rhs_fvs+                                        , is_active a]++    -- Finding the usage details of the INLINE pragma (if any)+    mb_unf_uds = occAnalUnfolding env Recursive bndr++    -- Find the "nd_inl" free vars; for the loop-breaker phase+    inl_fvs = case mb_unf_uds of+                Nothing -> udFreeVars bndr_set rhs_usage1 -- No INLINE, use RHS+                Just unf_uds -> udFreeVars bndr_set unf_uds+                      -- We could check for an *active* INLINE (returning+                      -- emptyVarSet for an inactive one), but is_active+                      -- isn't the right thing (it tells about+                      -- RULE activation), so we'd need more plumbing++mkLoopBreakerNodes :: OccEnv -> TopLevelFlag+                   -> VarSet+                   -> UsageDetails   -- for BODY of let+                   -> [Details]+                   -> (UsageDetails, -- adjusted+                       [LetrecNode])+-- Does four things+--   a) tag each binder with its occurrence info+--   b) add a NodeScore to each node+--   c) make a Node with the right dependency edges for+--      the loop-breaker SCC analysis+--   d) adjust each RHS's usage details according to+--      the binder's (new) shotness and join-point-hood+mkLoopBreakerNodes env lvl bndr_set body_uds details_s+  = (final_uds, zipWith mk_lb_node details_s bndrs')+  where+    (final_uds, bndrs') = tagRecBinders lvl body_uds+                            [ ((nd_bndr nd)+                               ,(nd_uds nd)+                               ,(nd_rhs_bndrs nd))+                            | nd <- details_s ]+    mk_lb_node nd@(ND { nd_bndr = bndr, nd_rhs = rhs, nd_inl = inl_fvs }) bndr'+      = DigraphNode nd' (varUnique bndr) (nonDetKeysUniqSet lb_deps)+              -- It's OK to use nonDetKeysUniqSet here as+              -- stronglyConnCompFromEdgedVerticesR is still deterministic with edges+              -- in nondeterministic order as explained in+              -- Note [Deterministic SCC] in Digraph.+      where+        nd'     = nd { nd_bndr = bndr', nd_score = score }+        score   = nodeScore env bndr bndr' rhs lb_deps+        lb_deps = extendFvs_ rule_fv_env inl_fvs++    rule_fv_env :: IdEnv IdSet+        -- Maps a variable f to the variables from this group+        --      mentioned in RHS of active rules for f+        -- Domain is *subset* of bound vars (others have no rule fvs)+    rule_fv_env = transClosureFV (mkVarEnv init_rule_fvs)+    init_rule_fvs   -- See Note [Finding rule RHS free vars]+      = [ (b, trimmed_rule_fvs)+        | ND { nd_bndr = b, nd_active_rule_fvs = rule_fvs } <- details_s+        , let trimmed_rule_fvs = rule_fvs `intersectVarSet` bndr_set+        , not (isEmptyVarSet trimmed_rule_fvs) ]+++------------------------------------------+nodeScore :: OccEnv+          -> Id        -- Binder has old occ-info (just for loop-breaker-ness)+          -> Id        -- Binder with new occ-info+          -> CoreExpr  -- RHS+          -> VarSet    -- Loop-breaker dependencies+          -> NodeScore+nodeScore env old_bndr new_bndr bind_rhs lb_deps+  | not (isId old_bndr)     -- A type or cercion variable is never a loop breaker+  = (100, 0, False)++  | old_bndr `elemVarSet` lb_deps  -- Self-recursive things are great loop breakers+  = (0, 0, True)                   -- See Note [Self-recursion and loop breakers]++  | not (occ_unf_act env old_bndr) -- A binder whose inlining is inactive (e.g. has+  = (0, 0, True)                   -- a NOINLINE pragma) makes a great loop breaker++  | exprIsTrivial rhs+  = mk_score 10  -- Practically certain to be inlined+    -- Used to have also: && not (isExportedId bndr)+    -- But I found this sometimes cost an extra iteration when we have+    --      rec { d = (a,b); a = ...df...; b = ...df...; df = d }+    -- where df is the exported dictionary. Then df makes a really+    -- bad choice for loop breaker++  | DFunUnfolding { df_args = args } <- id_unfolding+    -- Never choose a DFun as a loop breaker+    -- Note [DFuns should not be loop breakers]+  = (9, length args, is_lb)++    -- Data structures are more important than INLINE pragmas+    -- so that dictionary/method recursion unravels++  | CoreUnfolding { uf_guidance = UnfWhen {} } <- id_unfolding+  = mk_score 6++  | is_con_app rhs   -- Data types help with cases:+  = mk_score 5       -- Note [Constructor applications]++  | isStableUnfolding id_unfolding+  , can_unfold+  = mk_score 3++  | isOneOcc (idOccInfo new_bndr)+  = mk_score 2  -- Likely to be inlined++  | can_unfold  -- The Id has some kind of unfolding+  = mk_score 1++  | otherwise+  = (0, 0, is_lb)++  where+    mk_score :: Int -> NodeScore+    mk_score rank = (rank, rhs_size, is_lb)++    is_lb    = isStrongLoopBreaker (idOccInfo old_bndr)+    rhs      = case id_unfolding of+                 CoreUnfolding { uf_src = src, uf_tmpl = unf_rhs }+                    | isStableSource src+                    -> unf_rhs+                 _  -> bind_rhs+       -- 'bind_rhs' is irrelevant for inlining things with a stable unfolding+    rhs_size = case id_unfolding of+                 CoreUnfolding { uf_guidance = guidance }+                    | UnfIfGoodArgs { ug_size = size } <- guidance+                    -> size+                 _  -> cheapExprSize rhs++    can_unfold   = canUnfold id_unfolding+    id_unfolding = realIdUnfolding old_bndr+       -- realIdUnfolding: Ignore loop-breaker-ness here because+       -- that is what we are setting!++        -- Checking for a constructor application+        -- Cheap and cheerful; the simplifier moves casts out of the way+        -- The lambda case is important to spot x = /\a. C (f a)+        -- which comes up when C is a dictionary constructor and+        -- f is a default method.+        -- Example: the instance for Show (ST s a) in GHC.ST+        --+        -- However we *also* treat (\x. C p q) as a con-app-like thing,+        --      Note [Closure conversion]+    is_con_app (Var v)    = isConLikeId v+    is_con_app (App f _)  = is_con_app f+    is_con_app (Lam _ e)  = is_con_app e+    is_con_app (Tick _ e) = is_con_app e+    is_con_app _          = False++maxExprSize :: Int+maxExprSize = 20  -- Rather arbitrary++cheapExprSize :: CoreExpr -> Int+-- Maxes out at maxExprSize+cheapExprSize e+  = go 0 e+  where+    go n e | n >= maxExprSize = n+           | otherwise        = go1 n e++    go1 n (Var {})        = n+1+    go1 n (Lit {})        = n+1+    go1 n (Type {})       = n+    go1 n (Coercion {})   = n+    go1 n (Tick _ e)      = go1 n e+    go1 n (Cast e _)      = go1 n e+    go1 n (App f a)       = go (go1 n f) a+    go1 n (Lam b e)+      | isTyVar b         = go1 n e+      | otherwise         = go (n+1) e+    go1 n (Let b e)       = gos (go1 n e) (rhssOfBind b)+    go1 n (Case e _ _ as) = gos (go1 n e) (rhssOfAlts as)++    gos n [] = n+    gos n (e:es) | n >= maxExprSize = n+                 | otherwise        = gos (go1 n e) es++betterLB :: NodeScore -> NodeScore -> Bool+-- If  n1 `betterLB` n2  then choose n1 as the loop breaker+betterLB (rank1, size1, lb1) (rank2, size2, _)+  | rank1 < rank2 = True+  | rank1 > rank2 = False+  | size1 < size2 = False   -- Make the bigger n2 into the loop breaker+  | size1 > size2 = True+  | lb1           = True    -- Tie-break: if n1 was a loop breaker before, choose it+  | otherwise     = False   -- See Note [Loop breakers, node scoring, and stability]++{- Note [Self-recursion and loop breakers]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If we have+   rec { f = ...f...g...+       ; g = .....f...   }+then 'f' has to be a loop breaker anyway, so we may as well choose it+right away, so that g can inline freely.++This is really just a cheap hack. Consider+   rec { f = ...g...+       ; g = ..f..h...+      ;  h = ...f....}+Here f or g are better loop breakers than h; but we might accidentally+choose h.  Finding the minimal set of loop breakers is hard.++Note [Loop breakers, node scoring, and stability]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+To choose a loop breaker, we give a NodeScore to each node in the SCC,+and pick the one with the best score (according to 'betterLB').++We need to be jolly careful (#12425, #12234) about the stability+of this choice. Suppose we have++    let rec { f = ...g...g...+            ; g = ...f...f... }+    in+    case x of+      True  -> ...f..+      False -> ..f...++In each iteration of the simplifier the occurrence analyser OccAnal+chooses a loop breaker. Suppose in iteration 1 it choose g as the loop+breaker. That means it is free to inline f.++Suppose that GHC decides to inline f in the branches of the case, but+(for some reason; eg it is not saturated) in the rhs of g. So we get++    let rec { f = ...g...g...+            ; g = ...f...f... }+    in+    case x of+      True  -> ...g...g.....+      False -> ..g..g....++Now suppose that, for some reason, in the next iteration the occurrence+analyser chooses f as the loop breaker, so it can freely inline g. And+again for some reason the simplifier inlines g at its calls in the case+branches, but not in the RHS of f. Then we get++    let rec { f = ...g...g...+            ; g = ...f...f... }+    in+    case x of+      True  -> ...(...f...f...)...(...f..f..).....+      False -> ..(...f...f...)...(..f..f...)....++You can see where this is going! Each iteration of the simplifier+doubles the number of calls to f or g. No wonder GHC is slow!++(In the particular example in comment:3 of #12425, f and g are the two+mutually recursive fmap instances for CondT and Result. They are both+marked INLINE which, oddly, is why they don't inline in each other's+RHS, because the call there is not saturated.)++The root cause is that we flip-flop on our choice of loop breaker. I+always thought it didn't matter, and indeed for any single iteration+to terminate, it doesn't matter. But when we iterate, it matters a+lot!!++So The Plan is this:+   If there is a tie, choose the node that+   was a loop breaker last time round++Hence the is_lb field of NodeScore++************************************************************************+*                                                                      *+                   Right hand sides+*                                                                      *+************************************************************************+-}++occAnalRhs :: OccEnv -> RecFlag -> Id -> [CoreBndr] -> CoreExpr+           -> (UsageDetails, [CoreBndr], CoreExpr)+              -- Returned usage details covers only the RHS,+              -- and *not* the RULE or INLINE template for the Id+occAnalRhs env Recursive _ bndrs body+  = occAnalRecRhs env bndrs body+occAnalRhs env NonRecursive id bndrs body+  = occAnalNonRecRhs env id bndrs body++occAnalRecRhs :: OccEnv -> [CoreBndr] -> CoreExpr    -- Rhs lambdas, body+           -> (UsageDetails, [CoreBndr], CoreExpr)+              -- Returned usage details covers only the RHS,+              -- and *not* the RULE or INLINE template for the Id+occAnalRecRhs env bndrs body = occAnalLamOrRhs (rhsCtxt env) bndrs body++occAnalNonRecRhs :: OccEnv+                 -> Id -> [CoreBndr] -> CoreExpr    -- Binder; rhs lams, body+                     -- Binder is already tagged with occurrence info+                 -> (UsageDetails, [CoreBndr], CoreExpr)+              -- Returned usage details covers only the RHS,+              -- and *not* the RULE or INLINE template for the Id+occAnalNonRecRhs env bndr bndrs body+  = occAnalLamOrRhs rhs_env bndrs body+  where+    env1 | is_join_point    = env  -- See Note [Join point RHSs]+         | certainly_inline = env  -- See Note [Cascading inlines]+         | otherwise        = rhsCtxt env++    -- See Note [Sources of one-shot information]+    rhs_env = env1 { occ_one_shots = argOneShots dmd }++    certainly_inline -- See Note [Cascading inlines]+      = case occ of+          OneOcc { occ_in_lam = in_lam, occ_one_br = one_br }+            -> not in_lam && one_br && active && not_stable+          _ -> False++    is_join_point = isAlwaysTailCalled occ+    -- Like (isJoinId bndr) but happens one step earlier+    --  c.f. willBeJoinId_maybe++    occ        = idOccInfo bndr+    dmd        = idDemandInfo bndr+    active     = isAlwaysActive (idInlineActivation bndr)+    not_stable = not (isStableUnfolding (idUnfolding bndr))++occAnalUnfolding :: OccEnv+                 -> RecFlag+                 -> Id+                 -> Maybe UsageDetails+                      -- Just the analysis, not a new unfolding. The unfolding+                      -- got analysed when it was created and we don't need to+                      -- update it.+occAnalUnfolding env rec_flag id+  = case realIdUnfolding id of -- ignore previous loop-breaker flag+      CoreUnfolding { uf_tmpl = rhs, uf_src = src }+        | not (isStableSource src)+        -> Nothing+        | otherwise+        -> Just $ markAllMany usage+        where+          (bndrs, body) = collectBinders rhs+          (usage, _, _) = occAnalRhs env rec_flag id bndrs body++      DFunUnfolding { df_bndrs = bndrs, df_args = args }+        -> Just $ zapDetails (delDetailsList usage bndrs)+        where+          usage = andUDsList (map (fst . occAnal env) args)++      _ -> Nothing++occAnalRules :: OccEnv+             -> Maybe JoinArity -- If the binder is (or MAY become) a join+                                -- point, what its join arity is (or WOULD+                                -- become). See Note [Rules and join points].+             -> RecFlag+             -> Id+             -> [(CoreRule,      -- Each (non-built-in) rule+                  UsageDetails,  -- Usage details for LHS+                  UsageDetails)] -- Usage details for RHS+occAnalRules env mb_expected_join_arity rec_flag id+  = [ (rule, lhs_uds, rhs_uds) | rule@Rule {} <- idCoreRules id+                               , let (lhs_uds, rhs_uds) = occ_anal_rule rule ]+  where+    occ_anal_rule (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs })+      = (lhs_uds, final_rhs_uds)+      where+        lhs_uds = addManyOccsSet emptyDetails $+                    (exprsFreeVars args `delVarSetList` bndrs)+        (rhs_bndrs, rhs_body) = collectBinders rhs+        (rhs_uds, _, _) = occAnalRhs env rec_flag id rhs_bndrs rhs_body+                            -- Note [Rules are extra RHSs]+                            -- Note [Rule dependency info]+        final_rhs_uds = adjust_tail_info args $ markAllMany $+                          (rhs_uds `delDetailsList` bndrs)+    occ_anal_rule _+      = (emptyDetails, emptyDetails)++    adjust_tail_info args uds -- see Note [Rules and join points]+      = case mb_expected_join_arity of+          Just ar | args `lengthIs` ar -> uds+          _                            -> markAllNonTailCalled uds+{- Note [Join point RHSs]+~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+   x = e+   join j = Just x++We want to inline x into j right away, so we don't want to give+the join point a RhsCtxt (#14137).  It's not a huge deal, because+the FloatIn pass knows to float into join point RHSs; and the simplifier+does not float things out of join point RHSs.  But it's a simple, cheap+thing to do.  See #14137.++Note [Cascading inlines]+~~~~~~~~~~~~~~~~~~~~~~~~+By default we use an rhsCtxt for the RHS of a binding.  This tells the+occ anal n that it's looking at an RHS, which has an effect in+occAnalApp.  In particular, for constructor applications, it makes+the arguments appear to have NoOccInfo, so that we don't inline into+them. Thus    x = f y+              k = Just x+we do not want to inline x.++But there's a problem.  Consider+     x1 = a0 : []+     x2 = a1 : x1+     x3 = a2 : x2+     g  = f x3+First time round, it looks as if x1 and x2 occur as an arg of a+let-bound constructor ==> give them a many-occurrence.+But then x3 is inlined (unconditionally as it happens) and+next time round, x2 will be, and the next time round x1 will be+Result: multiple simplifier iterations.  Sigh.++So, when analysing the RHS of x3 we notice that x3 will itself+definitely inline the next time round, and so we analyse x3's rhs in+an ordinary context, not rhsCtxt.  Hence the "certainly_inline" stuff.++Annoyingly, we have to approximate SimplUtils.preInlineUnconditionally.+If (a) the RHS is expandable (see isExpandableApp in occAnalApp), and+   (b) certainly_inline says "yes" when preInlineUnconditionally says "no"+then the simplifier iterates indefinitely:+        x = f y+        k = Just x   -- We decide that k is 'certainly_inline'+        v = ...k...  -- but preInlineUnconditionally doesn't inline it+inline ==>+        k = Just (f y)+        v = ...k...+float ==>+        x1 = f y+        k = Just x1+        v = ...k...++This is worse than the slow cascade, so we only want to say "certainly_inline"+if it really is certain.  Look at the note with preInlineUnconditionally+for the various clauses.+++************************************************************************+*                                                                      *+                Expressions+*                                                                      *+************************************************************************+-}++occAnal :: OccEnv+        -> CoreExpr+        -> (UsageDetails,       -- Gives info only about the "interesting" Ids+            CoreExpr)++occAnal _   expr@(Type _) = (emptyDetails,         expr)+occAnal _   expr@(Lit _)  = (emptyDetails,         expr)+occAnal env expr@(Var _)  = occAnalApp env (expr, [], [])+    -- At one stage, I gathered the idRuleVars for the variable here too,+    -- which in a way is the right thing to do.+    -- But that went wrong right after specialisation, when+    -- the *occurrences* of the overloaded function didn't have any+    -- rules in them, so the *specialised* versions looked as if they+    -- weren't used at all.++occAnal _ (Coercion co)+  = (addManyOccsSet emptyDetails (coVarsOfCo co), Coercion co)+        -- See Note [Gather occurrences of coercion variables]++{-+Note [Gather occurrences of coercion variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We need to gather info about what coercion variables appear, so that+we can sort them into the right place when doing dependency analysis.+-}++occAnal env (Tick tickish body)+  | SourceNote{} <- tickish+  = (usage, Tick tickish body')+                  -- SourceNotes are best-effort; so we just proceed as usual.+                  -- If we drop a tick due to the issues described below it's+                  -- not the end of the world.++  | tickish `tickishScopesLike` SoftScope+  = (markAllNonTailCalled usage, Tick tickish body')++  | Breakpoint _ ids <- tickish+  = (usage_lam `andUDs` foldr addManyOccs emptyDetails ids, Tick tickish body')+    -- never substitute for any of the Ids in a Breakpoint++  | otherwise+  = (usage_lam, Tick tickish body')+  where+    !(usage,body') = occAnal env body+    -- for a non-soft tick scope, we can inline lambdas only+    usage_lam = markAllNonTailCalled (markAllInsideLam usage)+                  -- TODO There may be ways to make ticks and join points play+                  -- nicer together, but right now there are problems:+                  --   let j x = ... in tick<t> (j 1)+                  -- Making j a join point may cause the simplifier to drop t+                  -- (if the tick is put into the continuation). So we don't+                  -- count j 1 as a tail call.+                  -- See #14242.++occAnal env (Cast expr co)+  = case occAnal env expr of { (usage, expr') ->+    let usage1 = zapDetailsIf (isRhsEnv env) usage+          -- usage1: if we see let x = y `cast` co+          -- then mark y as 'Many' so that we don't+          -- immediately inline y again.+        usage2 = addManyOccsSet usage1 (coVarsOfCo co)+          -- usage2: see Note [Gather occurrences of coercion variables]+    in (markAllNonTailCalled usage2, Cast expr' co)+    }++occAnal env app@(App _ _)+  = occAnalApp env (collectArgsTicks tickishFloatable app)++-- Ignore type variables altogether+--   (a) occurrences inside type lambdas only not marked as InsideLam+--   (b) type variables not in environment++occAnal env (Lam x body)+  | isTyVar x+  = case occAnal env body of { (body_usage, body') ->+    (markAllNonTailCalled body_usage, Lam x body')+    }++-- For value lambdas we do a special hack.  Consider+--      (\x. \y. ...x...)+-- If we did nothing, x is used inside the \y, so would be marked+-- as dangerous to dup.  But in the common case where the abstraction+-- is applied to two arguments this is over-pessimistic.+-- So instead, we just mark each binder with its occurrence+-- info in the *body* of the multiple lambda.+-- Then, the simplifier is careful when partially applying lambdas.++occAnal env expr@(Lam _ _)+  = case occAnalLamOrRhs env binders body of { (usage, tagged_binders, body') ->+    let+        expr'       = mkLams tagged_binders body'+        usage1      = markAllNonTailCalled usage+        one_shot_gp = all isOneShotBndr tagged_binders+        final_usage | one_shot_gp = usage1+                    | otherwise   = markAllInsideLam usage1+    in+    (final_usage, expr') }+  where+    (binders, body) = collectBinders expr++occAnal env (Case scrut bndr ty alts)+  = case occ_anal_scrut scrut alts     of { (scrut_usage, scrut') ->+    case mapAndUnzip occ_anal_alt alts of { (alts_usage_s, alts')   ->+    let+        alts_usage  = foldr orUDs emptyDetails alts_usage_s+        (alts_usage1, tagged_bndr) = tagLamBinder alts_usage bndr+        total_usage = markAllNonTailCalled scrut_usage `andUDs` alts_usage1+                        -- Alts can have tail calls, but the scrutinee can't+    in+    total_usage `seq` (total_usage, Case scrut' tagged_bndr ty alts') }}+  where+    alt_env = mkAltEnv env scrut bndr+    occ_anal_alt = occAnalAlt alt_env++    occ_anal_scrut (Var v) (alt1 : other_alts)+        | not (null other_alts) || not (isDefaultAlt alt1)+        = (mkOneOcc env v True 0, Var v)+            -- The 'True' says that the variable occurs in an interesting+            -- context; the case has at least one non-default alternative+    occ_anal_scrut (Tick t e) alts+        | t `tickishScopesLike` SoftScope+          -- No reason to not look through all ticks here, but only+          -- for soft-scoped ticks we can do so without having to+          -- update returned occurance info (see occAnal)+        = second (Tick t) $ occ_anal_scrut e alts++    occ_anal_scrut scrut _alts+        = occAnal (vanillaCtxt env) scrut    -- No need for rhsCtxt++occAnal env (Let bind body)+  = case occAnal env body                of { (body_usage, body') ->+    case occAnalBind env NotTopLevel+                     noImpRuleEdges bind+                     body_usage          of { (final_usage, new_binds) ->+       (final_usage, mkLets new_binds body') }}++occAnalArgs :: OccEnv -> [CoreExpr] -> [OneShots] -> (UsageDetails, [CoreExpr])+occAnalArgs _ [] _+  = (emptyDetails, [])++occAnalArgs env (arg:args) one_shots+  | isTypeArg arg+  = case occAnalArgs env args one_shots of { (uds, args') ->+    (uds, arg:args') }++  | otherwise+  = case argCtxt env one_shots           of { (arg_env, one_shots') ->+    case occAnal arg_env arg             of { (uds1, arg') ->+    case occAnalArgs env args one_shots' of { (uds2, args') ->+    (uds1 `andUDs` uds2, arg':args') }}}++{-+Applications are dealt with specially because we want+the "build hack" to work.++Note [Arguments of let-bound constructors]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+    f x = let y = expensive x in+          let z = (True,y) in+          (case z of {(p,q)->q}, case z of {(p,q)->q})+We feel free to duplicate the WHNF (True,y), but that means+that y may be duplicated thereby.++If we aren't careful we duplicate the (expensive x) call!+Constructors are rather like lambdas in this way.+-}++occAnalApp :: OccEnv+           -> (Expr CoreBndr, [Arg CoreBndr], [Tickish Id])+           -> (UsageDetails, Expr CoreBndr)+occAnalApp env (Var fun, args, ticks)+  | null ticks = (uds, mkApps (Var fun) args')+  | otherwise  = (uds, mkTicks ticks $ mkApps (Var fun) args')+  where+    uds = fun_uds `andUDs` final_args_uds++    !(args_uds, args') = occAnalArgs env args one_shots+    !final_args_uds+       | isRhsEnv env && is_exp = markAllNonTailCalled $+                                  markAllInsideLam args_uds+       | otherwise              = markAllNonTailCalled args_uds+       -- We mark the free vars of the argument of a constructor or PAP+       -- as "inside-lambda", if it is the RHS of a let(rec).+       -- This means that nothing gets inlined into a constructor or PAP+       -- argument position, which is what we want.  Typically those+       -- constructor arguments are just variables, or trivial expressions.+       -- We use inside-lam because it's like eta-expanding the PAP.+       --+       -- This is the *whole point* of the isRhsEnv predicate+       -- See Note [Arguments of let-bound constructors]++    n_val_args = valArgCount args+    n_args     = length args+    fun_uds    = mkOneOcc env fun (n_val_args > 0) n_args+    is_exp     = isExpandableApp fun n_val_args+        -- See Note [CONLIKE pragma] in BasicTypes+        -- The definition of is_exp should match that in Simplify.prepareRhs++    one_shots  = argsOneShots (idStrictness fun) guaranteed_val_args+    guaranteed_val_args = n_val_args + length (takeWhile isOneShotInfo+                                                         (occ_one_shots env))+        -- See Note [Sources of one-shot information], bullet point A']++occAnalApp env (fun, args, ticks)+  = (markAllNonTailCalled (fun_uds `andUDs` args_uds),+     mkTicks ticks $ mkApps fun' args')+  where+    !(fun_uds, fun') = occAnal (addAppCtxt env args) fun+        -- The addAppCtxt is a bit cunning.  One iteration of the simplifier+        -- often leaves behind beta redexs like+        --      (\x y -> e) a1 a2+        -- Here we would like to mark x,y as one-shot, and treat the whole+        -- thing much like a let.  We do this by pushing some True items+        -- onto the context stack.+    !(args_uds, args') = occAnalArgs env args []++zapDetailsIf :: Bool              -- If this is true+             -> UsageDetails      -- Then do zapDetails on this+             -> UsageDetails+zapDetailsIf True  uds = zapDetails uds+zapDetailsIf False uds = uds++{-+Note [Sources of one-shot information]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The occurrence analyser obtains one-shot-lambda information from two sources:++A:  Saturated applications:  eg   f e1 .. en++    In general, given a call (f e1 .. en) we can propagate one-shot info from+    f's strictness signature into e1 .. en, but /only/ if n is enough to+    saturate the strictness signature. A strictness signature like++          f :: C1(C1(L))LS++    means that *if f is applied to three arguments* then it will guarantee to+    call its first argument at most once, and to call the result of that at+    most once. But if f has fewer than three arguments, all bets are off; e.g.++          map (f (\x y. expensive) e2) xs++    Here the \x y abstraction may be called many times (once for each element of+    xs) so we should not mark x and y as one-shot. But if it was++          map (f (\x y. expensive) 3 2) xs++    then the first argument of f will be called at most once.++    The one-shot info, derived from f's strictness signature, is+    computed by 'argsOneShots', called in occAnalApp.++A': Non-obviously saturated applications: eg    build (f (\x y -> expensive))+    where f is as above.++    In this case, f is only manifestly applied to one argument, so it does not+    look saturated. So by the previous point, we should not use its strictness+    signature to learn about the one-shotness of \x y. But in this case we can:+    build is fully applied, so we may use its strictness signature; and from+    that we learn that build calls its argument with two arguments *at most once*.++    So there is really only one call to f, and it will have three arguments. In+    that sense, f is saturated, and we may proceed as described above.++    Hence the computation of 'guaranteed_val_args' in occAnalApp, using+    '(occ_one_shots env)'.  See also #13227, comment:9++B:  Let-bindings:  eg   let f = \c. let ... in \n -> blah+                        in (build f, build f)++    Propagate one-shot info from the demanand-info on 'f' to the+    lambdas in its RHS (which may not be syntactically at the top)++    This information must have come from a previous run of the demanand+    analyser.++Previously, the demand analyser would *also* set the one-shot information, but+that code was buggy (see #11770), so doing it only in on place, namely here, is+saner.++Note [OneShots]+~~~~~~~~~~~~~~~+When analysing an expression, the occ_one_shots argument contains information+about how the function is being used. The length of the list indicates+how many arguments will eventually be passed to the analysed expression,+and the OneShotInfo indicates whether this application is once or multiple times.++Example:++ Context of f                occ_one_shots when analysing f++ f 1 2                       [OneShot, OneShot]+ map (f 1)                   [OneShot, NoOneShotInfo]+ build f                     [OneShot, OneShot]+ f 1 2 `seq` f 2 1           [NoOneShotInfo, OneShot]++Note [Binders in case alternatives]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+    case x of y { (a,b) -> f y }+We treat 'a', 'b' as dead, because they don't physically occur in the+case alternative.  (Indeed, a variable is dead iff it doesn't occur in+its scope in the output of OccAnal.)  It really helps to know when+binders are unused.  See esp the call to isDeadBinder in+Simplify.mkDupableAlt++In this example, though, the Simplifier will bring 'a' and 'b' back to+life, beause it binds 'y' to (a,b) (imagine got inlined and+scrutinised y).+-}++occAnalLamOrRhs :: OccEnv -> [CoreBndr] -> CoreExpr+                -> (UsageDetails, [CoreBndr], CoreExpr)+occAnalLamOrRhs env [] body+  = case occAnal env body of (body_usage, body') -> (body_usage, [], body')+      -- RHS of thunk or nullary join point+occAnalLamOrRhs env (bndr:bndrs) body+  | isTyVar bndr+  = -- Important: Keep the environment so that we don't inline into an RHS like+    --   \(@ x) -> C @x (f @x)+    -- (see the beginning of Note [Cascading inlines]).+    case occAnalLamOrRhs env bndrs body of+      (body_usage, bndrs', body') -> (body_usage, bndr:bndrs', body')+occAnalLamOrRhs env binders body+  = case occAnal env_body body of { (body_usage, body') ->+    let+        (final_usage, tagged_binders) = tagLamBinders body_usage binders'+                      -- Use binders' to put one-shot info on the lambdas+    in+    (final_usage, tagged_binders, body') }+  where+    (env_body, binders') = oneShotGroup env binders++occAnalAlt :: (OccEnv, Maybe (Id, CoreExpr))+           -> CoreAlt+           -> (UsageDetails, Alt IdWithOccInfo)+occAnalAlt (env, scrut_bind) (con, bndrs, rhs)+  = case occAnal env rhs of { (rhs_usage1, rhs1) ->+    let+      (alt_usg, tagged_bndrs) = tagLamBinders rhs_usage1 bndrs+                                -- See Note [Binders in case alternatives]+      (alt_usg', rhs2) = wrapAltRHS env scrut_bind alt_usg tagged_bndrs rhs1+    in+    (alt_usg', (con, tagged_bndrs, rhs2)) }++wrapAltRHS :: OccEnv+           -> Maybe (Id, CoreExpr)      -- proxy mapping generated by mkAltEnv+           -> UsageDetails              -- usage for entire alt (p -> rhs)+           -> [Var]                     -- alt binders+           -> CoreExpr                  -- alt RHS+           -> (UsageDetails, CoreExpr)+wrapAltRHS env (Just (scrut_var, let_rhs)) alt_usg bndrs alt_rhs+  | occ_binder_swap env+  , scrut_var `usedIn` alt_usg -- bndrs are not be present in alt_usg so this+                               -- handles condition (a) in Note [Binder swap]+  , not captured               -- See condition (b) in Note [Binder swap]+  = ( alt_usg' `andUDs` let_rhs_usg+    , Let (NonRec tagged_scrut_var let_rhs') alt_rhs )+  where+    captured = any (`usedIn` let_rhs_usg) bndrs  -- Check condition (b)++    -- The rhs of the let may include coercion variables+    -- if the scrutinee was a cast, so we must gather their+    -- usage. See Note [Gather occurrences of coercion variables]+    -- Moreover, the rhs of the let may mention the case-binder, and+    -- we want to gather its occ-info as well+    (let_rhs_usg, let_rhs') = occAnal env let_rhs++    (alt_usg', tagged_scrut_var) = tagLamBinder alt_usg scrut_var++wrapAltRHS _ _ alt_usg _ alt_rhs+  = (alt_usg, alt_rhs)++{-+************************************************************************+*                                                                      *+                    OccEnv+*                                                                      *+************************************************************************+-}++data OccEnv+  = OccEnv { occ_encl       :: !OccEncl      -- Enclosing context information+           , occ_one_shots  :: !OneShots     -- See Note [OneShots]+           , occ_gbl_scrut  :: GlobalScruts++           , occ_unf_act   :: Id -> Bool   -- Which Id unfoldings are active++           , occ_rule_act   :: Activation -> Bool   -- Which rules are active+             -- See Note [Finding rule RHS free vars]++           , occ_binder_swap :: !Bool -- enable the binder_swap+             -- See CorePrep Note [Dead code in CorePrep]+    }++type GlobalScruts = IdSet   -- See Note [Binder swap on GlobalId scrutinees]++-----------------------------+-- OccEncl is used to control whether to inline into constructor arguments+-- For example:+--      x = (p,q)               -- Don't inline p or q+--      y = /\a -> (p a, q a)   -- Still don't inline p or q+--      z = f (p,q)             -- Do inline p,q; it may make a rule fire+-- So OccEncl tells enough about the context to know what to do when+-- we encounter a constructor application or PAP.++data OccEncl+  = OccRhs              -- RHS of let(rec), albeit perhaps inside a type lambda+                        -- Don't inline into constructor args here+  | OccVanilla          -- Argument of function, body of lambda, scruintee of case etc.+                        -- Do inline into constructor args here++instance Outputable OccEncl where+  ppr OccRhs     = text "occRhs"+  ppr OccVanilla = text "occVanilla"++-- See note [OneShots]+type OneShots = [OneShotInfo]++initOccEnv :: OccEnv+initOccEnv+  = OccEnv { occ_encl      = OccVanilla+           , occ_one_shots = []+           , occ_gbl_scrut = emptyVarSet+                 -- To be conservative, we say that all+                 -- inlines and rules are active+           , occ_unf_act   = \_ -> True+           , occ_rule_act  = \_ -> True+           , occ_binder_swap = True }++vanillaCtxt :: OccEnv -> OccEnv+vanillaCtxt env = env { occ_encl = OccVanilla, occ_one_shots = [] }++rhsCtxt :: OccEnv -> OccEnv+rhsCtxt env = env { occ_encl = OccRhs, occ_one_shots = [] }++argCtxt :: OccEnv -> [OneShots] -> (OccEnv, [OneShots])+argCtxt env []+  = (env { occ_encl = OccVanilla, occ_one_shots = [] }, [])+argCtxt env (one_shots:one_shots_s)+  = (env { occ_encl = OccVanilla, occ_one_shots = one_shots }, one_shots_s)++isRhsEnv :: OccEnv -> Bool+isRhsEnv (OccEnv { occ_encl = OccRhs })     = True+isRhsEnv (OccEnv { occ_encl = OccVanilla }) = False++oneShotGroup :: OccEnv -> [CoreBndr]+             -> ( OccEnv+                , [CoreBndr] )+        -- The result binders have one-shot-ness set that they might not have had originally.+        -- This happens in (build (\c n -> e)).  Here the occurrence analyser+        -- linearity context knows that c,n are one-shot, and it records that fact in+        -- the binder. This is useful to guide subsequent float-in/float-out tranformations++oneShotGroup env@(OccEnv { occ_one_shots = ctxt }) bndrs+  = go ctxt bndrs []+  where+    go ctxt [] rev_bndrs+      = ( env { occ_one_shots = ctxt, occ_encl = OccVanilla }+        , reverse rev_bndrs )++    go [] bndrs rev_bndrs+      = ( env { occ_one_shots = [], occ_encl = OccVanilla }+        , reverse rev_bndrs ++ bndrs )++    go ctxt@(one_shot : ctxt') (bndr : bndrs) rev_bndrs+      | isId bndr = go ctxt' bndrs (bndr': rev_bndrs)+      | otherwise = go ctxt  bndrs (bndr : rev_bndrs)+      where+        bndr' = updOneShotInfo bndr one_shot+               -- Use updOneShotInfo, not setOneShotInfo, as pre-existing+               -- one-shot info might be better than what we can infer, e.g.+               -- due to explicit use of the magic 'oneShot' function.+               -- See Note [The oneShot function]+++markJoinOneShots :: Maybe JoinArity -> [Var] -> [Var]+-- Mark the lambdas of a non-recursive join point as one-shot.+-- This is good to prevent gratuitous float-out etc+markJoinOneShots mb_join_arity bndrs+  = case mb_join_arity of+      Nothing -> bndrs+      Just n  -> go n bndrs+ where+   go 0 bndrs  = bndrs+   go _ []     = [] -- This can legitimately happen.+                    -- e.g.    let j = case ... in j True+                    -- This will become an arity-1 join point after the+                    -- simplifier has eta-expanded it; but it may not have+                    -- enough lambdas /yet/. (Lint checks that JoinIds do+                    -- have enough lambdas.)+   go n (b:bs) = b' : go (n-1) bs+     where+       b' | isId b    = setOneShotLambda b+          | otherwise = b++addAppCtxt :: OccEnv -> [Arg CoreBndr] -> OccEnv+addAppCtxt env@(OccEnv { occ_one_shots = ctxt }) args+  = env { occ_one_shots = replicate (valArgCount args) OneShotLam ++ ctxt }++transClosureFV :: UniqFM VarSet -> UniqFM VarSet+-- If (f,g), (g,h) are in the input, then (f,h) is in the output+--                                   as well as (f,g), (g,h)+transClosureFV env+  | no_change = env+  | otherwise = transClosureFV (listToUFM new_fv_list)+  where+    (no_change, new_fv_list) = mapAccumL bump True (nonDetUFMToList env)+      -- It's OK to use nonDetUFMToList here because we'll forget the+      -- ordering by creating a new set with listToUFM+    bump no_change (b,fvs)+      | no_change_here = (no_change, (b,fvs))+      | otherwise      = (False,     (b,new_fvs))+      where+        (new_fvs, no_change_here) = extendFvs env fvs++-------------+extendFvs_ :: UniqFM VarSet -> VarSet -> VarSet+extendFvs_ env s = fst (extendFvs env s)   -- Discard the Bool flag++extendFvs :: UniqFM VarSet -> VarSet -> (VarSet, Bool)+-- (extendFVs env s) returns+--     (s `union` env(s), env(s) `subset` s)+extendFvs env s+  | isNullUFM env+  = (s, True)+  | otherwise+  = (s `unionVarSet` extras, extras `subVarSet` s)+  where+    extras :: VarSet    -- env(s)+    extras = nonDetFoldUFM unionVarSet emptyVarSet $+      -- It's OK to use nonDetFoldUFM here because unionVarSet commutes+             intersectUFM_C (\x _ -> x) env (getUniqSet s)++{-+************************************************************************+*                                                                      *+                    Binder swap+*                                                                      *+************************************************************************++Note [Binder swap]+~~~~~~~~~~~~~~~~~~+The "binder swap" tranformation swaps occurence of the+scrutinee of a case for occurrences of the case-binder:++ (1)  case x of b { pi -> ri }+         ==>+      case x of b { pi -> let x=b in ri }++ (2)  case (x |> co) of b { pi -> ri }+        ==>+      case (x |> co) of b { pi -> let x = b |> sym co in ri }++In both cases, the trivial 'let' can be eliminated by the+immediately following simplifier pass.++There are two reasons for making this swap:++(A) It reduces the number of occurrences of the scrutinee, x.+    That in turn might reduce its occurrences to one, so we+    can inline it and save an allocation.  E.g.+      let x = factorial y in case x of b { I# v -> ...x... }+    If we replace 'x' by 'b' in the alternative we get+      let x = factorial y in case x of b { I# v -> ...b... }+    and now we can inline 'x', thus+      case (factorial y) of b { I# v -> ...b... }++(B) The case-binder b has unfolding information; in the+    example above we know that b = I# v. That in turn allows+    nested cases to simplify.  Consider+       case x of b { I# v ->+       ...(case x of b2 { I# v2 -> rhs })...+    If we replace 'x' by 'b' in the alternative we get+       case x of b { I# v ->+       ...(case b of b2 { I# v2 -> rhs })...+    and now it is trivial to simplify the inner case:+       case x of b { I# v ->+       ...(let b2 = b in rhs)...++    The same can happen even if the scrutinee is a variable+    with a cast: see Note [Case of cast]++In both cases, in a particular alternative (pi -> ri), we only+add the binding if+  (a) x occurs free in (pi -> ri)+        (ie it occurs in ri, but is not bound in pi)+  (b) the pi does not bind b (or the free vars of co)+We need (a) and (b) for the inserted binding to be correct.++For the alternatives where we inject the binding, we can transfer+all x's OccInfo to b.  And that is the point.++Notice that+  * The deliberate shadowing of 'x'.+  * That (a) rapidly becomes false, so no bindings are injected.++The reason for doing these transformations /here in the occurrence+analyser/ is because it allows us to adjust the OccInfo for 'x' and+'b' as we go.++  * Suppose the only occurrences of 'x' are the scrutinee and in the+    ri; then this transformation makes it occur just once, and hence+    get inlined right away.++  * If instead we do this in the Simplifier, we don't know whether 'x'+    is used in ri, so we are forced to pessimistically zap b's OccInfo+    even though it is typically dead (ie neither it nor x appear in+    the ri).  There's nothing actually wrong with zapping it, except+    that it's kind of nice to know which variables are dead.  My nose+    tells me to keep this information as robustly as possible.++The Maybe (Id,CoreExpr) passed to occAnalAlt is the extra let-binding+{x=b}; it's Nothing if the binder-swap doesn't happen.++There is a danger though.  Consider+      let v = x +# y+      in case (f v) of w -> ...v...v...+And suppose that (f v) expands to just v.  Then we'd like to+use 'w' instead of 'v' in the alternative.  But it may be too+late; we may have substituted the (cheap) x+#y for v in the+same simplifier pass that reduced (f v) to v.++I think this is just too bad.  CSE will recover some of it.++Note [Case of cast]+~~~~~~~~~~~~~~~~~~~+Consider        case (x `cast` co) of b { I# ->+                ... (case (x `cast` co) of {...}) ...+We'd like to eliminate the inner case.  That is the motivation for+equation (2) in Note [Binder swap].  When we get to the inner case, we+inline x, cancel the casts, and away we go.++Note [Binder swap on GlobalId scrutinees]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When the scrutinee is a GlobalId we must take care in two ways++ i) In order to *know* whether 'x' occurs free in the RHS, we need its+    occurrence info. BUT, we don't gather occurrence info for+    GlobalIds.  That's the reason for the (small) occ_gbl_scrut env in+    OccEnv is for: it says "gather occurrence info for these".++ ii) We must call localiseId on 'x' first, in case it's a GlobalId, or+     has an External Name. See, for example, SimplEnv Note [Global Ids in+     the substitution].++Note [Zap case binders in proxy bindings]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+From the original+     case x of cb(dead) { p -> ...x... }+we will get+     case x of cb(live) { p -> let x = cb in ...x... }++Core Lint never expects to find an *occurrence* of an Id marked+as Dead, so we must zap the OccInfo on cb before making the+binding x = cb.  See #5028.++NB: the OccInfo on /occurrences/ really doesn't matter much; the simplifier+doesn't use it. So this is only to satisfy the perhpas-over-picky Lint.++Historical note [no-case-of-case]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We *used* to suppress the binder-swap in case expressions when+-fno-case-of-case is on.  Old remarks:+    "This happens in the first simplifier pass,+    and enhances full laziness.  Here's the bad case:+            f = \ y -> ...(case x of I# v -> ...(case x of ...) ... )+    If we eliminate the inner case, we trap it inside the I# v -> arm,+    which might prevent some full laziness happening.  I've seen this+    in action in spectral/cichelli/Prog.hs:+             [(m,n) | m <- [1..max], n <- [1..max]]+    Hence the check for NoCaseOfCase."+However, now the full-laziness pass itself reverses the binder-swap, so this+check is no longer necessary.++Historical note [Suppressing the case binder-swap]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+This old note describes a problem that is also fixed by doing the+binder-swap in OccAnal:++    There is another situation when it might make sense to suppress the+    case-expression binde-swap. If we have++        case x of w1 { DEFAULT -> case x of w2 { A -> e1; B -> e2 }+                       ...other cases .... }++    We'll perform the binder-swap for the outer case, giving++        case x of w1 { DEFAULT -> case w1 of w2 { A -> e1; B -> e2 }+                       ...other cases .... }++    But there is no point in doing it for the inner case, because w1 can't+    be inlined anyway.  Furthermore, doing the case-swapping involves+    zapping w2's occurrence info (see paragraphs that follow), and that+    forces us to bind w2 when doing case merging.  So we get++        case x of w1 { A -> let w2 = w1 in e1+                       B -> let w2 = w1 in e2+                       ...other cases .... }++    This is plain silly in the common case where w2 is dead.++    Even so, I can't see a good way to implement this idea.  I tried+    not doing the binder-swap if the scrutinee was already evaluated+    but that failed big-time:++            data T = MkT !Int++            case v of w  { MkT x ->+            case x of x1 { I# y1 ->+            case x of x2 { I# y2 -> ...++    Notice that because MkT is strict, x is marked "evaluated".  But to+    eliminate the last case, we must either make sure that x (as well as+    x1) has unfolding MkT y1.  The straightforward thing to do is to do+    the binder-swap.  So this whole note is a no-op.++It's fixed by doing the binder-swap in OccAnal because we can do the+binder-swap unconditionally and still get occurrence analysis+information right.+-}++mkAltEnv :: OccEnv -> CoreExpr -> Id -> (OccEnv, Maybe (Id, CoreExpr))+-- Does three things: a) makes the occ_one_shots = OccVanilla+--                    b) extends the GlobalScruts if possible+--                    c) returns a proxy mapping, binding the scrutinee+--                       to the case binder, if possible+mkAltEnv env@(OccEnv { occ_gbl_scrut = pe }) scrut case_bndr+  = case stripTicksTopE (const True) scrut of+      Var v           -> add_scrut v case_bndr'+      Cast (Var v) co -> add_scrut v (Cast case_bndr' (mkSymCo co))+                          -- See Note [Case of cast]+      _               -> (env { occ_encl = OccVanilla }, Nothing)++  where+    add_scrut v rhs+      | isGlobalId v = (env { occ_encl = OccVanilla }, Nothing)+      | otherwise    = ( env { occ_encl = OccVanilla+                             , occ_gbl_scrut = pe `extendVarSet` v }+                       , Just (localise v, rhs) )+      -- ToDO: this isGlobalId stuff is a TEMPORARY FIX+      --       to avoid the binder-swap for GlobalIds+      --       See #16346++    case_bndr' = Var (zapIdOccInfo case_bndr)+                   -- See Note [Zap case binders in proxy bindings]++    -- Localise the scrut_var before shadowing it; we're making a+    -- new binding for it, and it might have an External Name, or+    -- even be a GlobalId; Note [Binder swap on GlobalId scrutinees]+    -- Also we don't want any INLINE or NOINLINE pragmas!+    localise scrut_var = mkLocalIdOrCoVar (localiseName (idName scrut_var))+                                          (idType scrut_var)++{-+************************************************************************+*                                                                      *+\subsection[OccurAnal-types]{OccEnv}+*                                                                      *+************************************************************************++Note [UsageDetails and zapping]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++On many occasions, we must modify all gathered occurrence data at once. For+instance, all occurrences underneath a (non-one-shot) lambda set the+'occ_in_lam' flag to become 'True'. We could use 'mapVarEnv' to do this, but+that takes O(n) time and we will do this often---in particular, there are many+places where tail calls are not allowed, and each of these causes all variables+to get marked with 'NoTailCallInfo'.++Instead of relying on `mapVarEnv`, then, we carry three 'IdEnv's around along+with the 'OccInfoEnv'. Each of these extra environments is a "zapped set"+recording which variables have been zapped in some way. Zapping all occurrence+info then simply means setting the corresponding zapped set to the whole+'OccInfoEnv', a fast O(1) operation.+-}++type OccInfoEnv = IdEnv OccInfo -- A finite map from ids to their usage+                -- INVARIANT: never IAmDead+                -- (Deadness is signalled by not being in the map at all)++type ZappedSet = OccInfoEnv -- Values are ignored++data UsageDetails+  = UD { ud_env       :: !OccInfoEnv+       , ud_z_many    :: ZappedSet   -- apply 'markMany' to these+       , ud_z_in_lam  :: ZappedSet   -- apply 'markInsideLam' to these+       , ud_z_no_tail :: ZappedSet } -- apply 'markNonTailCalled' to these+  -- INVARIANT: All three zapped sets are subsets of the OccInfoEnv++instance Outputable UsageDetails where+  ppr ud = ppr (ud_env (flattenUsageDetails ud))++-------------------+-- UsageDetails API++andUDs, orUDs+        :: UsageDetails -> UsageDetails -> UsageDetails+andUDs = combineUsageDetailsWith addOccInfo+orUDs  = combineUsageDetailsWith orOccInfo++andUDsList :: [UsageDetails] -> UsageDetails+andUDsList = foldl' andUDs emptyDetails++mkOneOcc :: OccEnv -> Id -> InterestingCxt -> JoinArity -> UsageDetails+mkOneOcc env id int_cxt arity+  | isLocalId id+  = singleton $ OneOcc { occ_in_lam  = False+                       , occ_one_br  = True+                       , occ_int_cxt = int_cxt+                       , occ_tail    = AlwaysTailCalled arity }+  | id `elemVarSet` occ_gbl_scrut env+  = singleton noOccInfo++  | otherwise+  = emptyDetails+  where+    singleton info = emptyDetails { ud_env = unitVarEnv id info }++addOneOcc :: UsageDetails -> Id -> OccInfo -> UsageDetails+addOneOcc ud id info+  = ud { ud_env = extendVarEnv_C plus_zapped (ud_env ud) id info }+      `alterZappedSets` (`delVarEnv` id)+  where+    plus_zapped old new = doZapping ud id old `addOccInfo` new++addManyOccsSet :: UsageDetails -> VarSet -> UsageDetails+addManyOccsSet usage id_set = nonDetFoldUniqSet addManyOccs usage id_set+  -- It's OK to use nonDetFoldUFM here because addManyOccs commutes++-- Add several occurrences, assumed not to be tail calls+addManyOccs :: Var -> UsageDetails -> UsageDetails+addManyOccs v u | isId v    = addOneOcc u v noOccInfo+                | otherwise = u+        -- Give a non-committal binder info (i.e noOccInfo) because+        --   a) Many copies of the specialised thing can appear+        --   b) We don't want to substitute a BIG expression inside a RULE+        --      even if that's the only occurrence of the thing+        --      (Same goes for INLINE.)++delDetails :: UsageDetails -> Id -> UsageDetails+delDetails ud bndr+  = ud `alterUsageDetails` (`delVarEnv` bndr)++delDetailsList :: UsageDetails -> [Id] -> UsageDetails+delDetailsList ud bndrs+  = ud `alterUsageDetails` (`delVarEnvList` bndrs)++emptyDetails :: UsageDetails+emptyDetails = UD { ud_env       = emptyVarEnv+                  , ud_z_many    = emptyVarEnv+                  , ud_z_in_lam  = emptyVarEnv+                  , ud_z_no_tail = emptyVarEnv }++isEmptyDetails :: UsageDetails -> Bool+isEmptyDetails = isEmptyVarEnv . ud_env++markAllMany, markAllInsideLam, markAllNonTailCalled, zapDetails+  :: UsageDetails -> UsageDetails+markAllMany          ud = ud { ud_z_many    = ud_env ud }+markAllInsideLam     ud = ud { ud_z_in_lam  = ud_env ud }+markAllNonTailCalled ud = ud { ud_z_no_tail = ud_env ud }++zapDetails = markAllMany . markAllNonTailCalled -- effectively sets to noOccInfo++lookupDetails :: UsageDetails -> Id -> OccInfo+lookupDetails ud id+  | isCoVar id  -- We do not currenly gather occurrence info (from types)+  = noOccInfo   -- for CoVars, so we must conservatively mark them as used+                -- See Note [DoO not mark CoVars as dead]+  | otherwise+  = case lookupVarEnv (ud_env ud) id of+      Just occ -> doZapping ud id occ+      Nothing  -> IAmDead++usedIn :: Id -> UsageDetails -> Bool+v `usedIn` ud = isExportedId v || v `elemVarEnv` ud_env ud++udFreeVars :: VarSet -> UsageDetails -> VarSet+-- Find the subset of bndrs that are mentioned in uds+udFreeVars bndrs ud = restrictUniqSetToUFM bndrs (ud_env ud)++{- Note [Do not mark CoVars as dead]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+It's obviously wrong to mark CoVars as dead if they are used.+Currently we don't traverse types to gather usase info for CoVars,+so we had better treat them as having noOccInfo.++This showed up in #15696 we had something like+  case eq_sel d of co -> ...(typeError @(...co...) "urk")...++Then 'd' was substitued by a dictionary, so the expression+simpified to+  case (Coercion <blah>) of co -> ...(typeError @(...co...) "urk")...++But then the "drop the case altogether" equation of rebuildCase+thought that 'co' was dead, and discarded the entire case. Urk!++I have no idea how we managed to avoid this pitfall for so long!+-}++-------------------+-- Auxiliary functions for UsageDetails implementation++combineUsageDetailsWith :: (OccInfo -> OccInfo -> OccInfo)+                        -> UsageDetails -> UsageDetails -> UsageDetails+combineUsageDetailsWith plus_occ_info ud1 ud2+  | isEmptyDetails ud1 = ud2+  | isEmptyDetails ud2 = ud1+  | otherwise+  = UD { ud_env       = plusVarEnv_C plus_occ_info (ud_env ud1) (ud_env ud2)+       , ud_z_many    = plusVarEnv (ud_z_many    ud1) (ud_z_many    ud2)+       , ud_z_in_lam  = plusVarEnv (ud_z_in_lam  ud1) (ud_z_in_lam  ud2)+       , ud_z_no_tail = plusVarEnv (ud_z_no_tail ud1) (ud_z_no_tail ud2) }++doZapping :: UsageDetails -> Var -> OccInfo -> OccInfo+doZapping ud var occ+  = doZappingByUnique ud (varUnique var) occ++doZappingByUnique :: UsageDetails -> Unique -> OccInfo -> OccInfo+doZappingByUnique ud uniq+  = (if | in_subset ud_z_many    -> markMany+        | in_subset ud_z_in_lam  -> markInsideLam+        | otherwise              -> id) .+    (if | in_subset ud_z_no_tail -> markNonTailCalled+        | otherwise              -> id)+  where+    in_subset field = uniq `elemVarEnvByKey` field ud++alterZappedSets :: UsageDetails -> (ZappedSet -> ZappedSet) -> UsageDetails+alterZappedSets ud f+  = ud { ud_z_many    = f (ud_z_many    ud)+       , ud_z_in_lam  = f (ud_z_in_lam  ud)+       , ud_z_no_tail = f (ud_z_no_tail ud) }++alterUsageDetails :: UsageDetails -> (OccInfoEnv -> OccInfoEnv) -> UsageDetails+alterUsageDetails ud f+  = ud { ud_env = f (ud_env ud) }+      `alterZappedSets` f++flattenUsageDetails :: UsageDetails -> UsageDetails+flattenUsageDetails ud+  = ud { ud_env = mapUFM_Directly (doZappingByUnique ud) (ud_env ud) }+      `alterZappedSets` const emptyVarEnv++-------------------+-- See Note [Adjusting right-hand sides]+adjustRhsUsage :: Maybe JoinArity -> RecFlag+               -> [CoreBndr] -- Outer lambdas, AFTER occ anal+               -> UsageDetails -> UsageDetails+adjustRhsUsage mb_join_arity rec_flag bndrs usage+  = maybe_mark_lam (maybe_drop_tails usage)+  where+    maybe_mark_lam ud   | one_shot   = ud+                        | otherwise  = markAllInsideLam ud+    maybe_drop_tails ud | exact_join = ud+                        | otherwise  = markAllNonTailCalled ud++    one_shot = case mb_join_arity of+                 Just join_arity+                   | isRec rec_flag -> False+                   | otherwise      -> all isOneShotBndr (drop join_arity bndrs)+                 Nothing            -> all isOneShotBndr bndrs++    exact_join = case mb_join_arity of+                   Just join_arity -> bndrs `lengthIs` join_arity+                   _               -> False++type IdWithOccInfo = Id++tagLamBinders :: UsageDetails          -- Of scope+              -> [Id]                  -- Binders+              -> (UsageDetails,        -- Details with binders removed+                 [IdWithOccInfo])    -- Tagged binders+tagLamBinders usage binders+  = usage' `seq` (usage', bndrs')+  where+    (usage', bndrs') = mapAccumR tagLamBinder usage binders++tagLamBinder :: UsageDetails       -- Of scope+             -> Id                 -- Binder+             -> (UsageDetails,     -- Details with binder removed+                 IdWithOccInfo)    -- Tagged binders+-- Used for lambda and case binders+-- It copes with the fact that lambda bindings can have a+-- stable unfolding, used for join points+tagLamBinder usage bndr+  = (usage2, bndr')+  where+        occ    = lookupDetails usage bndr+        bndr'  = setBinderOcc (markNonTailCalled occ) bndr+                   -- Don't try to make an argument into a join point+        usage1 = usage `delDetails` bndr+        usage2 | isId bndr = addManyOccsSet usage1 (idUnfoldingVars bndr)+                               -- This is effectively the RHS of a+                               -- non-join-point binding, so it's okay to use+                               -- addManyOccsSet, which assumes no tail calls+               | otherwise = usage1++tagNonRecBinder :: TopLevelFlag           -- At top level?+                -> UsageDetails           -- Of scope+                -> CoreBndr               -- Binder+                -> (UsageDetails,         -- Details with binder removed+                    IdWithOccInfo)        -- Tagged binder++tagNonRecBinder lvl usage binder+ = let+     occ     = lookupDetails usage binder+     will_be_join = decideJoinPointHood lvl usage [binder]+     occ'    | will_be_join = -- must already be marked AlwaysTailCalled+                              ASSERT(isAlwaysTailCalled occ) occ+             | otherwise    = markNonTailCalled occ+     binder' = setBinderOcc occ' binder+     usage'  = usage `delDetails` binder+   in+   usage' `seq` (usage', binder')++tagRecBinders :: TopLevelFlag           -- At top level?+              -> UsageDetails           -- Of body of let ONLY+              -> [(CoreBndr,            -- Binder+                   UsageDetails,        -- RHS usage details+                   [CoreBndr])]         -- Lambdas in new RHS+              -> (UsageDetails,         -- Adjusted details for whole scope,+                                        -- with binders removed+                  [IdWithOccInfo])      -- Tagged binders+-- Substantially more complicated than non-recursive case. Need to adjust RHS+-- details *before* tagging binders (because the tags depend on the RHSes).+tagRecBinders lvl body_uds triples+ = let+     (bndrs, rhs_udss, _) = unzip3 triples++     -- 1. Determine join-point-hood of whole group, as determined by+     --    the *unadjusted* usage details+     unadj_uds     = foldr andUDs body_uds rhs_udss+     will_be_joins = decideJoinPointHood lvl unadj_uds bndrs++     -- 2. Adjust usage details of each RHS, taking into account the+     --    join-point-hood decision+     rhs_udss' = map adjust triples+     adjust (bndr, rhs_uds, rhs_bndrs)+       = adjustRhsUsage mb_join_arity Recursive rhs_bndrs rhs_uds+       where+         -- Can't use willBeJoinId_maybe here because we haven't tagged the+         -- binder yet (the tag depends on these adjustments!)+         mb_join_arity+           | will_be_joins+           , let occ = lookupDetails unadj_uds bndr+           , AlwaysTailCalled arity <- tailCallInfo occ+           = Just arity+           | otherwise+           = ASSERT(not will_be_joins) -- Should be AlwaysTailCalled if+             Nothing                   -- we are making join points!++     -- 3. Compute final usage details from adjusted RHS details+     adj_uds   = foldr andUDs body_uds rhs_udss'++     -- 4. Tag each binder with its adjusted details+     bndrs'    = [ setBinderOcc (lookupDetails adj_uds bndr) bndr+                 | bndr <- bndrs ]++     -- 5. Drop the binders from the adjusted details and return+     usage'    = adj_uds `delDetailsList` bndrs+   in+   (usage', bndrs')++setBinderOcc :: OccInfo -> CoreBndr -> CoreBndr+setBinderOcc occ_info bndr+  | isTyVar bndr      = bndr+  | isExportedId bndr = if isManyOccs (idOccInfo bndr)+                          then bndr+                          else setIdOccInfo bndr noOccInfo+            -- Don't use local usage info for visible-elsewhere things+            -- BUT *do* erase any IAmALoopBreaker annotation, because we're+            -- about to re-generate it and it shouldn't be "sticky"++  | otherwise = setIdOccInfo bndr occ_info++-- | Decide whether some bindings should be made into join points or not.+-- Returns `False` if they can't be join points. Note that it's an+-- all-or-nothing decision, as if multiple binders are given, they're+-- assumed to be mutually recursive.+--+-- It must, however, be a final decision. If we say "True" for 'f',+-- and then subsequently decide /not/ make 'f' into a join point, then+-- the decision about another binding 'g' might be invalidated if (say)+-- 'f' tail-calls 'g'.+--+-- See Note [Invariants on join points] in CoreSyn.+decideJoinPointHood :: TopLevelFlag -> UsageDetails+                    -> [CoreBndr]+                    -> Bool+decideJoinPointHood TopLevel _ _+  = False+decideJoinPointHood NotTopLevel usage bndrs+  | isJoinId (head bndrs)+  = WARN(not all_ok, text "OccurAnal failed to rediscover join point(s):" <+>+                       ppr bndrs)+    all_ok+  | otherwise+  = all_ok+  where+    -- See Note [Invariants on join points]; invariants cited by number below.+    -- Invariant 2 is always satisfiable by the simplifier by eta expansion.+    all_ok = -- Invariant 3: Either all are join points or none are+             all ok bndrs++    ok bndr+      | -- Invariant 1: Only tail calls, all same join arity+        AlwaysTailCalled arity <- tailCallInfo (lookupDetails usage bndr)++      , -- Invariant 1 as applied to LHSes of rules+        all (ok_rule arity) (idCoreRules bndr)++        -- Invariant 2a: stable unfoldings+        -- See Note [Join points and INLINE pragmas]+      , ok_unfolding arity (realIdUnfolding bndr)++        -- Invariant 4: Satisfies polymorphism rule+      , isValidJoinPointType arity (idType bndr)+      = True++      | otherwise+      = False++    ok_rule _ BuiltinRule{} = False -- only possible with plugin shenanigans+    ok_rule join_arity (Rule { ru_args = args })+      = args `lengthIs` join_arity+        -- Invariant 1 as applied to LHSes of rules++    -- ok_unfolding returns False if we should /not/ convert a non-join-id+    -- into a join-id, even though it is AlwaysTailCalled+    ok_unfolding join_arity (CoreUnfolding { uf_src = src, uf_tmpl = rhs })+      = not (isStableSource src && join_arity > joinRhsArity rhs)+    ok_unfolding _ (DFunUnfolding {})+      = False+    ok_unfolding _ _+      = True++willBeJoinId_maybe :: CoreBndr -> Maybe JoinArity+willBeJoinId_maybe bndr+  = case tailCallInfo (idOccInfo bndr) of+      AlwaysTailCalled arity -> Just arity+      _                      -> isJoinId_maybe bndr+++{- Note [Join points and INLINE pragmas]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+   f x = let g = \x. not  -- Arity 1+             {-# INLINE g #-}+         in case x of+              A -> g True True+              B -> g True False+              C -> blah2++Here 'g' is always tail-called applied to 2 args, but the stable+unfolding captured by the INLINE pragma has arity 1.  If we try to+convert g to be a join point, its unfolding will still have arity 1+(since it is stable, and we don't meddle with stable unfoldings), and+Lint will complain (see Note [Invariants on join points], (2a), in+CoreSyn.  #13413.++Moreover, since g is going to be inlined anyway, there is no benefit+from making it a join point.++If it is recursive, and uselessly marked INLINE, this will stop us+making it a join point, which is annoying.  But occasionally+(notably in class methods; see Note [Instances and loop breakers] in+TcInstDcls) we mark recursive things as INLINE but the recursion+unravels; so ignoring INLINE pragmas on recursive things isn't good+either.++See Invariant 2a of Note [Invariants on join points] in CoreSyn+++************************************************************************+*                                                                      *+\subsection{Operations over OccInfo}+*                                                                      *+************************************************************************+-}++markMany, markInsideLam, markNonTailCalled :: OccInfo -> OccInfo++markMany IAmDead = IAmDead+markMany occ     = ManyOccs { occ_tail = occ_tail occ }++markInsideLam occ@(OneOcc {}) = occ { occ_in_lam = True }+markInsideLam occ             = occ++markNonTailCalled IAmDead = IAmDead+markNonTailCalled occ     = occ { occ_tail = NoTailCallInfo }++addOccInfo, orOccInfo :: OccInfo -> OccInfo -> OccInfo++addOccInfo a1 a2  = ASSERT( not (isDeadOcc a1 || isDeadOcc a2) )+                    ManyOccs { occ_tail = tailCallInfo a1 `andTailCallInfo`+                                          tailCallInfo a2 }+                                -- Both branches are at least One+                                -- (Argument is never IAmDead)++-- (orOccInfo orig new) is used+-- when combining occurrence info from branches of a case++orOccInfo (OneOcc { occ_in_lam = in_lam1, occ_int_cxt = int_cxt1+                  , occ_tail   = tail1 })+          (OneOcc { occ_in_lam = in_lam2, occ_int_cxt = int_cxt2+                  , occ_tail   = tail2 })+  = OneOcc { occ_one_br  = False -- False, because it occurs in both branches+           , occ_in_lam  = in_lam1 || in_lam2+           , occ_int_cxt = int_cxt1 && int_cxt2+           , occ_tail    = tail1 `andTailCallInfo` tail2 }++orOccInfo a1 a2 = ASSERT( not (isDeadOcc a1 || isDeadOcc a2) )+                  ManyOccs { occ_tail = tailCallInfo a1 `andTailCallInfo`+                                        tailCallInfo a2 }++andTailCallInfo :: TailCallInfo -> TailCallInfo -> TailCallInfo+andTailCallInfo info@(AlwaysTailCalled arity1) (AlwaysTailCalled arity2)+  | arity1 == arity2 = info+andTailCallInfo _ _  = NoTailCallInfo
+ compiler/simplStg/RepType.hs view
@@ -0,0 +1,370 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}++module RepType+  (+    -- * Code generator views onto Types+    UnaryType, NvUnaryType, isNvUnaryType,+    unwrapType,++    -- * Predicates on types+    isVoidTy,++    -- * Type representation for the code generator+    typePrimRep, typePrimRep1,+    runtimeRepPrimRep, typePrimRepArgs,+    PrimRep(..), primRepToType,+    countFunRepArgs, countConRepArgs, tyConPrimRep, tyConPrimRep1,++    -- * Unboxed sum representation type+    ubxSumRepType, layoutUbxSum, typeSlotTy, SlotTy (..),+    slotPrimRep, primRepSlot+  ) where++#include "HsVersions.h"++import GhcPrelude++import BasicTypes (Arity, RepArity)+import DataCon+import Outputable+import PrelNames+import Coercion+import TyCon+import TyCoRep+import Type+import Util+import TysPrim+import {-# SOURCE #-} TysWiredIn ( anyTypeOfKind )++import Data.List (sort)+import qualified Data.IntSet as IS++{- **********************************************************************+*                                                                       *+                Representation types+*                                                                       *+********************************************************************** -}++type NvUnaryType = Type+type UnaryType   = Type+     -- Both are always a value type; i.e. its kind is TYPE rr+     -- for some rr; moreover the rr is never a variable.+     --+     --   NvUnaryType : never an unboxed tuple or sum, or void+     --+     --   UnaryType   : never an unboxed tuple or sum;+     --                 can be Void# or (# #)++isNvUnaryType :: Type -> Bool+isNvUnaryType ty+  | [_] <- typePrimRep ty+  = True+  | otherwise+  = False++-- INVARIANT: the result list is never empty.+typePrimRepArgs :: Type -> [PrimRep]+typePrimRepArgs ty+  | [] <- reps+  = [VoidRep]+  | otherwise+  = reps+  where+    reps = typePrimRep ty++-- | Gets rid of the stuff that prevents us from understanding the+-- runtime representation of a type. Including:+--   1. Casts+--   2. Newtypes+--   3. Foralls+--   4. Synonyms+-- But not type/data families, because we don't have the envs to hand.+unwrapType :: Type -> Type+unwrapType ty+  | Just (_, unwrapped)+      <- topNormaliseTypeX stepper mappend inner_ty+  = unwrapped+  | otherwise+  = inner_ty+  where+    inner_ty = go ty++    go t | Just t' <- coreView t = go t'+    go (ForAllTy _ t)            = go t+    go (CastTy t _)              = go t+    go t                         = t++     -- cf. Coercion.unwrapNewTypeStepper+    stepper rec_nts tc tys+      | Just (ty', _) <- instNewTyCon_maybe tc tys+      = case checkRecTc rec_nts tc of+          Just rec_nts' -> NS_Step rec_nts' (go ty') ()+          Nothing       -> NS_Abort   -- infinite newtypes+      | otherwise+      = NS_Done++countFunRepArgs :: Arity -> Type -> RepArity+countFunRepArgs 0 _+  = 0+countFunRepArgs n ty+  | FunTy _ arg res <- unwrapType ty+  = length (typePrimRepArgs arg) + countFunRepArgs (n - 1) res+  | otherwise+  = pprPanic "countFunRepArgs: arity greater than type can handle" (ppr (n, ty, typePrimRep ty))++countConRepArgs :: DataCon -> RepArity+countConRepArgs dc = go (dataConRepArity dc) (dataConRepType dc)+  where+    go :: Arity -> Type -> RepArity+    go 0 _+      = 0+    go n ty+      | FunTy _ arg res <- unwrapType ty+      = length (typePrimRep arg) + go (n - 1) res+      | otherwise+      = pprPanic "countConRepArgs: arity greater than type can handle" (ppr (n, ty, typePrimRep ty))++-- | True if the type has zero width.+isVoidTy :: Type -> Bool+isVoidTy = null . typePrimRep+++{- **********************************************************************+*                                                                       *+                Unboxed sums+ See Note [Translating unboxed sums to unboxed tuples] in UnariseStg.hs+*                                                                       *+********************************************************************** -}++type SortedSlotTys = [SlotTy]++-- | Given the arguments of a sum type constructor application,+--   return the unboxed sum rep type.+--+-- E.g.+--+--   (# Int# | Maybe Int | (# Int#, Float# #) #)+--+-- We call `ubxSumRepType [ [IntRep], [LiftedRep], [IntRep, FloatRep] ]`,+-- which returns [WordSlot, PtrSlot, WordSlot, FloatSlot]+--+-- INVARIANT: Result slots are sorted (via Ord SlotTy), except that at the head+-- of the list we have the slot for the tag.+ubxSumRepType :: [[PrimRep]] -> [SlotTy]+ubxSumRepType constrs0+  -- These first two cases never classify an actual unboxed sum, which always+  -- has at least two disjuncts. But it could happen if a user writes, e.g.,+  -- forall (a :: TYPE (SumRep [IntRep])). ...+  -- which could never be instantiated. We still don't want to panic.+  | constrs0 `lengthLessThan` 2+  = [WordSlot]++  | otherwise+  = let+      combine_alts :: [SortedSlotTys]  -- slots of constructors+                   -> SortedSlotTys    -- final slots+      combine_alts constrs = foldl' merge [] constrs++      merge :: SortedSlotTys -> SortedSlotTys -> SortedSlotTys+      merge existing_slots []+        = existing_slots+      merge [] needed_slots+        = needed_slots+      merge (es : ess) (s : ss)+        | Just s' <- s `fitsIn` es+        = -- found a slot, use it+          s' : merge ess ss+        | s < es+        = -- we need a new slot and this is the right place for it+          s : merge (es : ess) ss+        | otherwise+        = -- keep searching for a slot+          es : merge ess (s : ss)++      -- Nesting unboxed tuples and sums is OK, so we need to flatten first.+      rep :: [PrimRep] -> SortedSlotTys+      rep ty = sort (map primRepSlot ty)++      sumRep = WordSlot : combine_alts (map rep constrs0)+               -- WordSlot: for the tag of the sum+    in+      sumRep++layoutUbxSum :: SortedSlotTys -- Layout of sum. Does not include tag.+                              -- We assume that they are in increasing order+             -> [SlotTy]      -- Slot types of things we want to map to locations in the+                              -- sum layout+             -> [Int]         -- Where to map 'things' in the sum layout+layoutUbxSum sum_slots0 arg_slots0 =+    go arg_slots0 IS.empty+  where+    go :: [SlotTy] -> IS.IntSet -> [Int]+    go [] _+      = []+    go (arg : args) used+      = let slot_idx = findSlot arg 0 sum_slots0 used+         in slot_idx : go args (IS.insert slot_idx used)++    findSlot :: SlotTy -> Int -> SortedSlotTys -> IS.IntSet -> Int+    findSlot arg slot_idx (slot : slots) useds+      | not (IS.member slot_idx useds)+      , Just slot == arg `fitsIn` slot+      = slot_idx+      | otherwise+      = findSlot arg (slot_idx + 1) slots useds+    findSlot _ _ [] _+      = pprPanic "findSlot" (text "Can't find slot" $$ ppr sum_slots0 $$ ppr arg_slots0)++--------------------------------------------------------------------------------++-- We have 3 kinds of slots:+--+--   - Pointer slot: Only shared between actual pointers to Haskell heap (i.e.+--     boxed objects)+--+--   - Word slots: Shared between IntRep, WordRep, Int64Rep, Word64Rep, AddrRep.+--+--   - Float slots: Shared between floating point types.+--+--   - Void slots: Shared between void types. Not used in sums.+--+-- TODO(michalt): We should probably introduce `SlotTy`s for 8-/16-/32-bit+-- values, so that we can pack things more tightly.+data SlotTy = PtrSlot | WordSlot | Word64Slot | FloatSlot | DoubleSlot+  deriving (Eq, Ord)+    -- Constructor order is important! If slot A could fit into slot B+    -- then slot A must occur first.  E.g.  FloatSlot before DoubleSlot+    --+    -- We are assuming that WordSlot is smaller than or equal to Word64Slot+    -- (would not be true on a 128-bit machine)++instance Outputable SlotTy where+  ppr PtrSlot    = text "PtrSlot"+  ppr Word64Slot = text "Word64Slot"+  ppr WordSlot   = text "WordSlot"+  ppr DoubleSlot = text "DoubleSlot"+  ppr FloatSlot  = text "FloatSlot"++typeSlotTy :: UnaryType -> Maybe SlotTy+typeSlotTy ty+  | isVoidTy ty+  = Nothing+  | otherwise+  = Just (primRepSlot (typePrimRep1 ty))++primRepSlot :: PrimRep -> SlotTy+primRepSlot VoidRep     = pprPanic "primRepSlot" (text "No slot for VoidRep")+primRepSlot LiftedRep   = PtrSlot+primRepSlot UnliftedRep = PtrSlot+primRepSlot IntRep      = WordSlot+primRepSlot Int8Rep     = WordSlot+primRepSlot Int16Rep    = WordSlot+primRepSlot Int64Rep    = Word64Slot+primRepSlot WordRep     = WordSlot+primRepSlot Word8Rep    = WordSlot+primRepSlot Word16Rep   = WordSlot+primRepSlot Word64Rep   = Word64Slot+primRepSlot AddrRep     = WordSlot+primRepSlot FloatRep    = FloatSlot+primRepSlot DoubleRep   = DoubleSlot+primRepSlot VecRep{}    = pprPanic "primRepSlot" (text "No slot for VecRep")++slotPrimRep :: SlotTy -> PrimRep+slotPrimRep PtrSlot     = LiftedRep   -- choice between lifted & unlifted seems arbitrary+slotPrimRep Word64Slot  = Word64Rep+slotPrimRep WordSlot    = WordRep+slotPrimRep DoubleSlot  = DoubleRep+slotPrimRep FloatSlot   = FloatRep++-- | Returns the bigger type if one fits into the other. (commutative)+fitsIn :: SlotTy -> SlotTy -> Maybe SlotTy+fitsIn ty1 ty2+  | isWordSlot ty1 && isWordSlot ty2+  = Just (max ty1 ty2)+  | isFloatSlot ty1 && isFloatSlot ty2+  = Just (max ty1 ty2)+  | isPtrSlot ty1 && isPtrSlot ty2+  = Just PtrSlot+  | otherwise+  = Nothing+  where+    isPtrSlot PtrSlot = True+    isPtrSlot _       = False++    isWordSlot Word64Slot = True+    isWordSlot WordSlot   = True+    isWordSlot _          = False++    isFloatSlot DoubleSlot = True+    isFloatSlot FloatSlot  = True+    isFloatSlot _          = False+++{- **********************************************************************+*                                                                       *+                   PrimRep+*                                                                       *+********************************************************************** -}++-- | Discovers the primitive representation of a 'Type'. Returns+-- a list of 'PrimRep': it's a list because of the possibility of+-- no runtime representation (void) or multiple (unboxed tuple/sum)+typePrimRep :: HasDebugCallStack => Type -> [PrimRep]+typePrimRep ty = kindPrimRep (text "typePrimRep" <+>+                              parens (ppr ty <+> dcolon <+> ppr (typeKind ty)))+                             (typeKind ty)++-- | Like 'typePrimRep', but assumes that there is precisely one 'PrimRep' output;+-- an empty list of PrimReps becomes a VoidRep+typePrimRep1 :: HasDebugCallStack => UnaryType -> PrimRep+typePrimRep1 ty = case typePrimRep ty of+  []    -> VoidRep+  [rep] -> rep+  _     -> pprPanic "typePrimRep1" (ppr ty $$ ppr (typePrimRep ty))++-- | Find the runtime representation of a 'TyCon'. Defined here to+-- avoid module loops. Returns a list of the register shapes necessary.+tyConPrimRep :: HasDebugCallStack => TyCon -> [PrimRep]+tyConPrimRep tc+  = kindPrimRep (text "kindRep tc" <+> ppr tc $$ ppr res_kind)+                res_kind+  where+    res_kind = tyConResKind tc++-- | Like 'tyConPrimRep', but assumed that there is precisely zero or+-- one 'PrimRep' output+tyConPrimRep1 :: HasDebugCallStack => TyCon -> PrimRep+tyConPrimRep1 tc = case tyConPrimRep tc of+  []    -> VoidRep+  [rep] -> rep+  _     -> pprPanic "tyConPrimRep1" (ppr tc $$ ppr (tyConPrimRep tc))++-- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep's+-- of values of types of this kind.+kindPrimRep :: HasDebugCallStack => SDoc -> Kind -> [PrimRep]+kindPrimRep doc ki+  | Just ki' <- coreView ki+  = kindPrimRep doc ki'+kindPrimRep doc (TyConApp typ [runtime_rep])+  = ASSERT( typ `hasKey` tYPETyConKey )+    runtimeRepPrimRep doc runtime_rep+kindPrimRep doc ki+  = pprPanic "kindPrimRep" (ppr ki $$ doc)++-- | Take a type of kind RuntimeRep and extract the list of 'PrimRep' that+-- it encodes.+runtimeRepPrimRep :: HasDebugCallStack => SDoc -> Type -> [PrimRep]+runtimeRepPrimRep doc rr_ty+  | Just rr_ty' <- coreView rr_ty+  = runtimeRepPrimRep doc rr_ty'+  | TyConApp rr_dc args <- rr_ty+  , RuntimeRep fun <- tyConRuntimeRepInfo rr_dc+  = fun args+  | otherwise+  = pprPanic "runtimeRepPrimRep" (doc $$ ppr rr_ty)++-- | Convert a PrimRep back to a Type. Used only in the unariser to give types+-- to fresh Ids. Really, only the type's representation matters.+primRepToType :: PrimRep -> Type+primRepToType = anyTypeOfKind . tYPE . primRepToRuntimeRep
+ compiler/specialise/Rules.hs view
@@ -0,0 +1,1280 @@+{-+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[CoreRules]{Transformation rules}+-}++{-# LANGUAGE CPP #-}++-- | Functions for collecting together and applying rewrite rules to a module.+-- The 'CoreRule' datatype itself is declared elsewhere.+module Rules (+        -- ** Constructing+        emptyRuleBase, mkRuleBase, extendRuleBaseList,+        unionRuleBase, pprRuleBase,++        -- ** Checking rule applications+        ruleCheckProgram,++        -- ** Manipulating 'RuleInfo' rules+        mkRuleInfo, extendRuleInfo, addRuleInfo,+        addIdSpecialisations,++        -- * Misc. CoreRule helpers+        rulesOfBinds, getRules, pprRulesForUser,++        lookupRule, mkRule, roughTopNames+    ) where++#include "HsVersions.h"++import GhcPrelude++import CoreSyn          -- All of it+import Module           ( Module, ModuleSet, elemModuleSet )+import CoreSubst+import CoreOpt          ( exprIsLambda_maybe )+import CoreFVs          ( exprFreeVars, exprsFreeVars, bindFreeVars+                        , rulesFreeVarsDSet, exprsOrphNames, exprFreeVarsList )+import CoreUtils        ( exprType, eqExpr, mkTick, mkTicks,+                          stripTicksTopT, stripTicksTopE,+                          isJoinBind )+import PprCore          ( pprRules )+import Type             ( Type, Kind, substTy, mkTCvSubst )+import TcType           ( tcSplitTyConApp_maybe )+import TysWiredIn       ( anyTypeOfKind )+import Coercion+import CoreTidy         ( tidyRules )+import Id+import IdInfo           ( RuleInfo( RuleInfo ) )+import Var+import VarEnv+import VarSet+import Name             ( Name, NamedThing(..), nameIsLocalOrFrom )+import NameSet+import NameEnv+import UniqFM+import Unify            ( ruleMatchTyKiX )+import BasicTypes+import DynFlags         ( DynFlags )+import Outputable+import FastString+import Maybes+import Bag+import Util+import Data.List+import Data.Ord+import Control.Monad    ( guard )++{-+Note [Overall plumbing for rules]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+* After the desugarer:+   - The ModGuts initially contains mg_rules :: [CoreRule] of+     locally-declared rules for imported Ids.+   - Locally-declared rules for locally-declared Ids are attached to+     the IdInfo for that Id.  See Note [Attach rules to local ids] in+     DsBinds++* TidyPgm strips off all the rules from local Ids and adds them to+  mg_rules, so that the ModGuts has *all* the locally-declared rules.++* The HomePackageTable contains a ModDetails for each home package+  module.  Each contains md_rules :: [CoreRule] of rules declared in+  that module.  The HomePackageTable grows as ghc --make does its+  up-sweep.  In batch mode (ghc -c), the HPT is empty; all imported modules+  are treated by the "external" route, discussed next, regardless of+  which package they come from.++* The ExternalPackageState has a single eps_rule_base :: RuleBase for+  Ids in other packages.  This RuleBase simply grow monotonically, as+  ghc --make compiles one module after another.++  During simplification, interface files may get demand-loaded,+  as the simplifier explores the unfoldings for Ids it has in+  its hand.  (Via an unsafePerformIO; the EPS is really a cache.)+  That in turn may make the EPS rule-base grow.  In contrast, the+  HPT never grows in this way.++* The result of all this is that during Core-to-Core optimisation+  there are four sources of rules:++    (a) Rules in the IdInfo of the Id they are a rule for.  These are+        easy: fast to look up, and if you apply a substitution then+        it'll be applied to the IdInfo as a matter of course.++    (b) Rules declared in this module for imported Ids, kept in the+        ModGuts. If you do a substitution, you'd better apply the+        substitution to these.  There are seldom many of these.++    (c) Rules declared in the HomePackageTable.  These never change.++    (d) Rules in the ExternalPackageTable. These can grow in response+        to lazy demand-loading of interfaces.++* At the moment (c) is carried in a reader-monad way by the CoreMonad.+  The HomePackageTable doesn't have a single RuleBase because technically+  we should only be able to "see" rules "below" this module; so we+  generate a RuleBase for (c) by combing rules from all the modules+  "below" us.  That's why we can't just select the home-package RuleBase+  from HscEnv.++  [NB: we are inconsistent here.  We should do the same for external+  packages, but we don't.  Same for type-class instances.]++* So in the outer simplifier loop, we combine (b-d) into a single+  RuleBase, reading+     (b) from the ModGuts,+     (c) from the CoreMonad, and+     (d) from its mutable variable+  [Of coures this means that we won't see new EPS rules that come in+  during a single simplifier iteration, but that probably does not+  matter.]+++************************************************************************+*                                                                      *+\subsection[specialisation-IdInfo]{Specialisation info about an @Id@}+*                                                                      *+************************************************************************++A @CoreRule@ holds details of one rule for an @Id@, which+includes its specialisations.++For example, if a rule for @f@ contains the mapping:+\begin{verbatim}+        forall a b d. [Type (List a), Type b, Var d]  ===>  f' a b+\end{verbatim}+then when we find an application of f to matching types, we simply replace+it by the matching RHS:+\begin{verbatim}+        f (List Int) Bool dict ===>  f' Int Bool+\end{verbatim}+All the stuff about how many dictionaries to discard, and what types+to apply the specialised function to, are handled by the fact that the+Rule contains a template for the result of the specialisation.++There is one more exciting case, which is dealt with in exactly the same+way.  If the specialised value is unboxed then it is lifted at its+definition site and unlifted at its uses.  For example:++        pi :: forall a. Num a => a++might have a specialisation++        [Int#] ===>  (case pi' of Lift pi# -> pi#)++where pi' :: Lift Int# is the specialised version of pi.+-}++mkRule :: Module -> Bool -> Bool -> RuleName -> Activation+       -> Name -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule+-- ^ Used to make 'CoreRule' for an 'Id' defined in the module being+-- compiled. See also 'CoreSyn.CoreRule'+mkRule this_mod is_auto is_local name act fn bndrs args rhs+  = Rule { ru_name = name, ru_fn = fn, ru_act = act,+           ru_bndrs = bndrs, ru_args = args,+           ru_rhs = rhs,+           ru_rough = roughTopNames args,+           ru_origin = this_mod,+           ru_orphan = orph,+           ru_auto = is_auto, ru_local = is_local }+  where+        -- Compute orphanhood.  See Note [Orphans] in InstEnv+        -- A rule is an orphan only if none of the variables+        -- mentioned on its left-hand side are locally defined+    lhs_names = extendNameSet (exprsOrphNames args) fn++        -- Since rules get eventually attached to one of the free names+        -- from the definition when compiling the ABI hash, we should make+        -- it deterministic. This chooses the one with minimal OccName+        -- as opposed to uniq value.+    local_lhs_names = filterNameSet (nameIsLocalOrFrom this_mod) lhs_names+    orph = chooseOrphanAnchor local_lhs_names++--------------+roughTopNames :: [CoreExpr] -> [Maybe Name]+-- ^ Find the \"top\" free names of several expressions.+-- Such names are either:+--+-- 1. The function finally being applied to in an application chain+--    (if that name is a GlobalId: see "Var#globalvslocal"), or+--+-- 2. The 'TyCon' if the expression is a 'Type'+--+-- This is used for the fast-match-check for rules;+--      if the top names don't match, the rest can't+roughTopNames args = map roughTopName args++roughTopName :: CoreExpr -> Maybe Name+roughTopName (Type ty) = case tcSplitTyConApp_maybe ty of+                               Just (tc,_) -> Just (getName tc)+                               Nothing     -> Nothing+roughTopName (Coercion _) = Nothing+roughTopName (App f _) = roughTopName f+roughTopName (Var f)   | isGlobalId f   -- Note [Care with roughTopName]+                       , isDataConWorkId f || idArity f > 0+                       = Just (idName f)+roughTopName (Tick t e) | tickishFloatable t+                        = roughTopName e+roughTopName _ = Nothing++ruleCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool+-- ^ @ruleCantMatch tpl actual@ returns True only if @actual@+-- definitely can't match @tpl@ by instantiating @tpl@.+-- It's only a one-way match; unlike instance matching we+-- don't consider unification.+--+-- Notice that [_$_]+--      @ruleCantMatch [Nothing] [Just n2] = False@+--      Reason: a template variable can be instantiated by a constant+-- Also:+--      @ruleCantMatch [Just n1] [Nothing] = False@+--      Reason: a local variable @v@ in the actuals might [_$_]++ruleCantMatch (Just n1 : ts) (Just n2 : as) = n1 /= n2 || ruleCantMatch ts as+ruleCantMatch (_       : ts) (_       : as) = ruleCantMatch ts as+ruleCantMatch _              _              = False++{-+Note [Care with roughTopName]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider this+    module M where { x = a:b }+    module N where { ...f x...+                     RULE f (p:q) = ... }+You'd expect the rule to match, because the matcher can+look through the unfolding of 'x'.  So we must avoid roughTopName+returning 'M.x' for the call (f x), or else it'll say "can't match"+and we won't even try!!++However, suppose we have+         RULE g (M.h x) = ...+         foo = ...(g (M.k v))....+where k is a *function* exported by M.  We never really match+functions (lambdas) except by name, so in this case it seems like+a good idea to treat 'M.k' as a roughTopName of the call.+-}++pprRulesForUser :: DynFlags -> [CoreRule] -> SDoc+-- (a) tidy the rules+-- (b) sort them into order based on the rule name+-- (c) suppress uniques (unless -dppr-debug is on)+-- This combination makes the output stable so we can use in testing+-- It's here rather than in PprCore because it calls tidyRules+pprRulesForUser dflags rules+  = withPprStyle (defaultUserStyle dflags) $+    pprRules $+    sortBy (comparing ruleName) $+    tidyRules emptyTidyEnv rules++{-+************************************************************************+*                                                                      *+                RuleInfo: the rules in an IdInfo+*                                                                      *+************************************************************************+-}++-- | Make a 'RuleInfo' containing a number of 'CoreRule's, suitable+-- for putting into an 'IdInfo'+mkRuleInfo :: [CoreRule] -> RuleInfo+mkRuleInfo rules = RuleInfo rules (rulesFreeVarsDSet rules)++extendRuleInfo :: RuleInfo -> [CoreRule] -> RuleInfo+extendRuleInfo (RuleInfo rs1 fvs1) rs2+  = RuleInfo (rs2 ++ rs1) (rulesFreeVarsDSet rs2 `unionDVarSet` fvs1)++addRuleInfo :: RuleInfo -> RuleInfo -> RuleInfo+addRuleInfo (RuleInfo rs1 fvs1) (RuleInfo rs2 fvs2)+  = RuleInfo (rs1 ++ rs2) (fvs1 `unionDVarSet` fvs2)++addIdSpecialisations :: Id -> [CoreRule] -> Id+addIdSpecialisations id rules+  | null rules+  = id+  | otherwise+  = setIdSpecialisation id $+    extendRuleInfo (idSpecialisation id) rules++-- | Gather all the rules for locally bound identifiers from the supplied bindings+rulesOfBinds :: [CoreBind] -> [CoreRule]+rulesOfBinds binds = concatMap (concatMap idCoreRules . bindersOf) binds++getRules :: RuleEnv -> Id -> [CoreRule]+-- See Note [Where rules are found]+getRules (RuleEnv { re_base = rule_base, re_visible_orphs = orphs }) fn+  = idCoreRules fn ++ filter (ruleIsVisible orphs) imp_rules+  where+    imp_rules = lookupNameEnv rule_base (idName fn) `orElse` []++ruleIsVisible :: ModuleSet -> CoreRule -> Bool+ruleIsVisible _ BuiltinRule{} = True+ruleIsVisible vis_orphs Rule { ru_orphan = orph, ru_origin = origin }+    = notOrphan orph || origin `elemModuleSet` vis_orphs++{- Note [Where rules are found]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The rules for an Id come from two places:+  (a) the ones it is born with, stored inside the Id iself (idCoreRules fn),+  (b) rules added in other modules, stored in the global RuleBase (imp_rules)++It's tempting to think that+     - LocalIds have only (a)+     - non-LocalIds have only (b)++but that isn't quite right:++     - PrimOps and ClassOps are born with a bunch of rules inside the Id,+       even when they are imported++     - The rules in PrelRules.builtinRules should be active even+       in the module defining the Id (when it's a LocalId), but+       the rules are kept in the global RuleBase+++************************************************************************+*                                                                      *+                RuleBase+*                                                                      *+************************************************************************+-}++-- RuleBase itself is defined in CoreSyn, along with CoreRule++emptyRuleBase :: RuleBase+emptyRuleBase = emptyNameEnv++mkRuleBase :: [CoreRule] -> RuleBase+mkRuleBase rules = extendRuleBaseList emptyRuleBase rules++extendRuleBaseList :: RuleBase -> [CoreRule] -> RuleBase+extendRuleBaseList rule_base new_guys+  = foldl' extendRuleBase rule_base new_guys++unionRuleBase :: RuleBase -> RuleBase -> RuleBase+unionRuleBase rb1 rb2 = plusNameEnv_C (++) rb1 rb2++extendRuleBase :: RuleBase -> CoreRule -> RuleBase+extendRuleBase rule_base rule+  = extendNameEnv_Acc (:) singleton rule_base (ruleIdName rule) rule++pprRuleBase :: RuleBase -> SDoc+pprRuleBase rules = pprUFM rules $ \rss ->+  vcat [ pprRules (tidyRules emptyTidyEnv rs)+       | rs <- rss ]++{-+************************************************************************+*                                                                      *+                        Matching+*                                                                      *+************************************************************************+-}++-- | The main rule matching function. Attempts to apply all (active)+-- supplied rules to this instance of an application in a given+-- context, returning the rule applied and the resulting expression if+-- successful.+lookupRule :: DynFlags -> InScopeEnv+           -> (Activation -> Bool)      -- When rule is active+           -> Id -> [CoreExpr]+           -> [CoreRule] -> Maybe (CoreRule, CoreExpr)++-- See Note [Extra args in rule matching]+-- See comments on matchRule+lookupRule dflags in_scope is_active fn args rules+  = -- pprTrace "matchRules" (ppr fn <+> ppr args $$ ppr rules ) $+    case go [] rules of+        []     -> Nothing+        (m:ms) -> Just (findBest (fn,args') m ms)+  where+    rough_args = map roughTopName args++    -- Strip ticks from arguments, see note [Tick annotations in RULE+    -- matching]. We only collect ticks if a rule actually matches -+    -- this matters for performance tests.+    args' = map (stripTicksTopE tickishFloatable) args+    ticks = concatMap (stripTicksTopT tickishFloatable) args++    go :: [(CoreRule,CoreExpr)] -> [CoreRule] -> [(CoreRule,CoreExpr)]+    go ms [] = ms+    go ms (r:rs)+      | Just e <- matchRule dflags in_scope is_active fn args' rough_args r+      = go ((r,mkTicks ticks e):ms) rs+      | otherwise+      = -- pprTrace "match failed" (ppr r $$ ppr args $$+        --   ppr [ (arg_id, unfoldingTemplate unf)+        --       | Var arg_id <- args+        --       , let unf = idUnfolding arg_id+        --       , isCheapUnfolding unf] )+        go ms rs++findBest :: (Id, [CoreExpr])+         -> (CoreRule,CoreExpr) -> [(CoreRule,CoreExpr)] -> (CoreRule,CoreExpr)+-- All these pairs matched the expression+-- Return the pair the most specific rule+-- The (fn,args) is just for overlap reporting++findBest _      (rule,ans)   [] = (rule,ans)+findBest target (rule1,ans1) ((rule2,ans2):prs)+  | rule1 `isMoreSpecific` rule2 = findBest target (rule1,ans1) prs+  | rule2 `isMoreSpecific` rule1 = findBest target (rule2,ans2) prs+  | debugIsOn = let pp_rule rule+                      = ifPprDebug (ppr rule)+                                   (doubleQuotes (ftext (ruleName rule)))+                in pprTrace "Rules.findBest: rule overlap (Rule 1 wins)"+                         (vcat [ whenPprDebug $+                                 text "Expression to match:" <+> ppr fn+                                 <+> sep (map ppr args)+                               , text "Rule 1:" <+> pp_rule rule1+                               , text "Rule 2:" <+> pp_rule rule2]) $+                findBest target (rule1,ans1) prs+  | otherwise = findBest target (rule1,ans1) prs+  where+    (fn,args) = target++isMoreSpecific :: CoreRule -> CoreRule -> Bool+-- This tests if one rule is more specific than another+-- We take the view that a BuiltinRule is less specific than+-- anything else, because we want user-define rules to "win"+-- In particular, class ops have a built-in rule, but we+-- any user-specific rules to win+--   eg (#4397)+--      truncate :: (RealFrac a, Integral b) => a -> b+--      {-# RULES "truncate/Double->Int" truncate = double2Int #-}+--      double2Int :: Double -> Int+--   We want the specific RULE to beat the built-in class-op rule+isMoreSpecific (BuiltinRule {}) _                = False+isMoreSpecific (Rule {})        (BuiltinRule {}) = True+isMoreSpecific (Rule { ru_bndrs = bndrs1, ru_args = args1 })+               (Rule { ru_bndrs = bndrs2, ru_args = args2, ru_name = rule_name2 })+  = isJust (matchN (in_scope, id_unfolding_fun) rule_name2 bndrs2 args2 args1)+  where+   id_unfolding_fun _ = NoUnfolding     -- Don't expand in templates+   in_scope = mkInScopeSet (mkVarSet bndrs1)+        -- Actually we should probably include the free vars+        -- of rule1's args, but I can't be bothered++noBlackList :: Activation -> Bool+noBlackList _ = False           -- Nothing is black listed++{-+Note [Extra args in rule matching]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If we find a matching rule, we return (Just (rule, rhs)),+but the rule firing has only consumed as many of the input args+as the ruleArity says.  It's up to the caller to keep track+of any left-over args.  E.g. if you call+        lookupRule ... f [e1, e2, e3]+and it returns Just (r, rhs), where r has ruleArity 2+then the real rewrite is+        f e1 e2 e3 ==> rhs e3++You might think it'd be cleaner for lookupRule to deal with the+leftover arguments, by applying 'rhs' to them, but the main call+in the Simplifier works better as it is.  Reason: the 'args' passed+to lookupRule are the result of a lazy substitution+-}++------------------------------------+matchRule :: DynFlags -> InScopeEnv -> (Activation -> Bool)+          -> Id -> [CoreExpr] -> [Maybe Name]+          -> CoreRule -> Maybe CoreExpr++-- If (matchRule rule args) returns Just (name,rhs)+-- then (f args) matches the rule, and the corresponding+-- rewritten RHS is rhs+--+-- The returned expression is occurrence-analysed+--+--      Example+--+-- The rule+--      forall f g x. map f (map g x) ==> map (f . g) x+-- is stored+--      CoreRule "map/map"+--               [f,g,x]                -- tpl_vars+--               [f,map g x]            -- tpl_args+--               map (f.g) x)           -- rhs+--+-- Then the call: matchRule the_rule [e1,map e2 e3]+--        = Just ("map/map", (\f,g,x -> rhs) e1 e2 e3)+--+-- Any 'surplus' arguments in the input are simply put on the end+-- of the output.++matchRule dflags rule_env _is_active fn args _rough_args+          (BuiltinRule { ru_try = match_fn })+-- Built-in rules can't be switched off, it seems+  = case match_fn dflags rule_env fn args of+        Nothing   -> Nothing+        Just expr -> Just expr++matchRule _ in_scope is_active _ args rough_args+          (Rule { ru_name = rule_name, ru_act = act, ru_rough = tpl_tops+                , ru_bndrs = tpl_vars, ru_args = tpl_args, ru_rhs = rhs })+  | not (is_active act)               = Nothing+  | ruleCantMatch tpl_tops rough_args = Nothing+  | otherwise+  = case matchN in_scope rule_name tpl_vars tpl_args args of+        Nothing                       -> Nothing+        Just (bind_wrapper, tpl_vals) -> Just (bind_wrapper $+                                               rule_fn `mkApps` tpl_vals)+  where+    rule_fn = mkLams tpl_vars rhs++---------------------------------------+matchN  :: InScopeEnv+        -> RuleName -> [Var] -> [CoreExpr]+        -> [CoreExpr]           -- ^ Target; can have more elements than the template+        -> Maybe (BindWrapper,  -- Floated bindings; see Note [Matching lets]+                  [CoreExpr])+-- For a given match template and context, find bindings to wrap around+-- the entire result and what should be substituted for each template variable.+-- Fail if there are two few actual arguments from the target to match the template++matchN (in_scope, id_unf) rule_name tmpl_vars tmpl_es target_es+  = do  { subst <- go init_menv emptyRuleSubst tmpl_es target_es+        ; let (_, matched_es) = mapAccumL lookup_tmpl subst $+                                tmpl_vars `zip` tmpl_vars1+        ; return (rs_binds subst, matched_es) }+  where+    (init_rn_env, tmpl_vars1) = mapAccumL rnBndrL (mkRnEnv2 in_scope) tmpl_vars+                  -- See Note [Cloning the template binders]++    init_menv = RV { rv_tmpls = mkVarSet tmpl_vars1+                   , rv_lcl   = init_rn_env+                   , rv_fltR  = mkEmptySubst (rnInScopeSet init_rn_env)+                   , rv_unf   = id_unf }++    go _    subst []     _      = Just subst+    go _    _     _      []     = Nothing       -- Fail if too few actual args+    go menv subst (t:ts) (e:es) = do { subst1 <- match menv subst t e+                                     ; go menv subst1 ts es }++    lookup_tmpl :: RuleSubst -> (InVar,OutVar) -> (RuleSubst, CoreExpr)+                   -- Need to return a RuleSubst solely for the benefit of mk_fake_ty+    lookup_tmpl rs@(RS { rs_tv_subst = tv_subst, rs_id_subst = id_subst })+                (tmpl_var, tmpl_var1)+        | isId tmpl_var1+        = case lookupVarEnv id_subst tmpl_var1 of+             Just e -> (rs, e)+             Nothing | Just refl_co <- isReflCoVar_maybe tmpl_var1+                     , let co_expr   = Coercion refl_co+                           id_subst' = extendVarEnv id_subst tmpl_var1 co_expr+                           rs'       = rs { rs_id_subst = id_subst' }+                     -> (rs', co_expr) -- See Note [Unbound RULE binders]+                     | otherwise+                     -> unbound tmpl_var+        | otherwise+        = case lookupVarEnv tv_subst tmpl_var1 of+             Just ty -> (rs, Type ty)+             Nothing -> (rs', Type fake_ty) -- See Note [Unbound RULE binders]+        where+          rs'     = rs { rs_tv_subst = extendVarEnv tv_subst tmpl_var1 fake_ty }+          fake_ty = mk_fake_ty in_scope rs tmpl_var1+                    -- This call is the sole reason we accumulate+                    -- RuleSubst in lookup_tmpl++    unbound tmpl_var+       = pprPanic "Template variable unbound in rewrite rule" $+         vcat [ text "Variable:" <+> ppr tmpl_var <+> dcolon <+> ppr (varType tmpl_var)+              , text "Rule" <+> pprRuleName rule_name+              , text "Rule bndrs:" <+> ppr tmpl_vars+              , text "LHS args:" <+> ppr tmpl_es+              , text "Actual args:" <+> ppr target_es ]+++mk_fake_ty :: InScopeSet -> RuleSubst -> TyVar -> Kind+-- Roughly:+--    mk_fake_ty subst tv = Any @(subst (tyVarKind tv))+-- That is: apply the substitution to the kind of the given tyvar,+-- and make an 'any' type of that kind.+-- Tiresomely, the RuleSubst is not well adapted to substTy, leading to+-- horrible impedence matching.+--+-- Happily, this function is seldom called+mk_fake_ty in_scope (RS { rs_tv_subst = tv_subst, rs_id_subst = id_subst }) tmpl_var1+  = anyTypeOfKind kind+  where+    kind = Type.substTy (mkTCvSubst in_scope (tv_subst, cv_subst))+                        (tyVarKind tmpl_var1)++    cv_subst = to_co_env id_subst++    to_co_env :: IdSubstEnv -> CvSubstEnv+    to_co_env env = nonDetFoldUFM_Directly to_co emptyVarEnv env+      -- It's OK to use nonDetFoldUFM_Directly because we forget the+      -- order immediately by creating a new env++    to_co uniq expr env+      = case exprToCoercion_maybe expr of+          Just co -> extendVarEnv_Directly env uniq co+          Nothing -> env++{- Note [Unbound RULE binders]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+It can be the case that the binder in a rule is not actually+bound on the LHS:++* Type variables.  Type synonyms with phantom args can give rise to+  unbound template type variables.  Consider this (#10689,+  simplCore/should_compile/T10689):++    type Foo a b = b++    f :: Eq a => a -> Bool+    f x = x==x++    {-# RULES "foo" forall (x :: Foo a Char). f x = True #-}+    finkle = f 'c'++  The rule looks like+    forall (a::*) (d::Eq Char) (x :: Foo a Char).+         f (Foo a Char) d x = True++  Matching the rule won't bind 'a', and legitimately so.  We fudge by+  pretending that 'a' is bound to (Any :: *).++* Coercion variables.  On the LHS of a RULE for a local binder+  we might have+    RULE forall (c :: a~b). f (x |> c) = e+  Now, if that binding is inlined, so that a=b=Int, we'd get+    RULE forall (c :: Int~Int). f (x |> c) = e+  and now when we simplify the LHS (Simplify.simplRule) we+  optCoercion will turn that 'c' into Refl:+    RULE forall (c :: Int~Int). f (x |> <Int>) = e+  and then perhaps drop it altogether.  Now 'c' is unbound.++  It's tricky to be sure this never happens, so instead I+  say it's OK to have an unbound coercion binder in a RULE+  provided its type is (c :: t~t).  Then, when the RULE+  fires we can substitute <t> for c.++  This actually happened (in a RULE for a local function)+  in #13410, and also in test T10602.+++Note [Cloning the template binders]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider the following match (example 1):+        Template:  forall x.  f x+        Target:               f (x+1)+This should succeed, because the template variable 'x' has nothing to+do with the 'x' in the target.++Likewise this one (example 2):+        Template:  forall x. f (\x.x)+        Target:              f (\y.y)++We achieve this simply by using rnBndrL to clone the template+binders if they are already in scope.++------ Historical note -------+At one point I tried simply adding the template binders to the+in-scope set /without/ cloning them, but that failed in a horribly+obscure way in #14777.  Problem was that during matching we look+up target-term variables in the in-scope set (see Note [Lookup+in-scope]).  If a target-term variable happens to name-clash with a+template variable, that lookup will find the template variable, which+is /utterly/ bogus.  In #14777, this transformed a term variable+into a type variable, and then crashed when we wanted its idInfo.+------ End of historical note -------+++************************************************************************+*                                                                      *+                   The main matcher+*                                                                      *+********************************************************************* -}++-- * The domain of the TvSubstEnv and IdSubstEnv are the template+--   variables passed into the match.+--+-- * The BindWrapper in a RuleSubst are the bindings floated out+--   from nested matches; see the Let case of match, below+--+data RuleMatchEnv+  = RV { rv_lcl   :: RnEnv2          -- Renamings for *local bindings*+                                     --   (lambda/case)+       , rv_tmpls :: VarSet          -- Template variables+                                     --   (after applying envL of rv_lcl)+       , rv_fltR  :: Subst           -- Renamings for floated let-bindings+                                     --   (domain disjoint from envR of rv_lcl)+                                     -- See Note [Matching lets]+       , rv_unf :: IdUnfoldingFun+       }++rvInScopeEnv :: RuleMatchEnv -> InScopeEnv+rvInScopeEnv renv = (rnInScopeSet (rv_lcl renv), rv_unf renv)++data RuleSubst = RS { rs_tv_subst :: TvSubstEnv   -- Range is the+                    , rs_id_subst :: IdSubstEnv   --   template variables+                    , rs_binds    :: BindWrapper  -- Floated bindings+                    , rs_bndrs    :: VarSet       -- Variables bound by floated lets+                    }++type BindWrapper = CoreExpr -> CoreExpr+  -- See Notes [Matching lets] and [Matching cases]+  -- we represent the floated bindings as a core-to-core function++emptyRuleSubst :: RuleSubst+emptyRuleSubst = RS { rs_tv_subst = emptyVarEnv, rs_id_subst = emptyVarEnv+                    , rs_binds = \e -> e, rs_bndrs = emptyVarSet }++--      At one stage I tried to match even if there are more+--      template args than real args.++--      I now think this is probably a bad idea.+--      Should the template (map f xs) match (map g)?  I think not.+--      For a start, in general eta expansion wastes work.+--      SLPJ July 99++match :: RuleMatchEnv+      -> RuleSubst+      -> CoreExpr               -- Template+      -> CoreExpr               -- Target+      -> Maybe RuleSubst++-- We look through certain ticks. See note [Tick annotations in RULE matching]+match renv subst e1 (Tick t e2)+  | tickishFloatable t+  = match renv subst' e1 e2+  where subst' = subst { rs_binds = rs_binds subst . mkTick t }+match _ _ e@Tick{} _+  = pprPanic "Tick in rule" (ppr e)++-- See the notes with Unify.match, which matches types+-- Everything is very similar for terms++-- Interesting examples:+-- Consider matching+--      \x->f      against    \f->f+-- When we meet the lambdas we must remember to rename f to f' in the+-- second expression.  The RnEnv2 does that.+--+-- Consider matching+--      forall a. \b->b    against   \a->3+-- We must rename the \a.  Otherwise when we meet the lambdas we+-- might substitute [a/b] in the template, and then erroneously+-- succeed in matching what looks like the template variable 'a' against 3.++-- The Var case follows closely what happens in Unify.match+match renv subst (Var v1) e2+  = match_var renv subst v1 e2++match renv subst e1 (Var v2)      -- Note [Expanding variables]+  | not (inRnEnvR rn_env v2) -- Note [Do not expand locally-bound variables]+  , Just e2' <- expandUnfolding_maybe (rv_unf renv v2')+  = match (renv { rv_lcl = nukeRnEnvR rn_env }) subst e1 e2'+  where+    v2'    = lookupRnInScope rn_env v2+    rn_env = rv_lcl renv+        -- Notice that we look up v2 in the in-scope set+        -- See Note [Lookup in-scope]+        -- No need to apply any renaming first (hence no rnOccR)+        -- because of the not-inRnEnvR++match renv subst e1 (Let bind e2)+  | -- pprTrace "match:Let" (vcat [ppr bind, ppr $ okToFloat (rv_lcl renv) (bindFreeVars bind)]) $+    not (isJoinBind bind) -- can't float join point out of argument position+  , okToFloat (rv_lcl renv) (bindFreeVars bind) -- See Note [Matching lets]+  = match (renv { rv_fltR = flt_subst' })+          (subst { rs_binds = rs_binds subst . Let bind'+                 , rs_bndrs = extendVarSetList (rs_bndrs subst) new_bndrs })+          e1 e2+  where+    flt_subst = addInScopeSet (rv_fltR renv) (rs_bndrs subst)+    (flt_subst', bind') = substBind flt_subst bind+    new_bndrs = bindersOf bind'++{- Disabled: see Note [Matching cases] below+match renv (tv_subst, id_subst, binds) e1+      (Case scrut case_bndr ty [(con, alt_bndrs, rhs)])+  | exprOkForSpeculation scrut  -- See Note [Matching cases]+  , okToFloat rn_env bndrs (exprFreeVars scrut)+  = match (renv { me_env = rn_env' })+          (tv_subst, id_subst, binds . case_wrap)+          e1 rhs+  where+    rn_env   = me_env renv+    rn_env'  = extendRnInScopeList rn_env bndrs+    bndrs    = case_bndr : alt_bndrs+    case_wrap rhs' = Case scrut case_bndr ty [(con, alt_bndrs, rhs')]+-}++match _ subst (Lit lit1) (Lit lit2)+  | lit1 == lit2+  = Just subst++match renv subst (App f1 a1) (App f2 a2)+  = do  { subst' <- match renv subst f1 f2+        ; match renv subst' a1 a2 }++match renv subst (Lam x1 e1) e2+  | Just (x2, e2, ts) <- exprIsLambda_maybe (rvInScopeEnv renv) e2+  = let renv' = renv { rv_lcl = rnBndr2 (rv_lcl renv) x1 x2+                     , rv_fltR = delBndr (rv_fltR renv) x2 }+        subst' = subst { rs_binds = rs_binds subst . flip (foldr mkTick) ts }+    in  match renv' subst' e1 e2++match renv subst (Case e1 x1 ty1 alts1) (Case e2 x2 ty2 alts2)+  = do  { subst1 <- match_ty renv subst ty1 ty2+        ; subst2 <- match renv subst1 e1 e2+        ; let renv' = rnMatchBndr2 renv subst x1 x2+        ; match_alts renv' subst2 alts1 alts2   -- Alts are both sorted+        }++match renv subst (Type ty1) (Type ty2)+  = match_ty renv subst ty1 ty2+match renv subst (Coercion co1) (Coercion co2)+  = match_co renv subst co1 co2++match renv subst (Cast e1 co1) (Cast e2 co2)+  = do  { subst1 <- match_co renv subst co1 co2+        ; match renv subst1 e1 e2 }++-- Everything else fails+match _ _ _e1 _e2 = -- pprTrace "Failing at" ((text "e1:" <+> ppr _e1) $$ (text "e2:" <+> ppr _e2)) $+                    Nothing++-------------+match_co :: RuleMatchEnv+         -> RuleSubst+         -> Coercion+         -> Coercion+         -> Maybe RuleSubst+match_co renv subst co1 co2+  | Just cv <- getCoVar_maybe co1+  = match_var renv subst cv (Coercion co2)+  | Just (ty1, r1) <- isReflCo_maybe co1+  = do { (ty2, r2) <- isReflCo_maybe co2+       ; guard (r1 == r2)+       ; match_ty renv subst ty1 ty2 }+match_co renv subst co1 co2+  | Just (tc1, cos1) <- splitTyConAppCo_maybe co1+  = case splitTyConAppCo_maybe co2 of+      Just (tc2, cos2)+        |  tc1 == tc2+        -> match_cos renv subst cos1 cos2+      _ -> Nothing+match_co renv subst co1 co2+  | Just (arg1, res1) <- splitFunCo_maybe co1+  = case splitFunCo_maybe co2 of+      Just (arg2, res2)+        -> match_cos renv subst [arg1, res1] [arg2, res2]+      _ -> Nothing+match_co _ _ _co1 _co2+    -- Currently just deals with CoVarCo, TyConAppCo and Refl+#if defined(DEBUG)+  = pprTrace "match_co: needs more cases" (ppr _co1 $$ ppr _co2) Nothing+#else+  = Nothing+#endif++match_cos :: RuleMatchEnv+         -> RuleSubst+         -> [Coercion]+         -> [Coercion]+         -> Maybe RuleSubst+match_cos renv subst (co1:cos1) (co2:cos2) =+  do { subst' <- match_co renv subst co1 co2+     ; match_cos renv subst' cos1 cos2 }+match_cos _ subst [] [] = Just subst+match_cos _ _ cos1 cos2 = pprTrace "match_cos: not same length" (ppr cos1 $$ ppr cos2) Nothing++-------------+rnMatchBndr2 :: RuleMatchEnv -> RuleSubst -> Var -> Var -> RuleMatchEnv+rnMatchBndr2 renv subst x1 x2+  = renv { rv_lcl  = rnBndr2 rn_env x1 x2+         , rv_fltR = delBndr (rv_fltR renv) x2 }+  where+    rn_env = addRnInScopeSet (rv_lcl renv) (rs_bndrs subst)+    -- Typically this is a no-op, but it may matter if+    -- there are some floated let-bindings++------------------------------------------+match_alts :: RuleMatchEnv+           -> RuleSubst+           -> [CoreAlt]         -- Template+           -> [CoreAlt]         -- Target+           -> Maybe RuleSubst+match_alts _ subst [] []+  = return subst+match_alts renv subst ((c1,vs1,r1):alts1) ((c2,vs2,r2):alts2)+  | c1 == c2+  = do  { subst1 <- match renv' subst r1 r2+        ; match_alts renv subst1 alts1 alts2 }+  where+    renv' = foldl' mb renv (vs1 `zip` vs2)+    mb renv (v1,v2) = rnMatchBndr2 renv subst v1 v2++match_alts _ _ _ _+  = Nothing++------------------------------------------+okToFloat :: RnEnv2 -> VarSet -> Bool+okToFloat rn_env bind_fvs+  = allVarSet not_captured bind_fvs+  where+    not_captured fv = not (inRnEnvR rn_env fv)++------------------------------------------+match_var :: RuleMatchEnv+          -> RuleSubst+          -> Var                -- Template+          -> CoreExpr        -- Target+          -> Maybe RuleSubst+match_var renv@(RV { rv_tmpls = tmpls, rv_lcl = rn_env, rv_fltR = flt_env })+          subst v1 e2+  | v1' `elemVarSet` tmpls+  = match_tmpl_var renv subst v1' e2++  | otherwise   -- v1' is not a template variable; check for an exact match with e2+  = case e2 of  -- Remember, envR of rn_env is disjoint from rv_fltR+       Var v2 | v1' == rnOccR rn_env v2+              -> Just subst++              | Var v2' <- lookupIdSubst (text "match_var") flt_env v2+              , v1' == v2'+              -> Just subst++       _ -> Nothing++  where+    v1' = rnOccL rn_env v1+        -- If the template is+        --      forall x. f x (\x -> x) = ...+        -- Then the x inside the lambda isn't the+        -- template x, so we must rename first!++------------------------------------------+match_tmpl_var :: RuleMatchEnv+               -> RuleSubst+               -> Var                -- Template+               -> CoreExpr              -- Target+               -> Maybe RuleSubst++match_tmpl_var renv@(RV { rv_lcl = rn_env, rv_fltR = flt_env })+               subst@(RS { rs_id_subst = id_subst, rs_bndrs = let_bndrs })+               v1' e2+  | any (inRnEnvR rn_env) (exprFreeVarsList e2)+  = Nothing     -- Occurs check failure+                -- e.g. match forall a. (\x-> a x) against (\y. y y)++  | Just e1' <- lookupVarEnv id_subst v1'+  = if eqExpr (rnInScopeSet rn_env) e1' e2'+    then Just subst+    else Nothing++  | otherwise+  =             -- Note [Matching variable types]+                -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+                -- However, we must match the *types*; e.g.+                --   forall (c::Char->Int) (x::Char).+                --      f (c x) = "RULE FIRED"+                -- We must only match on args that have the right type+                -- It's actually quite difficult to come up with an example that shows+                -- you need type matching, esp since matching is left-to-right, so type+                -- args get matched first.  But it's possible (e.g. simplrun008) and+                -- this is the Right Thing to do+    do { subst' <- match_ty renv subst (idType v1') (exprType e2)+       ; return (subst' { rs_id_subst = id_subst' }) }+  where+    -- e2' is the result of applying flt_env to e2+    e2' | isEmptyVarSet let_bndrs = e2+        | otherwise = substExpr (text "match_tmpl_var") flt_env e2++    id_subst' = extendVarEnv (rs_id_subst subst) v1' e2'+         -- No further renaming to do on e2',+         -- because no free var of e2' is in the rnEnvR of the envt++------------------------------------------+match_ty :: RuleMatchEnv+         -> RuleSubst+         -> Type                -- Template+         -> Type                -- Target+         -> Maybe RuleSubst+-- Matching Core types: use the matcher in TcType.+-- Notice that we treat newtypes as opaque.  For example, suppose+-- we have a specialised version of a function at a newtype, say+--      newtype T = MkT Int+-- We only want to replace (f T) with f', not (f Int).++match_ty renv subst ty1 ty2+  = do  { tv_subst'+            <- Unify.ruleMatchTyKiX (rv_tmpls renv) (rv_lcl renv) tv_subst ty1 ty2+        ; return (subst { rs_tv_subst = tv_subst' }) }+  where+    tv_subst = rs_tv_subst subst++{-+Note [Expanding variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~+Here is another Very Important rule: if the term being matched is a+variable, we expand it so long as its unfolding is "expandable". (Its+occurrence information is not necessarily up to date, so we don't use+it.)  By "expandable" we mean a WHNF or a "constructor-like" application.+This is the key reason for "constructor-like" Ids.  If we have+     {-# NOINLINE [1] CONLIKE g #-}+     {-# RULE f (g x) = h x #-}+then in the term+   let v = g 3 in ....(f v)....+we want to make the rule fire, to replace (f v) with (h 3).++Note [Do not expand locally-bound variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Do *not* expand locally-bound variables, else there's a worry that the+unfolding might mention variables that are themselves renamed.+Example+          case x of y { (p,q) -> ...y... }+Don't expand 'y' to (p,q) because p,q might themselves have been+renamed.  Essentially we only expand unfoldings that are "outside"+the entire match.++Hence, (a) the guard (not (isLocallyBoundR v2))+       (b) when we expand we nuke the renaming envt (nukeRnEnvR).++Note [Tick annotations in RULE matching]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++We used to unconditionally look through Notes in both template and+expression being matched. This is actually illegal for counting or+cost-centre-scoped ticks, because we have no place to put them without+changing entry counts and/or costs. So now we just fail the match in+these cases.++On the other hand, where we are allowed to insert new cost into the+tick scope, we can float them upwards to the rule application site.++cf Note [Notes in call patterns] in SpecConstr++Note [Matching lets]+~~~~~~~~~~~~~~~~~~~~+Matching a let-expression.  Consider+        RULE forall x.  f (g x) = <rhs>+and target expression+        f (let { w=R } in g E))+Then we'd like the rule to match, to generate+        let { w=R } in (\x. <rhs>) E+In effect, we want to float the let-binding outward, to enable+the match to happen.  This is the WHOLE REASON for accumulating+bindings in the RuleSubst++We can only do this if the free variables of R are not bound by the+part of the target expression outside the let binding; e.g.+        f (\v. let w = v+1 in g E)+Here we obviously cannot float the let-binding for w.  Hence the+use of okToFloat.++There are a couple of tricky points.+  (a) What if floating the binding captures a variable?+        f (let v = x+1 in v) v+      --> NOT!+        let v = x+1 in f (x+1) v++  (b) What if two non-nested let bindings bind the same variable?+        f (let v = e1 in b1) (let v = e2 in b2)+      --> NOT!+        let v = e1 in let v = e2 in (f b2 b2)+      See testsuite test "RuleFloatLet".++Our cunning plan is this:+  * Along with the growing substitution for template variables+    we maintain a growing set of floated let-bindings (rs_binds)+    plus the set of variables thus bound.++  * The RnEnv2 in the MatchEnv binds only the local binders+    in the term (lambdas, case)++  * When we encounter a let in the term to be matched, we+    check that does not mention any locally bound (lambda, case)+    variables.  If so we fail++  * We use CoreSubst.substBind to freshen the binding, using an+    in-scope set that is the original in-scope variables plus the+    rs_bndrs (currently floated let-bindings).  So in (a) above+    we'll freshen the 'v' binding; in (b) above we'll freshen+    the *second* 'v' binding.++  * We apply that freshening substitution, in a lexically-scoped+    way to the term, although lazily; this is the rv_fltR field.+++Note [Matching cases]+~~~~~~~~~~~~~~~~~~~~~+{- NOTE: This idea is currently disabled.  It really only works if+         the primops involved are OkForSpeculation, and, since+         they have side effects readIntOfAddr and touch are not.+         Maybe we'll get back to this later .  -}++Consider+   f (case readIntOffAddr# p# i# realWorld# of { (# s#, n# #) ->+      case touch# fp s# of { _ ->+      I# n# } } )+This happened in a tight loop generated by stream fusion that+Roman encountered.  We'd like to treat this just like the let+case, because the primops concerned are ok-for-speculation.+That is, we'd like to behave as if it had been+   case readIntOffAddr# p# i# realWorld# of { (# s#, n# #) ->+   case touch# fp s# of { _ ->+   f (I# n# } } )++Note [Lookup in-scope]+~~~~~~~~~~~~~~~~~~~~~~+Consider this example+        foo :: Int -> Maybe Int -> Int+        foo 0 (Just n) = n+        foo m (Just n) = foo (m-n) (Just n)++SpecConstr sees this fragment:++        case w_smT of wild_Xf [Just A] {+          Data.Maybe.Nothing -> lvl_smf;+          Data.Maybe.Just n_acT [Just S(L)] ->+            case n_acT of wild1_ams [Just A] { GHC.Base.I# y_amr [Just L] ->+              $wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf+            }};++and correctly generates the rule++        RULES: "SC:$wfoo1" [0] __forall {y_amr [Just L] :: GHC.Prim.Int#+                                          sc_snn :: GHC.Prim.Int#}+          $wfoo_smW sc_snn (Data.Maybe.Just @ GHC.Base.Int (GHC.Base.I# y_amr))+          = $s$wfoo_sno y_amr sc_snn ;]++BUT we must ensure that this rule matches in the original function!+Note that the call to $wfoo is+            $wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf++During matching we expand wild_Xf to (Just n_acT).  But then we must also+expand n_acT to (I# y_amr).  And we can only do that if we look up n_acT+in the in-scope set, because in wild_Xf's unfolding it won't have an unfolding+at all.++That is why the 'lookupRnInScope' call in the (Var v2) case of 'match'+is so important.+++************************************************************************+*                                                                      *+                   Rule-check the program+*                                                                      *+************************************************************************++   We want to know what sites have rules that could have fired but didn't.+   This pass runs over the tree (without changing it) and reports such.+-}++-- | Report partial matches for rules beginning with the specified+-- string for the purposes of error reporting+ruleCheckProgram :: CompilerPhase               -- ^ Rule activation test+                 -> String                      -- ^ Rule pattern+                 -> (Id -> [CoreRule])          -- ^ Rules for an Id+                 -> CoreProgram                 -- ^ Bindings to check in+                 -> SDoc                        -- ^ Resulting check message+ruleCheckProgram phase rule_pat rules binds+  | isEmptyBag results+  = text "Rule check results: no rule application sites"+  | otherwise+  = vcat [text "Rule check results:",+          line,+          vcat [ p $$ line | p <- bagToList results ]+         ]+  where+    env = RuleCheckEnv { rc_is_active = isActive phase+                       , rc_id_unf    = idUnfolding     -- Not quite right+                                                        -- Should use activeUnfolding+                       , rc_pattern   = rule_pat+                       , rc_rules = rules }+    results = unionManyBags (map (ruleCheckBind env) binds)+    line = text (replicate 20 '-')++data RuleCheckEnv = RuleCheckEnv {+    rc_is_active :: Activation -> Bool,+    rc_id_unf  :: IdUnfoldingFun,+    rc_pattern :: String,+    rc_rules :: Id -> [CoreRule]+}++ruleCheckBind :: RuleCheckEnv -> CoreBind -> Bag SDoc+   -- The Bag returned has one SDoc for each call site found+ruleCheckBind env (NonRec _ r) = ruleCheck env r+ruleCheckBind env (Rec prs)    = unionManyBags [ruleCheck env r | (_,r) <- prs]++ruleCheck :: RuleCheckEnv -> CoreExpr -> Bag SDoc+ruleCheck _   (Var _)       = emptyBag+ruleCheck _   (Lit _)       = emptyBag+ruleCheck _   (Type _)      = emptyBag+ruleCheck _   (Coercion _)  = emptyBag+ruleCheck env (App f a)     = ruleCheckApp env (App f a) []+ruleCheck env (Tick _ e)  = ruleCheck env e+ruleCheck env (Cast e _)    = ruleCheck env e+ruleCheck env (Let bd e)    = ruleCheckBind env bd `unionBags` ruleCheck env e+ruleCheck env (Lam _ e)     = ruleCheck env e+ruleCheck env (Case e _ _ as) = ruleCheck env e `unionBags`+                                unionManyBags [ruleCheck env r | (_,_,r) <- as]++ruleCheckApp :: RuleCheckEnv -> Expr CoreBndr -> [Arg CoreBndr] -> Bag SDoc+ruleCheckApp env (App f a) as = ruleCheck env a `unionBags` ruleCheckApp env f (a:as)+ruleCheckApp env (Var f) as   = ruleCheckFun env f as+ruleCheckApp env other _      = ruleCheck env other++ruleCheckFun :: RuleCheckEnv -> Id -> [CoreExpr] -> Bag SDoc+-- Produce a report for all rules matching the predicate+-- saying why it doesn't match the specified application++ruleCheckFun env fn args+  | null name_match_rules = emptyBag+  | otherwise             = unitBag (ruleAppCheck_help env fn args name_match_rules)+  where+    name_match_rules = filter match (rc_rules env fn)+    match rule = (rc_pattern env) `isPrefixOf` unpackFS (ruleName rule)++ruleAppCheck_help :: RuleCheckEnv -> Id -> [CoreExpr] -> [CoreRule] -> SDoc+ruleAppCheck_help env fn args rules+  =     -- The rules match the pattern, so we want to print something+    vcat [text "Expression:" <+> ppr (mkApps (Var fn) args),+          vcat (map check_rule rules)]+  where+    n_args = length args+    i_args = args `zip` [1::Int ..]+    rough_args = map roughTopName args++    check_rule rule = sdocWithDynFlags $ \dflags ->+                      rule_herald rule <> colon <+> rule_info dflags rule++    rule_herald (BuiltinRule { ru_name = name })+        = text "Builtin rule" <+> doubleQuotes (ftext name)+    rule_herald (Rule { ru_name = name })+        = text "Rule" <+> doubleQuotes (ftext name)++    rule_info dflags rule+        | Just _ <- matchRule dflags (emptyInScopeSet, rc_id_unf env)+                              noBlackList fn args rough_args rule+        = text "matches (which is very peculiar!)"++    rule_info _ (BuiltinRule {}) = text "does not match"++    rule_info _ (Rule { ru_act = act,+                        ru_bndrs = rule_bndrs, ru_args = rule_args})+        | not (rc_is_active env act)  = text "active only in later phase"+        | n_args < n_rule_args        = text "too few arguments"+        | n_mismatches == n_rule_args = text "no arguments match"+        | n_mismatches == 0           = text "all arguments match (considered individually), but rule as a whole does not"+        | otherwise                   = text "arguments" <+> ppr mismatches <+> text "do not match (1-indexing)"+        where+          n_rule_args  = length rule_args+          n_mismatches = length mismatches+          mismatches   = [i | (rule_arg, (arg,i)) <- rule_args `zip` i_args,+                              not (isJust (match_fn rule_arg arg))]++          lhs_fvs = exprsFreeVars rule_args     -- Includes template tyvars+          match_fn rule_arg arg = match renv emptyRuleSubst rule_arg arg+                where+                  in_scope = mkInScopeSet (lhs_fvs `unionVarSet` exprFreeVars arg)+                  renv = RV { rv_lcl   = mkRnEnv2 in_scope+                            , rv_tmpls = mkVarSet rule_bndrs+                            , rv_fltR  = mkEmptySubst in_scope+                            , rv_unf   = rc_id_unf env }
+ compiler/typecheck/TcEvidence.hs view
@@ -0,0 +1,991 @@+-- (c) The University of Glasgow 2006++{-# LANGUAGE CPP, DeriveDataTypeable #-}++module TcEvidence (++  -- HsWrapper+  HsWrapper(..),+  (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams,+  mkWpLams, mkWpLet, mkWpCastN, mkWpCastR, collectHsWrapBinders,+  mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, pprHsWrapper,++  -- Evidence bindings+  TcEvBinds(..), EvBindsVar(..),+  EvBindMap(..), emptyEvBindMap, extendEvBinds,+  lookupEvBind, evBindMapBinds, foldEvBindMap, filterEvBindMap,+  isEmptyEvBindMap,+  EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, mkGivenEvBind, mkWantedEvBind,+  evBindVar, isCoEvBindsVar,++  -- EvTerm (already a CoreExpr)+  EvTerm(..), EvExpr,+  evId, evCoercion, evCast, evDFunApp,  evDataConApp, evSelector,+  mkEvCast, evVarsOfTerm, mkEvScSelectors, evTypeable, findNeededEvVars,++  evTermCoercion, evTermCoercion_maybe,+  EvCallStack(..),+  EvTypeable(..),++  -- TcCoercion+  TcCoercion, TcCoercionR, TcCoercionN, TcCoercionP, CoercionHole,+  Role(..), LeftOrRight(..), pickLR,+  mkTcReflCo, mkTcNomReflCo, mkTcRepReflCo,+  mkTcTyConAppCo, mkTcAppCo, mkTcFunCo,+  mkTcAxInstCo, mkTcUnbranchedAxInstCo, mkTcForAllCo, mkTcForAllCos,+  mkTcSymCo, mkTcTransCo, mkTcNthCo, mkTcLRCo, mkTcSubCo, maybeTcSubCo,+  tcDowngradeRole,+  mkTcAxiomRuleCo, mkTcGReflRightCo, mkTcGReflLeftCo, mkTcPhantomCo,+  mkTcCoherenceLeftCo,+  mkTcCoherenceRightCo,+  mkTcKindCo,+  tcCoercionKind, coVarsOfTcCo,+  mkTcCoVarCo,+  isTcReflCo, isTcReflexiveCo,+  tcCoercionRole,+  unwrapIP, wrapIP+  ) where+#include "HsVersions.h"++import GhcPrelude++import Var+import CoAxiom+import Coercion+import PprCore ()   -- Instance OutputableBndr TyVar+import TcType+import Type+import TyCon+import DataCon( DataCon, dataConWrapId )+import Class( Class )+import PrelNames+import DynFlags   ( gopt, GeneralFlag(Opt_PrintTypecheckerElaboration) )+import VarEnv+import VarSet+import Name+import Pair++import CoreSyn+import Class ( classSCSelId )+import Id ( isEvVar )+import CoreFVs ( exprSomeFreeVars )++import Util+import Bag+import qualified Data.Data as Data+import Outputable+import SrcLoc+import Data.IORef( IORef )+import UniqSet++{-+Note [TcCoercions]+~~~~~~~~~~~~~~~~~~+| TcCoercions are a hack used by the typechecker. Normally,+Coercions have free variables of type (a ~# b): we call these+CoVars. However, the type checker passes around equality evidence+(boxed up) at type (a ~ b).++An TcCoercion is simply a Coercion whose free variables have may be either+boxed or unboxed. After we are done with typechecking the desugarer finds the+boxed free variables, unboxes them, and creates a resulting real Coercion with+kosher free variables.++-}++type TcCoercion  = Coercion+type TcCoercionN = CoercionN    -- A Nominal          coercion ~N+type TcCoercionR = CoercionR    -- A Representational coercion ~R+type TcCoercionP = CoercionP    -- a phantom coercion++mkTcReflCo             :: Role -> TcType -> TcCoercion+mkTcSymCo              :: TcCoercion -> TcCoercion+mkTcTransCo            :: TcCoercion -> TcCoercion -> TcCoercion+mkTcNomReflCo          :: TcType -> TcCoercionN+mkTcRepReflCo          :: TcType -> TcCoercionR+mkTcTyConAppCo         :: Role -> TyCon -> [TcCoercion] -> TcCoercion+mkTcAppCo              :: TcCoercion -> TcCoercionN -> TcCoercion+mkTcFunCo              :: Role -> TcCoercion -> TcCoercion -> TcCoercion+mkTcAxInstCo           :: Role -> CoAxiom br -> BranchIndex+                       -> [TcType] -> [TcCoercion] -> TcCoercion+mkTcUnbranchedAxInstCo :: CoAxiom Unbranched -> [TcType]+                       -> [TcCoercion] -> TcCoercionR+mkTcForAllCo           :: TyVar -> TcCoercionN -> TcCoercion -> TcCoercion+mkTcForAllCos          :: [(TyVar, TcCoercionN)] -> TcCoercion -> TcCoercion+mkTcNthCo              :: Role -> Int -> TcCoercion -> TcCoercion+mkTcLRCo               :: LeftOrRight -> TcCoercion -> TcCoercion+mkTcSubCo              :: TcCoercionN -> TcCoercionR+maybeTcSubCo           :: EqRel -> TcCoercion -> TcCoercion+tcDowngradeRole        :: Role -> Role -> TcCoercion -> TcCoercion+mkTcAxiomRuleCo        :: CoAxiomRule -> [TcCoercion] -> TcCoercionR+mkTcGReflRightCo       :: Role -> TcType -> TcCoercionN -> TcCoercion+mkTcGReflLeftCo        :: Role -> TcType -> TcCoercionN -> TcCoercion+mkTcCoherenceLeftCo    :: Role -> TcType -> TcCoercionN+                       -> TcCoercion -> TcCoercion+mkTcCoherenceRightCo   :: Role -> TcType -> TcCoercionN+                       -> TcCoercion -> TcCoercion+mkTcPhantomCo          :: TcCoercionN -> TcType -> TcType -> TcCoercionP+mkTcKindCo             :: TcCoercion -> TcCoercionN+mkTcCoVarCo            :: CoVar -> TcCoercion++tcCoercionKind         :: TcCoercion -> Pair TcType+tcCoercionRole         :: TcCoercion -> Role+coVarsOfTcCo           :: TcCoercion -> TcTyCoVarSet+isTcReflCo             :: TcCoercion -> Bool++-- | This version does a slow check, calculating the related types and seeing+-- if they are equal.+isTcReflexiveCo        :: TcCoercion -> Bool++mkTcReflCo             = mkReflCo+mkTcSymCo              = mkSymCo+mkTcTransCo            = mkTransCo+mkTcNomReflCo          = mkNomReflCo+mkTcRepReflCo          = mkRepReflCo+mkTcTyConAppCo         = mkTyConAppCo+mkTcAppCo              = mkAppCo+mkTcFunCo              = mkFunCo+mkTcAxInstCo           = mkAxInstCo+mkTcUnbranchedAxInstCo = mkUnbranchedAxInstCo Representational+mkTcForAllCo           = mkForAllCo+mkTcForAllCos          = mkForAllCos+mkTcNthCo              = mkNthCo+mkTcLRCo               = mkLRCo+mkTcSubCo              = mkSubCo+maybeTcSubCo           = maybeSubCo+tcDowngradeRole        = downgradeRole+mkTcAxiomRuleCo        = mkAxiomRuleCo+mkTcGReflRightCo       = mkGReflRightCo+mkTcGReflLeftCo        = mkGReflLeftCo+mkTcCoherenceLeftCo    = mkCoherenceLeftCo+mkTcCoherenceRightCo   = mkCoherenceRightCo+mkTcPhantomCo          = mkPhantomCo+mkTcKindCo             = mkKindCo+mkTcCoVarCo            = mkCoVarCo++tcCoercionKind         = coercionKind+tcCoercionRole         = coercionRole+coVarsOfTcCo           = coVarsOfCo+isTcReflCo             = isReflCo+isTcReflexiveCo        = isReflexiveCo++{-+%************************************************************************+%*                                                                      *+                  HsWrapper+*                                                                      *+************************************************************************+-}++data HsWrapper+  = WpHole                      -- The identity coercion++  | WpCompose HsWrapper HsWrapper+       -- (wrap1 `WpCompose` wrap2)[e] = wrap1[ wrap2[ e ]]+       --+       -- Hence  (\a. []) `WpCompose` (\b. []) = (\a b. [])+       -- But    ([] a)   `WpCompose` ([] b)   = ([] b a)++  | WpFun HsWrapper HsWrapper TcType SDoc+       -- (WpFun wrap1 wrap2 t1)[e] = \(x:t1). wrap2[ e wrap1[x] ]+       -- So note that if  wrap1 :: exp_arg <= act_arg+       --                  wrap2 :: act_res <= exp_res+       --           then   WpFun wrap1 wrap2 : (act_arg -> arg_res) <= (exp_arg -> exp_res)+       -- This isn't the same as for mkFunCo, but it has to be this way+       -- because we can't use 'sym' to flip around these HsWrappers+       -- The TcType is the "from" type of the first wrapper+       -- The SDoc explains the circumstances under which we have created this+       -- WpFun, in case we run afoul of levity polymorphism restrictions in+       -- the desugarer. See Note [Levity polymorphism checking] in DsMonad++  | WpCast TcCoercionR        -- A cast:  [] `cast` co+                              -- Guaranteed not the identity coercion+                              -- At role Representational++        -- Evidence abstraction and application+        -- (both dictionaries and coercions)+  | WpEvLam EvVar               -- \d. []       the 'd' is an evidence variable+  | WpEvApp EvTerm              -- [] d         the 'd' is evidence for a constraint+        -- Kind and Type abstraction and application+  | WpTyLam TyVar       -- \a. []  the 'a' is a type/kind variable (not coercion var)+  | WpTyApp KindOrType  -- [] t    the 't' is a type (not coercion)+++  | WpLet TcEvBinds             -- Non-empty (or possibly non-empty) evidence bindings,+                                -- so that the identity coercion is always exactly WpHole++-- Cannot derive Data instance because SDoc is not Data (it stores a function).+-- So we do it manually:+instance Data.Data HsWrapper where+  gfoldl _ z WpHole             = z WpHole+  gfoldl k z (WpCompose a1 a2)  = z WpCompose `k` a1 `k` a2+  gfoldl k z (WpFun a1 a2 a3 _) = z wpFunEmpty `k` a1 `k` a2 `k` a3+  gfoldl k z (WpCast a1)        = z WpCast `k` a1+  gfoldl k z (WpEvLam a1)       = z WpEvLam `k` a1+  gfoldl k z (WpEvApp a1)       = z WpEvApp `k` a1+  gfoldl k z (WpTyLam a1)       = z WpTyLam `k` a1+  gfoldl k z (WpTyApp a1)       = z WpTyApp `k` a1+  gfoldl k z (WpLet a1)         = z WpLet `k` a1++  gunfold k z c = case Data.constrIndex c of+                    1 -> z WpHole+                    2 -> k (k (z WpCompose))+                    3 -> k (k (k (z wpFunEmpty)))+                    4 -> k (z WpCast)+                    5 -> k (z WpEvLam)+                    6 -> k (z WpEvApp)+                    7 -> k (z WpTyLam)+                    8 -> k (z WpTyApp)+                    _ -> k (z WpLet)++  toConstr WpHole          = wpHole_constr+  toConstr (WpCompose _ _) = wpCompose_constr+  toConstr (WpFun _ _ _ _) = wpFun_constr+  toConstr (WpCast _)      = wpCast_constr+  toConstr (WpEvLam _)     = wpEvLam_constr+  toConstr (WpEvApp _)     = wpEvApp_constr+  toConstr (WpTyLam _)     = wpTyLam_constr+  toConstr (WpTyApp _)     = wpTyApp_constr+  toConstr (WpLet _)       = wpLet_constr++  dataTypeOf _ = hsWrapper_dataType++hsWrapper_dataType :: Data.DataType+hsWrapper_dataType+  = Data.mkDataType "HsWrapper"+      [ wpHole_constr, wpCompose_constr, wpFun_constr, wpCast_constr+      , wpEvLam_constr, wpEvApp_constr, wpTyLam_constr, wpTyApp_constr+      , wpLet_constr]++wpHole_constr, wpCompose_constr, wpFun_constr, wpCast_constr, wpEvLam_constr,+  wpEvApp_constr, wpTyLam_constr, wpTyApp_constr, wpLet_constr :: Data.Constr+wpHole_constr    = mkHsWrapperConstr "WpHole"+wpCompose_constr = mkHsWrapperConstr "WpCompose"+wpFun_constr     = mkHsWrapperConstr "WpFun"+wpCast_constr    = mkHsWrapperConstr "WpCast"+wpEvLam_constr   = mkHsWrapperConstr "WpEvLam"+wpEvApp_constr   = mkHsWrapperConstr "WpEvApp"+wpTyLam_constr   = mkHsWrapperConstr "WpTyLam"+wpTyApp_constr   = mkHsWrapperConstr "WpTyApp"+wpLet_constr     = mkHsWrapperConstr "WpLet"++mkHsWrapperConstr :: String -> Data.Constr+mkHsWrapperConstr name = Data.mkConstr hsWrapper_dataType name [] Data.Prefix++wpFunEmpty :: HsWrapper -> HsWrapper -> TcType -> HsWrapper+wpFunEmpty c1 c2 t1 = WpFun c1 c2 t1 empty++(<.>) :: HsWrapper -> HsWrapper -> HsWrapper+WpHole <.> c = c+c <.> WpHole = c+c1 <.> c2    = c1 `WpCompose` c2++mkWpFun :: HsWrapper -> HsWrapper+        -> TcType    -- the "from" type of the first wrapper+        -> TcType    -- either type of the second wrapper (used only when the+                     -- second wrapper is the identity)+        -> SDoc      -- what caused you to want a WpFun? Something like "When converting ..."+        -> HsWrapper+mkWpFun WpHole       WpHole       _  _  _ = WpHole+mkWpFun WpHole       (WpCast co2) t1 _  _ = WpCast (mkTcFunCo Representational (mkTcRepReflCo t1) co2)+mkWpFun (WpCast co1) WpHole       _  t2 _ = WpCast (mkTcFunCo Representational (mkTcSymCo co1) (mkTcRepReflCo t2))+mkWpFun (WpCast co1) (WpCast co2) _  _  _ = WpCast (mkTcFunCo Representational (mkTcSymCo co1) co2)+mkWpFun co1          co2          t1 _  d = WpFun co1 co2 t1 d++-- | @mkWpFuns [(ty1, wrap1), (ty2, wrap2)] ty_res wrap_res@,+-- where @wrap1 :: ty1 "->" ty1'@ and @wrap2 :: ty2 "->" ty2'@,+-- @wrap3 :: ty3 "->" ty3'@ and @ty_res@ is /either/ @ty3@ or @ty3'@,+-- gives a wrapper @(ty1' -> ty2' -> ty3) "->" (ty1 -> ty2 -> ty3')@.+-- Notice that the result wrapper goes the other way round to all+-- the others. This is a result of sub-typing contravariance.+-- The SDoc is a description of what you were doing when you called mkWpFuns.+mkWpFuns :: [(TcType, HsWrapper)] -> TcType -> HsWrapper -> SDoc -> HsWrapper+mkWpFuns args res_ty res_wrap doc = snd $ go args res_ty res_wrap+  where+    go [] res_ty res_wrap = (res_ty, res_wrap)+    go ((arg_ty, arg_wrap) : args) res_ty res_wrap+      = let (tail_ty, tail_wrap) = go args res_ty res_wrap in+        (arg_ty `mkVisFunTy` tail_ty, mkWpFun arg_wrap tail_wrap arg_ty tail_ty doc)++mkWpCastR :: TcCoercionR -> HsWrapper+mkWpCastR co+  | isTcReflCo co = WpHole+  | otherwise     = ASSERT2(tcCoercionRole co == Representational, ppr co)+                    WpCast co++mkWpCastN :: TcCoercionN -> HsWrapper+mkWpCastN co+  | isTcReflCo co = WpHole+  | otherwise     = ASSERT2(tcCoercionRole co == Nominal, ppr co)+                    WpCast (mkTcSubCo co)+    -- The mkTcSubCo converts Nominal to Representational++mkWpTyApps :: [Type] -> HsWrapper+mkWpTyApps tys = mk_co_app_fn WpTyApp tys++mkWpEvApps :: [EvTerm] -> HsWrapper+mkWpEvApps args = mk_co_app_fn WpEvApp args++mkWpEvVarApps :: [EvVar] -> HsWrapper+mkWpEvVarApps vs = mk_co_app_fn WpEvApp (map (EvExpr . evId) vs)++mkWpTyLams :: [TyVar] -> HsWrapper+mkWpTyLams ids = mk_co_lam_fn WpTyLam ids++mkWpLams :: [Var] -> HsWrapper+mkWpLams ids = mk_co_lam_fn WpEvLam ids++mkWpLet :: TcEvBinds -> HsWrapper+-- This no-op is a quite a common case+mkWpLet (EvBinds b) | isEmptyBag b = WpHole+mkWpLet ev_binds                   = WpLet ev_binds++mk_co_lam_fn :: (a -> HsWrapper) -> [a] -> HsWrapper+mk_co_lam_fn f as = foldr (\x wrap -> f x <.> wrap) WpHole as++mk_co_app_fn :: (a -> HsWrapper) -> [a] -> HsWrapper+-- For applications, the *first* argument must+-- come *last* in the composition sequence+mk_co_app_fn f as = foldr (\x wrap -> wrap <.> f x) WpHole as++idHsWrapper :: HsWrapper+idHsWrapper = WpHole++isIdHsWrapper :: HsWrapper -> Bool+isIdHsWrapper WpHole = True+isIdHsWrapper _      = False++collectHsWrapBinders :: HsWrapper -> ([Var], HsWrapper)+-- Collect the outer lambda binders of a HsWrapper,+-- stopping as soon as you get to a non-lambda binder+collectHsWrapBinders wrap = go wrap []+  where+    -- go w ws = collectHsWrapBinders (w <.> w1 <.> ... <.> wn)+    go :: HsWrapper -> [HsWrapper] -> ([Var], HsWrapper)+    go (WpEvLam v)       wraps = add_lam v (gos wraps)+    go (WpTyLam v)       wraps = add_lam v (gos wraps)+    go (WpCompose w1 w2) wraps = go w1 (w2:wraps)+    go wrap              wraps = ([], foldl' (<.>) wrap wraps)++    gos []     = ([], WpHole)+    gos (w:ws) = go w ws++    add_lam v (vs,w) = (v:vs, w)++{-+************************************************************************+*                                                                      *+                  Evidence bindings+*                                                                      *+************************************************************************+-}++data TcEvBinds+  = TcEvBinds           -- Mutable evidence bindings+       EvBindsVar       -- Mutable because they are updated "later"+                        --    when an implication constraint is solved++  | EvBinds             -- Immutable after zonking+       (Bag EvBind)++data EvBindsVar+  = EvBindsVar {+      ebv_uniq :: Unique,+         -- The Unique is for debug printing only++      ebv_binds :: IORef EvBindMap,+      -- The main payload: the value-level evidence bindings+      --     (dictionaries etc)+      -- Some Given, some Wanted++      ebv_tcvs :: IORef CoVarSet+      -- The free Given coercion vars needed by Wanted coercions that+      -- are solved by filling in their HoleDest in-place. Since they+      -- don't appear in ebv_binds, we keep track of their free+      -- variables so that we can report unused given constraints+      -- See Note [Tracking redundant constraints] in TcSimplify+    }++  | CoEvBindsVar {  -- See Note [Coercion evidence only]++      -- See above for comments on ebv_uniq, ebv_tcvs+      ebv_uniq :: Unique,+      ebv_tcvs :: IORef CoVarSet+    }++instance Data.Data TcEvBinds where+  -- Placeholder; we can't travers into TcEvBinds+  toConstr _   = abstractConstr "TcEvBinds"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = Data.mkNoRepType "TcEvBinds"++{- Note [Coercion evidence only]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Class constraints etc give rise to /term/ bindings for evidence, and+we have nowhere to put term bindings in /types/.  So in some places we+use CoEvBindsVar (see newCoTcEvBinds) to signal that no term-level+evidence bindings are allowed.  Notebly ():++  - Places in types where we are solving kind constraints (all of which+    are equalities); see solveEqualities, solveLocalEqualities,+    checkTvConstraints++  - When unifying forall-types+-}++isCoEvBindsVar :: EvBindsVar -> Bool+isCoEvBindsVar (CoEvBindsVar {}) = True+isCoEvBindsVar (EvBindsVar {})   = False++-----------------+newtype EvBindMap+  = EvBindMap {+       ev_bind_varenv :: DVarEnv EvBind+    }       -- Map from evidence variables to evidence terms+            -- We use @DVarEnv@ here to get deterministic ordering when we+            -- turn it into a Bag.+            -- If we don't do that, when we generate let bindings for+            -- dictionaries in dsTcEvBinds they will be generated in random+            -- order.+            --+            -- For example:+            --+            -- let $dEq = GHC.Classes.$fEqInt in+            -- let $$dNum = GHC.Num.$fNumInt in ...+            --+            -- vs+            --+            -- let $dNum = GHC.Num.$fNumInt in+            -- let $dEq = GHC.Classes.$fEqInt in ...+            --+            -- See Note [Deterministic UniqFM] in UniqDFM for explanation why+            -- @UniqFM@ can lead to nondeterministic order.++emptyEvBindMap :: EvBindMap+emptyEvBindMap = EvBindMap { ev_bind_varenv = emptyDVarEnv }++extendEvBinds :: EvBindMap -> EvBind -> EvBindMap+extendEvBinds bs ev_bind+  = EvBindMap { ev_bind_varenv = extendDVarEnv (ev_bind_varenv bs)+                                               (eb_lhs ev_bind)+                                               ev_bind }++isEmptyEvBindMap :: EvBindMap -> Bool+isEmptyEvBindMap (EvBindMap m) = isEmptyDVarEnv m++lookupEvBind :: EvBindMap -> EvVar -> Maybe EvBind+lookupEvBind bs = lookupDVarEnv (ev_bind_varenv bs)++evBindMapBinds :: EvBindMap -> Bag EvBind+evBindMapBinds = foldEvBindMap consBag emptyBag++foldEvBindMap :: (EvBind -> a -> a) -> a -> EvBindMap -> a+foldEvBindMap k z bs = foldDVarEnv k z (ev_bind_varenv bs)++filterEvBindMap :: (EvBind -> Bool) -> EvBindMap -> EvBindMap+filterEvBindMap k (EvBindMap { ev_bind_varenv = env })+  = EvBindMap { ev_bind_varenv = filterDVarEnv k env }++instance Outputable EvBindMap where+  ppr (EvBindMap m) = ppr m++-----------------+-- All evidence is bound by EvBinds; no side effects+data EvBind+  = EvBind { eb_lhs      :: EvVar+           , eb_rhs      :: EvTerm+           , eb_is_given :: Bool  -- True <=> given+                 -- See Note [Tracking redundant constraints] in TcSimplify+    }++evBindVar :: EvBind -> EvVar+evBindVar = eb_lhs++mkWantedEvBind :: EvVar -> EvTerm -> EvBind+mkWantedEvBind ev tm = EvBind { eb_is_given = False, eb_lhs = ev, eb_rhs = tm }++-- EvTypeable are never given, so we can work with EvExpr here instead of EvTerm+mkGivenEvBind :: EvVar -> EvTerm -> EvBind+mkGivenEvBind ev tm = EvBind { eb_is_given = True, eb_lhs = ev, eb_rhs = tm }+++-- An EvTerm is, conceptually, a CoreExpr that implements the constraint.+-- Unfortunately, we cannot just do+--   type EvTerm  = CoreExpr+-- Because of staging problems issues around EvTypeable+data EvTerm+  = EvExpr EvExpr++  | EvTypeable Type EvTypeable   -- Dictionary for (Typeable ty)++  | EvFun     -- /\as \ds. let binds in v+      { et_tvs   :: [TyVar]+      , et_given :: [EvVar]+      , et_binds :: TcEvBinds -- This field is why we need an EvFun+                              -- constructor, and can't just use EvExpr+      , et_body  :: EvVar }++  deriving Data.Data++type EvExpr = CoreExpr++-- An EvTerm is (usually) constructed by any of the constructors here+-- and those more complicates ones who were moved to module TcEvTerm++-- | Any sort of evidence Id, including coercions+evId ::  EvId -> EvExpr+evId = Var++-- coercion bindings+-- See Note [Coercion evidence terms]+evCoercion :: TcCoercion -> EvTerm+evCoercion co = EvExpr (Coercion co)++-- | d |> co+evCast :: EvExpr -> TcCoercion -> EvTerm+evCast et tc | isReflCo tc = EvExpr et+             | otherwise   = EvExpr (Cast et tc)++-- Dictionary instance application+evDFunApp :: DFunId -> [Type] -> [EvExpr] -> EvTerm+evDFunApp df tys ets = EvExpr $ Var df `mkTyApps` tys `mkApps` ets++evDataConApp :: DataCon -> [Type] -> [EvExpr] -> EvTerm+evDataConApp dc tys ets = evDFunApp (dataConWrapId dc) tys ets++-- Selector id plus the types at which it+-- should be instantiated, used for HasField+-- dictionaries; see Note [HasField instances]+-- in TcInterface+evSelector :: Id -> [Type] -> [EvExpr] -> EvExpr+evSelector sel_id tys tms = Var sel_id `mkTyApps` tys `mkApps` tms++-- Dictionary for (Typeable ty)+evTypeable :: Type -> EvTypeable -> EvTerm+evTypeable = EvTypeable++-- | Instructions on how to make a 'Typeable' dictionary.+-- See Note [Typeable evidence terms]+data EvTypeable+  = EvTypeableTyCon TyCon [EvTerm]+    -- ^ Dictionary for @Typeable T@ where @T@ is a type constructor with all of+    -- its kind variables saturated. The @[EvTerm]@ is @Typeable@ evidence for+    -- the applied kinds..++  | EvTypeableTyApp EvTerm EvTerm+    -- ^ Dictionary for @Typeable (s t)@,+    -- given a dictionaries for @s@ and @t@.++  | EvTypeableTrFun EvTerm EvTerm+    -- ^ Dictionary for @Typeable (s -> t)@,+    -- given a dictionaries for @s@ and @t@.++  | EvTypeableTyLit EvTerm+    -- ^ Dictionary for a type literal,+    -- e.g. @Typeable "foo"@ or @Typeable 3@+    -- The 'EvTerm' is evidence of, e.g., @KnownNat 3@+    -- (see #10348)+  deriving Data.Data++-- | Evidence for @CallStack@ implicit parameters.+data EvCallStack+  -- See Note [Overview of implicit CallStacks]+  = EvCsEmpty+  | EvCsPushCall Name RealSrcSpan EvExpr+    -- ^ @EvCsPushCall name loc stk@ represents a call to @name@, occurring at+    -- @loc@, in a calling context @stk@.+  deriving Data.Data++{-+Note [Typeable evidence terms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The EvTypeable data type looks isomorphic to Type, but the EvTerms+inside can be EvIds.  Eg+    f :: forall a. Typeable a => a -> TypeRep+    f x = typeRep (undefined :: Proxy [a])+Here for the (Typeable [a]) dictionary passed to typeRep we make+evidence+    dl :: Typeable [a] = EvTypeable [a]+                            (EvTypeableTyApp (EvTypeableTyCon []) (EvId d))+where+    d :: Typable a+is the lambda-bound dictionary passed into f.++Note [Coercion evidence terms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A "coercion evidence term" takes one of these forms+   co_tm ::= EvId v           where v :: t1 ~# t2+           | EvCoercion co+           | EvCast co_tm co++We do quite often need to get a TcCoercion from an EvTerm; see+'evTermCoercion'.++INVARIANT: The evidence for any constraint with type (t1 ~# t2) is+a coercion evidence term.  Consider for example+    [G] d :: F Int a+If we have+    ax7 a :: F Int a ~ (a ~ Bool)+then we do NOT generate the constraint+    [G] (d |> ax7 a) :: a ~ Bool+because that does not satisfy the invariant (d is not a coercion variable).+Instead we make a binding+    g1 :: a~Bool = g |> ax7 a+and the constraint+    [G] g1 :: a~Bool+See #7238 and Note [Bind new Givens immediately] in TcRnTypes++Note [EvBinds/EvTerm]+~~~~~~~~~~~~~~~~~~~~~+How evidence is created and updated. Bindings for dictionaries,+and coercions and implicit parameters are carried around in TcEvBinds+which during constraint generation and simplification is always of the+form (TcEvBinds ref). After constraint simplification is finished it+will be transformed to t an (EvBinds ev_bag).++Evidence for coercions *SHOULD* be filled in using the TcEvBinds+However, all EvVars that correspond to *wanted* coercion terms in+an EvBind must be mutable variables so that they can be readily+inlined (by zonking) after constraint simplification is finished.++Conclusion: a new wanted coercion variable should be made mutable.+[Notice though that evidence variables that bind coercion terms+ from super classes will be "given" and hence rigid]+++Note [Overview of implicit CallStacks]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+(See https://gitlab.haskell.org/ghc/ghc/wikis/explicit-call-stack/implicit-locations)++The goal of CallStack evidence terms is to reify locations+in the program source as runtime values, without any support+from the RTS. We accomplish this by assigning a special meaning+to constraints of type GHC.Stack.Types.HasCallStack, an alias++  type HasCallStack = (?callStack :: CallStack)++Implicit parameters of type GHC.Stack.Types.CallStack (the name is not+important) are solved in three steps:++1. Occurrences of CallStack IPs are solved directly from the given IP,+   just like a regular IP. For example, the occurrence of `?stk` in++     error :: (?stk :: CallStack) => String -> a+     error s = raise (ErrorCall (s ++ prettyCallStack ?stk))++   will be solved for the `?stk` in `error`s context as before.++2. In a function call, instead of simply passing the given IP, we first+   append the current call-site to it. For example, consider a+   call to the callstack-aware `error` above.++     undefined :: (?stk :: CallStack) => a+     undefined = error "undefined!"++   Here we want to take the given `?stk` and append the current+   call-site, before passing it to `error`. In essence, we want to+   rewrite `error "undefined!"` to++     let ?stk = pushCallStack <error's location> ?stk+     in error "undefined!"++   We achieve this effect by emitting a NEW wanted++     [W] d :: IP "stk" CallStack++   from which we build the evidence term++     EvCsPushCall "error" <error's location> (EvId d)++   that we use to solve the call to `error`. The new wanted `d` will+   then be solved per rule (1), ie as a regular IP.++   (see TcInteract.interactDict)++3. We default any insoluble CallStacks to the empty CallStack. Suppose+   `undefined` did not request a CallStack, ie++     undefinedNoStk :: a+     undefinedNoStk = error "undefined!"++   Under the usual IP rules, the new wanted from rule (2) would be+   insoluble as there's no given IP from which to solve it, so we+   would get an "unbound implicit parameter" error.++   We don't ever want to emit an insoluble CallStack IP, so we add a+   defaulting pass to default any remaining wanted CallStacks to the+   empty CallStack with the evidence term++     EvCsEmpty++   (see TcSimplify.simpl_top and TcSimplify.defaultCallStacks)++This provides a lightweight mechanism for building up call-stacks+explicitly, but is notably limited by the fact that the stack will+stop at the first function whose type does not include a CallStack IP.+For example, using the above definition of `undefined`:++  head :: [a] -> a+  head []    = undefined+  head (x:_) = x++  g = head []++the resulting CallStack will include the call to `undefined` in `head`+and the call to `error` in `undefined`, but *not* the call to `head`+in `g`, because `head` did not explicitly request a CallStack.+++Important Details:+- GHC should NEVER report an insoluble CallStack constraint.++- GHC should NEVER infer a CallStack constraint unless one was requested+  with a partial type signature (See TcType.pickQuantifiablePreds).++- A CallStack (defined in GHC.Stack.Types) is a [(String, SrcLoc)],+  where the String is the name of the binder that is used at the+  SrcLoc. SrcLoc is also defined in GHC.Stack.Types and contains the+  package/module/file name, as well as the full source-span. Both+  CallStack and SrcLoc are kept abstract so only GHC can construct new+  values.++- We will automatically solve any wanted CallStack regardless of the+  name of the IP, i.e.++    f = show (?stk :: CallStack)+    g = show (?loc :: CallStack)++  are both valid. However, we will only push new SrcLocs onto existing+  CallStacks when the IP names match, e.g. in++    head :: (?loc :: CallStack) => [a] -> a+    head [] = error (show (?stk :: CallStack))++  the printed CallStack will NOT include head's call-site. This reflects the+  standard scoping rules of implicit-parameters.++- An EvCallStack term desugars to a CoreExpr of type `IP "some str" CallStack`.+  The desugarer will need to unwrap the IP newtype before pushing a new+  call-site onto a given stack (See DsBinds.dsEvCallStack)++- When we emit a new wanted CallStack from rule (2) we set its origin to+  `IPOccOrigin ip_name` instead of the original `OccurrenceOf func`+  (see TcInteract.interactDict).++  This is a bit shady, but is how we ensure that the new wanted is+  solved like a regular IP.++-}++mkEvCast :: EvExpr -> TcCoercion -> EvTerm+mkEvCast ev lco+  | ASSERT2( tcCoercionRole lco == Representational+           , (vcat [text "Coercion of wrong role passed to mkEvCast:", ppr ev, ppr lco]))+    isTcReflCo lco = EvExpr ev+  | otherwise      = evCast ev lco+++mkEvScSelectors         -- Assume   class (..., D ty, ...) => C a b+  :: Class -> [TcType]  -- C ty1 ty2+  -> [(TcPredType,      -- D ty[ty1/a,ty2/b]+       EvExpr)          -- :: C ty1 ty2 -> D ty[ty1/a,ty2/b]+     ]+mkEvScSelectors cls tys+   = zipWith mk_pr (immSuperClasses cls tys) [0..]+  where+    mk_pr pred i = (pred, Var sc_sel_id `mkTyApps` tys)+      where+        sc_sel_id  = classSCSelId cls i -- Zero-indexed++emptyTcEvBinds :: TcEvBinds+emptyTcEvBinds = EvBinds emptyBag++isEmptyTcEvBinds :: TcEvBinds -> Bool+isEmptyTcEvBinds (EvBinds b)    = isEmptyBag b+isEmptyTcEvBinds (TcEvBinds {}) = panic "isEmptyTcEvBinds"++evTermCoercion_maybe :: EvTerm -> Maybe TcCoercion+-- Applied only to EvTerms of type (s~t)+-- See Note [Coercion evidence terms]+evTermCoercion_maybe ev_term+  | EvExpr e <- ev_term = go e+  | otherwise           = Nothing+  where+    go :: EvExpr -> Maybe TcCoercion+    go (Var v)       = return (mkCoVarCo v)+    go (Coercion co) = return co+    go (Cast tm co)  = do { co' <- go tm+                          ; return (mkCoCast co' co) }+    go _             = Nothing++evTermCoercion :: EvTerm -> TcCoercion+evTermCoercion tm = case evTermCoercion_maybe tm of+                      Just co -> co+                      Nothing -> pprPanic "evTermCoercion" (ppr tm)+++{- *********************************************************************+*                                                                      *+                  Free variables+*                                                                      *+********************************************************************* -}++findNeededEvVars :: EvBindMap -> VarSet -> VarSet+-- Find all the Given evidence needed by seeds,+-- looking transitively through binds+findNeededEvVars ev_binds seeds+  = transCloVarSet also_needs seeds+  where+   also_needs :: VarSet -> VarSet+   also_needs needs = nonDetFoldUniqSet add emptyVarSet needs+     -- It's OK to use nonDetFoldUFM here because we immediately+     -- forget about the ordering by creating a set++   add :: Var -> VarSet -> VarSet+   add v needs+     | Just ev_bind <- lookupEvBind ev_binds v+     , EvBind { eb_is_given = is_given, eb_rhs = rhs } <- ev_bind+     , is_given+     = evVarsOfTerm rhs `unionVarSet` needs+     | otherwise+     = needs++evVarsOfTerm :: EvTerm -> VarSet+evVarsOfTerm (EvExpr e)         = exprSomeFreeVars isEvVar e+evVarsOfTerm (EvTypeable _ ev)  = evVarsOfTypeable ev+evVarsOfTerm (EvFun {})         = emptyVarSet -- See Note [Free vars of EvFun]++evVarsOfTerms :: [EvTerm] -> VarSet+evVarsOfTerms = mapUnionVarSet evVarsOfTerm++evVarsOfTypeable :: EvTypeable -> VarSet+evVarsOfTypeable ev =+  case ev of+    EvTypeableTyCon _ e   -> mapUnionVarSet evVarsOfTerm e+    EvTypeableTyApp e1 e2 -> evVarsOfTerms [e1,e2]+    EvTypeableTrFun e1 e2 -> evVarsOfTerms [e1,e2]+    EvTypeableTyLit e     -> evVarsOfTerm e+++{- Note [Free vars of EvFun]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Finding the free vars of an EvFun is made tricky by the fact the+bindings et_binds may be a mutable variable.  Fortunately, we+can just squeeze by.  Here's how.++* evVarsOfTerm is used only by TcSimplify.neededEvVars.+* Each EvBindsVar in an et_binds field of an EvFun is /also/ in the+  ic_binds field of an Implication+* So we can track usage via the processing for that implication,+  (see Note [Tracking redundant constraints] in TcSimplify).+  We can ignore usage from the EvFun altogether.++************************************************************************+*                                                                      *+                  Pretty printing+*                                                                      *+************************************************************************+-}++instance Outputable HsWrapper where+  ppr co_fn = pprHsWrapper co_fn (no_parens (text "<>"))++pprHsWrapper :: HsWrapper -> (Bool -> SDoc) -> SDoc+-- With -fprint-typechecker-elaboration, print the wrapper+--   otherwise just print what's inside+-- The pp_thing_inside function takes Bool to say whether+--    it's in a position that needs parens for a non-atomic thing+pprHsWrapper wrap pp_thing_inside+  = sdocWithDynFlags $ \ dflags ->+    if gopt Opt_PrintTypecheckerElaboration dflags+    then help pp_thing_inside wrap False+    else pp_thing_inside False+  where+    help :: (Bool -> SDoc) -> HsWrapper -> Bool -> SDoc+    -- True  <=> appears in function application position+    -- False <=> appears as body of let or lambda+    help it WpHole             = it+    help it (WpCompose f1 f2)  = help (help it f2) f1+    help it (WpFun f1 f2 t1 _) = add_parens $ text "\\(x" <> dcolon <> ppr t1 <> text ")." <+>+                                              help (\_ -> it True <+> help (\_ -> text "x") f1 True) f2 False+    help it (WpCast co)   = add_parens $ sep [it False, nest 2 (text "|>"+                                              <+> pprParendCo co)]+    help it (WpEvApp id)  = no_parens  $ sep [it True, nest 2 (ppr id)]+    help it (WpTyApp ty)  = no_parens  $ sep [it True, text "@" <+> pprParendType ty]+    help it (WpEvLam id)  = add_parens $ sep [ text "\\" <> pprLamBndr id <> dot, it False]+    help it (WpTyLam tv)  = add_parens $ sep [text "/\\" <> pprLamBndr tv <> dot, it False]+    help it (WpLet binds) = add_parens $ sep [text "let" <+> braces (ppr binds), it False]++pprLamBndr :: Id -> SDoc+pprLamBndr v = pprBndr LambdaBind v++add_parens, no_parens :: SDoc -> Bool -> SDoc+add_parens d True  = parens d+add_parens d False = d+no_parens d _ = d++instance Outputable TcEvBinds where+  ppr (TcEvBinds v) = ppr v+  ppr (EvBinds bs)  = text "EvBinds" <> braces (vcat (map ppr (bagToList bs)))++instance Outputable EvBindsVar where+  ppr (EvBindsVar { ebv_uniq = u })+     = text "EvBindsVar" <> angleBrackets (ppr u)+  ppr (CoEvBindsVar { ebv_uniq = u })+     = text "CoEvBindsVar" <> angleBrackets (ppr u)++instance Uniquable EvBindsVar where+  getUnique = ebv_uniq++instance Outputable EvBind where+  ppr (EvBind { eb_lhs = v, eb_rhs = e, eb_is_given = is_given })+     = sep [ pp_gw <+> ppr v+           , nest 2 $ equals <+> ppr e ]+     where+       pp_gw = brackets (if is_given then char 'G' else char 'W')+   -- We cheat a bit and pretend EqVars are CoVars for the purposes of pretty printing++instance Outputable EvTerm where+  ppr (EvExpr e)         = ppr e+  ppr (EvTypeable ty ev) = ppr ev <+> dcolon <+> text "Typeable" <+> ppr ty+  ppr (EvFun { et_tvs = tvs, et_given = gs, et_binds = bs, et_body = w })+      = hang (text "\\" <+> sep (map pprLamBndr (tvs ++ gs)) <+> arrow)+           2 (ppr bs $$ ppr w)   -- Not very pretty++instance Outputable EvCallStack where+  ppr EvCsEmpty+    = text "[]"+  ppr (EvCsPushCall name loc tm)+    = ppr (name,loc) <+> text ":" <+> ppr tm++instance Outputable EvTypeable where+  ppr (EvTypeableTyCon ts _)  = text "TyCon" <+> ppr ts+  ppr (EvTypeableTyApp t1 t2) = parens (ppr t1 <+> ppr t2)+  ppr (EvTypeableTrFun t1 t2) = parens (ppr t1 <+> arrow <+> ppr t2)+  ppr (EvTypeableTyLit t1)    = text "TyLit" <> ppr t1+++----------------------------------------------------------------------+-- Helper functions for dealing with IP newtype-dictionaries+----------------------------------------------------------------------++-- | Create a 'Coercion' that unwraps an implicit-parameter or+-- overloaded-label dictionary to expose the underlying value. We+-- expect the 'Type' to have the form `IP sym ty` or `IsLabel sym ty`,+-- and return a 'Coercion' `co :: IP sym ty ~ ty` or+-- `co :: IsLabel sym ty ~ Proxy# sym -> ty`.  See also+-- Note [Type-checking overloaded labels] in TcExpr.+unwrapIP :: Type -> CoercionR+unwrapIP ty =+  case unwrapNewTyCon_maybe tc of+    Just (_,_,ax) -> mkUnbranchedAxInstCo Representational ax tys []+    Nothing       -> pprPanic "unwrapIP" $+                       text "The dictionary for" <+> quotes (ppr tc)+                         <+> text "is not a newtype!"+  where+  (tc, tys) = splitTyConApp ty++-- | Create a 'Coercion' that wraps a value in an implicit-parameter+-- dictionary. See 'unwrapIP'.+wrapIP :: Type -> CoercionR+wrapIP ty = mkSymCo (unwrapIP ty)
+ compiler/typecheck/TcRnTypes.hs view
@@ -0,0 +1,3918 @@+{-+(c) The University of Glasgow 2006-2012+(c) The GRASP Project, Glasgow University, 1992-2002+++Various types used during typechecking, please see TcRnMonad as well for+operations on these types. You probably want to import it, instead of this+module.++All the monads exported here are built on top of the same IOEnv monad. The+monad functions like a Reader monad in the way it passes the environment+around. This is done to allow the environment to be manipulated in a stack+like fashion when entering expressions... etc.++For state that is global and should be returned at the end (e.g not part+of the stack mechanism), you should use a TcRef (= IORef) to store them.+-}++{-# LANGUAGE CPP, ExistentialQuantification, GeneralizedNewtypeDeriving,+             ViewPatterns #-}++module TcRnTypes(+        TcRnIf, TcRn, TcM, RnM, IfM, IfL, IfG, -- The monad is opaque outside this module+        TcRef,++        -- The environment types+        Env(..),+        TcGblEnv(..), TcLclEnv(..),+        IfGblEnv(..), IfLclEnv(..),+        tcVisibleOrphanMods,++        -- Frontend types (shouldn't really be here)+        FrontendResult(..),++        -- Renamer types+        ErrCtxt, RecFieldEnv,+        ImportAvails(..), emptyImportAvails, plusImportAvails,+        WhereFrom(..), mkModDeps, modDepsElts,++        -- Typechecker types+        TcTypeEnv, TcBinderStack, TcBinder(..),+        TcTyThing(..), PromotionErr(..),+        IdBindingInfo(..), ClosedTypeId, RhsNames,+        IsGroupClosed(..),+        SelfBootInfo(..),+        pprTcTyThingCategory, pprPECategory, CompleteMatch(..),++        -- Desugaring types+        DsM, DsLclEnv(..), DsGblEnv(..),+        DsMetaEnv, DsMetaVal(..), CompleteMatchMap,+        mkCompleteMatchMap, extendCompleteMatchMap,++        -- Template Haskell+        ThStage(..), SpliceType(..), PendingStuff(..),+        topStage, topAnnStage, topSpliceStage,+        ThLevel, impLevel, outerLevel, thLevel,+        ForeignSrcLang(..),++        -- Arrows+        ArrowCtxt(..),++        -- TcSigInfo+        TcSigFun, TcSigInfo(..), TcIdSigInfo(..),+        TcIdSigInst(..), TcPatSynInfo(..),+        isPartialSig, hasCompleteSig,++        -- QCInst+        QCInst(..), isPendingScInst,++        -- Canonical constraints+        Xi, Ct(..), Cts, emptyCts, andCts, andManyCts, pprCts,+        singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList,+        isEmptyCts, isCTyEqCan, isCFunEqCan,+        isPendingScDict, superClassesMightHelp, getPendingWantedScs,+        isCDictCan_Maybe, isCFunEqCan_maybe,+        isCNonCanonical, isWantedCt, isDerivedCt,+        isGivenCt, isHoleCt, isOutOfScopeCt, isExprHoleCt, isTypeHoleCt,+        isUserTypeErrorCt, getUserTypeErrorMsg,+        ctEvidence, ctLoc, setCtLoc, ctPred, ctFlavour, ctEqRel, ctOrigin,+        ctEvId, mkTcEqPredLikeEv,+        mkNonCanonical, mkNonCanonicalCt, mkGivens,+        mkIrredCt, mkInsolubleCt,+        ctEvPred, ctEvLoc, ctEvOrigin, ctEvEqRel,+        ctEvExpr, ctEvTerm, ctEvCoercion, ctEvEvId,+        tyCoVarsOfCt, tyCoVarsOfCts,+        tyCoVarsOfCtList, tyCoVarsOfCtsList,++        WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC,+        isSolvedWC, andWC, unionsWC, mkSimpleWC, mkImplicWC,+        addInsols, insolublesOnly, addSimples, addImplics,+        tyCoVarsOfWC, dropDerivedWC, dropDerivedSimples,+        tyCoVarsOfWCList, insolubleCt, insolubleEqCt,+        isDroppableCt, insolubleImplic,+        arisesFromGivens,++        Implication(..), newImplication, implicationPrototype,+        implicLclEnv, implicDynFlags,+        ImplicStatus(..), isInsolubleStatus, isSolvedStatus,+        SubGoalDepth, initialSubGoalDepth, maxSubGoalDepth,+        bumpSubGoalDepth, subGoalDepthExceeded,+        CtLoc(..), ctLocSpan, ctLocEnv, ctLocLevel, ctLocOrigin,+        ctLocTypeOrKind_maybe,+        ctLocDepth, bumpCtLocDepth, isGivenLoc,+        setCtLocOrigin, updateCtLocOrigin, setCtLocEnv, setCtLocSpan,+        CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,+        isVisibleOrigin, toInvisibleOrigin,+        TypeOrKind(..), isTypeLevel, isKindLevel,+        pprCtOrigin, pprCtLoc,+        pushErrCtxt, pushErrCtxtSameOrigin,+++        SkolemInfo(..), pprSigSkolInfo, pprSkolInfo,++        CtEvidence(..), TcEvDest(..),+        mkKindLoc, toKindLoc, mkGivenLoc,+        isWanted, isGiven, isDerived, isGivenOrWDeriv,+        ctEvRole,++        wrapType, wrapTypeWithImplication,+        removeBindingShadowing,++        -- Constraint solver plugins+        TcPlugin(..), TcPluginResult(..), TcPluginSolver,+        TcPluginM, runTcPluginM, unsafeTcPluginTcM,+        getEvBindsTcPluginM,++        CtFlavour(..), ShadowInfo(..), ctEvFlavour,+        CtFlavourRole, ctEvFlavourRole, ctFlavourRole,+        eqCanRewrite, eqCanRewriteFR, eqMayRewriteFR,+        eqCanDischargeFR,+        funEqCanDischarge, funEqCanDischargeF,++        -- Pretty printing+        pprEvVarTheta,+        pprEvVars, pprEvVarWithType,++        -- Misc other types+        TcId, TcIdSet,+        Hole(..), holeOcc,+        NameShape(..),++        -- Role annotations+        RoleAnnotEnv, emptyRoleAnnotEnv, mkRoleAnnotEnv,+        lookupRoleAnnot, getRoleAnnots,++  ) where++#include "HsVersions.h"++import GhcPrelude++import HsSyn+import CoreSyn+import HscTypes+import TcEvidence+import Type+import Class    ( Class )+import TyCon    ( TyCon, TyConFlavour, tyConKind )+import TyCoRep  ( coHoleCoVar )+import Coercion ( Coercion, mkHoleCo )+import ConLike  ( ConLike(..) )+import DataCon  ( DataCon, dataConUserType, dataConOrigArgTys )+import PatSyn   ( PatSyn, pprPatSynType )+import Id       ( idType, idName )+import FieldLabel ( FieldLabel )+import TcType+import Annotations+import InstEnv+import FamInstEnv+import PmExpr+import IOEnv+import RdrName+import Name+import NameEnv+import NameSet+import Avail+import Var+import FV+import VarEnv+import Module+import SrcLoc+import VarSet+import ErrUtils+import UniqFM+import UniqSupply+import BasicTypes+import Bag+import DynFlags+import Outputable+import ListSetOps+import FastString+import qualified GHC.LanguageExtensions as LangExt+import Fingerprint+import Util+import PrelNames ( isUnboundName )+import CostCentreState++import Control.Monad (ap, liftM, msum)+import qualified Control.Monad.Fail as MonadFail+import Data.Set      ( Set )+import qualified Data.Set as S++import Data.List ( sort )+import Data.Map ( Map )+import Data.Dynamic  ( Dynamic )+import Data.Typeable ( TypeRep )+import Data.Maybe    ( mapMaybe )+import GHCi.Message+import GHCi.RemoteTypes++import qualified Language.Haskell.TH as TH++-- | A 'NameShape' is a substitution on 'Name's that can be used+-- to refine the identities of a hole while we are renaming interfaces+-- (see 'RnModIface').  Specifically, a 'NameShape' for+-- 'ns_module_name' @A@, defines a mapping from @{A.T}@+-- (for some 'OccName' @T@) to some arbitrary other 'Name'.+--+-- The most intruiging thing about a 'NameShape', however, is+-- how it's constructed.  A 'NameShape' is *implied* by the+-- exported 'AvailInfo's of the implementor of an interface:+-- if an implementor of signature @<H>@ exports @M.T@, you implicitly+-- define a substitution from @{H.T}@ to @M.T@.  So a 'NameShape'+-- is computed from the list of 'AvailInfo's that are exported+-- by the implementation of a module, or successively merged+-- together by the export lists of signatures which are joining+-- together.+--+-- It's not the most obvious way to go about doing this, but it+-- does seem to work!+--+-- NB: Can't boot this and put it in NameShape because then we+-- start pulling in too many DynFlags things.+data NameShape = NameShape {+        ns_mod_name :: ModuleName,+        ns_exports :: [AvailInfo],+        ns_map :: OccEnv Name+    }+++{-+************************************************************************+*                                                                      *+               Standard monad definition for TcRn+    All the combinators for the monad can be found in TcRnMonad+*                                                                      *+************************************************************************++The monad itself has to be defined here, because it is mentioned by ErrCtxt+-}++type TcRnIf a b = IOEnv (Env a b)+type TcRn       = TcRnIf TcGblEnv TcLclEnv    -- Type inference+type IfM lcl    = TcRnIf IfGblEnv lcl         -- Iface stuff+type IfG        = IfM ()                      --    Top level+type IfL        = IfM IfLclEnv                --    Nested+type DsM        = TcRnIf DsGblEnv DsLclEnv    -- Desugaring++-- TcRn is the type-checking and renaming monad: the main monad that+-- most type-checking takes place in.  The global environment is+-- 'TcGblEnv', which tracks all of the top-level type-checking+-- information we've accumulated while checking a module, while the+-- local environment is 'TcLclEnv', which tracks local information as+-- we move inside expressions.++-- | Historical "renaming monad" (now it's just 'TcRn').+type RnM  = TcRn++-- | Historical "type-checking monad" (now it's just 'TcRn').+type TcM  = TcRn++-- We 'stack' these envs through the Reader like monad infrastructure+-- as we move into an expression (although the change is focused in+-- the lcl type).+data Env gbl lcl+  = Env {+        env_top  :: !HscEnv, -- Top-level stuff that never changes+                             -- Includes all info about imported things+                             -- BangPattern is to fix leak, see #15111++        env_us   :: {-# UNPACK #-} !(IORef UniqSupply),+                             -- Unique supply for local variables++        env_gbl  :: gbl,     -- Info about things defined at the top level+                             -- of the module being compiled++        env_lcl  :: lcl      -- Nested stuff; changes as we go into+    }++instance ContainsDynFlags (Env gbl lcl) where+    extractDynFlags env = hsc_dflags (env_top env)++instance ContainsModule gbl => ContainsModule (Env gbl lcl) where+    extractModule env = extractModule (env_gbl env)+++{-+************************************************************************+*                                                                      *+                The interface environments+              Used when dealing with IfaceDecls+*                                                                      *+************************************************************************+-}++data IfGblEnv+  = IfGblEnv {+        -- Some information about where this environment came from;+        -- useful for debugging.+        if_doc :: SDoc,+        -- The type environment for the module being compiled,+        -- in case the interface refers back to it via a reference that+        -- was originally a hi-boot file.+        -- We need the module name so we can test when it's appropriate+        -- to look in this env.+        -- See Note [Tying the knot] in TcIface+        if_rec_types :: Maybe (Module, IfG TypeEnv)+                -- Allows a read effect, so it can be in a mutable+                -- variable; c.f. handling the external package type env+                -- Nothing => interactive stuff, no loops possible+    }++data IfLclEnv+  = IfLclEnv {+        -- The module for the current IfaceDecl+        -- So if we see   f = \x -> x+        -- it means M.f = \x -> x, where M is the if_mod+        -- NB: This is a semantic module, see+        -- Note [Identity versus semantic module]+        if_mod :: Module,++        -- Whether or not the IfaceDecl came from a boot+        -- file or not; we'll use this to choose between+        -- NoUnfolding and BootUnfolding+        if_boot :: Bool,++        -- The field is used only for error reporting+        -- if (say) there's a Lint error in it+        if_loc :: SDoc,+                -- Where the interface came from:+                --      .hi file, or GHCi state, or ext core+                -- plus which bit is currently being examined++        if_nsubst :: Maybe NameShape,++        -- This field is used to make sure "implicit" declarations+        -- (anything that cannot be exported in mi_exports) get+        -- wired up correctly in typecheckIfacesForMerging.  Most+        -- of the time it's @Nothing@.  See Note [Resolving never-exported Names in TcIface]+        -- in TcIface.+        if_implicits_env :: Maybe TypeEnv,++        if_tv_env  :: FastStringEnv TyVar,     -- Nested tyvar bindings+        if_id_env  :: FastStringEnv Id         -- Nested id binding+    }++{-+************************************************************************+*                                                                      *+                Desugarer monad+*                                                                      *+************************************************************************++Now the mondo monad magic (yes, @DsM@ is a silly name)---carry around+a @UniqueSupply@ and some annotations, which+presumably include source-file location information:+-}++data DsGblEnv+        = DsGblEnv+        { ds_mod          :: Module             -- For SCC profiling+        , ds_fam_inst_env :: FamInstEnv         -- Like tcg_fam_inst_env+        , ds_unqual  :: PrintUnqualified+        , ds_msgs    :: IORef Messages          -- Warning messages+        , ds_if_env  :: (IfGblEnv, IfLclEnv)    -- Used for looking up global,+                                                -- possibly-imported things+        , ds_complete_matches :: CompleteMatchMap+           -- Additional complete pattern matches+        , ds_cc_st   :: IORef CostCentreState+           -- Tracking indices for cost centre annotations+        }++instance ContainsModule DsGblEnv where+    extractModule = ds_mod++data DsLclEnv = DsLclEnv {+        dsl_meta    :: DsMetaEnv,        -- Template Haskell bindings+        dsl_loc     :: RealSrcSpan,      -- To put in pattern-matching error msgs++        -- See Note [Note [Type and Term Equality Propagation] in Check.hs+        -- These two fields are augmented as we walk inwards,+        -- through each patttern match in turn+        dsl_dicts   :: Bag EvVar,     -- Constraints from GADT pattern-matching+        dsl_tm_cs   :: Bag SimpleEq,  -- Constraints form term-level pattern matching++        dsl_pm_iter :: IORef Int  -- Number of iterations for pmcheck so far+                                  -- We fail if this gets too big+     }++-- Inside [| |] brackets, the desugarer looks+-- up variables in the DsMetaEnv+type DsMetaEnv = NameEnv DsMetaVal++data DsMetaVal+   = DsBound Id         -- Bound by a pattern inside the [| |].+                        -- Will be dynamically alpha renamed.+                        -- The Id has type THSyntax.Var++   | DsSplice (HsExpr GhcTc) -- These bindings are introduced by+                             -- the PendingSplices on a HsBracketOut+++{-+************************************************************************+*                                                                      *+                Global typechecker environment+*                                                                      *+************************************************************************+-}++-- | 'FrontendResult' describes the result of running the+-- frontend of a Haskell module.  Usually, you'll get+-- a 'FrontendTypecheck', since running the frontend involves+-- typechecking a program, but for an hs-boot merge you'll+-- just get a ModIface, since no actual typechecking occurred.+--+-- This data type really should be in HscTypes, but it needs+-- to have a TcGblEnv which is only defined here.+data FrontendResult+        = FrontendTypecheck TcGblEnv++-- Note [Identity versus semantic module]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- When typechecking an hsig file, it is convenient to keep track+-- of two different "this module" identifiers:+--+--      - The IDENTITY module is simply thisPackage + the module+--        name; i.e. it uniquely *identifies* the interface file+--        we're compiling.  For example, p[A=<A>]:A is an+--        identity module identifying the requirement named A+--        from library p.+--+--      - The SEMANTIC module, which is the actual module that+--        this signature is intended to represent (e.g. if+--        we have a identity module p[A=base:Data.IORef]:A,+--        then the semantic module is base:Data.IORef)+--+-- Which one should you use?+--+--      - In the desugarer and later phases of compilation,+--        identity and semantic modules coincide, since we never compile+--        signatures (we just generate blank object files for+--        hsig files.)+--+--        A corrolary of this is that the following invariant holds at any point+--        past desugaring,+--+--            if I have a Module, this_mod, in hand representing the module+--            currently being compiled,+--            then moduleUnitId this_mod == thisPackage dflags+--+--      - For any code involving Names, we want semantic modules.+--        See lookupIfaceTop in IfaceEnv, mkIface and addFingerprints+--        in MkIface, and tcLookupGlobal in TcEnv+--+--      - When reading interfaces, we want the identity module to+--        identify the specific interface we want (such interfaces+--        should never be loaded into the EPS).  However, if a+--        hole module <A> is requested, we look for A.hi+--        in the home library we are compiling.  (See LoadIface.)+--        Similarly, in RnNames we check for self-imports using+--        identity modules, to allow signatures to import their implementor.+--+--      - For recompilation avoidance, you want the identity module,+--        since that will actually say the specific interface you+--        want to track (and recompile if it changes)++-- | 'TcGblEnv' describes the top-level of the module at the+-- point at which the typechecker is finished work.+-- It is this structure that is handed on to the desugarer+-- For state that needs to be updated during the typechecking+-- phase and returned at end, use a 'TcRef' (= 'IORef').+data TcGblEnv+  = TcGblEnv {+        tcg_mod     :: Module,         -- ^ Module being compiled+        tcg_semantic_mod :: Module,    -- ^ If a signature, the backing module+            -- See also Note [Identity versus semantic module]+        tcg_src     :: HscSource,+          -- ^ What kind of module (regular Haskell, hs-boot, hsig)++        tcg_rdr_env :: GlobalRdrEnv,   -- ^ Top level envt; used during renaming+        tcg_default :: Maybe [Type],+          -- ^ Types used for defaulting. @Nothing@ => no @default@ decl++        tcg_fix_env   :: FixityEnv,     -- ^ Just for things in this module+        tcg_field_env :: RecFieldEnv,   -- ^ Just for things in this module+                                        -- See Note [The interactive package] in HscTypes++        tcg_type_env :: TypeEnv,+          -- ^ Global type env for the module we are compiling now.  All+          -- TyCons and Classes (for this module) end up in here right away,+          -- along with their derived constructors, selectors.+          --+          -- (Ids defined in this module start in the local envt, though they+          --  move to the global envt during zonking)+          --+          -- NB: for what "things in this module" means, see+          -- Note [The interactive package] in HscTypes++        tcg_type_env_var :: TcRef TypeEnv,+                -- Used only to initialise the interface-file+                -- typechecker in initIfaceTcRn, so that it can see stuff+                -- bound in this module when dealing with hi-boot recursions+                -- Updated at intervals (e.g. after dealing with types and classes)++        tcg_inst_env     :: !InstEnv,+          -- ^ Instance envt for all /home-package/ modules;+          -- Includes the dfuns in tcg_insts+          -- NB. BangPattern is to fix a leak, see #15111+        tcg_fam_inst_env :: !FamInstEnv, -- ^ Ditto for family instances+          -- NB. BangPattern is to fix a leak, see #15111+        tcg_ann_env      :: AnnEnv,     -- ^ And for annotations++                -- Now a bunch of things about this module that are simply+                -- accumulated, but never consulted until the end.+                -- Nevertheless, it's convenient to accumulate them along+                -- with the rest of the info from this module.+        tcg_exports :: [AvailInfo],     -- ^ What is exported+        tcg_imports :: ImportAvails,+          -- ^ Information about what was imported from where, including+          -- things bound in this module. Also store Safe Haskell info+          -- here about transitive trusted package requirements.+          --+          -- There are not many uses of this field, so you can grep for+          -- all them.+          --+          -- The ImportAvails records information about the following+          -- things:+          --+          --    1. All of the modules you directly imported (tcRnImports)+          --    2. The orphans (only!) of all imported modules in a GHCi+          --       session (runTcInteractive)+          --    3. The module that instantiated a signature+          --    4. Each of the signatures that merged in+          --+          -- It is used in the following ways:+          --    - imp_orphs is used to determine what orphan modules should be+          --      visible in the context (tcVisibleOrphanMods)+          --    - imp_finsts is used to determine what family instances should+          --      be visible (tcExtendLocalFamInstEnv)+          --    - To resolve the meaning of the export list of a module+          --      (tcRnExports)+          --    - imp_mods is used to compute usage info (mkIfaceTc, deSugar)+          --    - imp_trust_own_pkg is used for Safe Haskell in interfaces+          --      (mkIfaceTc, as well as in HscMain)+          --    - To create the Dependencies field in interface (mkDependencies)++        tcg_dus       :: DefUses,   -- ^ What is defined in this module and what is used.+        tcg_used_gres :: TcRef [GlobalRdrElt],  -- ^ Records occurrences of imported entities+          -- One entry for each occurrence; but may have different GREs for+          -- the same Name See Note [Tracking unused binding and imports]++        tcg_keep :: TcRef NameSet,+          -- ^ Locally-defined top-level names to keep alive.+          --+          -- "Keep alive" means give them an Exported flag, so that the+          -- simplifier does not discard them as dead code, and so that they+          -- are exposed in the interface file (but not to export to the+          -- user).+          --+          -- Some things, like dict-fun Ids and default-method Ids are "born"+          -- with the Exported flag on, for exactly the above reason, but some+          -- we only discover as we go.  Specifically:+          --+          --   * The to/from functions for generic data types+          --+          --   * Top-level variables appearing free in the RHS of an orphan+          --     rule+          --+          --   * Top-level variables appearing free in a TH bracket++        tcg_th_used :: TcRef Bool,+          -- ^ @True@ <=> Template Haskell syntax used.+          --+          -- We need this so that we can generate a dependency on the+          -- Template Haskell package, because the desugarer is going+          -- to emit loads of references to TH symbols.  The reference+          -- is implicit rather than explicit, so we have to zap a+          -- mutable variable.++        tcg_th_splice_used :: TcRef Bool,+          -- ^ @True@ <=> A Template Haskell splice was used.+          --+          -- Splices disable recompilation avoidance (see #481)++        tcg_th_top_level_locs :: TcRef (Set RealSrcSpan),+          -- ^ Locations of the top-level splices; used for providing details on+          -- scope in error messages for out-of-scope variables++        tcg_dfun_n  :: TcRef OccSet,+          -- ^ Allows us to choose unique DFun names.++        tcg_merged :: [(Module, Fingerprint)],+          -- ^ The requirements we merged with; we always have to recompile+          -- if any of these changed.++        -- The next fields accumulate the payload of the module+        -- The binds, rules and foreign-decl fields are collected+        -- initially in un-zonked form and are finally zonked in tcRnSrcDecls++        tcg_rn_exports :: Maybe [(Located (IE GhcRn), Avails)],+                -- Nothing <=> no explicit export list+                -- Is always Nothing if we don't want to retain renamed+                -- exports.+                -- If present contains each renamed export list item+                -- together with its exported names.++        tcg_rn_imports :: [LImportDecl GhcRn],+                -- Keep the renamed imports regardless.  They are not+                -- voluminous and are needed if you want to report unused imports++        tcg_rn_decls :: Maybe (HsGroup GhcRn),+          -- ^ Renamed decls, maybe.  @Nothing@ <=> Don't retain renamed+          -- decls.++        tcg_dependent_files :: TcRef [FilePath], -- ^ dependencies from addDependentFile++        tcg_th_topdecls :: TcRef [LHsDecl GhcPs],+        -- ^ Top-level declarations from addTopDecls++        tcg_th_foreign_files :: TcRef [(ForeignSrcLang, FilePath)],+        -- ^ Foreign files emitted from TH.++        tcg_th_topnames :: TcRef NameSet,+        -- ^ Exact names bound in top-level declarations in tcg_th_topdecls++        tcg_th_modfinalizers :: TcRef [(TcLclEnv, ThModFinalizers)],+        -- ^ Template Haskell module finalizers.+        --+        -- They can use particular local environments.++        tcg_th_coreplugins :: TcRef [String],+        -- ^ Core plugins added by Template Haskell code.++        tcg_th_state :: TcRef (Map TypeRep Dynamic),+        tcg_th_remote_state :: TcRef (Maybe (ForeignRef (IORef QState))),+        -- ^ Template Haskell state++        tcg_ev_binds  :: Bag EvBind,        -- Top-level evidence bindings++        -- Things defined in this module, or (in GHCi)+        -- in the declarations for a single GHCi command.+        -- For the latter, see Note [The interactive package] in HscTypes+        tcg_tr_module :: Maybe Id,   -- Id for $trModule :: GHC.Types.Module+                                             -- for which every module has a top-level defn+                                             -- except in GHCi in which case we have Nothing+        tcg_binds     :: LHsBinds GhcTc,     -- Value bindings in this module+        tcg_sigs      :: NameSet,            -- ...Top-level names that *lack* a signature+        tcg_imp_specs :: [LTcSpecPrag],      -- ...SPECIALISE prags for imported Ids+        tcg_warns     :: Warnings,           -- ...Warnings and deprecations+        tcg_anns      :: [Annotation],       -- ...Annotations+        tcg_tcs       :: [TyCon],            -- ...TyCons and Classes+        tcg_insts     :: [ClsInst],          -- ...Instances+        tcg_fam_insts :: [FamInst],          -- ...Family instances+        tcg_rules     :: [LRuleDecl GhcTc],  -- ...Rules+        tcg_fords     :: [LForeignDecl GhcTc], -- ...Foreign import & exports+        tcg_patsyns   :: [PatSyn],            -- ...Pattern synonyms++        tcg_doc_hdr   :: Maybe LHsDocString, -- ^ Maybe Haddock header docs+        tcg_hpc       :: !AnyHpcUsage,       -- ^ @True@ if any part of the+                                             --  prog uses hpc instrumentation.+           -- NB. BangPattern is to fix a leak, see #15111++        tcg_self_boot :: SelfBootInfo,       -- ^ Whether this module has a+                                             -- corresponding hi-boot file++        tcg_main      :: Maybe Name,         -- ^ The Name of the main+                                             -- function, if this module is+                                             -- the main module.++        tcg_safeInfer :: TcRef (Bool, WarningMessages),+        -- ^ Has the typechecker inferred this module as -XSafe (Safe Haskell)+        -- See Note [Safe Haskell Overlapping Instances Implementation],+        -- although this is used for more than just that failure case.++        tcg_tc_plugins :: [TcPluginSolver],+        -- ^ A list of user-defined plugins for the constraint solver.++        tcg_top_loc :: RealSrcSpan,+        -- ^ The RealSrcSpan this module came from++        tcg_static_wc :: TcRef WantedConstraints,+          -- ^ Wanted constraints of static forms.+        -- See Note [Constraints in static forms].+        tcg_complete_matches :: [CompleteMatch],++        -- ^ Tracking indices for cost centre annotations+        tcg_cc_st   :: TcRef CostCentreState+    }++-- NB: topModIdentity, not topModSemantic!+-- Definition sites of orphan identities will be identity modules, not semantic+-- modules.++-- Note [Constraints in static forms]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- When a static form produces constraints like+--+-- f :: StaticPtr (Bool -> String)+-- f = static show+--+-- we collect them in tcg_static_wc and resolve them at the end+-- of type checking. They need to be resolved separately because+-- we don't want to resolve them in the context of the enclosing+-- expression. Consider+--+-- g :: Show a => StaticPtr (a -> String)+-- g = static show+--+-- If the @Show a0@ constraint that the body of the static form produces was+-- resolved in the context of the enclosing expression, then the body of the+-- static form wouldn't be closed because the Show dictionary would come from+-- g's context instead of coming from the top level.++tcVisibleOrphanMods :: TcGblEnv -> ModuleSet+tcVisibleOrphanMods tcg_env+    = mkModuleSet (tcg_mod tcg_env : imp_orphs (tcg_imports tcg_env))++instance ContainsModule TcGblEnv where+    extractModule env = tcg_semantic_mod env++type RecFieldEnv = NameEnv [FieldLabel]+        -- Maps a constructor name *in this module*+        -- to the fields for that constructor.+        -- This is used when dealing with ".." notation in record+        -- construction and pattern matching.+        -- The FieldEnv deals *only* with constructors defined in *this*+        -- module.  For imported modules, we get the same info from the+        -- TypeEnv++data SelfBootInfo+  = NoSelfBoot    -- No corresponding hi-boot file+  | SelfBoot+       { sb_mds :: ModDetails   -- There was a hi-boot file,+       , sb_tcs :: NameSet }    -- defining these TyCons,+-- What is sb_tcs used for?  See Note [Extra dependencies from .hs-boot files]+-- in RnSource+++{- Note [Tracking unused binding and imports]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We gather two sorts of usage information++ * tcg_dus (defs/uses)+      Records *defined* Names (local, top-level)+          and *used*    Names (local or imported)++      Used (a) to report "defined but not used"+               (see RnNames.reportUnusedNames)+           (b) to generate version-tracking usage info in interface+               files (see MkIface.mkUsedNames)+   This usage info is mainly gathered by the renamer's+   gathering of free-variables++ * tcg_used_gres+      Used only to report unused import declarations++      Records each *occurrence* an *imported* (not locally-defined) entity.+      The occurrence is recorded by keeping a GlobalRdrElt for it.+      These is not the GRE that is in the GlobalRdrEnv; rather it+      is recorded *after* the filtering done by pickGREs.  So it reflect+      /how that occurrence is in scope/.   See Note [GRE filtering] in+      RdrName.+++************************************************************************+*                                                                      *+                The local typechecker environment+*                                                                      *+************************************************************************++Note [The Global-Env/Local-Env story]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+During type checking, we keep in the tcg_type_env+        * All types and classes+        * All Ids derived from types and classes (constructors, selectors)++At the end of type checking, we zonk the local bindings,+and as we do so we add to the tcg_type_env+        * Locally defined top-level Ids++Why?  Because they are now Ids not TcIds.  This final GlobalEnv is+        a) fed back (via the knot) to typechecking the+           unfoldings of interface signatures+        b) used in the ModDetails of this module+-}++data TcLclEnv           -- Changes as we move inside an expression+                        -- Discarded after typecheck/rename; not passed on to desugarer+  = TcLclEnv {+        tcl_loc        :: RealSrcSpan,     -- Source span+        tcl_ctxt       :: [ErrCtxt],       -- Error context, innermost on top+        tcl_tclvl      :: TcLevel,         -- Birthplace for new unification variables++        tcl_th_ctxt    :: ThStage,         -- Template Haskell context+        tcl_th_bndrs   :: ThBindEnv,       -- and binder info+            -- The ThBindEnv records the TH binding level of in-scope Names+            -- defined in this module (not imported)+            -- We can't put this info in the TypeEnv because it's needed+            -- (and extended) in the renamer, for untyed splices++        tcl_arrow_ctxt :: ArrowCtxt,       -- Arrow-notation context++        tcl_rdr :: LocalRdrEnv,         -- Local name envt+                -- Maintained during renaming, of course, but also during+                -- type checking, solely so that when renaming a Template-Haskell+                -- splice we have the right environment for the renamer.+                --+                --   Does *not* include global name envt; may shadow it+                --   Includes both ordinary variables and type variables;+                --   they are kept distinct because tyvar have a different+                --   occurrence constructor (Name.TvOcc)+                -- We still need the unsullied global name env so that+                --   we can look up record field names++        tcl_env  :: TcTypeEnv,    -- The local type environment:+                                  -- Ids and TyVars defined in this module++        tcl_bndrs :: TcBinderStack,   -- Used for reporting relevant bindings,+                                      -- and for tidying types++        tcl_tyvars :: TcRef TcTyVarSet, -- The "global tyvars"+                        -- Namely, the in-scope TyVars bound in tcl_env,+                        -- plus the tyvars mentioned in the types of Ids bound+                        -- in tcl_lenv.+                        -- Why mutable? see notes with tcGetGlobalTyCoVars++        tcl_lie  :: TcRef WantedConstraints,    -- Place to accumulate type constraints+        tcl_errs :: TcRef Messages              -- Place to accumulate errors+    }++type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, MsgDoc))+        -- Monadic so that we have a chance+        -- to deal with bound type variables just before error+        -- message construction++        -- Bool:  True <=> this is a landmark context; do not+        --                 discard it when trimming for display++type TcTypeEnv = NameEnv TcTyThing++type ThBindEnv = NameEnv (TopLevelFlag, ThLevel)+   -- Domain = all Ids bound in this module (ie not imported)+   -- The TopLevelFlag tells if the binding is syntactically top level.+   -- We need to know this, because the cross-stage persistence story allows+   -- cross-stage at arbitrary types if the Id is bound at top level.+   --+   -- Nota bene: a ThLevel of 'outerLevel' is *not* the same as being+   -- bound at top level!  See Note [Template Haskell levels] in TcSplice++{- Note [Given Insts]+   ~~~~~~~~~~~~~~~~~~+Because of GADTs, we have to pass inwards the Insts provided by type signatures+and existential contexts. Consider+        data T a where { T1 :: b -> b -> T [b] }+        f :: Eq a => T a -> Bool+        f (T1 x y) = [x]==[y]++The constructor T1 binds an existential variable 'b', and we need Eq [b].+Well, we have it, because Eq a refines to Eq [b], but we can only spot that if we+pass it inwards.++-}++-- | Type alias for 'IORef'; the convention is we'll use this for mutable+-- bits of data in 'TcGblEnv' which are updated during typechecking and+-- returned at the end.+type TcRef a     = IORef a+-- ToDo: when should I refer to it as a 'TcId' instead of an 'Id'?+type TcId        = Id+type TcIdSet     = IdSet++---------------------------+-- The TcBinderStack+---------------------------++type TcBinderStack = [TcBinder]+   -- This is a stack of locally-bound ids and tyvars,+   --   innermost on top+   -- Used only in error reporting (relevantBindings in TcError),+   --   and in tidying+   -- We can't use the tcl_env type environment, because it doesn't+   --   keep track of the nesting order++data TcBinder+  = TcIdBndr+       TcId+       TopLevelFlag    -- Tells whether the binding is syntactically top-level+                       -- (The monomorphic Ids for a recursive group count+                       --  as not-top-level for this purpose.)++  | TcIdBndr_ExpType  -- Variant that allows the type to be specified as+                      -- an ExpType+       Name+       ExpType+       TopLevelFlag++  | TcTvBndr          -- e.g.   case x of P (y::a) -> blah+       Name           -- We bind the lexical name "a" to the type of y,+       TyVar          -- which might be an utterly different (perhaps+                      -- existential) tyvar++instance Outputable TcBinder where+   ppr (TcIdBndr id top_lvl)           = ppr id <> brackets (ppr top_lvl)+   ppr (TcIdBndr_ExpType id _ top_lvl) = ppr id <> brackets (ppr top_lvl)+   ppr (TcTvBndr name tv)              = ppr name <+> ppr tv++instance HasOccName TcBinder where+    occName (TcIdBndr id _)             = occName (idName id)+    occName (TcIdBndr_ExpType name _ _) = occName name+    occName (TcTvBndr name _)           = occName name++-- fixes #12177+-- Builds up a list of bindings whose OccName has not been seen before+-- i.e., If    ys  = removeBindingShadowing xs+-- then+--  - ys is obtained from xs by deleting some elements+--  - ys has no duplicate OccNames+--  - The first duplicated OccName in xs is retained in ys+-- Overloaded so that it can be used for both GlobalRdrElt in typed-hole+-- substitutions and TcBinder when looking for relevant bindings.+removeBindingShadowing :: HasOccName a => [a] -> [a]+removeBindingShadowing bindings = reverse $ fst $ foldl+    (\(bindingAcc, seenNames) binding ->+    if occName binding `elemOccSet` seenNames -- if we've seen it+        then (bindingAcc, seenNames)              -- skip it+        else (binding:bindingAcc, extendOccSet seenNames (occName binding)))+    ([], emptyOccSet) bindings++---------------------------+-- Template Haskell stages and levels+---------------------------++data SpliceType = Typed | Untyped++data ThStage    -- See Note [Template Haskell state diagram] in TcSplice+  = Splice SpliceType -- Inside a top-level splice+                      -- This code will be run *at compile time*;+                      --   the result replaces the splice+                      -- Binding level = 0++  | RunSplice (TcRef [ForeignRef (TH.Q ())])+      -- Set when running a splice, i.e. NOT when renaming or typechecking the+      -- Haskell code for the splice. See Note [RunSplice ThLevel].+      --+      -- Contains a list of mod finalizers collected while executing the splice.+      --+      -- 'addModFinalizer' inserts finalizers here, and from here they are taken+      -- to construct an @HsSpliced@ annotation for untyped splices. See Note+      -- [Delaying modFinalizers in untyped splices] in "RnSplice".+      --+      -- For typed splices, the typechecker takes finalizers from here and+      -- inserts them in the list of finalizers in the global environment.+      --+      -- See Note [Collecting modFinalizers in typed splices] in "TcSplice".++  | Comp        -- Ordinary Haskell code+                -- Binding level = 1++  | Brack                       -- Inside brackets+      ThStage                   --   Enclosing stage+      PendingStuff++data PendingStuff+  = RnPendingUntyped              -- Renaming the inside of an *untyped* bracket+      (TcRef [PendingRnSplice])   -- Pending splices in here++  | RnPendingTyped                -- Renaming the inside of a *typed* bracket++  | TcPending                     -- Typechecking the inside of a typed bracket+      (TcRef [PendingTcSplice])   --   Accumulate pending splices here+      (TcRef WantedConstraints)   --     and type constraints here++topStage, topAnnStage, topSpliceStage :: ThStage+topStage       = Comp+topAnnStage    = Splice Untyped+topSpliceStage = Splice Untyped++instance Outputable ThStage where+   ppr (Splice _)    = text "Splice"+   ppr (RunSplice _) = text "RunSplice"+   ppr Comp          = text "Comp"+   ppr (Brack s _)   = text "Brack" <> parens (ppr s)++type ThLevel = Int+    -- NB: see Note [Template Haskell levels] in TcSplice+    -- Incremented when going inside a bracket,+    -- decremented when going inside a splice+    -- NB: ThLevel is one greater than the 'n' in Fig 2 of the+    --     original "Template meta-programming for Haskell" paper++impLevel, outerLevel :: ThLevel+impLevel = 0    -- Imported things; they can be used inside a top level splice+outerLevel = 1  -- Things defined outside brackets++thLevel :: ThStage -> ThLevel+thLevel (Splice _)    = 0+thLevel (RunSplice _) =+    -- See Note [RunSplice ThLevel].+    panic "thLevel: called when running a splice"+thLevel Comp          = 1+thLevel (Brack s _)   = thLevel s + 1++{- Node [RunSplice ThLevel]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The 'RunSplice' stage is set when executing a splice, and only when running a+splice. In particular it is not set when the splice is renamed or typechecked.++'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert+the finalizer (see Note [Delaying modFinalizers in untyped splices]), and+'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to+set 'RunSplice' when renaming or typechecking the splice, where 'Splice', +'Brack' or 'Comp' are used instead.++-}++---------------------------+-- Arrow-notation context+---------------------------++{- Note [Escaping the arrow scope]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In arrow notation, a variable bound by a proc (or enclosed let/kappa)+is not in scope to the left of an arrow tail (-<) or the head of (|..|).+For example++        proc x -> (e1 -< e2)++Here, x is not in scope in e1, but it is in scope in e2.  This can get+a bit complicated:++        let x = 3 in+        proc y -> (proc z -> e1) -< e2++Here, x and z are in scope in e1, but y is not.++We implement this by+recording the environment when passing a proc (using newArrowScope),+and returning to that (using escapeArrowScope) on the left of -< and the+head of (|..|).++All this can be dealt with by the *renamer*. But the type checker needs+to be involved too.  Example (arrowfail001)+  class Foo a where foo :: a -> ()+  data Bar = forall a. Foo a => Bar a+  get :: Bar -> ()+  get = proc x -> case x of Bar a -> foo -< a+Here the call of 'foo' gives rise to a (Foo a) constraint that should not+be captured by the pattern match on 'Bar'.  Rather it should join the+constraints from further out.  So we must capture the constraint bag+from further out in the ArrowCtxt that we push inwards.+-}++data ArrowCtxt   -- Note [Escaping the arrow scope]+  = NoArrowCtxt+  | ArrowCtxt LocalRdrEnv (TcRef WantedConstraints)+++---------------------------+-- TcTyThing+---------------------------++-- | A typecheckable thing available in a local context.  Could be+-- 'AGlobal' 'TyThing', but also lexically scoped variables, etc.+-- See 'TcEnv' for how to retrieve a 'TyThing' given a 'Name'.+data TcTyThing+  = AGlobal TyThing             -- Used only in the return type of a lookup++  | ATcId           -- Ids defined in this module; may not be fully zonked+      { tct_id   :: TcId+      , tct_info :: IdBindingInfo   -- See Note [Meaning of IdBindingInfo]+      }++  | ATyVar  Name TcTyVar   -- See Note [Type variables in the type environment]++  | ATcTyCon TyCon   -- Used temporarily, during kind checking, for the+                     -- tycons and clases in this recursive group+                     -- The TyCon is always a TcTyCon.  Its kind+                     -- can be a mono-kind or a poly-kind; in TcTyClsDcls see+                     -- Note [Type checking recursive type and class declarations]++  | APromotionErr PromotionErr++data PromotionErr+  = TyConPE          -- TyCon used in a kind before we are ready+                     --     data T :: T -> * where ...+  | ClassPE          -- Ditto Class++  | FamDataConPE     -- Data constructor for a data family+                     -- See Note [AFamDataCon: not promoting data family constructors]+                     -- in TcEnv.+  | ConstrainedDataConPE PredType+                     -- Data constructor with a non-equality context+                     -- See Note [Don't promote data constructors with+                     --           non-equality contexts] in TcHsType+  | PatSynPE         -- Pattern synonyms+                     -- See Note [Don't promote pattern synonyms] in TcEnv++  | RecDataConPE     -- Data constructor in a recursive loop+                     -- See Note [Recursion and promoting data constructors] in TcTyClsDecls+  | NoDataKindsTC    -- -XDataKinds not enabled (for a tycon)+  | NoDataKindsDC    -- -XDataKinds not enabled (for a datacon)++instance Outputable TcTyThing where     -- Debugging only+   ppr (AGlobal g)      = ppr g+   ppr elt@(ATcId {})   = text "Identifier" <>+                          brackets (ppr (tct_id elt) <> dcolon+                                 <> ppr (varType (tct_id elt)) <> comma+                                 <+> ppr (tct_info elt))+   ppr (ATyVar n tv)    = text "Type variable" <+> quotes (ppr n) <+> equals <+> ppr tv+                            <+> dcolon <+> ppr (varType tv)+   ppr (ATcTyCon tc)    = text "ATcTyCon" <+> ppr tc <+> dcolon <+> ppr (tyConKind tc)+   ppr (APromotionErr err) = text "APromotionErr" <+> ppr err++-- | IdBindingInfo describes how an Id is bound.+--+-- It is used for the following purposes:+-- a) for static forms in TcExpr.checkClosedInStaticForm and+-- b) to figure out when a nested binding can be generalised,+--    in TcBinds.decideGeneralisationPlan.+--+data IdBindingInfo -- See Note [Meaning of IdBindingInfo and ClosedTypeId]+    = NotLetBound+    | ClosedLet+    | NonClosedLet+         RhsNames        -- Used for (static e) checks only+         ClosedTypeId    -- Used for generalisation checks+                         -- and for (static e) checks++-- | IsGroupClosed describes a group of mutually-recursive bindings+data IsGroupClosed+  = IsGroupClosed+      (NameEnv RhsNames)  -- Free var info for the RHS of each binding in the goup+                          -- Used only for (static e) checks++      ClosedTypeId        -- True <=> all the free vars of the group are+                          --          imported or ClosedLet or+                          --          NonClosedLet with ClosedTypeId=True.+                          --          In particular, no tyvars, no NotLetBound++type RhsNames = NameSet   -- Names of variables, mentioned on the RHS of+                          -- a definition, that are not Global or ClosedLet++type ClosedTypeId = Bool+  -- See Note [Meaning of IdBindingInfo and ClosedTypeId]++{- Note [Meaning of IdBindingInfo]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+NotLetBound means that+  the Id is not let-bound (e.g. it is bound in a+  lambda-abstraction or in a case pattern)++ClosedLet means that+   - The Id is let-bound,+   - Any free term variables are also Global or ClosedLet+   - Its type has no free variables (NB: a top-level binding subject+     to the MR might have free vars in its type)+   These ClosedLets can definitely be floated to top level; and we+   may need to do so for static forms.++   Property:   ClosedLet+             is equivalent to+               NonClosedLet emptyNameSet True++(NonClosedLet (fvs::RhsNames) (cl::ClosedTypeId)) means that+   - The Id is let-bound++   - The fvs::RhsNames contains the free names of the RHS,+     excluding Global and ClosedLet ones.++   - For the ClosedTypeId field see Note [Bindings with closed types]++For (static e) to be valid, we need for every 'x' free in 'e',+that x's binding is floatable to the top level.  Specifically:+   * x's RhsNames must be empty+   * x's type has no free variables+See Note [Grand plan for static forms] in StaticPtrTable.hs.+This test is made in TcExpr.checkClosedInStaticForm.+Actually knowing x's RhsNames (rather than just its emptiness+or otherwise) is just so we can produce better error messages++Note [Bindings with closed types: ClosedTypeId]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider++  f x = let g ys = map not ys+        in ...++Can we generalise 'g' under the OutsideIn algorithm?  Yes,+because all g's free variables are top-level; that is they themselves+have no free type variables, and it is the type variables in the+environment that makes things tricky for OutsideIn generalisation.++Here's the invariant:+   If an Id has ClosedTypeId=True (in its IdBindingInfo), then+   the Id's type is /definitely/ closed (has no free type variables).+   Specifically,+       a) The Id's acutal type is closed (has no free tyvars)+       b) Either the Id has a (closed) user-supplied type signature+          or all its free variables are Global/ClosedLet+             or NonClosedLet with ClosedTypeId=True.+          In particular, none are NotLetBound.++Why is (b) needed?   Consider+    \x. (x :: Int, let y = x+1 in ...)+Initially x::alpha.  If we happen to typecheck the 'let' before the+(x::Int), y's type will have a free tyvar; but if the other way round+it won't.  So we treat any let-bound variable with a free+non-let-bound variable as not ClosedTypeId, regardless of what the+free vars of its type actually are.++But if it has a signature, all is well:+   \x. ...(let { y::Int; y = x+1 } in+           let { v = y+2 } in ...)...+Here the signature on 'v' makes 'y' a ClosedTypeId, so we can+generalise 'v'.++Note that:++  * A top-level binding may not have ClosedTypeId=True, if it suffers+    from the MR++  * A nested binding may be closed (eg 'g' in the example we started+    with). Indeed, that's the point; whether a function is defined at+    top level or nested is orthogonal to the question of whether or+    not it is closed.++  * A binding may be non-closed because it mentions a lexically scoped+    *type variable*  Eg+        f :: forall a. blah+        f x = let g y = ...(y::a)...++Under OutsideIn we are free to generalise an Id all of whose free+variables have ClosedTypeId=True (or imported).  This is an extension+compared to the JFP paper on OutsideIn, which used "top-level" as a+proxy for "closed".  (It's not a good proxy anyway -- the MR can make+a top-level binding with a free type variable.)++Note [Type variables in the type environment]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The type environment has a binding for each lexically-scoped+type variable that is in scope.  For example++  f :: forall a. a -> a+  f x = (x :: a)++  g1 :: [a] -> a+  g1 (ys :: [b]) = head ys :: b++  g2 :: [Int] -> Int+  g2 (ys :: [c]) = head ys :: c++* The forall'd variable 'a' in the signature scopes over f's RHS.++* The pattern-bound type variable 'b' in 'g1' scopes over g1's+  RHS; note that it is bound to a skolem 'a' which is not itself+  lexically in scope.++* The pattern-bound type variable 'c' in 'g2' is bound to+  Int; that is, pattern-bound type variables can stand for+  arbitrary types. (see+    GHC proposal #128 "Allow ScopedTypeVariables to refer to types"+    https://github.com/ghc-proposals/ghc-proposals/pull/128,+  and the paper+    "Type variables in patterns", Haskell Symposium 2018.+++This is implemented by the constructor+   ATyVar Name TcTyVar+in the type environment.++* The Name is the name of the original, lexically scoped type+  variable++* The TcTyVar is sometimes a skolem (like in 'f'), and sometimes+  a unification variable (like in 'g1', 'g2').  We never zonk the+  type environment so in the latter case it always stays as a+  unification variable, although that variable may be later+  unified with a type (such as Int in 'g2').+-}++instance Outputable IdBindingInfo where+  ppr NotLetBound = text "NotLetBound"+  ppr ClosedLet = text "TopLevelLet"+  ppr (NonClosedLet fvs closed_type) =+    text "TopLevelLet" <+> ppr fvs <+> ppr closed_type++instance Outputable PromotionErr where+  ppr ClassPE                     = text "ClassPE"+  ppr TyConPE                     = text "TyConPE"+  ppr PatSynPE                    = text "PatSynPE"+  ppr FamDataConPE                = text "FamDataConPE"+  ppr (ConstrainedDataConPE pred) = text "ConstrainedDataConPE"+                                      <+> parens (ppr pred)+  ppr RecDataConPE                = text "RecDataConPE"+  ppr NoDataKindsTC               = text "NoDataKindsTC"+  ppr NoDataKindsDC               = text "NoDataKindsDC"++pprTcTyThingCategory :: TcTyThing -> SDoc+pprTcTyThingCategory (AGlobal thing)    = pprTyThingCategory thing+pprTcTyThingCategory (ATyVar {})        = text "Type variable"+pprTcTyThingCategory (ATcId {})         = text "Local identifier"+pprTcTyThingCategory (ATcTyCon {})     = text "Local tycon"+pprTcTyThingCategory (APromotionErr pe) = pprPECategory pe++pprPECategory :: PromotionErr -> SDoc+pprPECategory ClassPE                = text "Class"+pprPECategory TyConPE                = text "Type constructor"+pprPECategory PatSynPE               = text "Pattern synonym"+pprPECategory FamDataConPE           = text "Data constructor"+pprPECategory ConstrainedDataConPE{} = text "Data constructor"+pprPECategory RecDataConPE           = text "Data constructor"+pprPECategory NoDataKindsTC          = text "Type constructor"+pprPECategory NoDataKindsDC          = text "Data constructor"++{-+************************************************************************+*                                                                      *+        Operations over ImportAvails+*                                                                      *+************************************************************************+-}++-- | 'ImportAvails' summarises what was imported from where, irrespective of+-- whether the imported things are actually used or not.  It is used:+--+--  * when processing the export list,+--+--  * when constructing usage info for the interface file,+--+--  * to identify the list of directly imported modules for initialisation+--    purposes and for optimised overlap checking of family instances,+--+--  * when figuring out what things are really unused+--+data ImportAvails+   = ImportAvails {+        imp_mods :: ImportedMods,+          --      = ModuleEnv [ImportedModsVal],+          -- ^ Domain is all directly-imported modules+          --+          -- See the documentation on ImportedModsVal in HscTypes for the+          -- meaning of the fields.+          --+          -- We need a full ModuleEnv rather than a ModuleNameEnv here,+          -- because we might be importing modules of the same name from+          -- different packages. (currently not the case, but might be in the+          -- future).++        imp_dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface),+          -- ^ Home-package modules needed by the module being compiled+          --+          -- It doesn't matter whether any of these dependencies+          -- are actually /used/ when compiling the module; they+          -- are listed if they are below it at all.  For+          -- example, suppose M imports A which imports X.  Then+          -- compiling M might not need to consult X.hi, but X+          -- is still listed in M's dependencies.++        imp_dep_pkgs :: Set InstalledUnitId,+          -- ^ Packages needed by the module being compiled, whether directly,+          -- or via other modules in this package, or via modules imported+          -- from other packages.++        imp_trust_pkgs :: Set InstalledUnitId,+          -- ^ This is strictly a subset of imp_dep_pkgs and records the+          -- packages the current module needs to trust for Safe Haskell+          -- compilation to succeed. A package is required to be trusted if+          -- we are dependent on a trustworthy module in that package.+          -- While perhaps making imp_dep_pkgs a tuple of (UnitId, Bool)+          -- where True for the bool indicates the package is required to be+          -- trusted is the more logical  design, doing so complicates a lot+          -- of code not concerned with Safe Haskell.+          -- See Note [RnNames . Tracking Trust Transitively]++        imp_trust_own_pkg :: Bool,+          -- ^ Do we require that our own package is trusted?+          -- This is to handle efficiently the case where a Safe module imports+          -- a Trustworthy module that resides in the same package as it.+          -- See Note [RnNames . Trust Own Package]++        imp_orphs :: [Module],+          -- ^ Orphan modules below us in the import tree (and maybe including+          -- us for imported modules)++        imp_finsts :: [Module]+          -- ^ Family instance modules below us in the import tree (and maybe+          -- including us for imported modules)+      }++mkModDeps :: [(ModuleName, IsBootInterface)]+          -> ModuleNameEnv (ModuleName, IsBootInterface)+mkModDeps deps = foldl' add emptyUFM deps+               where+                 add env elt@(m,_) = addToUFM env m elt++modDepsElts+  :: ModuleNameEnv (ModuleName, IsBootInterface)+  -> [(ModuleName, IsBootInterface)]+modDepsElts = sort . nonDetEltsUFM+  -- It's OK to use nonDetEltsUFM here because sorting by module names+  -- restores determinism++emptyImportAvails :: ImportAvails+emptyImportAvails = ImportAvails { imp_mods          = emptyModuleEnv,+                                   imp_dep_mods      = emptyUFM,+                                   imp_dep_pkgs      = S.empty,+                                   imp_trust_pkgs    = S.empty,+                                   imp_trust_own_pkg = False,+                                   imp_orphs         = [],+                                   imp_finsts        = [] }++-- | Union two ImportAvails+--+-- This function is a key part of Import handling, basically+-- for each import we create a separate ImportAvails structure+-- and then union them all together with this function.+plusImportAvails ::  ImportAvails ->  ImportAvails ->  ImportAvails+plusImportAvails+  (ImportAvails { imp_mods = mods1,+                  imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1,+                  imp_trust_pkgs = tpkgs1, imp_trust_own_pkg = tself1,+                  imp_orphs = orphs1, imp_finsts = finsts1 })+  (ImportAvails { imp_mods = mods2,+                  imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,+                  imp_trust_pkgs = tpkgs2, imp_trust_own_pkg = tself2,+                  imp_orphs = orphs2, imp_finsts = finsts2 })+  = ImportAvails { imp_mods          = plusModuleEnv_C (++) mods1 mods2,+                   imp_dep_mods      = plusUFM_C plus_mod_dep dmods1 dmods2,+                   imp_dep_pkgs      = dpkgs1 `S.union` dpkgs2,+                   imp_trust_pkgs    = tpkgs1 `S.union` tpkgs2,+                   imp_trust_own_pkg = tself1 || tself2,+                   imp_orphs         = orphs1 `unionLists` orphs2,+                   imp_finsts        = finsts1 `unionLists` finsts2 }+  where+    plus_mod_dep r1@(m1, boot1) r2@(m2, boot2)+      | ASSERT2( m1 == m2, (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) )+        boot1 = r2+      | otherwise = r1+      -- If either side can "see" a non-hi-boot interface, use that+      -- Reusing existing tuples saves 10% of allocations on test+      -- perf/compiler/MultiLayerModules++{-+************************************************************************+*                                                                      *+\subsection{Where from}+*                                                                      *+************************************************************************++The @WhereFrom@ type controls where the renamer looks for an interface file+-}++data WhereFrom+  = ImportByUser IsBootInterface        -- Ordinary user import (perhaps {-# SOURCE #-})+  | ImportBySystem                      -- Non user import.+  | ImportByPlugin                      -- Importing a plugin;+                                        -- See Note [Care with plugin imports] in LoadIface++instance Outputable WhereFrom where+  ppr (ImportByUser is_boot) | is_boot     = text "{- SOURCE -}"+                             | otherwise   = empty+  ppr ImportBySystem                       = text "{- SYSTEM -}"+  ppr ImportByPlugin                       = text "{- PLUGIN -}"+++{- *********************************************************************+*                                                                      *+                Type signatures+*                                                                      *+********************************************************************* -}++-- These data types need to be here only because+-- TcSimplify uses them, and TcSimplify is fairly+-- low down in the module hierarchy++type TcSigFun  = Name -> Maybe TcSigInfo++data TcSigInfo = TcIdSig     TcIdSigInfo+               | TcPatSynSig TcPatSynInfo++data TcIdSigInfo   -- See Note [Complete and partial type signatures]+  = CompleteSig    -- A complete signature with no wildcards,+                   -- so the complete polymorphic type is known.+      { sig_bndr :: TcId          -- The polymorphic Id with that type++      , sig_ctxt :: UserTypeCtxt  -- In the case of type-class default methods,+                                  -- the Name in the FunSigCtxt is not the same+                                  -- as the TcId; the former is 'op', while the+                                  -- latter is '$dmop' or some such++      , sig_loc  :: SrcSpan       -- Location of the type signature+      }++  | PartialSig     -- A partial type signature (i.e. includes one or more+                   -- wildcards). In this case it doesn't make sense to give+                   -- the polymorphic Id, because we are going to /infer/ its+                   -- type, so we can't make the polymorphic Id ab-initio+      { psig_name  :: Name   -- Name of the function; used when report wildcards+      , psig_hs_ty :: LHsSigWcType GhcRn  -- The original partial signature in+                                          -- HsSyn form+      , sig_ctxt   :: UserTypeCtxt+      , sig_loc    :: SrcSpan            -- Location of the type signature+      }+++{- Note [Complete and partial type signatures]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A type signature is partial when it contains one or more wildcards+(= type holes).  The wildcard can either be:+* A (type) wildcard occurring in sig_theta or sig_tau. These are+  stored in sig_wcs.+      f :: Bool -> _+      g :: Eq _a => _a -> _a -> Bool+* Or an extra-constraints wildcard, stored in sig_cts:+      h :: (Num a, _) => a -> a++A type signature is a complete type signature when there are no+wildcards in the type signature, i.e. iff sig_wcs is empty and+sig_extra_cts is Nothing.+-}++data TcIdSigInst+  = TISI { sig_inst_sig :: TcIdSigInfo++         , sig_inst_skols :: [(Name, TcTyVar)]+               -- Instantiated type and kind variables, TyVarTvs+               -- The Name is the Name that the renamer chose;+               --   but the TcTyVar may come from instantiating+               --   the type and hence have a different unique.+               -- No need to keep track of whether they are truly lexically+               --   scoped because the renamer has named them uniquely+               -- See Note [Binding scoped type variables] in TcSigs++         , sig_inst_theta  :: TcThetaType+               -- Instantiated theta.  In the case of a+               -- PartialSig, sig_theta does not include+               -- the extra-constraints wildcard++         , sig_inst_tau :: TcSigmaType   -- Instantiated tau+               -- See Note [sig_inst_tau may be polymorphic]++         -- Relevant for partial signature only+         , sig_inst_wcs   :: [(Name, TcTyVar)]+               -- Like sig_inst_skols, but for wildcards.  The named+               -- wildcards scope over the binding, and hence their+               -- Names may appear in type signatures in the binding++         , sig_inst_wcx   :: Maybe TcType+               -- Extra-constraints wildcard to fill in, if any+               -- If this exists, it is surely of the form (meta_tv |> co)+               -- (where the co might be reflexive). This is filled in+               -- only from the return value of TcHsType.tcWildCardOcc+         }++{- Note [sig_inst_tau may be polymorphic]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Note that "sig_inst_tau" might actually be a polymorphic type,+if the original function had a signature like+   forall a. Eq a => forall b. Ord b => ....+But that's ok: tcMatchesFun (called by tcRhs) can deal with that+It happens, too!  See Note [Polymorphic methods] in TcClassDcl.++Note [Wildcards in partial signatures]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The wildcards in psig_wcs may stand for a type mentioning+the universally-quantified tyvars of psig_ty++E.g.  f :: forall a. _ -> a+      f x = x+We get sig_inst_skols = [a]+       sig_inst_tau   = _22 -> a+       sig_inst_wcs   = [_22]+and _22 in the end is unified with the type 'a'++Moreover the kind of a wildcard in sig_inst_wcs may mention+the universally-quantified tyvars sig_inst_skols+e.g.   f :: t a -> t _+Here we get+   sig_inst_skols = [k:*, (t::k ->*), (a::k)]+   sig_inst_tau   = t a -> t _22+   sig_inst_wcs   = [ _22::k ]+-}++data TcPatSynInfo+  = TPSI {+        patsig_name           :: Name,+        patsig_implicit_bndrs :: [TyVarBinder], -- Implicitly-bound kind vars (Inferred) and+                                                -- implicitly-bound type vars (Specified)+          -- See Note [The pattern-synonym signature splitting rule] in TcPatSyn+        patsig_univ_bndrs     :: [TyVar],       -- Bound by explicit user forall+        patsig_req            :: TcThetaType,+        patsig_ex_bndrs       :: [TyVar],       -- Bound by explicit user forall+        patsig_prov           :: TcThetaType,+        patsig_body_ty        :: TcSigmaType+    }++instance Outputable TcSigInfo where+  ppr (TcIdSig     idsi) = ppr idsi+  ppr (TcPatSynSig tpsi) = text "TcPatSynInfo" <+> ppr tpsi++instance Outputable TcIdSigInfo where+    ppr (CompleteSig { sig_bndr = bndr })+        = ppr bndr <+> dcolon <+> ppr (idType bndr)+    ppr (PartialSig { psig_name = name, psig_hs_ty = hs_ty })+        = text "psig" <+> ppr name <+> dcolon <+> ppr hs_ty++instance Outputable TcIdSigInst where+    ppr (TISI { sig_inst_sig = sig, sig_inst_skols = skols+              , sig_inst_theta = theta, sig_inst_tau = tau })+        = hang (ppr sig) 2 (vcat [ ppr skols, ppr theta <+> darrow <+> ppr tau ])++instance Outputable TcPatSynInfo where+    ppr (TPSI{ patsig_name = name}) = ppr name++isPartialSig :: TcIdSigInst -> Bool+isPartialSig (TISI { sig_inst_sig = PartialSig {} }) = True+isPartialSig _                                       = False++-- | No signature or a partial signature+hasCompleteSig :: TcSigFun -> Name -> Bool+hasCompleteSig sig_fn name+  = case sig_fn name of+      Just (TcIdSig (CompleteSig {})) -> True+      _                               -> False+++{-+************************************************************************+*                                                                      *+*                       Canonical constraints                          *+*                                                                      *+*   These are the constraints the low-level simplifier works with      *+*                                                                      *+************************************************************************+-}++-- The syntax of xi (ξ) types:+-- xi ::= a | T xis | xis -> xis | ... | forall a. tau+-- Two important notes:+--      (i) No type families, unless we are under a ForAll+--      (ii) Note that xi types can contain unexpanded type synonyms;+--           however, the (transitive) expansions of those type synonyms+--           will not contain any type functions, unless we are under a ForAll.+-- We enforce the structure of Xi types when we flatten (TcCanonical)++type Xi = Type       -- In many comments, "xi" ranges over Xi++type Cts = Bag Ct++data Ct+  -- Atomic canonical constraints+  = CDictCan {  -- e.g.  Num xi+      cc_ev     :: CtEvidence, -- See Note [Ct/evidence invariant]++      cc_class  :: Class,+      cc_tyargs :: [Xi],   -- cc_tyargs are function-free, hence Xi++      cc_pend_sc :: Bool   -- See Note [The superclass story] in TcCanonical+                           -- True <=> (a) cc_class has superclasses+                           --          (b) we have not (yet) added those+                           --              superclasses as Givens+    }++  | CIrredCan {  -- These stand for yet-unusable predicates+      cc_ev    :: CtEvidence,   -- See Note [Ct/evidence invariant]+      cc_insol :: Bool   -- True  <=> definitely an error, can never be solved+                         -- False <=> might be soluble++        -- For the might-be-soluble case, the ctev_pred of the evidence is+        -- of form   (tv xi1 xi2 ... xin)   with a tyvar at the head+        --      or   (tv1 ~ ty2)   where the CTyEqCan  kind invariant fails+        --      or   (F tys ~ ty)  where the CFunEqCan kind invariant fails+        -- See Note [CIrredCan constraints]++        -- The definitely-insoluble case is for things like+        --    Int ~ Bool      tycons don't match+        --    a ~ [a]         occurs check+    }++  | CTyEqCan {  -- tv ~ rhs+       -- Invariants:+       --   * See Note [Applying the inert substitution] in TcFlatten+       --   * tv not in tvs(rhs)   (occurs check)+       --   * If tv is a TauTv, then rhs has no foralls+       --       (this avoids substituting a forall for the tyvar in other types)+       --   * tcTypeKind ty `tcEqKind` tcTypeKind tv; Note [Ct kind invariant]+       --   * rhs may have at most one top-level cast+       --   * rhs (perhaps under the one cast) is not necessarily function-free,+       --       but it has no top-level function.+       --     E.g. a ~ [F b]  is fine+       --     but  a ~ F b    is not+       --   * If the equality is representational, rhs has no top-level newtype+       --     See Note [No top-level newtypes on RHS of representational+       --     equalities] in TcCanonical+       --   * If rhs (perhaps under the cast) is also a tv, then it is oriented+       --     to give best chance of+       --     unification happening; eg if rhs is touchable then lhs is too+      cc_ev     :: CtEvidence, -- See Note [Ct/evidence invariant]+      cc_tyvar  :: TcTyVar,+      cc_rhs    :: TcType,     -- Not necessarily function-free (hence not Xi)+                               -- See invariants above++      cc_eq_rel :: EqRel       -- INVARIANT: cc_eq_rel = ctEvEqRel cc_ev+    }++  | CFunEqCan {  -- F xis ~ fsk+       -- Invariants:+       --   * isTypeFamilyTyCon cc_fun+       --   * tcTypeKind (F xis) = tyVarKind fsk; Note [Ct kind invariant]+       --   * always Nominal role+      cc_ev     :: CtEvidence,  -- See Note [Ct/evidence invariant]+      cc_fun    :: TyCon,       -- A type function++      cc_tyargs :: [Xi],        -- cc_tyargs are function-free (hence Xi)+        -- Either under-saturated or exactly saturated+        --    *never* over-saturated (because if so+        --    we should have decomposed)++      cc_fsk    :: TcTyVar  -- [G]  always a FlatSkolTv+                            -- [W], [WD], or [D] always a FlatMetaTv+        -- See Note [The flattening story] in TcFlatten+    }++  | CNonCanonical {        -- See Note [NonCanonical Semantics] in TcSMonad+      cc_ev  :: CtEvidence+    }++  | CHoleCan {             -- See Note [Hole constraints]+       -- Treated as an "insoluble" constraint+       -- See Note [Insoluble constraints]+      cc_ev   :: CtEvidence,+      cc_hole :: Hole+    }++  | CQuantCan QCInst       -- A quantified constraint+      -- NB: I expect to make more of the cases in Ct+      --     look like this, with the payload in an+      --     auxiliary type++------------+data QCInst  -- A much simplified version of ClsInst+             -- See Note [Quantified constraints] in TcCanonical+  = QCI { qci_ev   :: CtEvidence -- Always of type forall tvs. context => ty+                                 -- Always Given+        , qci_tvs  :: [TcTyVar]  -- The tvs+        , qci_pred :: TcPredType -- The ty+        , qci_pend_sc :: Bool    -- Same as cc_pend_sc flag in CDictCan+                                 -- Invariant: True => qci_pred is a ClassPred+    }++instance Outputable QCInst where+  ppr (QCI { qci_ev = ev }) = ppr ev++------------+-- | An expression or type hole+data Hole = ExprHole UnboundVar+            -- ^ Either an out-of-scope variable or a "true" hole in an+            -- expression (TypedHoles)+          | TypeHole OccName+            -- ^ A hole in a type (PartialTypeSignatures)++instance Outputable Hole where+  ppr (ExprHole ub)  = ppr ub+  ppr (TypeHole occ) = text "TypeHole" <> parens (ppr occ)++holeOcc :: Hole -> OccName+holeOcc (ExprHole uv)  = unboundVarOcc uv+holeOcc (TypeHole occ) = occ++{- Note [Hole constraints]+~~~~~~~~~~~~~~~~~~~~~~~~~~+CHoleCan constraints are used for two kinds of holes,+distinguished by cc_hole:++  * For holes in expressions (including variables not in scope)+    e.g.   f x = g _ x++  * For holes in type signatures+    e.g.   f :: _ -> _+           f x = [x,True]++Note [CIrredCan constraints]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+CIrredCan constraints are used for constraints that are "stuck"+   - we can't solve them (yet)+   - we can't use them to solve other constraints+   - but they may become soluble if we substitute for some+     of the type variables in the constraint++Example 1:  (c Int), where c :: * -> Constraint.  We can't do anything+            with this yet, but if later c := Num, *then* we can solve it++Example 2:  a ~ b, where a :: *, b :: k, where k is a kind variable+            We don't want to use this to substitute 'b' for 'a', in case+            'k' is subsequently unifed with (say) *->*, because then+            we'd have ill-kinded types floating about.  Rather we want+            to defer using the equality altogether until 'k' get resolved.++Note [Ct/evidence invariant]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If  ct :: Ct, then extra fields of 'ct' cache precisely the ctev_pred field+of (cc_ev ct), and is fully rewritten wrt the substitution.   Eg for CDictCan,+   ctev_pred (cc_ev ct) = (cc_class ct) (cc_tyargs ct)+This holds by construction; look at the unique place where CDictCan is+built (in TcCanonical).++In contrast, the type of the evidence *term* (ctev_dest / ctev_evar) in+the evidence may *not* be fully zonked; we are careful not to look at it+during constraint solving. See Note [Evidence field of CtEvidence].++Note [Ct kind invariant]+~~~~~~~~~~~~~~~~~~~~~~~~+CTyEqCan and CFunEqCan both require that the kind of the lhs matches the kind+of the rhs. This is necessary because both constraints are used for substitutions+during solving. If the kinds differed, then the substitution would take a well-kinded+type to an ill-kinded one.++-}++mkNonCanonical :: CtEvidence -> Ct+mkNonCanonical ev = CNonCanonical { cc_ev = ev }++mkNonCanonicalCt :: Ct -> Ct+mkNonCanonicalCt ct = CNonCanonical { cc_ev = cc_ev ct }++mkIrredCt :: CtEvidence -> Ct+mkIrredCt ev = CIrredCan { cc_ev = ev, cc_insol = False }++mkInsolubleCt :: CtEvidence -> Ct+mkInsolubleCt ev = CIrredCan { cc_ev = ev, cc_insol = True }++mkGivens :: CtLoc -> [EvId] -> [Ct]+mkGivens loc ev_ids+  = map mk ev_ids+  where+    mk ev_id = mkNonCanonical (CtGiven { ctev_evar = ev_id+                                       , ctev_pred = evVarPred ev_id+                                       , ctev_loc = loc })++ctEvidence :: Ct -> CtEvidence+ctEvidence (CQuantCan (QCI { qci_ev = ev })) = ev+ctEvidence ct = cc_ev ct++ctLoc :: Ct -> CtLoc+ctLoc = ctEvLoc . ctEvidence++setCtLoc :: Ct -> CtLoc -> Ct+setCtLoc ct loc = ct { cc_ev = (cc_ev ct) { ctev_loc = loc } }++ctOrigin :: Ct -> CtOrigin+ctOrigin = ctLocOrigin . ctLoc++ctPred :: Ct -> PredType+-- See Note [Ct/evidence invariant]+ctPred ct = ctEvPred (ctEvidence ct)++ctEvId :: Ct -> EvVar+-- The evidence Id for this Ct+ctEvId ct = ctEvEvId (ctEvidence ct)++-- | Makes a new equality predicate with the same role as the given+-- evidence.+mkTcEqPredLikeEv :: CtEvidence -> TcType -> TcType -> TcType+mkTcEqPredLikeEv ev+  = case predTypeEqRel pred of+      NomEq  -> mkPrimEqPred+      ReprEq -> mkReprPrimEqPred+  where+    pred = ctEvPred ev++-- | Get the flavour of the given 'Ct'+ctFlavour :: Ct -> CtFlavour+ctFlavour = ctEvFlavour . ctEvidence++-- | Get the equality relation for the given 'Ct'+ctEqRel :: Ct -> EqRel+ctEqRel = ctEvEqRel . ctEvidence++instance Outputable Ct where+  ppr ct = ppr (ctEvidence ct) <+> parens pp_sort+    where+      pp_sort = case ct of+         CTyEqCan {}      -> text "CTyEqCan"+         CFunEqCan {}     -> text "CFunEqCan"+         CNonCanonical {} -> text "CNonCanonical"+         CDictCan { cc_pend_sc = pend_sc }+            | pend_sc   -> text "CDictCan(psc)"+            | otherwise -> text "CDictCan"+         CIrredCan { cc_insol = insol }+            | insol     -> text "CIrredCan(insol)"+            | otherwise -> text "CIrredCan(sol)"+         CHoleCan { cc_hole = hole } -> text "CHoleCan:" <+> ppr hole+         CQuantCan (QCI { qci_pend_sc = pend_sc })+            | pend_sc   -> text "CQuantCan(psc)"+            | otherwise -> text "CQuantCan"++{-+************************************************************************+*                                                                      *+        Simple functions over evidence variables+*                                                                      *+************************************************************************+-}++---------------- Getting free tyvars -------------------------++-- | Returns free variables of constraints as a non-deterministic set+tyCoVarsOfCt :: Ct -> TcTyCoVarSet+tyCoVarsOfCt = fvVarSet . tyCoFVsOfCt++-- | Returns free variables of constraints as a deterministically ordered.+-- list. See Note [Deterministic FV] in FV.+tyCoVarsOfCtList :: Ct -> [TcTyCoVar]+tyCoVarsOfCtList = fvVarList . tyCoFVsOfCt++-- | Returns free variables of constraints as a composable FV computation.+-- See Note [Deterministic FV] in FV.+tyCoFVsOfCt :: Ct -> FV+tyCoFVsOfCt (CTyEqCan { cc_tyvar = tv, cc_rhs = xi })+  = tyCoFVsOfType xi `unionFV` FV.unitFV tv+                     `unionFV` tyCoFVsOfType (tyVarKind tv)+tyCoFVsOfCt (CFunEqCan { cc_tyargs = tys, cc_fsk = fsk })+  = tyCoFVsOfTypes tys `unionFV` FV.unitFV fsk+                       `unionFV` tyCoFVsOfType (tyVarKind fsk)+tyCoFVsOfCt (CDictCan { cc_tyargs = tys }) = tyCoFVsOfTypes tys+tyCoFVsOfCt ct = tyCoFVsOfType (ctPred ct)++-- | Returns free variables of a bag of constraints as a non-deterministic+-- set. See Note [Deterministic FV] in FV.+tyCoVarsOfCts :: Cts -> TcTyCoVarSet+tyCoVarsOfCts = fvVarSet . tyCoFVsOfCts++-- | Returns free variables of a bag of constraints as a deterministically+-- odered list. See Note [Deterministic FV] in FV.+tyCoVarsOfCtsList :: Cts -> [TcTyCoVar]+tyCoVarsOfCtsList = fvVarList . tyCoFVsOfCts++-- | Returns free variables of a bag of constraints as a composable FV+-- computation. See Note [Deterministic FV] in FV.+tyCoFVsOfCts :: Cts -> FV+tyCoFVsOfCts = foldrBag (unionFV . tyCoFVsOfCt) emptyFV++-- | Returns free variables of WantedConstraints as a non-deterministic+-- set. See Note [Deterministic FV] in FV.+tyCoVarsOfWC :: WantedConstraints -> TyCoVarSet+-- Only called on *zonked* things, hence no need to worry about flatten-skolems+tyCoVarsOfWC = fvVarSet . tyCoFVsOfWC++-- | Returns free variables of WantedConstraints as a deterministically+-- ordered list. See Note [Deterministic FV] in FV.+tyCoVarsOfWCList :: WantedConstraints -> [TyCoVar]+-- Only called on *zonked* things, hence no need to worry about flatten-skolems+tyCoVarsOfWCList = fvVarList . tyCoFVsOfWC++-- | Returns free variables of WantedConstraints as a composable FV+-- computation. See Note [Deterministic FV] in FV.+tyCoFVsOfWC :: WantedConstraints -> FV+-- Only called on *zonked* things, hence no need to worry about flatten-skolems+tyCoFVsOfWC (WC { wc_simple = simple, wc_impl = implic })+  = tyCoFVsOfCts simple `unionFV`+    tyCoFVsOfBag tyCoFVsOfImplic implic++-- | Returns free variables of Implication as a composable FV computation.+-- See Note [Deterministic FV] in FV.+tyCoFVsOfImplic :: Implication -> FV+-- Only called on *zonked* things, hence no need to worry about flatten-skolems+tyCoFVsOfImplic (Implic { ic_skols = skols+                        , ic_given = givens+                        , ic_wanted = wanted })+  | isEmptyWC wanted+  = emptyFV+  | otherwise+  = tyCoFVsVarBndrs skols  $+    tyCoFVsVarBndrs givens $+    tyCoFVsOfWC wanted++tyCoFVsOfBag :: (a -> FV) -> Bag a -> FV+tyCoFVsOfBag tvs_of = foldrBag (unionFV . tvs_of) emptyFV++---------------------------+dropDerivedWC :: WantedConstraints -> WantedConstraints+-- See Note [Dropping derived constraints]+dropDerivedWC wc@(WC { wc_simple = simples })+  = wc { wc_simple = dropDerivedSimples simples }+    -- The wc_impl implications are already (recursively) filtered++--------------------------+dropDerivedSimples :: Cts -> Cts+-- Drop all Derived constraints, but make [W] back into [WD],+-- so that if we re-simplify these constraints we will get all+-- the right derived constraints re-generated.  Forgetting this+-- step led to #12936+dropDerivedSimples simples = mapMaybeBag dropDerivedCt simples++dropDerivedCt :: Ct -> Maybe Ct+dropDerivedCt ct+  = case ctEvFlavour ev of+      Wanted WOnly -> Just (ct' { cc_ev = ev_wd })+      Wanted _     -> Just ct'+      _ | isDroppableCt ct -> Nothing+        | otherwise        -> Just ct+  where+    ev    = ctEvidence ct+    ev_wd = ev { ctev_nosh = WDeriv }+    ct'   = setPendingScDict ct -- See Note [Resetting cc_pend_sc]++{- Note [Resetting cc_pend_sc]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+When we discard Derived constraints, in dropDerivedSimples, we must+set the cc_pend_sc flag to True, so that if we re-process this+CDictCan we will re-generate its derived superclasses. Otherwise+we might miss some fundeps.  #13662 showed this up.++See Note [The superclass story] in TcCanonical.+-}++isDroppableCt :: Ct -> Bool+isDroppableCt ct+  = isDerived ev && not keep_deriv+    -- Drop only derived constraints, and then only if they+    -- obey Note [Dropping derived constraints]+  where+    ev   = ctEvidence ct+    loc  = ctEvLoc ev+    orig = ctLocOrigin loc++    keep_deriv+      = case ct of+          CHoleCan {} -> True+          CIrredCan { cc_insol = insoluble }+                      -> keep_eq insoluble+          _           -> keep_eq False++    keep_eq definitely_insoluble+       | isGivenOrigin orig    -- Arising only from givens+       = definitely_insoluble  -- Keep only definitely insoluble+       | otherwise+       = case orig of+           KindEqOrigin {} -> True    -- See Note [Dropping derived constraints]++           -- See Note [Dropping derived constraints]+           -- For fundeps, drop wanted/wanted interactions+           FunDepOrigin2 {} -> True   -- Top-level/Wanted+           FunDepOrigin1 _ loc1 _ loc2+             | g1 || g2  -> True  -- Given/Wanted errors: keep all+             | otherwise -> False -- Wanted/Wanted errors: discard+             where+               g1 = isGivenLoc loc1+               g2 = isGivenLoc loc2++           _ -> False++arisesFromGivens :: Ct -> Bool+arisesFromGivens ct+  = case ctEvidence ct of+      CtGiven {}                   -> True+      CtWanted {}                  -> False+      CtDerived { ctev_loc = loc } -> isGivenLoc loc++isGivenLoc :: CtLoc -> Bool+isGivenLoc loc = isGivenOrigin (ctLocOrigin loc)++isGivenOrigin :: CtOrigin -> Bool+isGivenOrigin (GivenOrigin {})          = True+isGivenOrigin (FunDepOrigin1 _ l1 _ l2) = isGivenLoc l1 && isGivenLoc l2+isGivenOrigin (FunDepOrigin2 _ o1 _ _)  = isGivenOrigin o1+isGivenOrigin _                         = False++{- Note [Dropping derived constraints]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In general we discard derived constraints at the end of constraint solving;+see dropDerivedWC.  For example++ * Superclasses: if we have an unsolved [W] (Ord a), we don't want to+   complain about an unsolved [D] (Eq a) as well.++ * If we have [W] a ~ Int, [W] a ~ Bool, improvement will generate+   [D] Int ~ Bool, and we don't want to report that because it's+   incomprehensible. That is why we don't rewrite wanteds with wanteds!++But (tiresomely) we do keep *some* Derived constraints:++ * Type holes are derived constraints, because they have no evidence+   and we want to keep them, so we get the error report++ * Insoluble kind equalities (e.g. [D] * ~ (* -> *)), with+   KindEqOrigin, may arise from a type equality a ~ Int#, say.  See+   Note [Equalities with incompatible kinds] in TcCanonical.+   These need to be kept because the kind equalities might have different+   source locations and hence different error messages.+   E.g., test case dependent/should_fail/T11471++ * We keep most derived equalities arising from functional dependencies+      - Given/Given interactions (subset of FunDepOrigin1):+        The definitely-insoluble ones reflect unreachable code.++        Others not-definitely-insoluble ones like [D] a ~ Int do not+        reflect unreachable code; indeed if fundeps generated proofs, it'd+        be a useful equality.  See #14763.   So we discard them.++      - Given/Wanted interacGiven or Wanted interacting with an+        instance declaration (FunDepOrigin2)++      - Given/Wanted interactions (FunDepOrigin1); see #9612++      - But for Wanted/Wanted interactions we do /not/ want to report an+        error (#13506).  Consider [W] C Int Int, [W] C Int Bool, with+        a fundep on class C.  We don't want to report an insoluble Int~Bool;+        c.f. "wanteds do not rewrite wanteds".++To distinguish these cases we use the CtOrigin.++NB: we keep *all* derived insolubles under some circumstances:++  * They are looked at by simplifyInfer, to decide whether to+    generalise.  Example: [W] a ~ Int, [W] a ~ Bool+    We get [D] Int ~ Bool, and indeed the constraints are insoluble,+    and we want simplifyInfer to see that, even though we don't+    ultimately want to generate an (inexplicable) error message from it+++************************************************************************+*                                                                      *+                    CtEvidence+         The "flavor" of a canonical constraint+*                                                                      *+************************************************************************+-}++isWantedCt :: Ct -> Bool+isWantedCt = isWanted . ctEvidence++isGivenCt :: Ct -> Bool+isGivenCt = isGiven . ctEvidence++isDerivedCt :: Ct -> Bool+isDerivedCt = isDerived . ctEvidence++isCTyEqCan :: Ct -> Bool+isCTyEqCan (CTyEqCan {})  = True+isCTyEqCan (CFunEqCan {}) = False+isCTyEqCan _              = False++isCDictCan_Maybe :: Ct -> Maybe Class+isCDictCan_Maybe (CDictCan {cc_class = cls })  = Just cls+isCDictCan_Maybe _              = Nothing++isCFunEqCan_maybe :: Ct -> Maybe (TyCon, [Type])+isCFunEqCan_maybe (CFunEqCan { cc_fun = tc, cc_tyargs = xis }) = Just (tc, xis)+isCFunEqCan_maybe _ = Nothing++isCFunEqCan :: Ct -> Bool+isCFunEqCan (CFunEqCan {}) = True+isCFunEqCan _ = False++isCNonCanonical :: Ct -> Bool+isCNonCanonical (CNonCanonical {}) = True+isCNonCanonical _ = False++isHoleCt:: Ct -> Bool+isHoleCt (CHoleCan {}) = True+isHoleCt _ = False++isOutOfScopeCt :: Ct -> Bool+-- We treat expression holes representing out-of-scope variables a bit+-- differently when it comes to error reporting+isOutOfScopeCt (CHoleCan { cc_hole = ExprHole (OutOfScope {}) }) = True+isOutOfScopeCt _ = False++isExprHoleCt :: Ct -> Bool+isExprHoleCt (CHoleCan { cc_hole = ExprHole {} }) = True+isExprHoleCt _ = False++isTypeHoleCt :: Ct -> Bool+isTypeHoleCt (CHoleCan { cc_hole = TypeHole {} }) = True+isTypeHoleCt _ = False+++{- Note [Custom type errors in constraints]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++When GHC reports a type-error about an unsolved-constraint, we check+to see if the constraint contains any custom-type errors, and if so+we report them.  Here are some examples of constraints containing type+errors:++TypeError msg           -- The actual constraint is a type error++TypError msg ~ Int      -- Some type was supposed to be Int, but ended up+                        -- being a type error instead++Eq (TypeError msg)      -- A class constraint is stuck due to a type error++F (TypeError msg) ~ a   -- A type function failed to evaluate due to a type err++It is also possible to have constraints where the type error is nested deeper,+for example see #11990, and also:++Eq (F (TypeError msg))  -- Here the type error is nested under a type-function+                        -- call, which failed to evaluate because of it,+                        -- and so the `Eq` constraint was unsolved.+                        -- This may happen when one function calls another+                        -- and the called function produced a custom type error.+-}++-- | A constraint is considered to be a custom type error, if it contains+-- custom type errors anywhere in it.+-- See Note [Custom type errors in constraints]+getUserTypeErrorMsg :: Ct -> Maybe Type+getUserTypeErrorMsg ct = findUserTypeError (ctPred ct)+  where+  findUserTypeError t = msum ( userTypeError_maybe t+                             : map findUserTypeError (subTys t)+                             )++  subTys t            = case splitAppTys t of+                          (t,[]) ->+                            case splitTyConApp_maybe t of+                              Nothing     -> []+                              Just (_,ts) -> ts+                          (t,ts) -> t : ts+++++isUserTypeErrorCt :: Ct -> Bool+isUserTypeErrorCt ct = case getUserTypeErrorMsg ct of+                         Just _ -> True+                         _      -> False++isPendingScDict :: Ct -> Maybe Ct+-- Says whether this is a CDictCan with cc_pend_sc is True,+-- AND if so flips the flag+isPendingScDict ct@(CDictCan { cc_pend_sc = True })+                  = Just (ct { cc_pend_sc = False })+isPendingScDict _ = Nothing++isPendingScInst :: QCInst -> Maybe QCInst+-- Same as isPrendinScDict, but for QCInsts+isPendingScInst qci@(QCI { qci_pend_sc = True })+                  = Just (qci { qci_pend_sc = False })+isPendingScInst _ = Nothing++setPendingScDict :: Ct -> Ct+-- Set the cc_pend_sc flag to True+setPendingScDict ct@(CDictCan { cc_pend_sc = False })+                    = ct { cc_pend_sc = True }+setPendingScDict ct = ct++superClassesMightHelp :: WantedConstraints -> Bool+-- ^ True if taking superclasses of givens, or of wanteds (to perhaps+-- expose more equalities or functional dependencies) might help to+-- solve this constraint.  See Note [When superclasses help]+superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics })+  = anyBag might_help_ct simples || anyBag might_help_implic implics+  where+    might_help_implic ic+       | IC_Unsolved <- ic_status ic = superClassesMightHelp (ic_wanted ic)+       | otherwise                   = False++    might_help_ct ct = isWantedCt ct && not (is_ip ct)++    is_ip (CDictCan { cc_class = cls }) = isIPClass cls+    is_ip _                             = False++getPendingWantedScs :: Cts -> ([Ct], Cts)+getPendingWantedScs simples+  = mapAccumBagL get [] simples+  where+    get acc ct | Just ct' <- isPendingScDict ct+               = (ct':acc, ct')+               | otherwise+               = (acc,     ct)++{- Note [When superclasses help]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+First read Note [The superclass story] in TcCanonical.++We expand superclasses and iterate only if there is at unsolved wanted+for which expansion of superclasses (e.g. from given constraints)+might actually help. The function superClassesMightHelp tells if+doing this superclass expansion might help solve this constraint.+Note that++  * We look inside implications; maybe it'll help to expand the Givens+    at level 2 to help solve an unsolved Wanted buried inside an+    implication.  E.g.+        forall a. Ord a => forall b. [W] Eq a++  * Superclasses help only for Wanted constraints.  Derived constraints+    are not really "unsolved" and we certainly don't want them to+    trigger superclass expansion. This was a good part of the loop+    in  #11523++  * Even for Wanted constraints, we say "no" for implicit parameters.+    we have [W] ?x::ty, expanding superclasses won't help:+      - Superclasses can't be implicit parameters+      - If we have a [G] ?x:ty2, then we'll have another unsolved+        [D] ty ~ ty2 (from the functional dependency)+        which will trigger superclass expansion.++    It's a bit of a special case, but it's easy to do.  The runtime cost+    is low because the unsolved set is usually empty anyway (errors+    aside), and the first non-imlicit-parameter will terminate the search.++    The special case is worth it (#11480, comment:2) because it+    applies to CallStack constraints, which aren't type errors. If we have+       f :: (C a) => blah+       f x = ...undefined...+    we'll get a CallStack constraint.  If that's the only unsolved+    constraint it'll eventually be solved by defaulting.  So we don't+    want to emit warnings about hitting the simplifier's iteration+    limit.  A CallStack constraint really isn't an unsolved+    constraint; it can always be solved by defaulting.+-}++singleCt :: Ct -> Cts+singleCt = unitBag++andCts :: Cts -> Cts -> Cts+andCts = unionBags++listToCts :: [Ct] -> Cts+listToCts = listToBag++ctsElts :: Cts -> [Ct]+ctsElts = bagToList++consCts :: Ct -> Cts -> Cts+consCts = consBag++snocCts :: Cts -> Ct -> Cts+snocCts = snocBag++extendCtsList :: Cts -> [Ct] -> Cts+extendCtsList cts xs | null xs   = cts+                     | otherwise = cts `unionBags` listToBag xs++andManyCts :: [Cts] -> Cts+andManyCts = unionManyBags++emptyCts :: Cts+emptyCts = emptyBag++isEmptyCts :: Cts -> Bool+isEmptyCts = isEmptyBag++pprCts :: Cts -> SDoc+pprCts cts = vcat (map ppr (bagToList cts))++{-+************************************************************************+*                                                                      *+                Wanted constraints+     These are forced to be in TcRnTypes because+           TcLclEnv mentions WantedConstraints+           WantedConstraint mentions CtLoc+           CtLoc mentions ErrCtxt+           ErrCtxt mentions TcM+*                                                                      *+v%************************************************************************+-}++data WantedConstraints+  = WC { wc_simple :: Cts              -- Unsolved constraints, all wanted+       , wc_impl   :: Bag Implication+    }++emptyWC :: WantedConstraints+emptyWC = WC { wc_simple = emptyBag, wc_impl = emptyBag }++mkSimpleWC :: [CtEvidence] -> WantedConstraints+mkSimpleWC cts+  = WC { wc_simple = listToBag (map mkNonCanonical cts)+       , wc_impl = emptyBag }++mkImplicWC :: Bag Implication -> WantedConstraints+mkImplicWC implic+  = WC { wc_simple = emptyBag, wc_impl = implic }++isEmptyWC :: WantedConstraints -> Bool+isEmptyWC (WC { wc_simple = f, wc_impl = i })+  = isEmptyBag f && isEmptyBag i+++-- | Checks whether a the given wanted constraints are solved, i.e.+-- that there are no simple constraints left and all the implications+-- are solved.+isSolvedWC :: WantedConstraints -> Bool+isSolvedWC WC {wc_simple = wc_simple, wc_impl = wc_impl} =+  isEmptyBag wc_simple && allBag (isSolvedStatus . ic_status) wc_impl++andWC :: WantedConstraints -> WantedConstraints -> WantedConstraints+andWC (WC { wc_simple = f1, wc_impl = i1 })+      (WC { wc_simple = f2, wc_impl = i2 })+  = WC { wc_simple = f1 `unionBags` f2+       , wc_impl   = i1 `unionBags` i2 }++unionsWC :: [WantedConstraints] -> WantedConstraints+unionsWC = foldr andWC emptyWC++addSimples :: WantedConstraints -> Bag Ct -> WantedConstraints+addSimples wc cts+  = wc { wc_simple = wc_simple wc `unionBags` cts }+    -- Consider: Put the new constraints at the front, so they get solved first++addImplics :: WantedConstraints -> Bag Implication -> WantedConstraints+addImplics wc implic = wc { wc_impl = wc_impl wc `unionBags` implic }++addInsols :: WantedConstraints -> Bag Ct -> WantedConstraints+addInsols wc cts+  = wc { wc_simple = wc_simple wc `unionBags` cts }++insolublesOnly :: WantedConstraints -> WantedConstraints+-- Keep only the definitely-insoluble constraints+insolublesOnly (WC { wc_simple = simples, wc_impl = implics })+  = WC { wc_simple = filterBag insolubleCt simples+       , wc_impl   = mapBag implic_insols_only implics }+  where+    implic_insols_only implic+      = implic { ic_wanted = insolublesOnly (ic_wanted implic) }++isSolvedStatus :: ImplicStatus -> Bool+isSolvedStatus (IC_Solved {}) = True+isSolvedStatus _              = False++isInsolubleStatus :: ImplicStatus -> Bool+isInsolubleStatus IC_Insoluble    = True+isInsolubleStatus IC_BadTelescope = True+isInsolubleStatus _               = False++insolubleImplic :: Implication -> Bool+insolubleImplic ic = isInsolubleStatus (ic_status ic)++insolubleWC :: WantedConstraints -> Bool+insolubleWC (WC { wc_impl = implics, wc_simple = simples })+  =  anyBag insolubleCt simples+  || anyBag insolubleImplic implics++insolubleCt :: Ct -> Bool+-- Definitely insoluble, in particular /excluding/ type-hole constraints+-- Namely: a) an equality constraint+--         b) that is insoluble+--         c) and does not arise from a Given+insolubleCt ct+  | isHoleCt ct            = isOutOfScopeCt ct  -- See Note [Insoluble holes]+  | not (insolubleEqCt ct) = False+  | arisesFromGivens ct    = False              -- See Note [Given insolubles]+  | otherwise              = True++insolubleEqCt :: Ct -> Bool+-- Returns True of /equality/ constraints+-- that are /definitely/ insoluble+-- It won't detect some definite errors like+--       F a ~ T (F a)+-- where F is a type family, which actually has an occurs check+--+-- The function is tuned for application /after/ constraint solving+--       i.e. assuming canonicalisation has been done+-- E.g.  It'll reply True  for     a ~ [a]+--               but False for   [a] ~ a+-- and+--                   True for  Int ~ F a Int+--               but False for  Maybe Int ~ F a Int Int+--               (where F is an arity-1 type function)+insolubleEqCt (CIrredCan { cc_insol = insol }) = insol+insolubleEqCt _                                = False++instance Outputable WantedConstraints where+  ppr (WC {wc_simple = s, wc_impl = i})+   = text "WC" <+> braces (vcat+        [ ppr_bag (text "wc_simple") s+        , ppr_bag (text "wc_impl") i ])++ppr_bag :: Outputable a => SDoc -> Bag a -> SDoc+ppr_bag doc bag+ | isEmptyBag bag = empty+ | otherwise      = hang (doc <+> equals)+                       2 (foldrBag (($$) . ppr) empty bag)++{- Note [Given insolubles]+~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider (#14325, comment:)+    class (a~b) => C a b++    foo :: C a c => a -> c+    foo x = x++    hm3 :: C (f b) b => b -> f b+    hm3 x = foo x++In the RHS of hm3, from the [G] C (f b) b we get the insoluble+[G] f b ~# b.  Then we also get an unsolved [W] C b (f b).+Residual implication looks like+    forall b. C (f b) b => [G] f b ~# b+                           [W] C f (f b)++We do /not/ want to set the implication status to IC_Insoluble,+because that'll suppress reports of [W] C b (f b).  But we+may not report the insoluble [G] f b ~# b either (see Note [Given errors]+in TcErrors), so we may fail to report anything at all!  Yikes.++The same applies to Derived constraints that /arise from/ Givens.+E.g.   f :: (C Int [a]) => blah+where a fundep means we get+       [D] Int ~ [a]+By the same reasoning we must not suppress other errors (#15767)++Bottom line: insolubleWC (called in TcSimplify.setImplicationStatus)+             should ignore givens even if they are insoluble.++Note [Insoluble holes]+~~~~~~~~~~~~~~~~~~~~~~+Hole constraints that ARE NOT treated as truly insoluble:+  a) type holes, arising from PartialTypeSignatures,+  b) "true" expression holes arising from TypedHoles++An "expression hole" or "type hole" constraint isn't really an error+at all; it's a report saying "_ :: Int" here.  But an out-of-scope+variable masquerading as expression holes IS treated as truly+insoluble, so that it trumps other errors during error reporting.+Yuk!++************************************************************************+*                                                                      *+                Implication constraints+*                                                                      *+************************************************************************+-}++data Implication+  = Implic {   -- Invariants for a tree of implications:+               -- see TcType Note [TcLevel and untouchable type variables]++      ic_tclvl :: TcLevel,       -- TcLevel of unification variables+                                 -- allocated /inside/ this implication++      ic_skols :: [TcTyVar],     -- Introduced skolems+      ic_info  :: SkolemInfo,    -- See Note [Skolems in an implication]+                                 -- See Note [Shadowing in a constraint]+      ic_telescope :: Maybe SDoc,  -- User-written telescope, if there is one+                                   -- The list of skolems is order-checked+                                   -- if and only if this is a Just.+                                   -- See Note [Keeping scoped variables in order: Explicit]+                                   -- in TcHsType++      ic_given  :: [EvVar],      -- Given evidence variables+                                 --   (order does not matter)+                                 -- See Invariant (GivenInv) in TcType++      ic_no_eqs :: Bool,         -- True  <=> ic_givens have no equalities, for sure+                                 -- False <=> ic_givens might have equalities++      ic_env   :: Env TcGblEnv TcLclEnv,+                                 -- Records the Env at the time of creation.+                                 --+                                 -- This is primarly needed for the enclosed+                                 -- TcLclEnv, which gives the source location+                                 -- and error context for the implication, and+                                 -- hence for all the given evidence variables.+                                 --+                                 -- The enclosed DynFlags also influences error+                                 -- reporting. See Note [Avoid+                                 -- -Winaccessible-code when deriving] in+                                 -- TcInstDcls.++      ic_wanted :: WantedConstraints,  -- The wanteds+                                       -- See Invariang (WantedInf) in TcType++      ic_binds  :: EvBindsVar,    -- Points to the place to fill in the+                                  -- abstraction and bindings.++      -- The ic_need fields keep track of which Given evidence+      -- is used by this implication or its children+      -- NB: including stuff used by nested implications that have since+      --     been discarded+      ic_need_inner :: VarSet,    -- Includes all used Given evidence+      ic_need_outer :: VarSet,    -- Includes only the free Given evidence+                                  --  i.e. ic_need_inner after deleting+                                  --       (a) givens (b) binders of ic_binds++      ic_status   :: ImplicStatus+    }++-- | Create a new 'Implication' with as many sensible defaults for its fields+-- as possible. Note that the 'ic_tclvl', 'ic_binds', and 'ic_info' fields do+-- /not/ have sensible defaults, so they are initialized with lazy thunks that+-- will 'panic' if forced, so one should take care to initialize these fields+-- after creation.+--+-- This is monadic purely to look up the 'Env', which is used to initialize+-- 'ic_env'.+newImplication :: TcM Implication+newImplication+  = do env <- getEnv+       return (implicationPrototype { ic_env = env })++implicationPrototype :: Implication+implicationPrototype+   = Implic { -- These fields must be initialised+              ic_tclvl      = panic "newImplic:tclvl"+            , ic_binds      = panic "newImplic:binds"+            , ic_info       = panic "newImplic:info"+            , ic_env        = panic "newImplic:env"++              -- The rest have sensible default values+            , ic_skols      = []+            , ic_telescope  = Nothing+            , ic_given      = []+            , ic_wanted     = emptyWC+            , ic_no_eqs     = False+            , ic_status     = IC_Unsolved+            , ic_need_inner = emptyVarSet+            , ic_need_outer = emptyVarSet }++-- | Retrieve the enclosed 'TcLclEnv' from an 'Implication'.+implicLclEnv :: Implication -> TcLclEnv+implicLclEnv = env_lcl . ic_env++-- | Retrieve the enclosed 'DynFlags' from an 'Implication'.+implicDynFlags :: Implication -> DynFlags+implicDynFlags = hsc_dflags . env_top . ic_env++data ImplicStatus+  = IC_Solved     -- All wanteds in the tree are solved, all the way down+       { ics_dead :: [EvVar] }  -- Subset of ic_given that are not needed+         -- See Note [Tracking redundant constraints] in TcSimplify++  | IC_Insoluble  -- At least one insoluble constraint in the tree++  | IC_BadTelescope  -- solved, but the skolems in the telescope are out of+                     -- dependency order++  | IC_Unsolved   -- Neither of the above; might go either way++instance Outputable Implication where+  ppr (Implic { ic_tclvl = tclvl, ic_skols = skols+              , ic_given = given, ic_no_eqs = no_eqs+              , ic_wanted = wanted, ic_status = status+              , ic_binds = binds+              , ic_need_inner = need_in, ic_need_outer = need_out+              , ic_info = info })+   = hang (text "Implic" <+> lbrace)+        2 (sep [ text "TcLevel =" <+> ppr tclvl+               , text "Skolems =" <+> pprTyVars skols+               , text "No-eqs =" <+> ppr no_eqs+               , text "Status =" <+> ppr status+               , hang (text "Given =")  2 (pprEvVars given)+               , hang (text "Wanted =") 2 (ppr wanted)+               , text "Binds =" <+> ppr binds+               , whenPprDebug (text "Needed inner =" <+> ppr need_in)+               , whenPprDebug (text "Needed outer =" <+> ppr need_out)+               , pprSkolInfo info ] <+> rbrace)++instance Outputable ImplicStatus where+  ppr IC_Insoluble    = text "Insoluble"+  ppr IC_BadTelescope = text "Bad telescope"+  ppr IC_Unsolved     = text "Unsolved"+  ppr (IC_Solved { ics_dead = dead })+    = text "Solved" <+> (braces (text "Dead givens =" <+> ppr dead))++{-+Note [Needed evidence variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Th ic_need_evs field holds the free vars of ic_binds, and all the+ic_binds in nested implications.++  * Main purpose: if one of the ic_givens is not mentioned in here, it+    is redundant.++  * solveImplication may drop an implication altogether if it has no+    remaining 'wanteds'. But we still track the free vars of its+    evidence binds, even though it has now disappeared.++Note [Shadowing in a constraint]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We assume NO SHADOWING in a constraint.  Specifically+ * The unification variables are all implicitly quantified at top+   level, and are all unique+ * The skolem variables bound in ic_skols are all freah when the+   implication is created.+So we can safely substitute. For example, if we have+   forall a.  a~Int => ...(forall b. ...a...)...+we can push the (a~Int) constraint inwards in the "givens" without+worrying that 'b' might clash.++Note [Skolems in an implication]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The skolems in an implication are not there to perform a skolem escape+check.  That happens because all the environment variables are in the+untouchables, and therefore cannot be unified with anything at all,+let alone the skolems.++Instead, ic_skols is used only when considering floating a constraint+outside the implication in TcSimplify.floatEqualities or+TcSimplify.approximateImplications++Note [Insoluble constraints]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Some of the errors that we get during canonicalization are best+reported when all constraints have been simplified as much as+possible. For instance, assume that during simplification the+following constraints arise:++ [Wanted]   F alpha ~  uf1+ [Wanted]   beta ~ uf1 beta++When canonicalizing the wanted (beta ~ uf1 beta), if we eagerly fail+we will simply see a message:+    'Can't construct the infinite type  beta ~ uf1 beta'+and the user has no idea what the uf1 variable is.++Instead our plan is that we will NOT fail immediately, but:+    (1) Record the "frozen" error in the ic_insols field+    (2) Isolate the offending constraint from the rest of the inerts+    (3) Keep on simplifying/canonicalizing++At the end, we will hopefully have substituted uf1 := F alpha, and we+will be able to report a more informative error:+    'Can't construct the infinite type beta ~ F alpha beta'++Insoluble constraints *do* include Derived constraints. For example,+a functional dependency might give rise to [D] Int ~ Bool, and we must+report that.  If insolubles did not contain Deriveds, reportErrors would+never see it.+++************************************************************************+*                                                                      *+            Pretty printing+*                                                                      *+************************************************************************+-}++pprEvVars :: [EvVar] -> SDoc    -- Print with their types+pprEvVars ev_vars = vcat (map pprEvVarWithType ev_vars)++pprEvVarTheta :: [EvVar] -> SDoc+pprEvVarTheta ev_vars = pprTheta (map evVarPred ev_vars)++pprEvVarWithType :: EvVar -> SDoc+pprEvVarWithType v = ppr v <+> dcolon <+> pprType (evVarPred v)++++-- | Wraps the given type with the constraints (via ic_given) in the given+-- implication, according to the variables mentioned (via ic_skols)+-- in the implication, but taking care to only wrap those variables+-- that are mentioned in the type or the implication.+wrapTypeWithImplication :: Type -> Implication -> Type+wrapTypeWithImplication ty impl = wrapType ty mentioned_skols givens+    where givens = map idType $ ic_given impl+          skols = ic_skols impl+          freeVars = fvVarSet $ tyCoFVsOfTypes (ty:givens)+          mentioned_skols = filter (`elemVarSet` freeVars) skols++wrapType :: Type -> [TyVar] -> [PredType] -> Type+wrapType ty skols givens = mkSpecForAllTys skols $ mkPhiTy givens ty+++{-+************************************************************************+*                                                                      *+            CtEvidence+*                                                                      *+************************************************************************++Note [Evidence field of CtEvidence]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+During constraint solving we never look at the type of ctev_evar/ctev_dest;+instead we look at the ctev_pred field.  The evtm/evar field+may be un-zonked.++Note [Bind new Givens immediately]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For Givens we make new EvVars and bind them immediately. Two main reasons:+  * Gain sharing.  E.g. suppose we start with g :: C a b, where+       class D a => C a b+       class (E a, F a) => D a+    If we generate all g's superclasses as separate EvTerms we might+    get    selD1 (selC1 g) :: E a+           selD2 (selC1 g) :: F a+           selC1 g :: D a+    which we could do more economically as:+           g1 :: D a = selC1 g+           g2 :: E a = selD1 g1+           g3 :: F a = selD2 g1++  * For *coercion* evidence we *must* bind each given:+      class (a~b) => C a b where ....+      f :: C a b => ....+    Then in f's Givens we have g:(C a b) and the superclass sc(g,0):a~b.+    But that superclass selector can't (yet) appear in a coercion+    (see evTermCoercion), so the easy thing is to bind it to an Id.++So a Given has EvVar inside it rather than (as previously) an EvTerm.++-}++-- | A place for type-checking evidence to go after it is generated.+-- Wanted equalities are always HoleDest; other wanteds are always+-- EvVarDest.+data TcEvDest+  = EvVarDest EvVar         -- ^ bind this var to the evidence+              -- EvVarDest is always used for non-type-equalities+              -- e.g. class constraints++  | HoleDest  CoercionHole  -- ^ fill in this hole with the evidence+              -- HoleDest is always used for type-equalities+              -- See Note [Coercion holes] in TyCoRep++data CtEvidence+  = CtGiven    -- Truly given, not depending on subgoals+      { ctev_pred :: TcPredType      -- See Note [Ct/evidence invariant]+      , ctev_evar :: EvVar           -- See Note [Evidence field of CtEvidence]+      , ctev_loc  :: CtLoc }+++  | CtWanted   -- Wanted goal+      { ctev_pred :: TcPredType     -- See Note [Ct/evidence invariant]+      , ctev_dest :: TcEvDest+      , ctev_nosh :: ShadowInfo     -- See Note [Constraint flavours]+      , ctev_loc  :: CtLoc }++  | CtDerived  -- A goal that we don't really have to solve and can't+               -- immediately rewrite anything other than a derived+               -- (there's no evidence!) but if we do manage to solve+               -- it may help in solving other goals.+      { ctev_pred :: TcPredType+      , ctev_loc  :: CtLoc }++ctEvPred :: CtEvidence -> TcPredType+-- The predicate of a flavor+ctEvPred = ctev_pred++ctEvLoc :: CtEvidence -> CtLoc+ctEvLoc = ctev_loc++ctEvOrigin :: CtEvidence -> CtOrigin+ctEvOrigin = ctLocOrigin . ctEvLoc++-- | Get the equality relation relevant for a 'CtEvidence'+ctEvEqRel :: CtEvidence -> EqRel+ctEvEqRel = predTypeEqRel . ctEvPred++-- | Get the role relevant for a 'CtEvidence'+ctEvRole :: CtEvidence -> Role+ctEvRole = eqRelRole . ctEvEqRel++ctEvTerm :: CtEvidence -> EvTerm+ctEvTerm ev = EvExpr (ctEvExpr ev)++ctEvExpr :: CtEvidence -> EvExpr+ctEvExpr ev@(CtWanted { ctev_dest = HoleDest _ })+            = Coercion $ ctEvCoercion ev+ctEvExpr ev = evId (ctEvEvId ev)++ctEvCoercion :: HasDebugCallStack => CtEvidence -> Coercion+ctEvCoercion (CtGiven { ctev_evar = ev_id })+  = mkTcCoVarCo ev_id+ctEvCoercion (CtWanted { ctev_dest = dest })+  | HoleDest hole <- dest+  = -- ctEvCoercion is only called on type equalities+    -- and they always have HoleDests+    mkHoleCo hole+ctEvCoercion ev+  = pprPanic "ctEvCoercion" (ppr ev)++ctEvEvId :: CtEvidence -> EvVar+ctEvEvId (CtWanted { ctev_dest = EvVarDest ev }) = ev+ctEvEvId (CtWanted { ctev_dest = HoleDest h })   = coHoleCoVar h+ctEvEvId (CtGiven  { ctev_evar = ev })           = ev+ctEvEvId ctev@(CtDerived {}) = pprPanic "ctEvId:" (ppr ctev)++instance Outputable TcEvDest where+  ppr (HoleDest h)   = text "hole" <> ppr h+  ppr (EvVarDest ev) = ppr ev++instance Outputable CtEvidence where+  ppr ev = ppr (ctEvFlavour ev)+           <+> pp_ev+           <+> braces (ppr (ctl_depth (ctEvLoc ev))) <> dcolon+                  -- Show the sub-goal depth too+           <+> ppr (ctEvPred ev)+    where+      pp_ev = case ev of+             CtGiven { ctev_evar = v } -> ppr v+             CtWanted {ctev_dest = d } -> ppr d+             CtDerived {}              -> text "_"++isWanted :: CtEvidence -> Bool+isWanted (CtWanted {}) = True+isWanted _ = False++isGiven :: CtEvidence -> Bool+isGiven (CtGiven {})  = True+isGiven _ = False++isDerived :: CtEvidence -> Bool+isDerived (CtDerived {}) = True+isDerived _              = False++{-+%************************************************************************+%*                                                                      *+            CtFlavour+%*                                                                      *+%************************************************************************++Note [Constraint flavours]+~~~~~~~~~~~~~~~~~~~~~~~~~~+Constraints come in four flavours:++* [G] Given: we have evidence++* [W] Wanted WOnly: we want evidence++* [D] Derived: any solution must satisfy this constraint, but+      we don't need evidence for it.  Examples include:+        - superclasses of [W] class constraints+        - equalities arising from functional dependencies+          or injectivity++* [WD] Wanted WDeriv: a single constraint that represents+                      both [W] and [D]+  We keep them paired as one both for efficiency, and because+  when we have a finite map  F tys -> CFunEqCan, it's inconvenient+  to have two CFunEqCans in the range++The ctev_nosh field of a Wanted distinguishes between [W] and [WD]++Wanted constraints are born as [WD], but are split into [W] and its+"shadow" [D] in TcSMonad.maybeEmitShadow.++See Note [The improvement story and derived shadows] in TcSMonad+-}++data CtFlavour  -- See Note [Constraint flavours]+  = Given+  | Wanted ShadowInfo+  | Derived+  deriving Eq++data ShadowInfo+  = WDeriv   -- [WD] This Wanted constraint has no Derived shadow,+             -- so it behaves like a pair of a Wanted and a Derived+  | WOnly    -- [W] It has a separate derived shadow+             -- See Note [Derived shadows]+  deriving( Eq )++isGivenOrWDeriv :: CtFlavour -> Bool+isGivenOrWDeriv Given           = True+isGivenOrWDeriv (Wanted WDeriv) = True+isGivenOrWDeriv _               = False++instance Outputable CtFlavour where+  ppr Given           = text "[G]"+  ppr (Wanted WDeriv) = text "[WD]"+  ppr (Wanted WOnly)  = text "[W]"+  ppr Derived         = text "[D]"++ctEvFlavour :: CtEvidence -> CtFlavour+ctEvFlavour (CtWanted { ctev_nosh = nosh }) = Wanted nosh+ctEvFlavour (CtGiven {})                    = Given+ctEvFlavour (CtDerived {})                  = Derived++-- | Whether or not one 'Ct' can rewrite another is determined by its+-- flavour and its equality relation. See also+-- Note [Flavours with roles] in TcSMonad+type CtFlavourRole = (CtFlavour, EqRel)++-- | Extract the flavour, role, and boxity from a 'CtEvidence'+ctEvFlavourRole :: CtEvidence -> CtFlavourRole+ctEvFlavourRole ev = (ctEvFlavour ev, ctEvEqRel ev)++-- | Extract the flavour and role from a 'Ct'+ctFlavourRole :: Ct -> CtFlavourRole+-- Uses short-cuts to role for special cases+ctFlavourRole (CDictCan { cc_ev = ev })+  = (ctEvFlavour ev, NomEq)+ctFlavourRole (CTyEqCan { cc_ev = ev, cc_eq_rel = eq_rel })+  = (ctEvFlavour ev, eq_rel)+ctFlavourRole (CFunEqCan { cc_ev = ev })+  = (ctEvFlavour ev, NomEq)+ctFlavourRole (CHoleCan { cc_ev = ev })+  = (ctEvFlavour ev, NomEq)  -- NomEq: CHoleCans can be rewritten by+                             -- by nominal equalities but empahatically+                             -- not by representational equalities+ctFlavourRole ct+  = ctEvFlavourRole (ctEvidence ct)++{- Note [eqCanRewrite]+~~~~~~~~~~~~~~~~~~~~~~+(eqCanRewrite ct1 ct2) holds if the constraint ct1 (a CTyEqCan of form+tv ~ ty) can be used to rewrite ct2.  It must satisfy the properties of+a can-rewrite relation, see Definition [Can-rewrite relation] in+TcSMonad.++With the solver handling Coercible constraints like equality constraints,+the rewrite conditions must take role into account, never allowing+a representational equality to rewrite a nominal one.++Note [Wanteds do not rewrite Wanteds]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We don't allow Wanteds to rewrite Wanteds, because that can give rise+to very confusing type error messages.  A good example is #8450.+Here's another+   f :: a -> Bool+   f x = ( [x,'c'], [x,True] ) `seq` True+Here we get+  [W] a ~ Char+  [W] a ~ Bool+but we do not want to complain about Bool ~ Char!++Note [Deriveds do rewrite Deriveds]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+However we DO allow Deriveds to rewrite Deriveds, because that's how+improvement works; see Note [The improvement story] in TcInteract.++However, for now at least I'm only letting (Derived,NomEq) rewrite+(Derived,NomEq) and not doing anything for ReprEq.  If we have+    eqCanRewriteFR (Derived, NomEq) (Derived, _)  = True+then we lose property R2 of Definition [Can-rewrite relation]+in TcSMonad+  R2.  If f1 >= f, and f2 >= f,+       then either f1 >= f2 or f2 >= f1+Consider f1 = (Given, ReprEq)+         f2 = (Derived, NomEq)+          f = (Derived, ReprEq)++I thought maybe we could never get Derived ReprEq constraints, but+we can; straight from the Wanteds during improvement. And from a Derived+ReprEq we could conceivably get a Derived NomEq improvement (by decomposing+a type constructor with Nomninal role), and hence unify.+-}++eqCanRewrite :: EqRel -> EqRel -> Bool+eqCanRewrite NomEq  _      = True+eqCanRewrite ReprEq ReprEq = True+eqCanRewrite ReprEq NomEq  = False++eqCanRewriteFR :: CtFlavourRole -> CtFlavourRole -> Bool+-- Can fr1 actually rewrite fr2?+-- Very important function!+-- See Note [eqCanRewrite]+-- See Note [Wanteds do not rewrite Wanteds]+-- See Note [Deriveds do rewrite Deriveds]+eqCanRewriteFR (Given,         r1)    (_,       r2)    = eqCanRewrite r1 r2+eqCanRewriteFR (Wanted WDeriv, NomEq) (Derived, NomEq) = True+eqCanRewriteFR (Derived,       NomEq) (Derived, NomEq) = True+eqCanRewriteFR _                      _                = False++eqMayRewriteFR :: CtFlavourRole -> CtFlavourRole -> Bool+-- Is it /possible/ that fr1 can rewrite fr2?+-- This is used when deciding which inerts to kick out,+-- at which time a [WD] inert may be split into [W] and [D]+eqMayRewriteFR (Wanted WDeriv, NomEq) (Wanted WDeriv, NomEq) = True+eqMayRewriteFR (Derived,       NomEq) (Wanted WDeriv, NomEq) = True+eqMayRewriteFR fr1 fr2 = eqCanRewriteFR fr1 fr2++-----------------+{- Note [funEqCanDischarge]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have two CFunEqCans with the same LHS:+    (x1:F ts ~ f1) `funEqCanDischarge` (x2:F ts ~ f2)+Can we drop x2 in favour of x1, either unifying+f2 (if it's a flatten meta-var) or adding a new Given+(f1 ~ f2), if x2 is a Given?++Answer: yes if funEqCanDischarge is true.+-}++funEqCanDischarge+  :: CtEvidence -> CtEvidence+  -> ( SwapFlag   -- NotSwapped => lhs can discharge rhs+                  -- Swapped    => rhs can discharge lhs+     , Bool)      -- True <=> upgrade non-discharded one+                  --          from [W] to [WD]+-- See Note [funEqCanDischarge]+funEqCanDischarge ev1 ev2+  = ASSERT2( ctEvEqRel ev1 == NomEq, ppr ev1 )+    ASSERT2( ctEvEqRel ev2 == NomEq, ppr ev2 )+    -- CFunEqCans are all Nominal, hence asserts+    funEqCanDischargeF (ctEvFlavour ev1) (ctEvFlavour ev2)++funEqCanDischargeF :: CtFlavour -> CtFlavour -> (SwapFlag, Bool)+funEqCanDischargeF Given           _               = (NotSwapped, False)+funEqCanDischargeF _               Given           = (IsSwapped,  False)+funEqCanDischargeF (Wanted WDeriv) _               = (NotSwapped, False)+funEqCanDischargeF _               (Wanted WDeriv) = (IsSwapped,  True)+funEqCanDischargeF (Wanted WOnly)  (Wanted WOnly)  = (NotSwapped, False)+funEqCanDischargeF (Wanted WOnly)  Derived         = (NotSwapped, True)+funEqCanDischargeF Derived         (Wanted WOnly)  = (IsSwapped,  True)+funEqCanDischargeF Derived         Derived         = (NotSwapped, False)+++{- Note [eqCanDischarge]+~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have two identical CTyEqCan equality constraints+(i.e. both LHS and RHS are the same)+      (x1:a~t) `eqCanDischarge` (xs:a~t)+Can we just drop x2 in favour of x1?++Answer: yes if eqCanDischarge is true.++Note that we do /not/ allow Wanted to discharge Derived.+We must keep both.  Why?  Because the Derived may rewrite+other Deriveds in the model whereas the Wanted cannot.++However a Wanted can certainly discharge an identical Wanted.  So+eqCanDischarge does /not/ define a can-rewrite relation in the+sense of Definition [Can-rewrite relation] in TcSMonad.++We /do/ say that a [W] can discharge a [WD].  In evidence terms it+certainly can, and the /caller/ arranges that the otherwise-lost [D]+is spat out as a new Derived.  -}++eqCanDischargeFR :: CtFlavourRole -> CtFlavourRole -> Bool+-- See Note [eqCanDischarge]+eqCanDischargeFR (f1,r1) (f2, r2) =  eqCanRewrite r1 r2+                                  && eqCanDischargeF f1 f2++eqCanDischargeF :: CtFlavour -> CtFlavour -> Bool+eqCanDischargeF Given   _                  = True+eqCanDischargeF (Wanted _)      (Wanted _) = True+eqCanDischargeF (Wanted WDeriv) Derived    = True+eqCanDischargeF Derived         Derived    = True+eqCanDischargeF _               _          = False+++{-+************************************************************************+*                                                                      *+            SubGoalDepth+*                                                                      *+************************************************************************++Note [SubGoalDepth]+~~~~~~~~~~~~~~~~~~~+The 'SubGoalDepth' takes care of stopping the constraint solver from looping.++The counter starts at zero and increases. It includes dictionary constraints,+equality simplification, and type family reduction. (Why combine these? Because+it's actually quite easy to mistake one for another, in sufficiently involved+scenarios, like ConstraintKinds.)++The flag -fcontext-stack=n (not very well named!) fixes the maximium+level.++* The counter includes the depth of type class instance declarations.  Example:+     [W] d{7} : Eq [Int]+  That is d's dictionary-constraint depth is 7.  If we use the instance+     $dfEqList :: Eq a => Eq [a]+  to simplify it, we get+     d{7} = $dfEqList d'{8}+  where d'{8} : Eq Int, and d' has depth 8.++  For civilised (decidable) instance declarations, each increase of+  depth removes a type constructor from the type, so the depth never+  gets big; i.e. is bounded by the structural depth of the type.++* The counter also increments when resolving+equalities involving type functions. Example:+  Assume we have a wanted at depth 7:+    [W] d{7} : F () ~ a+  If there is a type function equation "F () = Int", this would be rewritten to+    [W] d{8} : Int ~ a+  and remembered as having depth 8.++  Again, without UndecidableInstances, this counter is bounded, but without it+  can resolve things ad infinitum. Hence there is a maximum level.++* Lastly, every time an equality is rewritten, the counter increases. Again,+  rewriting an equality constraint normally makes progress, but it's possible+  the "progress" is just the reduction of an infinitely-reducing type family.+  Hence we need to track the rewrites.++When compiling a program requires a greater depth, then GHC recommends turning+off this check entirely by setting -freduction-depth=0. This is because the+exact number that works is highly variable, and is likely to change even between+minor releases. Because this check is solely to prevent infinite compilation+times, it seems safe to disable it when a user has ascertained that their program+doesn't loop at the type level.++-}++-- | See Note [SubGoalDepth]+newtype SubGoalDepth = SubGoalDepth Int+  deriving (Eq, Ord, Outputable)++initialSubGoalDepth :: SubGoalDepth+initialSubGoalDepth = SubGoalDepth 0++bumpSubGoalDepth :: SubGoalDepth -> SubGoalDepth+bumpSubGoalDepth (SubGoalDepth n) = SubGoalDepth (n + 1)++maxSubGoalDepth :: SubGoalDepth -> SubGoalDepth -> SubGoalDepth+maxSubGoalDepth (SubGoalDepth n) (SubGoalDepth m) = SubGoalDepth (n `max` m)++subGoalDepthExceeded :: DynFlags -> SubGoalDepth -> Bool+subGoalDepthExceeded dflags (SubGoalDepth d)+  = mkIntWithInf d > reductionDepth dflags++{-+************************************************************************+*                                                                      *+            CtLoc+*                                                                      *+************************************************************************++The 'CtLoc' gives information about where a constraint came from.+This is important for decent error message reporting because+dictionaries don't appear in the original source code.+type will evolve...++-}++data CtLoc = CtLoc { ctl_origin :: CtOrigin+                   , ctl_env    :: TcLclEnv+                   , ctl_t_or_k :: Maybe TypeOrKind  -- OK if we're not sure+                   , ctl_depth  :: !SubGoalDepth }++  -- The TcLclEnv includes particularly+  --    source location:  tcl_loc   :: RealSrcSpan+  --    context:          tcl_ctxt  :: [ErrCtxt]+  --    binder stack:     tcl_bndrs :: TcBinderStack+  --    level:            tcl_tclvl :: TcLevel++mkKindLoc :: TcType -> TcType   -- original *types* being compared+          -> CtLoc -> CtLoc+mkKindLoc s1 s2 loc = setCtLocOrigin (toKindLoc loc)+                        (KindEqOrigin s1 (Just s2) (ctLocOrigin loc)+                                      (ctLocTypeOrKind_maybe loc))++-- | Take a CtLoc and moves it to the kind level+toKindLoc :: CtLoc -> CtLoc+toKindLoc loc = loc { ctl_t_or_k = Just KindLevel }++mkGivenLoc :: TcLevel -> SkolemInfo -> TcLclEnv -> CtLoc+mkGivenLoc tclvl skol_info env+  = CtLoc { ctl_origin = GivenOrigin skol_info+          , ctl_env    = env { tcl_tclvl = tclvl }+          , ctl_t_or_k = Nothing    -- this only matters for error msgs+          , ctl_depth  = initialSubGoalDepth }++ctLocEnv :: CtLoc -> TcLclEnv+ctLocEnv = ctl_env++ctLocLevel :: CtLoc -> TcLevel+ctLocLevel loc = tcl_tclvl (ctLocEnv loc)++ctLocDepth :: CtLoc -> SubGoalDepth+ctLocDepth = ctl_depth++ctLocOrigin :: CtLoc -> CtOrigin+ctLocOrigin = ctl_origin++ctLocSpan :: CtLoc -> RealSrcSpan+ctLocSpan (CtLoc { ctl_env = lcl}) = tcl_loc lcl++ctLocTypeOrKind_maybe :: CtLoc -> Maybe TypeOrKind+ctLocTypeOrKind_maybe = ctl_t_or_k++setCtLocSpan :: CtLoc -> RealSrcSpan -> CtLoc+setCtLocSpan ctl@(CtLoc { ctl_env = lcl }) loc = setCtLocEnv ctl (lcl { tcl_loc = loc })++bumpCtLocDepth :: CtLoc -> CtLoc+bumpCtLocDepth loc@(CtLoc { ctl_depth = d }) = loc { ctl_depth = bumpSubGoalDepth d }++setCtLocOrigin :: CtLoc -> CtOrigin -> CtLoc+setCtLocOrigin ctl orig = ctl { ctl_origin = orig }++updateCtLocOrigin :: CtLoc -> (CtOrigin -> CtOrigin) -> CtLoc+updateCtLocOrigin ctl@(CtLoc { ctl_origin = orig }) upd+  = ctl { ctl_origin = upd orig }++setCtLocEnv :: CtLoc -> TcLclEnv -> CtLoc+setCtLocEnv ctl env = ctl { ctl_env = env }++pushErrCtxt :: CtOrigin -> ErrCtxt -> CtLoc -> CtLoc+pushErrCtxt o err loc@(CtLoc { ctl_env = lcl })+  = loc { ctl_origin = o, ctl_env = lcl { tcl_ctxt = err : tcl_ctxt lcl } }++pushErrCtxtSameOrigin :: ErrCtxt -> CtLoc -> CtLoc+-- Just add information w/o updating the origin!+pushErrCtxtSameOrigin err loc@(CtLoc { ctl_env = lcl })+  = loc { ctl_env = lcl { tcl_ctxt = err : tcl_ctxt lcl } }++{-+************************************************************************+*                                                                      *+                SkolemInfo+*                                                                      *+************************************************************************+-}++-- SkolemInfo gives the origin of *given* constraints+--   a) type variables are skolemised+--   b) an implication constraint is generated+data SkolemInfo+  = SigSkol -- A skolem that is created by instantiating+            -- a programmer-supplied type signature+            -- Location of the binding site is on the TyVar+            -- See Note [SigSkol SkolemInfo]+       UserTypeCtxt        -- What sort of signature+       TcType              -- Original type signature (before skolemisation)+       [(Name,TcTyVar)]    -- Maps the original name of the skolemised tyvar+                           -- to its instantiated version++  | SigTypeSkol UserTypeCtxt+                 -- like SigSkol, but when we're kind-checking the *type*+                 -- hence, we have less info++  | ForAllSkol SDoc     -- Bound by a user-written "forall".++  | DerivSkol Type      -- Bound by a 'deriving' clause;+                        -- the type is the instance we are trying to derive++  | InstSkol            -- Bound at an instance decl+  | InstSC TypeSize     -- A "given" constraint obtained by superclass selection.+                        -- If (C ty1 .. tyn) is the largest class from+                        --    which we made a superclass selection in the chain,+                        --    then TypeSize = sizeTypes [ty1, .., tyn]+                        -- See Note [Solving superclass constraints] in TcInstDcls++  | FamInstSkol         -- Bound at a family instance decl+  | PatSkol             -- An existential type variable bound by a pattern for+      ConLike           -- a data constructor with an existential type.+      (HsMatchContext Name)+             -- e.g.   data T = forall a. Eq a => MkT a+             --        f (MkT x) = ...+             -- The pattern MkT x will allocate an existential type+             -- variable for 'a'.++  | ArrowSkol           -- An arrow form (see TcArrows)++  | IPSkol [HsIPName]   -- Binding site of an implicit parameter++  | RuleSkol RuleName   -- The LHS of a RULE++  | InferSkol [(Name,TcType)]+                        -- We have inferred a type for these (mutually-recursivive)+                        -- polymorphic Ids, and are now checking that their RHS+                        -- constraints are satisfied.++  | BracketSkol         -- Template Haskell bracket++  | UnifyForAllSkol     -- We are unifying two for-all types+       TcType           -- The instantiated type *inside* the forall++  | TyConSkol TyConFlavour Name  -- bound in a type declaration of the given flavour++  | DataConSkol Name    -- bound as an existential in a Haskell98 datacon decl or+                        -- as any variable in a GADT datacon decl++  | ReifySkol           -- Bound during Template Haskell reification++  | QuantCtxtSkol       -- Quantified context, e.g.+                        --   f :: forall c. (forall a. c a => c [a]) => blah++  | UnkSkol             -- Unhelpful info (until I improve it)++instance Outputable SkolemInfo where+  ppr = pprSkolInfo++pprSkolInfo :: SkolemInfo -> SDoc+-- Complete the sentence "is a rigid type variable bound by..."+pprSkolInfo (SigSkol cx ty _) = pprSigSkolInfo cx ty+pprSkolInfo (SigTypeSkol cx)  = pprUserTypeCtxt cx+pprSkolInfo (ForAllSkol doc)  = quotes doc+pprSkolInfo (IPSkol ips)      = text "the implicit-parameter binding" <> plural ips <+> text "for"+                                 <+> pprWithCommas ppr ips+pprSkolInfo (DerivSkol pred)  = text "the deriving clause for" <+> quotes (ppr pred)+pprSkolInfo InstSkol          = text "the instance declaration"+pprSkolInfo (InstSC n)        = text "the instance declaration" <> whenPprDebug (parens (ppr n))+pprSkolInfo FamInstSkol       = text "a family instance declaration"+pprSkolInfo BracketSkol       = text "a Template Haskell bracket"+pprSkolInfo (RuleSkol name)   = text "the RULE" <+> pprRuleName name+pprSkolInfo ArrowSkol         = text "an arrow form"+pprSkolInfo (PatSkol cl mc)   = sep [ pprPatSkolInfo cl+                                    , text "in" <+> pprMatchContext mc ]+pprSkolInfo (InferSkol ids)   = hang (text "the inferred type" <> plural ids <+> text "of")+                                   2 (vcat [ ppr name <+> dcolon <+> ppr ty+                                                   | (name,ty) <- ids ])+pprSkolInfo (UnifyForAllSkol ty) = text "the type" <+> ppr ty+pprSkolInfo (TyConSkol flav name) = text "the" <+> ppr flav <+> text "declaration for" <+> quotes (ppr name)+pprSkolInfo (DataConSkol name)= text "the data constructor" <+> quotes (ppr name)+pprSkolInfo ReifySkol         = text "the type being reified"++pprSkolInfo (QuantCtxtSkol {}) = text "a quantified context"++-- UnkSkol+-- For type variables the others are dealt with by pprSkolTvBinding.+-- For Insts, these cases should not happen+pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) text "UnkSkol"++pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc+-- The type is already tidied+pprSigSkolInfo ctxt ty+  = case ctxt of+       FunSigCtxt f _ -> vcat [ text "the type signature for:"+                              , nest 2 (pprPrefixOcc f <+> dcolon <+> ppr ty) ]+       PatSynCtxt {}  -> pprUserTypeCtxt ctxt  -- See Note [Skolem info for pattern synonyms]+       _              -> vcat [ pprUserTypeCtxt ctxt <> colon+                              , nest 2 (ppr ty) ]++pprPatSkolInfo :: ConLike -> SDoc+pprPatSkolInfo (RealDataCon dc)+  = sep [ text "a pattern with constructor:"+        , nest 2 $ ppr dc <+> dcolon+          <+> pprType (dataConUserType dc) <> comma ]+          -- pprType prints forall's regardless of -fprint-explicit-foralls+          -- which is what we want here, since we might be saying+          -- type variable 't' is bound by ...++pprPatSkolInfo (PatSynCon ps)+  = sep [ text "a pattern with pattern synonym:"+        , nest 2 $ ppr ps <+> dcolon+                   <+> pprPatSynType ps <> comma ]++{- Note [Skolem info for pattern synonyms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For pattern synonym SkolemInfo we have+   SigSkol (PatSynCtxt p) ty _+but the type 'ty' is not very helpful.  The full pattern-synonym type+has the provided and required pieces, which it is inconvenient to+record and display here. So we simply don't display the type at all,+contenting outselves with just the name of the pattern synonym, which+is fine.  We could do more, but it doesn't seem worth it.++Note [SigSkol SkolemInfo]+~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we (deeply) skolemise a type+   f :: forall a. a -> forall b. b -> a+Then we'll instantiate [a :-> a', b :-> b'], and with the instantiated+      a' -> b' -> a.+But when, in an error message, we report that "b is a rigid type+variable bound by the type signature for f", we want to show the foralls+in the right place.  So we proceed as follows:++* In SigSkol we record+    - the original signature forall a. a -> forall b. b -> a+    - the instantiation mapping [a :-> a', b :-> b']++* Then when tidying in TcMType.tidySkolemInfo, we first tidy a' to+  whatever it tidies to, say a''; and then we walk over the type+  replacing the binder a by the tidied version a'', to give+       forall a''. a'' -> forall b''. b'' -> a''+  We need to do this under function arrows, to match what deeplySkolemise+  does.++* Typically a'' will have a nice pretty name like "a", but the point is+  that the foral-bound variables of the signature we report line up with+  the instantiated skolems lying  around in other types.+++************************************************************************+*                                                                      *+            CtOrigin+*                                                                      *+************************************************************************+-}++data CtOrigin+  = GivenOrigin SkolemInfo++  -- All the others are for *wanted* constraints+  | OccurrenceOf Name              -- Occurrence of an overloaded identifier+  | OccurrenceOfRecSel RdrName     -- Occurrence of a record selector+  | AppOrigin                      -- An application of some kind++  | SpecPragOrigin UserTypeCtxt    -- Specialisation pragma for+                                   -- function or instance++  | TypeEqOrigin { uo_actual   :: TcType+                 , uo_expected :: TcType+                 , uo_thing    :: Maybe SDoc+                       -- ^ The thing that has type "actual"+                 , uo_visible  :: Bool+                       -- ^ Is at least one of the three elements above visible?+                       -- (Errors from the polymorphic subsumption check are considered+                       -- visible.) Only used for prioritizing error messages.+                 }++  | KindEqOrigin  -- See Note [Equalities with incompatible kinds] in TcCanonical.+      TcType (Maybe TcType)     -- A kind equality arising from unifying these two types+      CtOrigin                  -- originally arising from this+      (Maybe TypeOrKind)        -- the level of the eq this arises from++  | IPOccOrigin  HsIPName       -- Occurrence of an implicit parameter+  | OverLabelOrigin FastString  -- Occurrence of an overloaded label++  | LiteralOrigin (HsOverLit GhcRn)     -- Occurrence of a literal+  | NegateOrigin                        -- Occurrence of syntactic negation++  | ArithSeqOrigin (ArithSeqInfo GhcRn) -- [x..], [x..y] etc+  | AssocFamPatOrigin   -- When matching the patterns of an associated+                        -- family instance with that of its parent class+  | SectionOrigin+  | TupleOrigin         -- (..,..)+  | ExprSigOrigin       -- e :: ty+  | PatSigOrigin        -- p :: ty+  | PatOrigin           -- Instantiating a polytyped pattern at a constructor+  | ProvCtxtOrigin      -- The "provided" context of a pattern synonym signature+        (PatSynBind GhcRn GhcRn) -- Information about the pattern synonym, in+                                 -- particular the name and the right-hand side+  | RecordUpdOrigin+  | ViewPatOrigin++  | ScOrigin TypeSize   -- Typechecking superclasses of an instance declaration+                        -- If the instance head is C ty1 .. tyn+                        --    then TypeSize = sizeTypes [ty1, .., tyn]+                        -- See Note [Solving superclass constraints] in TcInstDcls++  | DerivClauseOrigin   -- Typechecking a deriving clause (as opposed to+                        -- standalone deriving).+  | DerivOriginDC DataCon Int Bool+      -- Checking constraints arising from this data con and field index. The+      -- Bool argument in DerivOriginDC and DerivOriginCoerce is True if+      -- standalong deriving (with a wildcard constraint) is being used. This+      -- is used to inform error messages on how to recommended fixes (e.g., if+      -- the argument is True, then don't recommend "use standalone deriving",+      -- but rather "fill in the wildcard constraint yourself").+      -- See Note [Inferring the instance context] in TcDerivInfer+  | DerivOriginCoerce Id Type Type Bool+                        -- DerivOriginCoerce id ty1 ty2: Trying to coerce class method `id` from+                        -- `ty1` to `ty2`.+  | StandAloneDerivOrigin -- Typechecking stand-alone deriving. Useful for+                          -- constraints coming from a wildcard constraint,+                          -- e.g., deriving instance _ => Eq (Foo a)+                          -- See Note [Inferring the instance context]+                          -- in TcDerivInfer+  | DefaultOrigin       -- Typechecking a default decl+  | DoOrigin            -- Arising from a do expression+  | DoPatOrigin (LPat GhcRn) -- Arising from a failable pattern in+                             -- a do expression+  | MCompOrigin         -- Arising from a monad comprehension+  | MCompPatOrigin (LPat GhcRn) -- Arising from a failable pattern in a+                                -- monad comprehension+  | IfOrigin            -- Arising from an if statement+  | ProcOrigin          -- Arising from a proc expression+  | AnnOrigin           -- An annotation++  | FunDepOrigin1       -- A functional dependency from combining+        PredType CtLoc      -- This constraint arising from ...+        PredType CtLoc      -- and this constraint arising from ...++  | FunDepOrigin2       -- A functional dependency from combining+        PredType CtOrigin   -- This constraint arising from ...+        PredType SrcSpan    -- and this top-level instance+        -- We only need a CtOrigin on the first, because the location+        -- is pinned on the entire error message++  | HoleOrigin+  | UnboundOccurrenceOf OccName+  | ListOrigin          -- An overloaded list+  | StaticOrigin        -- A static form+  | FailablePattern (LPat GhcTcId) -- A failable pattern in do-notation for the+                                   -- MonadFail Proposal (MFP). Obsolete when+                                   -- actual desugaring to MonadFail.fail is+                                   -- live.+  | Shouldn'tHappenOrigin String+                            -- the user should never see this one,+                            -- unless ImpredicativeTypes is on, where all+                            -- bets are off+  | InstProvidedOrigin Module ClsInst+        -- Skolem variable arose when we were testing if an instance+        -- is solvable or not.++-- | Flag to see whether we're type-checking terms or kind-checking types+data TypeOrKind = TypeLevel | KindLevel+  deriving Eq++instance Outputable TypeOrKind where+  ppr TypeLevel = text "TypeLevel"+  ppr KindLevel = text "KindLevel"++isTypeLevel :: TypeOrKind -> Bool+isTypeLevel TypeLevel = True+isTypeLevel KindLevel = False++isKindLevel :: TypeOrKind -> Bool+isKindLevel TypeLevel = False+isKindLevel KindLevel = True++-- An origin is visible if the place where the constraint arises is manifest+-- in user code. Currently, all origins are visible except for invisible+-- TypeEqOrigins. This is used when choosing which error of+-- several to report+isVisibleOrigin :: CtOrigin -> Bool+isVisibleOrigin (TypeEqOrigin { uo_visible = vis }) = vis+isVisibleOrigin (KindEqOrigin _ _ sub_orig _)       = isVisibleOrigin sub_orig+isVisibleOrigin _                                   = True++-- Converts a visible origin to an invisible one, if possible. Currently,+-- this works only for TypeEqOrigin+toInvisibleOrigin :: CtOrigin -> CtOrigin+toInvisibleOrigin orig@(TypeEqOrigin {}) = orig { uo_visible = False }+toInvisibleOrigin orig                   = orig++instance Outputable CtOrigin where+  ppr = pprCtOrigin++ctoHerald :: SDoc+ctoHerald = text "arising from"++-- | Extract a suitable CtOrigin from a HsExpr+lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin+lexprCtOrigin (L _ e) = exprCtOrigin e++exprCtOrigin :: HsExpr GhcRn -> CtOrigin+exprCtOrigin (HsVar _ (L _ name)) = OccurrenceOf name+exprCtOrigin (HsUnboundVar _ uv)  = UnboundOccurrenceOf (unboundVarOcc uv)+exprCtOrigin (HsConLikeOut {})    = panic "exprCtOrigin HsConLikeOut"+exprCtOrigin (HsRecFld _ f)    = OccurrenceOfRecSel (rdrNameAmbiguousFieldOcc f)+exprCtOrigin (HsOverLabel _ _ l)  = OverLabelOrigin l+exprCtOrigin (HsIPVar _ ip)       = IPOccOrigin ip+exprCtOrigin (HsOverLit _ lit)    = LiteralOrigin lit+exprCtOrigin (HsLit {})           = Shouldn'tHappenOrigin "concrete literal"+exprCtOrigin (HsLam _ matches)    = matchesCtOrigin matches+exprCtOrigin (HsLamCase _ ms)     = matchesCtOrigin ms+exprCtOrigin (HsApp _ e1 _)       = lexprCtOrigin e1+exprCtOrigin (HsAppType _ e1 _)   = lexprCtOrigin e1+exprCtOrigin (OpApp _ _ op _)     = lexprCtOrigin op+exprCtOrigin (NegApp _ e _)       = lexprCtOrigin e+exprCtOrigin (HsPar _ e)          = lexprCtOrigin e+exprCtOrigin (SectionL _ _ _)     = SectionOrigin+exprCtOrigin (SectionR _ _ _)     = SectionOrigin+exprCtOrigin (ExplicitTuple {})   = Shouldn'tHappenOrigin "explicit tuple"+exprCtOrigin ExplicitSum{}        = Shouldn'tHappenOrigin "explicit sum"+exprCtOrigin (HsCase _ _ matches) = matchesCtOrigin matches+exprCtOrigin (HsIf _ (Just syn) _ _ _) = exprCtOrigin (syn_expr syn)+exprCtOrigin (HsIf {})           = Shouldn'tHappenOrigin "if expression"+exprCtOrigin (HsMultiIf _ rhs)   = lGRHSCtOrigin rhs+exprCtOrigin (HsLet _ _ e)       = lexprCtOrigin e+exprCtOrigin (HsDo {})           = DoOrigin+exprCtOrigin (ExplicitList {})   = Shouldn'tHappenOrigin "list"+exprCtOrigin (RecordCon {})      = Shouldn'tHappenOrigin "record construction"+exprCtOrigin (RecordUpd {})      = Shouldn'tHappenOrigin "record update"+exprCtOrigin (ExprWithTySig {})  = ExprSigOrigin+exprCtOrigin (ArithSeq {})       = Shouldn'tHappenOrigin "arithmetic sequence"+exprCtOrigin (HsSCC _ _ _ e)     = lexprCtOrigin e+exprCtOrigin (HsCoreAnn _ _ _ e) = lexprCtOrigin e+exprCtOrigin (HsBracket {})      = Shouldn'tHappenOrigin "TH bracket"+exprCtOrigin (HsRnBracketOut {})= Shouldn'tHappenOrigin "HsRnBracketOut"+exprCtOrigin (HsTcBracketOut {})= panic "exprCtOrigin HsTcBracketOut"+exprCtOrigin (HsSpliceE {})      = Shouldn'tHappenOrigin "TH splice"+exprCtOrigin (HsProc {})         = Shouldn'tHappenOrigin "proc"+exprCtOrigin (HsStatic {})       = Shouldn'tHappenOrigin "static expression"+exprCtOrigin (HsTick _ _ e)           = lexprCtOrigin e+exprCtOrigin (HsBinTick _ _ _ e)      = lexprCtOrigin e+exprCtOrigin (HsTickPragma _ _ _ _ e) = lexprCtOrigin e+exprCtOrigin (EWildPat {})      = panic "exprCtOrigin EWildPat"+exprCtOrigin (EAsPat {})        = panic "exprCtOrigin EAsPat"+exprCtOrigin (EViewPat {})      = panic "exprCtOrigin EViewPat"+exprCtOrigin (ELazyPat {})      = panic "exprCtOrigin ELazyPat"+exprCtOrigin (HsWrap {})        = panic "exprCtOrigin HsWrap"+exprCtOrigin (XExpr {})         = panic "exprCtOrigin XExpr"++-- | Extract a suitable CtOrigin from a MatchGroup+matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin+matchesCtOrigin (MG { mg_alts = alts })+  | L _ [L _ match] <- alts+  , Match { m_grhss = grhss } <- match+  = grhssCtOrigin grhss++  | otherwise+  = Shouldn'tHappenOrigin "multi-way match"+matchesCtOrigin (XMatchGroup{}) = panic "matchesCtOrigin"++-- | Extract a suitable CtOrigin from guarded RHSs+grhssCtOrigin :: GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin+grhssCtOrigin (GRHSs { grhssGRHSs = lgrhss }) = lGRHSCtOrigin lgrhss+grhssCtOrigin (XGRHSs _) = panic "grhssCtOrigin"++-- | Extract a suitable CtOrigin from a list of guarded RHSs+lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin+lGRHSCtOrigin [L _ (GRHS _ _ (L _ e))] = exprCtOrigin e+lGRHSCtOrigin [L _ (XGRHS _)] = panic "lGRHSCtOrigin"+lGRHSCtOrigin _ = Shouldn'tHappenOrigin "multi-way GRHS"++pprCtLoc :: CtLoc -> SDoc+-- "arising from ... at ..."+-- Not an instance of Outputable because of the "arising from" prefix+pprCtLoc (CtLoc { ctl_origin = o, ctl_env = lcl})+  = sep [ pprCtOrigin o+        , text "at" <+> ppr (tcl_loc lcl)]++pprCtOrigin :: CtOrigin -> SDoc+-- "arising from ..."+-- Not an instance of Outputable because of the "arising from" prefix+pprCtOrigin (GivenOrigin sk) = ctoHerald <+> ppr sk++pprCtOrigin (SpecPragOrigin ctxt)+  = case ctxt of+       FunSigCtxt n _ -> text "a SPECIALISE pragma for" <+> quotes (ppr n)+       SpecInstCtxt   -> text "a SPECIALISE INSTANCE pragma"+       _              -> text "a SPECIALISE pragma"  -- Never happens I think++pprCtOrigin (FunDepOrigin1 pred1 loc1 pred2 loc2)+  = hang (ctoHerald <+> text "a functional dependency between constraints:")+       2 (vcat [ hang (quotes (ppr pred1)) 2 (pprCtLoc loc1)+               , hang (quotes (ppr pred2)) 2 (pprCtLoc loc2) ])++pprCtOrigin (FunDepOrigin2 pred1 orig1 pred2 loc2)+  = hang (ctoHerald <+> text "a functional dependency between:")+       2 (vcat [ hang (text "constraint" <+> quotes (ppr pred1))+                    2 (pprCtOrigin orig1 )+               , hang (text "instance" <+> quotes (ppr pred2))+                    2 (text "at" <+> ppr loc2) ])++pprCtOrigin (KindEqOrigin t1 (Just t2) _ _)+  = hang (ctoHerald <+> text "a kind equality arising from")+       2 (sep [ppr t1, char '~', ppr t2])++pprCtOrigin AssocFamPatOrigin+  = text "when matching a family LHS with its class instance head"++pprCtOrigin (KindEqOrigin t1 Nothing _ _)+  = hang (ctoHerald <+> text "a kind equality when matching")+       2 (ppr t1)++pprCtOrigin (UnboundOccurrenceOf name)+  = ctoHerald <+> text "an undeclared identifier" <+> quotes (ppr name)++pprCtOrigin (DerivOriginDC dc n _)+  = hang (ctoHerald <+> text "the" <+> speakNth n+          <+> text "field of" <+> quotes (ppr dc))+       2 (parens (text "type" <+> quotes (ppr ty)))+  where+    ty = dataConOrigArgTys dc !! (n-1)++pprCtOrigin (DerivOriginCoerce meth ty1 ty2 _)+  = hang (ctoHerald <+> text "the coercion of the method" <+> quotes (ppr meth))+       2 (sep [ text "from type" <+> quotes (ppr ty1)+              , nest 2 $ text "to type" <+> quotes (ppr ty2) ])++pprCtOrigin (DoPatOrigin pat)+    = ctoHerald <+> text "a do statement"+      $$+      text "with the failable pattern" <+> quotes (ppr pat)++pprCtOrigin (MCompPatOrigin pat)+    = ctoHerald <+> hsep [ text "the failable pattern"+           , quotes (ppr pat)+           , text "in a statement in a monad comprehension" ]+pprCtOrigin (FailablePattern pat)+    = ctoHerald <+> text "the failable pattern" <+> quotes (ppr pat)+      $$+      text "(this will become an error in a future GHC release)"++pprCtOrigin (Shouldn'tHappenOrigin note)+  = sdocWithDynFlags $ \dflags ->+    if xopt LangExt.ImpredicativeTypes dflags+    then text "a situation created by impredicative types"+    else+    vcat [ text "<< This should not appear in error messages. If you see this"+         , text "in an error message, please report a bug mentioning" <+> quotes (text note) <+> text "at"+         , text "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug >>" ]++pprCtOrigin (ProvCtxtOrigin PSB{ psb_id = (L _ name) })+  = hang (ctoHerald <+> text "the \"provided\" constraints claimed by")+       2 (text "the signature of" <+> quotes (ppr name))++pprCtOrigin (InstProvidedOrigin mod cls_inst)+  = vcat [ text "arising when attempting to show that"+         , ppr cls_inst+         , text "is provided by" <+> quotes (ppr mod)]++pprCtOrigin simple_origin+  = ctoHerald <+> pprCtO simple_origin++-- | Short one-liners+pprCtO :: CtOrigin -> SDoc+pprCtO (OccurrenceOf name)   = hsep [text "a use of", quotes (ppr name)]+pprCtO (OccurrenceOfRecSel name) = hsep [text "a use of", quotes (ppr name)]+pprCtO AppOrigin             = text "an application"+pprCtO (IPOccOrigin name)    = hsep [text "a use of implicit parameter", quotes (ppr name)]+pprCtO (OverLabelOrigin l)   = hsep [text "the overloaded label"+                                    ,quotes (char '#' <> ppr l)]+pprCtO RecordUpdOrigin       = text "a record update"+pprCtO ExprSigOrigin         = text "an expression type signature"+pprCtO PatSigOrigin          = text "a pattern type signature"+pprCtO PatOrigin             = text "a pattern"+pprCtO ViewPatOrigin         = text "a view pattern"+pprCtO IfOrigin              = text "an if expression"+pprCtO (LiteralOrigin lit)   = hsep [text "the literal", quotes (ppr lit)]+pprCtO (ArithSeqOrigin seq)  = hsep [text "the arithmetic sequence", quotes (ppr seq)]+pprCtO SectionOrigin         = text "an operator section"+pprCtO AssocFamPatOrigin     = text "the LHS of a famly instance"+pprCtO TupleOrigin           = text "a tuple"+pprCtO NegateOrigin          = text "a use of syntactic negation"+pprCtO (ScOrigin n)          = text "the superclasses of an instance declaration"+                               <> whenPprDebug (parens (ppr n))+pprCtO DerivClauseOrigin     = text "the 'deriving' clause of a data type declaration"+pprCtO StandAloneDerivOrigin = text "a 'deriving' declaration"+pprCtO DefaultOrigin         = text "a 'default' declaration"+pprCtO DoOrigin              = text "a do statement"+pprCtO MCompOrigin           = text "a statement in a monad comprehension"+pprCtO ProcOrigin            = text "a proc expression"+pprCtO (TypeEqOrigin t1 t2 _ _)= text "a type equality" <+> sep [ppr t1, char '~', ppr t2]+pprCtO AnnOrigin             = text "an annotation"+pprCtO HoleOrigin            = text "a use of" <+> quotes (text "_")+pprCtO ListOrigin            = text "an overloaded list"+pprCtO StaticOrigin          = text "a static form"+pprCtO _                     = panic "pprCtOrigin"++{-+Constraint Solver Plugins+-------------------------+-}++type TcPluginSolver = [Ct]    -- given+                   -> [Ct]    -- derived+                   -> [Ct]    -- wanted+                   -> TcPluginM TcPluginResult++newtype TcPluginM a = TcPluginM (EvBindsVar -> TcM a)++instance Functor TcPluginM where+  fmap = liftM++instance Applicative TcPluginM where+  pure x = TcPluginM (const $ pure x)+  (<*>) = ap++instance Monad TcPluginM where+#if !MIN_VERSION_base(4,13,0)+  fail = MonadFail.fail+#endif+  TcPluginM m >>= k =+    TcPluginM (\ ev -> do a <- m ev+                          runTcPluginM (k a) ev)++instance MonadFail.MonadFail TcPluginM where+  fail x   = TcPluginM (const $ fail x)++runTcPluginM :: TcPluginM a -> EvBindsVar -> TcM a+runTcPluginM (TcPluginM m) = m++-- | This function provides an escape for direct access to+-- the 'TcM` monad.  It should not be used lightly, and+-- the provided 'TcPluginM' API should be favoured instead.+unsafeTcPluginTcM :: TcM a -> TcPluginM a+unsafeTcPluginTcM = TcPluginM . const++-- | Access the 'EvBindsVar' carried by the 'TcPluginM' during+-- constraint solving.  Returns 'Nothing' if invoked during+-- 'tcPluginInit' or 'tcPluginStop'.+getEvBindsTcPluginM :: TcPluginM EvBindsVar+getEvBindsTcPluginM = TcPluginM return+++data TcPlugin = forall s. TcPlugin+  { tcPluginInit  :: TcPluginM s+    -- ^ Initialize plugin, when entering type-checker.++  , tcPluginSolve :: s -> TcPluginSolver+    -- ^ Solve some constraints.+    -- TODO: WRITE MORE DETAILS ON HOW THIS WORKS.++  , tcPluginStop  :: s -> TcPluginM ()+   -- ^ Clean up after the plugin, when exiting the type-checker.+  }++data TcPluginResult+  = TcPluginContradiction [Ct]+    -- ^ The plugin found a contradiction.+    -- The returned constraints are removed from the inert set,+    -- and recorded as insoluble.++  | TcPluginOk [(EvTerm,Ct)] [Ct]+    -- ^ The first field is for constraints that were solved.+    -- These are removed from the inert set,+    -- and the evidence for them is recorded.+    -- The second field contains new work, that should be processed by+    -- the constraint solver.++{- *********************************************************************+*                                                                      *+                        Role annotations+*                                                                      *+********************************************************************* -}++type RoleAnnotEnv = NameEnv (LRoleAnnotDecl GhcRn)++mkRoleAnnotEnv :: [LRoleAnnotDecl GhcRn] -> RoleAnnotEnv+mkRoleAnnotEnv role_annot_decls+ = mkNameEnv [ (name, ra_decl)+             | ra_decl <- role_annot_decls+             , let name = roleAnnotDeclName (unLoc ra_decl)+             , not (isUnboundName name) ]+       -- Some of the role annots will be unbound;+       -- we don't wish to include these++emptyRoleAnnotEnv :: RoleAnnotEnv+emptyRoleAnnotEnv = emptyNameEnv++lookupRoleAnnot :: RoleAnnotEnv -> Name -> Maybe (LRoleAnnotDecl GhcRn)+lookupRoleAnnot = lookupNameEnv++getRoleAnnots :: [Name] -> RoleAnnotEnv+              -> ([LRoleAnnotDecl GhcRn], RoleAnnotEnv)+getRoleAnnots bndrs role_env+  = ( mapMaybe (lookupRoleAnnot role_env) bndrs+    , delListFromNameEnv role_env bndrs )
+ compiler/typecheck/TcRnTypes.hs-boot view
@@ -0,0 +1,6 @@+module TcRnTypes where++-- Build ordering+import GHC.Base()++data TcLclEnv
+ compiler/typecheck/TcType.hs view
@@ -0,0 +1,2618 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[TcType]{Types used in the typechecker}++This module provides the Type interface for front-end parts of the+compiler.  These parts++        * treat "source types" as opaque:+                newtypes, and predicates are meaningful.+        * look through usage types++The "tc" prefix is for "TypeChecker", because the type checker+is the principal client.+-}++{-# LANGUAGE CPP, ScopedTypeVariables, MultiWayIf, FlexibleContexts #-}++module TcType (+  --------------------------------+  -- Types+  TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType,+  TcTyVar, TcTyVarSet, TcDTyVarSet, TcTyCoVarSet, TcDTyCoVarSet,+  TcKind, TcCoVar, TcTyCoVar, TcTyVarBinder, TcTyCon,+  KnotTied,++  ExpType(..), InferResult(..), ExpSigmaType, ExpRhoType, mkCheckExpType,++  SyntaxOpType(..), synKnownType, mkSynFunTys,++  -- TcLevel+  TcLevel(..), topTcLevel, pushTcLevel, isTopTcLevel,+  strictlyDeeperThan, sameDepthAs,+  tcTypeLevel, tcTyVarLevel, maxTcLevel,+  promoteSkolem, promoteSkolemX, promoteSkolemsX,+  --------------------------------+  -- MetaDetails+  UserTypeCtxt(..), pprUserTypeCtxt, isSigMaybe,+  TcTyVarDetails(..), pprTcTyVarDetails, vanillaSkolemTv, superSkolemTv,+  MetaDetails(Flexi, Indirect), MetaInfo(..),+  isImmutableTyVar, isSkolemTyVar, isMetaTyVar,  isMetaTyVarTy, isTyVarTy,+  tcIsTcTyVar, isTyVarTyVar, isOverlappableTyVar,  isTyConableTyVar,+  isFskTyVar, isFmvTyVar, isFlattenTyVar,+  isAmbiguousTyVar, metaTyVarRef, metaTyVarInfo,+  isFlexi, isIndirect, isRuntimeUnkSkol,+  metaTyVarTcLevel, setMetaTyVarTcLevel, metaTyVarTcLevel_maybe,+  isTouchableMetaTyVar,+  isFloatedTouchableMetaTyVar,+  findDupTyVarTvs, mkTyVarNamePairs,++  --------------------------------+  -- Builders+  mkPhiTy, mkInfSigmaTy, mkSpecSigmaTy, mkSigmaTy,+  mkTcAppTy, mkTcAppTys, mkTcCastTy,++  --------------------------------+  -- Splitters+  -- These are important because they do not look through newtypes+  getTyVar,+  tcSplitForAllTy_maybe,+  tcSplitForAllTys, tcSplitForAllTysSameVis,+  tcSplitPiTys, tcSplitPiTy_maybe, tcSplitForAllVarBndrs,+  tcSplitPhiTy, tcSplitPredFunTy_maybe,+  tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcFunResultTyN,+  tcSplitFunTysN,+  tcSplitTyConApp, tcSplitTyConApp_maybe,+  tcTyConAppTyCon, tcTyConAppTyCon_maybe, tcTyConAppArgs,+  tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, tcRepSplitAppTy_maybe,+  tcRepGetNumAppTys,+  tcGetCastedTyVar_maybe, tcGetTyVar_maybe, tcGetTyVar, nextRole,+  tcSplitSigmaTy, tcSplitNestedSigmaTys, tcDeepSplitSigmaTy_maybe,++  ---------------------------------+  -- Predicates.+  -- Again, newtypes are opaque+  eqType, eqTypes, nonDetCmpType, nonDetCmpTypes, eqTypeX,+  pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck, tcEqTypeVis,+  isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy,+  isFloatingTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy,+  isIntegerTy, isBoolTy, isUnitTy, isCharTy, isCallStackTy, isCallStackPred,+  hasIPPred, isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy,+  isPredTy, isTyVarClassPred, isTyVarHead, isInsolubleOccursCheck,+  checkValidClsArgs, hasTyVarHead,+  isRigidTy,++  ---------------------------------+  -- Misc type manipulators++  deNoteType,+  orphNamesOfType, orphNamesOfCo,+  orphNamesOfTypes, orphNamesOfCoCon,+  getDFunTyKey, evVarPred,++  ---------------------------------+  -- Predicate types+  mkMinimalBySCs, transSuperClasses,+  pickQuantifiablePreds, pickCapturedPreds,+  immSuperClasses, boxEqPred,+  isImprovementPred,++  -- * Finding type instances+  tcTyFamInsts, tcTyFamInstsAndVis, tcTyConAppTyFamInstsAndVis, isTyFamFree,++  -- * Finding "exact" (non-dead) type variables+  exactTyCoVarsOfType, exactTyCoVarsOfTypes,+  anyRewritableTyVar,++  ---------------------------------+  -- Foreign import and export+  isFFIArgumentTy,     -- :: DynFlags -> Safety -> Type -> Bool+  isFFIImportResultTy, -- :: DynFlags -> Type -> Bool+  isFFIExportResultTy, -- :: Type -> Bool+  isFFIExternalTy,     -- :: Type -> Bool+  isFFIDynTy,          -- :: Type -> Type -> Bool+  isFFIPrimArgumentTy, -- :: DynFlags -> Type -> Bool+  isFFIPrimResultTy,   -- :: DynFlags -> Type -> Bool+  isFFILabelTy,        -- :: Type -> Bool+  isFFITy,             -- :: Type -> Bool+  isFunPtrTy,          -- :: Type -> Bool+  tcSplitIOType_maybe, -- :: Type -> Maybe Type++  --------------------------------+  -- Rexported from Kind+  Kind, tcTypeKind,+  liftedTypeKind,+  constraintKind,+  isLiftedTypeKind, isUnliftedTypeKind, classifiesTypeWithValues,++  --------------------------------+  -- Rexported from Type+  Type, PredType, ThetaType, TyCoBinder,+  ArgFlag(..), AnonArgFlag(..), ForallVisFlag(..),++  mkForAllTy, mkForAllTys, mkTyCoInvForAllTys, mkSpecForAllTys, mkTyCoInvForAllTy,+  mkInvForAllTy, mkInvForAllTys,+  mkVisFunTy, mkVisFunTys, mkInvisFunTy, mkInvisFunTys,+  mkTyConApp, mkAppTy, mkAppTys,+  mkTyConTy, mkTyVarTy, mkTyVarTys,+  mkTyCoVarTy, mkTyCoVarTys,++  isClassPred, isEqPrimPred, isIPPred, isEqPred, isEqPredClass,+  mkClassPred,+  isDictLikeTy,+  tcSplitDFunTy, tcSplitDFunHead, tcSplitMethodTy,+  isRuntimeRepVar, isKindLevPoly,+  isVisibleBinder, isInvisibleBinder,++  -- Type substitutions+  TCvSubst(..),         -- Representation visible to a few friends+  TvSubstEnv, emptyTCvSubst, mkEmptyTCvSubst,+  zipTvSubst,+  mkTvSubstPrs, notElemTCvSubst, unionTCvSubst,+  getTvSubstEnv, setTvSubstEnv, getTCvInScope, extendTCvInScope,+  extendTCvInScopeList, extendTCvInScopeSet, extendTvSubstAndInScope,+  Type.lookupTyVar, Type.extendTCvSubst, Type.substTyVarBndr,+  Type.extendTvSubst,+  isInScope, mkTCvSubst, mkTvSubst, zipTyEnv, zipCoEnv,+  Type.substTy, substTys, substTyWith, substTyWithCoVars,+  substTyAddInScope,+  substTyUnchecked, substTysUnchecked, substThetaUnchecked,+  substTyWithUnchecked,+  substCoUnchecked, substCoWithUnchecked,+  substTheta,++  isUnliftedType,       -- Source types are always lifted+  isUnboxedTupleType,   -- Ditto+  isPrimitiveType,++  tcView, coreView,++  tyCoVarsOfType, tyCoVarsOfTypes, closeOverKinds,+  tyCoFVsOfType, tyCoFVsOfTypes,+  tyCoVarsOfTypeDSet, tyCoVarsOfTypesDSet, closeOverKindsDSet,+  tyCoVarsOfTypeList, tyCoVarsOfTypesList,+  noFreeVarsOfType,++  --------------------------------+  pprKind, pprParendKind, pprSigmaType,+  pprType, pprParendType, pprTypeApp, pprTyThingCategory, tyThingCategory,+  pprTheta, pprParendTheta, pprThetaArrowTy, pprClassPred,+  pprTCvBndr, pprTCvBndrs,++  TypeSize, sizeType, sizeTypes, scopedSort,++  ---------------------------------+  -- argument visibility+  tcTyConVisibilities, isNextTyConArgVisible, isNextArgVisible++  ) where++#include "HsVersions.h"++-- friends:+import GhcPrelude++import Kind+import TyCoRep+import Class+import Var+import ForeignCall+import VarSet+import Coercion+import Type+import RepType+import TyCon++-- others:+import DynFlags+import CoreFVs+import Name -- hiding (varName)+            -- We use this to make dictionaries for type literals.+            -- Perhaps there's a better way to do this?+import NameSet+import VarEnv+import PrelNames+import TysWiredIn( coercibleClass, eqClass, heqClass, unitTyCon, unitTyConKey+                 , listTyCon, constraintKind )+import BasicTypes+import Util+import Maybes+import ListSetOps ( getNth, findDupsEq )+import Outputable+import FastString+import ErrUtils( Validity(..), MsgDoc, isValid )+import qualified GHC.LanguageExtensions as LangExt++import Data.List  ( mapAccumL )+-- import Data.Functor.Identity( Identity(..) )+import Data.IORef+import Data.List.NonEmpty( NonEmpty(..) )++{-+************************************************************************+*                                                                      *+              Types+*                                                                      *+************************************************************************++The type checker divides the generic Type world into the+following more structured beasts:++sigma ::= forall tyvars. phi+        -- A sigma type is a qualified type+        --+        -- Note that even if 'tyvars' is empty, theta+        -- may not be: e.g.   (?x::Int) => Int++        -- Note that 'sigma' is in prenex form:+        -- all the foralls are at the front.+        -- A 'phi' type has no foralls to the right of+        -- an arrow++phi :: theta => rho++rho ::= sigma -> rho+     |  tau++-- A 'tau' type has no quantification anywhere+-- Note that the args of a type constructor must be taus+tau ::= tyvar+     |  tycon tau_1 .. tau_n+     |  tau_1 tau_2+     |  tau_1 -> tau_2++-- In all cases, a (saturated) type synonym application is legal,+-- provided it expands to the required form.++Note [TcTyVars and TyVars in the typechecker]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The typechecker uses a lot of type variables with special properties,+notably being a unification variable with a mutable reference.  These+use the 'TcTyVar' variant of Var.Var.++Note, though, that a /bound/ type variable can (and probably should)+be a TyVar.  E.g+    forall a. a -> a+Here 'a' is really just a deBruijn-number; it certainly does not have+a signficant TcLevel (as every TcTyVar does).  So a forall-bound type+variable should be TyVars; and hence a TyVar can appear free in a TcType.++The type checker and constraint solver can also encounter /free/ type+variables that use the 'TyVar' variant of Var.Var, for a couple of+reasons:++  - When typechecking a class decl, say+       class C (a :: k) where+          foo :: T a -> Int+    We have first kind-check the header; fix k and (a:k) to be+    TyVars, bring 'k' and 'a' into scope, and kind check the+    signature for 'foo'.  In doing so we call solveEqualities to+    solve any kind equalities in foo's signature.  So the solver+    may see free occurrences of 'k'.++    See calls to tcExtendTyVarEnv for other places that ordinary+    TyVars are bought into scope, and hence may show up in the types+    and kinds generated by TcHsType.++  - The pattern-match overlap checker calls the constraint solver,+    long afer TcTyVars have been zonked away++It's convenient to simply treat these TyVars as skolem constants,+which of course they are.  We give them a level number of "outermost",+so they behave as global constants.  Specifically:++* Var.tcTyVarDetails succeeds on a TyVar, returning+  vanillaSkolemTv, as well as on a TcTyVar.++* tcIsTcTyVar returns True for both TyVar and TcTyVar variants+  of Var.Var.  The "tc" prefix means "a type variable that can be+  encountered by the typechecker".++This is a bit of a change from an earlier era when we remoselessly+insisted on real TcTyVars in the type checker.  But that seems+unnecessary (for skolems, TyVars are fine) and it's now very hard+to guarantee, with the advent of kind equalities.++Note [Coercion variables in free variable lists]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+There are several places in the GHC codebase where functions like+tyCoVarsOfType, tyCoVarsOfCt, et al. are used to compute the free type+variables of a type. The "Co" part of these functions' names shouldn't be+dismissed, as it is entirely possible that they will include coercion variables+in addition to type variables! As a result, there are some places in TcType+where we must take care to check that a variable is a _type_ variable (using+isTyVar) before calling tcTyVarDetails--a partial function that is not defined+for coercion variables--on the variable. Failing to do so led to+GHC #12785.+-}++-- See Note [TcTyVars and TyVars in the typechecker]+type TcCoVar = CoVar    -- Used only during type inference+type TcType = Type      -- A TcType can have mutable type variables+type TcTyCoVar = Var    -- Either a TcTyVar or a CoVar+        -- Invariant on ForAllTy in TcTypes:+        --      forall a. T+        -- a cannot occur inside a MutTyVar in T; that is,+        -- T is "flattened" before quantifying over a++type TcTyVarBinder   = TyVarBinder+type TcTyCon         = TyCon   -- these can be the TcTyCon constructor++-- These types do not have boxy type variables in them+type TcPredType     = PredType+type TcThetaType    = ThetaType+type TcSigmaType    = TcType+type TcRhoType      = TcType  -- Note [TcRhoType]+type TcTauType      = TcType+type TcKind         = Kind+type TcTyVarSet     = TyVarSet+type TcTyCoVarSet   = TyCoVarSet+type TcDTyVarSet    = DTyVarSet+type TcDTyCoVarSet  = DTyCoVarSet++{- *********************************************************************+*                                                                      *+          ExpType: an "expected type" in the type checker+*                                                                      *+********************************************************************* -}++-- | An expected type to check against during type-checking.+-- See Note [ExpType] in TcMType, where you'll also find manipulators.+data ExpType = Check TcType+             | Infer !InferResult++data InferResult+  = IR { ir_uniq :: Unique  -- For debugging only++       , ir_lvl  :: TcLevel -- See Note [TcLevel of ExpType] in TcMType++       , ir_inst :: Bool+         -- True <=> deeply instantiate before returning+         --           i.e. return a RhoType+         -- False <=> do not instantiate before returning+         --           i.e. return a SigmaType+         -- See Note [Deep instantiation of InferResult] in TcUnify++       , ir_ref  :: IORef (Maybe TcType) }+         -- The type that fills in this hole should be a Type,+         -- that is, its kind should be (TYPE rr) for some rr++type ExpSigmaType = ExpType+type ExpRhoType   = ExpType++instance Outputable ExpType where+  ppr (Check ty) = text "Check" <> braces (ppr ty)+  ppr (Infer ir) = ppr ir++instance Outputable InferResult where+  ppr (IR { ir_uniq = u, ir_lvl = lvl+          , ir_inst = inst })+    = text "Infer" <> braces (ppr u <> comma <> ppr lvl <+> ppr inst)++-- | Make an 'ExpType' suitable for checking.+mkCheckExpType :: TcType -> ExpType+mkCheckExpType = Check+++{- *********************************************************************+*                                                                      *+          SyntaxOpType+*                                                                      *+********************************************************************* -}++-- | What to expect for an argument to a rebindable-syntax operator.+-- Quite like 'Type', but allows for holes to be filled in by tcSyntaxOp.+-- The callback called from tcSyntaxOp gets a list of types; the meaning+-- of these types is determined by a left-to-right depth-first traversal+-- of the 'SyntaxOpType' tree. So if you pass in+--+-- > SynAny `SynFun` (SynList `SynFun` SynType Int) `SynFun` SynAny+--+-- you'll get three types back: one for the first 'SynAny', the /element/+-- type of the list, and one for the last 'SynAny'. You don't get anything+-- for the 'SynType', because you've said positively that it should be an+-- Int, and so it shall be.+--+-- This is defined here to avoid defining it in TcExpr.hs-boot.+data SyntaxOpType+  = SynAny     -- ^ Any type+  | SynRho     -- ^ A rho type, deeply skolemised or instantiated as appropriate+  | SynList    -- ^ A list type. You get back the element type of the list+  | SynFun SyntaxOpType SyntaxOpType+               -- ^ A function.+  | SynType ExpType   -- ^ A known type.+infixr 0 `SynFun`++-- | Like 'SynType' but accepts a regular TcType+synKnownType :: TcType -> SyntaxOpType+synKnownType = SynType . mkCheckExpType++-- | Like 'mkFunTys' but for 'SyntaxOpType'+mkSynFunTys :: [SyntaxOpType] -> ExpType -> SyntaxOpType+mkSynFunTys arg_tys res_ty = foldr SynFun (SynType res_ty) arg_tys+++{-+Note [TcRhoType]+~~~~~~~~~~~~~~~~+A TcRhoType has no foralls or contexts at the top, or to the right of an arrow+  YES    (forall a. a->a) -> Int+  NO     forall a. a ->  Int+  NO     Eq a => a -> a+  NO     Int -> forall a. a -> Int+++************************************************************************+*                                                                      *+        TyVarDetails, MetaDetails, MetaInfo+*                                                                      *+************************************************************************++TyVarDetails gives extra info about type variables, used during type+checking.  It's attached to mutable type variables only.+It's knot-tied back to Var.hs.  There is no reason in principle+why Var.hs shouldn't actually have the definition, but it "belongs" here.++Note [Signature skolems]+~~~~~~~~~~~~~~~~~~~~~~~~+A TyVarTv is a specialised variant of TauTv, with the following invarints:++    * A TyVarTv can be unified only with a TyVar,+      not with any other type++    * Its MetaDetails, if filled in, will always be another TyVarTv+      or a SkolemTv++TyVarTvs are only distinguished to improve error messages.+Consider this++  data T (a:k1) = MkT (S a)+  data S (b:k2) = MkS (T b)++When doing kind inference on {S,T} we don't want *skolems* for k1,k2,+because they end up unifying; we want those TyVarTvs again.+++Note [TyVars and TcTyVars during type checking]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The Var type has constructors TyVar and TcTyVar.  They are used+as follows:++* TcTyVar: used /only/ during type checking.  Should never appear+  afterwards.  May contain a mutable field, in the MetaTv case.++* TyVar: is never seen by the constraint solver, except locally+  inside a type like (forall a. [a] ->[a]), where 'a' is a TyVar.+  We instantiate these with TcTyVars before exposing the type+  to the constraint solver.++I have swithered about the latter invariant, excluding TyVars from the+constraint solver.  It's not strictly essential, and indeed+(historically but still there) Var.tcTyVarDetails returns+vanillaSkolemTv for a TyVar.++But ultimately I want to seeparate Type from TcType, and in that case+we would need to enforce the separation.+-}++-- A TyVarDetails is inside a TyVar+-- See Note [TyVars and TcTyVars]+data TcTyVarDetails+  = SkolemTv      -- A skolem+       TcLevel    -- Level of the implication that binds it+                  -- See TcUnify Note [Deeper level on the left] for+                  --     how this level number is used+       Bool       -- True <=> this skolem type variable can be overlapped+                  --          when looking up instances+                  -- See Note [Binding when looking up instances] in InstEnv++  | RuntimeUnk    -- Stands for an as-yet-unknown type in the GHCi+                  -- interactive context++  | MetaTv { mtv_info  :: MetaInfo+           , mtv_ref   :: IORef MetaDetails+           , mtv_tclvl :: TcLevel }  -- See Note [TcLevel and untouchable type variables]++vanillaSkolemTv, superSkolemTv :: TcTyVarDetails+-- See Note [Binding when looking up instances] in InstEnv+vanillaSkolemTv = SkolemTv topTcLevel False  -- Might be instantiated+superSkolemTv   = SkolemTv topTcLevel True   -- Treat this as a completely distinct type+                  -- The choice of level number here is a bit dodgy, but+                  -- topTcLevel works in the places that vanillaSkolemTv is used++-----------------------------+data MetaDetails+  = Flexi  -- Flexi type variables unify to become Indirects+  | Indirect TcType++data MetaInfo+   = TauTv         -- This MetaTv is an ordinary unification variable+                   -- A TauTv is always filled in with a tau-type, which+                   -- never contains any ForAlls.++   | TyVarTv       -- A variant of TauTv, except that it should not be+                   --   unified with a type, only with a type variable+                   -- See Note [Signature skolems]++   | FlatMetaTv    -- A flatten meta-tyvar+                   -- It is a meta-tyvar, but it is always untouchable, with level 0+                   -- See Note [The flattening story] in TcFlatten++   | FlatSkolTv    -- A flatten skolem tyvar+                   -- Just like FlatMetaTv, but is comletely "owned" by+                   --   its Given CFunEqCan.+                   -- It is filled in /only/ by unflattenGivens+                   -- See Note [The flattening story] in TcFlatten++instance Outputable MetaDetails where+  ppr Flexi         = text "Flexi"+  ppr (Indirect ty) = text "Indirect" <+> ppr ty++pprTcTyVarDetails :: TcTyVarDetails -> SDoc+-- For debugging+pprTcTyVarDetails (RuntimeUnk {})      = text "rt"+pprTcTyVarDetails (SkolemTv lvl True)  = text "ssk" <> colon <> ppr lvl+pprTcTyVarDetails (SkolemTv lvl False) = text "sk"  <> colon <> ppr lvl+pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_tclvl = tclvl })+  = pp_info <> colon <> ppr tclvl+  where+    pp_info = case info of+                TauTv      -> text "tau"+                TyVarTv    -> text "tyv"+                FlatMetaTv -> text "fmv"+                FlatSkolTv -> text "fsk"+++{- *********************************************************************+*                                                                      *+          UserTypeCtxt+*                                                                      *+********************************************************************* -}++-------------------------------------+-- UserTypeCtxt describes the origin of the polymorphic type+-- in the places where we need an expression to have that type++data UserTypeCtxt+  = FunSigCtxt      -- Function type signature, when checking the type+                    -- Also used for types in SPECIALISE pragmas+       Name              -- Name of the function+       Bool              -- True <=> report redundant constraints+                            -- This is usually True, but False for+                            --   * Record selectors (not important here)+                            --   * Class and instance methods.  Here+                            --     the code may legitimately be more+                            --     polymorphic than the signature+                            --     generated from the class+                            --     declaration++  | InfSigCtxt Name     -- Inferred type for function+  | ExprSigCtxt         -- Expression type signature+  | KindSigCtxt         -- Kind signature+  | TypeAppCtxt         -- Visible type application+  | ConArgCtxt Name     -- Data constructor argument+  | TySynCtxt Name      -- RHS of a type synonym decl+  | PatSynCtxt Name     -- Type sig for a pattern synonym+  | PatSigCtxt          -- Type sig in pattern+                        --   eg  f (x::t) = ...+                        --   or  (x::t, y) = e+  | RuleSigCtxt Name    -- LHS of a RULE forall+                        --    RULE "foo" forall (x :: a -> a). f (Just x) = ...+  | ResSigCtxt          -- Result type sig+                        --      f x :: t = ....+  | ForSigCtxt Name     -- Foreign import or export signature+  | DefaultDeclCtxt     -- Types in a default declaration+  | InstDeclCtxt Bool   -- An instance declaration+                        --    True:  stand-alone deriving+                        --    False: vanilla instance declaration+  | SpecInstCtxt        -- SPECIALISE instance pragma+  | ThBrackCtxt         -- Template Haskell type brackets [t| ... |]+  | GenSigCtxt          -- Higher-rank or impredicative situations+                        -- e.g. (f e) where f has a higher-rank type+                        -- We might want to elaborate this+  | GhciCtxt Bool       -- GHCi command :kind <type>+                        -- The Bool indicates if we are checking the outermost+                        -- type application.+                        -- See Note [Unsaturated type synonyms in GHCi] in+                        -- TcValidity.++  | ClassSCCtxt Name    -- Superclasses of a class+  | SigmaCtxt           -- Theta part of a normal for-all type+                        --      f :: <S> => a -> a+  | DataTyCtxt Name     -- The "stupid theta" part of a data decl+                        --      data <S> => T a = MkT a+  | DerivClauseCtxt     -- A 'deriving' clause+  | TyVarBndrKindCtxt Name  -- The kind of a type variable being bound+  | DataKindCtxt Name   -- The kind of a data/newtype (instance)+  | TySynKindCtxt Name  -- The kind of the RHS of a type synonym+  | TyFamResKindCtxt Name   -- The result kind of a type family++{-+-- Notes re TySynCtxt+-- We allow type synonyms that aren't types; e.g.  type List = []+--+-- If the RHS mentions tyvars that aren't in scope, we'll+-- quantify over them:+--      e.g.    type T = a->a+-- will become  type T = forall a. a->a+--+-- With gla-exts that's right, but for H98 we should complain.+-}+++pprUserTypeCtxt :: UserTypeCtxt -> SDoc+pprUserTypeCtxt (FunSigCtxt n _)  = text "the type signature for" <+> quotes (ppr n)+pprUserTypeCtxt (InfSigCtxt n)    = text "the inferred type for" <+> quotes (ppr n)+pprUserTypeCtxt (RuleSigCtxt n)   = text "a RULE for" <+> quotes (ppr n)+pprUserTypeCtxt ExprSigCtxt       = text "an expression type signature"+pprUserTypeCtxt KindSigCtxt       = text "a kind signature"+pprUserTypeCtxt TypeAppCtxt       = text "a type argument"+pprUserTypeCtxt (ConArgCtxt c)    = text "the type of the constructor" <+> quotes (ppr c)+pprUserTypeCtxt (TySynCtxt c)     = text "the RHS of the type synonym" <+> quotes (ppr c)+pprUserTypeCtxt ThBrackCtxt       = text "a Template Haskell quotation [t|...|]"+pprUserTypeCtxt PatSigCtxt        = text "a pattern type signature"+pprUserTypeCtxt ResSigCtxt        = text "a result type signature"+pprUserTypeCtxt (ForSigCtxt n)    = text "the foreign declaration for" <+> quotes (ppr n)+pprUserTypeCtxt DefaultDeclCtxt   = text "a type in a `default' declaration"+pprUserTypeCtxt (InstDeclCtxt False) = text "an instance declaration"+pprUserTypeCtxt (InstDeclCtxt True)  = text "a stand-alone deriving instance declaration"+pprUserTypeCtxt SpecInstCtxt      = text "a SPECIALISE instance pragma"+pprUserTypeCtxt GenSigCtxt        = text "a type expected by the context"+pprUserTypeCtxt (GhciCtxt {})     = text "a type in a GHCi command"+pprUserTypeCtxt (ClassSCCtxt c)   = text "the super-classes of class" <+> quotes (ppr c)+pprUserTypeCtxt SigmaCtxt         = text "the context of a polymorphic type"+pprUserTypeCtxt (DataTyCtxt tc)   = text "the context of the data type declaration for" <+> quotes (ppr tc)+pprUserTypeCtxt (PatSynCtxt n)    = text "the signature for pattern synonym" <+> quotes (ppr n)+pprUserTypeCtxt (DerivClauseCtxt) = text "a `deriving' clause"+pprUserTypeCtxt (TyVarBndrKindCtxt n) = text "the kind annotation on the type variable" <+> quotes (ppr n)+pprUserTypeCtxt (DataKindCtxt n)  = text "the kind annotation on the declaration for" <+> quotes (ppr n)+pprUserTypeCtxt (TySynKindCtxt n) = text "the kind annotation on the declaration for" <+> quotes (ppr n)+pprUserTypeCtxt (TyFamResKindCtxt n) = text "the result kind for" <+> quotes (ppr n)++isSigMaybe :: UserTypeCtxt -> Maybe Name+isSigMaybe (FunSigCtxt n _) = Just n+isSigMaybe (ConArgCtxt n)   = Just n+isSigMaybe (ForSigCtxt n)   = Just n+isSigMaybe (PatSynCtxt n)   = Just n+isSigMaybe _                = Nothing+++{- *********************************************************************+*                                                                      *+                Untouchable type variables+*                                                                      *+********************************************************************* -}++newtype TcLevel = TcLevel Int deriving( Eq, Ord )+  -- See Note [TcLevel and untouchable type variables] for what this Int is+  -- See also Note [TcLevel assignment]++{-+Note [TcLevel and untouchable type variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+* Each unification variable (MetaTv)+  and each Implication+  has a level number (of type TcLevel)++* INVARIANTS.  In a tree of Implications,++    (ImplicInv) The level number (ic_tclvl) of an Implication is+                STRICTLY GREATER THAN that of its parent++    (SkolInv)   The level number of the skolems (ic_skols) of an+                Implication is equal to the level of the implication+                itself (ic_tclvl)++    (GivenInv)  The level number of a unification variable appearing+                in the 'ic_given' of an implication I should be+                STRICTLY LESS THAN the ic_tclvl of I++    (WantedInv) The level number of a unification variable appearing+                in the 'ic_wanted' of an implication I should be+                LESS THAN OR EQUAL TO the ic_tclvl of I+                See Note [WantedInv]++* A unification variable is *touchable* if its level number+  is EQUAL TO that of its immediate parent implication,+  and it is a TauTv or TyVarTv (but /not/ FlatMetaTv or FlatSkolTv)++Note [WantedInv]+~~~~~~~~~~~~~~~~+Why is WantedInv important?  Consider this implication, where+the constraint (C alpha[3]) disobeys WantedInv:++   forall[2] a. blah => (C alpha[3])+                        (forall[3] b. alpha[3] ~ b)++We can unify alpha:=b in the inner implication, because 'alpha' is+touchable; but then 'b' has excaped its scope into the outer implication.++Note [Skolem escape prevention]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We only unify touchable unification variables.  Because of+(WantedInv), there can be no occurrences of the variable further out,+so the unification can't cause the skolems to escape. Example:+     data T = forall a. MkT a (a->Int)+     f x (MkT v f) = length [v,x]+We decide (x::alpha), and generate an implication like+      [1]forall a. (a ~ alpha[0])+But we must not unify alpha:=a, because the skolem would escape.++For the cases where we DO want to unify, we rely on floating the+equality.   Example (with same T)+     g x (MkT v f) = x && True+We decide (x::alpha), and generate an implication like+      [1]forall a. (Bool ~ alpha[0])+We do NOT unify directly, bur rather float out (if the constraint+does not mention 'a') to get+      (Bool ~ alpha[0]) /\ [1]forall a.()+and NOW we can unify alpha.++The same idea of only unifying touchables solves another problem.+Suppose we had+   (F Int ~ uf[0])  /\  [1](forall a. C a => F Int ~ beta[1])+In this example, beta is touchable inside the implication. The+first solveSimpleWanteds step leaves 'uf' un-unified. Then we move inside+the implication where a new constraint+       uf  ~  beta+emerges. If we (wrongly) spontaneously solved it to get uf := beta,+the whole implication disappears but when we pop out again we are left with+(F Int ~ uf) which will be unified by our final zonking stage and+uf will get unified *once more* to (F Int).++Note [TcLevel assignment]+~~~~~~~~~~~~~~~~~~~~~~~~~+We arrange the TcLevels like this++   0   Top level+   1   First-level implication constraints+   2   Second-level implication constraints+   ...etc...+-}++maxTcLevel :: TcLevel -> TcLevel -> TcLevel+maxTcLevel (TcLevel a) (TcLevel b) = TcLevel (a `max` b)++topTcLevel :: TcLevel+-- See Note [TcLevel assignment]+topTcLevel = TcLevel 0   -- 0 = outermost level++isTopTcLevel :: TcLevel -> Bool+isTopTcLevel (TcLevel 0) = True+isTopTcLevel _           = False++pushTcLevel :: TcLevel -> TcLevel+-- See Note [TcLevel assignment]+pushTcLevel (TcLevel us) = TcLevel (us + 1)++strictlyDeeperThan :: TcLevel -> TcLevel -> Bool+strictlyDeeperThan (TcLevel tv_tclvl) (TcLevel ctxt_tclvl)+  = tv_tclvl > ctxt_tclvl++sameDepthAs :: TcLevel -> TcLevel -> Bool+sameDepthAs (TcLevel ctxt_tclvl) (TcLevel tv_tclvl)+  = ctxt_tclvl == tv_tclvl   -- NB: invariant ctxt_tclvl >= tv_tclvl+                             --     So <= would be equivalent++checkTcLevelInvariant :: TcLevel -> TcLevel -> Bool+-- Checks (WantedInv) from Note [TcLevel and untouchable type variables]+checkTcLevelInvariant (TcLevel ctxt_tclvl) (TcLevel tv_tclvl)+  = ctxt_tclvl >= tv_tclvl++tcTyVarLevel :: TcTyVar -> TcLevel+tcTyVarLevel tv+  = ASSERT2( tcIsTcTyVar tv, ppr tv )+    case tcTyVarDetails tv of+          MetaTv { mtv_tclvl = tv_lvl } -> tv_lvl+          SkolemTv tv_lvl _             -> tv_lvl+          RuntimeUnk                    -> topTcLevel+++tcTypeLevel :: TcType -> TcLevel+-- Max level of any free var of the type+tcTypeLevel ty+  = foldDVarSet add topTcLevel (tyCoVarsOfTypeDSet ty)+  where+    add v lvl+      | isTcTyVar v = lvl `maxTcLevel` tcTyVarLevel v+      | otherwise = lvl++instance Outputable TcLevel where+  ppr (TcLevel us) = ppr us++promoteSkolem :: TcLevel -> TcTyVar -> TcTyVar+promoteSkolem tclvl skol+  | tclvl < tcTyVarLevel skol+  = ASSERT( isTcTyVar skol && isSkolemTyVar skol )+    setTcTyVarDetails skol (SkolemTv tclvl (isOverlappableTyVar skol))++  | otherwise+  = skol++-- | Change the TcLevel in a skolem, extending a substitution+promoteSkolemX :: TcLevel -> TCvSubst -> TcTyVar -> (TCvSubst, TcTyVar)+promoteSkolemX tclvl subst skol+  = ASSERT( isTcTyVar skol && isSkolemTyVar skol )+    (new_subst, new_skol)+  where+    new_skol+      | tclvl < tcTyVarLevel skol+      = setTcTyVarDetails (updateTyVarKind (substTy subst) skol)+                          (SkolemTv tclvl (isOverlappableTyVar skol))+      | otherwise+      = updateTyVarKind (substTy subst) skol+    new_subst = extendTvSubstWithClone subst skol new_skol++promoteSkolemsX :: TcLevel -> TCvSubst -> [TcTyVar] -> (TCvSubst, [TcTyVar])+promoteSkolemsX tclvl = mapAccumL (promoteSkolemX tclvl)++{- *********************************************************************+*                                                                      *+    Finding type family instances+*                                                                      *+************************************************************************+-}++-- | Finds outermost type-family applications occurring in a type,+-- after expanding synonyms.  In the list (F, tys) that is returned+-- we guarantee that tys matches F's arity.  For example, given+--    type family F a :: * -> *    (arity 1)+-- calling tcTyFamInsts on (Maybe (F Int Bool) will return+--     (F, [Int]), not (F, [Int,Bool])+--+-- This is important for its use in deciding termination of type+-- instances (see #11581).  E.g.+--    type instance G [Int] = ...(F Int <big type>)...+-- we don't need to take <big type> into account when asking if+-- the calls on the RHS are smaller than the LHS+tcTyFamInsts :: Type -> [(TyCon, [Type])]+tcTyFamInsts = map (\(_,b,c) -> (b,c)) . tcTyFamInstsAndVis++-- | Like 'tcTyFamInsts', except that the output records whether the+-- type family and its arguments occur as an /invisible/ argument in+-- some type application. This information is useful because it helps GHC know+-- when to turn on @-fprint-explicit-kinds@ during error reporting so that+-- users can actually see the type family being mentioned.+--+-- As an example, consider:+--+-- @+-- class C a+-- data T (a :: k)+-- type family F a :: k+-- instance C (T @(F Int) (F Bool))+-- @+--+-- There are two occurrences of the type family `F` in that `C` instance, so+-- @'tcTyFamInstsAndVis' (C (T \@(F Int) (F Bool)))@ will return:+--+-- @+-- [ ('True',  F, [Int])+-- , ('False', F, [Bool]) ]+-- @+--+-- @F Int@ is paired with 'True' since it appears as an /invisible/ argument+-- to @C@, whereas @F Bool@ is paired with 'False' since it appears an a+-- /visible/ argument to @C@.+--+-- See also @Note [Kind arguments in error messages]@ in "TcErrors".+tcTyFamInstsAndVis :: Type -> [(Bool, TyCon, [Type])]+tcTyFamInstsAndVis = tcTyFamInstsAndVisX False++tcTyFamInstsAndVisX+  :: Bool -- ^ Is this an invisible argument to some type application?+  -> Type -> [(Bool, TyCon, [Type])]+tcTyFamInstsAndVisX = go+  where+    go is_invis_arg ty+      | Just exp_ty <- tcView ty       = go is_invis_arg exp_ty+    go _ (TyVarTy _)                   = []+    go is_invis_arg (TyConApp tc tys)+      | isTypeFamilyTyCon tc+      = [(is_invis_arg, tc, take (tyConArity tc) tys)]+      | otherwise+      = tcTyConAppTyFamInstsAndVisX is_invis_arg tc tys+    go _            (LitTy {})         = []+    go is_invis_arg (ForAllTy bndr ty) = go is_invis_arg (binderType bndr)+                                         ++ go is_invis_arg ty+    go is_invis_arg (FunTy _ ty1 ty2)  = go is_invis_arg ty1+                                         ++ go is_invis_arg ty2+    go is_invis_arg ty@(AppTy _ _)     =+      let (ty_head, ty_args) = splitAppTys ty+          ty_arg_flags       = appTyArgFlags ty_head ty_args+      in go is_invis_arg ty_head+         ++ concat (zipWith (\flag -> go (isInvisibleArgFlag flag))+                            ty_arg_flags ty_args)+    go is_invis_arg (CastTy ty _)      = go is_invis_arg ty+    go _            (CoercionTy _)     = [] -- don't count tyfams in coercions,+                                            -- as they never get normalized,+                                            -- anyway++-- | In an application of a 'TyCon' to some arguments, find the outermost+-- occurrences of type family applications within the arguments. This function+-- will not consider the 'TyCon' itself when checking for type family+-- applications.+--+-- See 'tcTyFamInstsAndVis' for more details on how this works (as this+-- function is called inside of 'tcTyFamInstsAndVis').+tcTyConAppTyFamInstsAndVis :: TyCon -> [Type] -> [(Bool, TyCon, [Type])]+tcTyConAppTyFamInstsAndVis = tcTyConAppTyFamInstsAndVisX False++tcTyConAppTyFamInstsAndVisX+  :: Bool -- ^ Is this an invisible argument to some type application?+  -> TyCon -> [Type] -> [(Bool, TyCon, [Type])]+tcTyConAppTyFamInstsAndVisX is_invis_arg tc tys =+  let (invis_tys, vis_tys) = partitionInvisibleTypes tc tys+  in concat $ map (tcTyFamInstsAndVisX True)         invis_tys+           ++ map (tcTyFamInstsAndVisX is_invis_arg) vis_tys++isTyFamFree :: Type -> Bool+-- ^ Check that a type does not contain any type family applications.+isTyFamFree = null . tcTyFamInsts++{-+************************************************************************+*                                                                      *+          The "exact" free variables of a type+*                                                                      *+************************************************************************++Note [Silly type synonym]+~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+  type T a = Int+What are the free tyvars of (T x)?  Empty, of course!++exactTyCoVarsOfType is used by the type checker to figure out exactly+which type variables are mentioned in a type.  It only matters+occasionally -- see the calls to exactTyCoVarsOfType.++Historical note: years and years ago this function was used during+generalisation -- see #1813.  But that code has long since died.+-}++exactTyCoVarsOfType :: Type -> TyCoVarSet+-- Find the free type variables (of any kind)+-- but *expand* type synonyms.  See Note [Silly type synonym] above.+exactTyCoVarsOfType ty+  = go ty+  where+    go ty | Just ty' <- tcView ty = go ty'  -- This is the key line+    go (TyVarTy tv)         = goVar tv+    go (TyConApp _ tys)     = exactTyCoVarsOfTypes tys+    go (LitTy {})           = emptyVarSet+    go (AppTy fun arg)      = go fun `unionVarSet` go arg+    go (FunTy _ arg res)    = go arg `unionVarSet` go res+    go (ForAllTy bndr ty)   = delBinderVar (go ty) bndr `unionVarSet` go (binderType bndr)+    go (CastTy ty co)       = go ty `unionVarSet` goCo co+    go (CoercionTy co)      = goCo co++    goMCo MRefl    = emptyVarSet+    goMCo (MCo co) = goCo co++    goCo (Refl ty)            = go ty+    goCo (GRefl _ ty mco)     = go ty `unionVarSet` goMCo mco+    goCo (TyConAppCo _ _ args)= goCos args+    goCo (AppCo co arg)     = goCo co `unionVarSet` goCo arg+    goCo (ForAllCo tv k_co co)+      = goCo co `delVarSet` tv `unionVarSet` goCo k_co+    goCo (FunCo _ co1 co2)   = goCo co1 `unionVarSet` goCo co2+    goCo (CoVarCo v)         = goVar v+    goCo (HoleCo h)          = goVar (coHoleCoVar h)+    goCo (AxiomInstCo _ _ args) = goCos args+    goCo (UnivCo p _ t1 t2)  = goProv p `unionVarSet` go t1 `unionVarSet` go t2+    goCo (SymCo co)          = goCo co+    goCo (TransCo co1 co2)   = goCo co1 `unionVarSet` goCo co2+    goCo (NthCo _ _ co)      = goCo co+    goCo (LRCo _ co)         = goCo co+    goCo (InstCo co arg)     = goCo co `unionVarSet` goCo arg+    goCo (KindCo co)         = goCo co+    goCo (SubCo co)          = goCo co+    goCo (AxiomRuleCo _ c)   = goCos c++    goCos cos = foldr (unionVarSet . goCo) emptyVarSet cos++    goProv UnsafeCoerceProv     = emptyVarSet+    goProv (PhantomProv kco)    = goCo kco+    goProv (ProofIrrelProv kco) = goCo kco+    goProv (PluginProv _)       = emptyVarSet++    goVar v = unitVarSet v `unionVarSet` go (varType v)++exactTyCoVarsOfTypes :: [Type] -> TyVarSet+exactTyCoVarsOfTypes tys = mapUnionVarSet exactTyCoVarsOfType tys++anyRewritableTyVar :: Bool    -- Ignore casts and coercions+                   -> EqRel   -- Ambient role+                   -> (EqRel -> TcTyVar -> Bool)+                   -> TcType -> Bool+-- (anyRewritableTyVar ignore_cos pred ty) returns True+--    if the 'pred' returns True of any free TyVar in 'ty'+-- Do not look inside casts and coercions if 'ignore_cos' is True+-- See Note [anyRewritableTyVar must be role-aware]+anyRewritableTyVar ignore_cos role pred ty+  = go role emptyVarSet ty+  where+    go_tv rl bvs tv | tv `elemVarSet` bvs = False+                    | otherwise           = pred rl tv++    go rl bvs (TyVarTy tv)       = go_tv rl bvs tv+    go _ _     (LitTy {})        = False+    go rl bvs (TyConApp tc tys)  = go_tc rl bvs tc tys+    go rl bvs (AppTy fun arg)    = go rl bvs fun || go NomEq bvs arg+    go rl bvs (FunTy _ arg res)  = go rl bvs arg || go rl bvs res+    go rl bvs (ForAllTy tv ty)   = go rl (bvs `extendVarSet` binderVar tv) ty+    go rl bvs (CastTy ty co)     = go rl bvs ty || go_co rl bvs co+    go rl bvs (CoercionTy co)    = go_co rl bvs co  -- ToDo: check++    go_tc NomEq  bvs _  tys = any (go NomEq bvs) tys+    go_tc ReprEq bvs tc tys = any (go_arg bvs)+                              (tyConRolesRepresentational tc `zip` tys)++    go_arg bvs (Nominal,          ty) = go NomEq  bvs ty+    go_arg bvs (Representational, ty) = go ReprEq bvs ty+    go_arg _   (Phantom,          _)  = False  -- We never rewrite with phantoms++    go_co rl bvs co+      | ignore_cos = False+      | otherwise  = anyVarSet (go_tv rl bvs) (tyCoVarsOfCo co)+      -- We don't have an equivalent of anyRewritableTyVar for coercions+      -- (at least not yet) so take the free vars and test them++{- Note [anyRewritableTyVar must be role-aware]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+anyRewritableTyVar is used during kick-out from the inert set,+to decide if, given a new equality (a ~ ty), we should kick out+a constraint C.  Rather than gather free variables and see if 'a'+is among them, we instead pass in a predicate; this is just efficiency.++Moreover, consider+  work item:   [G] a ~R f b+  inert item:  [G] b ~R f a+We use anyRewritableTyVar to decide whether to kick out the inert item,+on the grounds that the work item might rewrite it. Well, 'a' is certainly+free in [G] b ~R f a.  But because the role of a type variable ('f' in+this case) is nominal, the work item can't actually rewrite the inert item.+Moreover, if we were to kick out the inert item the exact same situation+would re-occur and we end up with an infinite loop in which each kicks+out the other (#14363).+-}++{-+************************************************************************+*                                                                      *+                Predicates+*                                                                      *+************************************************************************+-}++tcIsTcTyVar :: TcTyVar -> Bool+-- See Note [TcTyVars and TyVars in the typechecker]+tcIsTcTyVar tv = isTyVar tv++isTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool+isTouchableMetaTyVar ctxt_tclvl tv+  | isTyVar tv -- See Note [Coercion variables in free variable lists]+  , MetaTv { mtv_tclvl = tv_tclvl, mtv_info = info } <- tcTyVarDetails tv+  , not (isFlattenInfo info)+  = ASSERT2( checkTcLevelInvariant ctxt_tclvl tv_tclvl,+             ppr tv $$ ppr tv_tclvl $$ ppr ctxt_tclvl )+    tv_tclvl `sameDepthAs` ctxt_tclvl++  | otherwise = False++isFloatedTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool+isFloatedTouchableMetaTyVar ctxt_tclvl tv+  | isTyVar tv -- See Note [Coercion variables in free variable lists]+  , MetaTv { mtv_tclvl = tv_tclvl, mtv_info = info } <- tcTyVarDetails tv+  , not (isFlattenInfo info)+  = tv_tclvl `strictlyDeeperThan` ctxt_tclvl++  | otherwise = False++isImmutableTyVar :: TyVar -> Bool+isImmutableTyVar tv = isSkolemTyVar tv++isTyConableTyVar, isSkolemTyVar, isOverlappableTyVar,+  isMetaTyVar, isAmbiguousTyVar,+  isFmvTyVar, isFskTyVar, isFlattenTyVar :: TcTyVar -> Bool++isTyConableTyVar tv+        -- True of a meta-type variable that can be filled in+        -- with a type constructor application; in particular,+        -- not a TyVarTv+  | isTyVar tv -- See Note [Coercion variables in free variable lists]+  = case tcTyVarDetails tv of+        MetaTv { mtv_info = TyVarTv } -> False+        _                             -> True+  | otherwise = True++isFmvTyVar tv+  = ASSERT2( tcIsTcTyVar tv, ppr tv )+    case tcTyVarDetails tv of+        MetaTv { mtv_info = FlatMetaTv } -> True+        _                                -> False++isFskTyVar tv+  = ASSERT2( tcIsTcTyVar tv, ppr tv )+    case tcTyVarDetails tv of+        MetaTv { mtv_info = FlatSkolTv } -> True+        _                                -> False++-- | True of both given and wanted flatten-skolems (fmv and fsk)+isFlattenTyVar tv+  = ASSERT2( tcIsTcTyVar tv, ppr tv )+    case tcTyVarDetails tv of+        MetaTv { mtv_info = info } -> isFlattenInfo info+        _                          -> False++isSkolemTyVar tv+  = ASSERT2( tcIsTcTyVar tv, ppr tv )+    case tcTyVarDetails tv of+        MetaTv {} -> False+        _other    -> True++isOverlappableTyVar tv+  | isTyVar tv -- See Note [Coercion variables in free variable lists]+  = case tcTyVarDetails tv of+        SkolemTv _ overlappable -> overlappable+        _                       -> False+  | otherwise = False++isMetaTyVar tv+  | isTyVar tv -- See Note [Coercion variables in free variable lists]+  = case tcTyVarDetails tv of+        MetaTv {} -> True+        _         -> False+  | otherwise = False++-- isAmbiguousTyVar is used only when reporting type errors+-- It picks out variables that are unbound, namely meta+-- type variables and the RuntimUnk variables created by+-- RtClosureInspect.zonkRTTIType.  These are "ambiguous" in+-- the sense that they stand for an as-yet-unknown type+isAmbiguousTyVar tv+  | isTyVar tv -- See Note [Coercion variables in free variable lists]+  = case tcTyVarDetails tv of+        MetaTv {}     -> True+        RuntimeUnk {} -> True+        _             -> False+  | otherwise = False++isMetaTyVarTy :: TcType -> Bool+isMetaTyVarTy (TyVarTy tv) = isMetaTyVar tv+isMetaTyVarTy _            = False++metaTyVarInfo :: TcTyVar -> MetaInfo+metaTyVarInfo tv+  = case tcTyVarDetails tv of+      MetaTv { mtv_info = info } -> info+      _ -> pprPanic "metaTyVarInfo" (ppr tv)++isFlattenInfo :: MetaInfo -> Bool+isFlattenInfo FlatMetaTv = True+isFlattenInfo FlatSkolTv = True+isFlattenInfo _          = False++metaTyVarTcLevel :: TcTyVar -> TcLevel+metaTyVarTcLevel tv+  = case tcTyVarDetails tv of+      MetaTv { mtv_tclvl = tclvl } -> tclvl+      _ -> pprPanic "metaTyVarTcLevel" (ppr tv)++metaTyVarTcLevel_maybe :: TcTyVar -> Maybe TcLevel+metaTyVarTcLevel_maybe tv+  = case tcTyVarDetails tv of+      MetaTv { mtv_tclvl = tclvl } -> Just tclvl+      _                            -> Nothing++metaTyVarRef :: TyVar -> IORef MetaDetails+metaTyVarRef tv+  = case tcTyVarDetails tv of+        MetaTv { mtv_ref = ref } -> ref+        _ -> pprPanic "metaTyVarRef" (ppr tv)++setMetaTyVarTcLevel :: TcTyVar -> TcLevel -> TcTyVar+setMetaTyVarTcLevel tv tclvl+  = case tcTyVarDetails tv of+      details@(MetaTv {}) -> setTcTyVarDetails tv (details { mtv_tclvl = tclvl })+      _ -> pprPanic "metaTyVarTcLevel" (ppr tv)++isTyVarTyVar :: Var -> Bool+isTyVarTyVar tv+  = case tcTyVarDetails tv of+        MetaTv { mtv_info = TyVarTv } -> True+        _                             -> False++isFlexi, isIndirect :: MetaDetails -> Bool+isFlexi Flexi = True+isFlexi _     = False++isIndirect (Indirect _) = True+isIndirect _            = False++isRuntimeUnkSkol :: TyVar -> Bool+-- Called only in TcErrors; see Note [Runtime skolems] there+isRuntimeUnkSkol x+  | RuntimeUnk <- tcTyVarDetails x = True+  | otherwise                      = False++mkTyVarNamePairs :: [TyVar] -> [(Name,TyVar)]+-- Just pair each TyVar with its own name+mkTyVarNamePairs tvs = [(tyVarName tv, tv) | tv <- tvs]++findDupTyVarTvs :: [(Name,TcTyVar)] -> [(Name,Name)]+-- If we have [...(x1,tv)...(x2,tv)...]+-- return (x1,x2) in the result list+findDupTyVarTvs prs+  = concatMap mk_result_prs $+    findDupsEq eq_snd prs+  where+    eq_snd (_,tv1) (_,tv2) = tv1 == tv2+    mk_result_prs ((n1,_) :| xs) = map (\(n2,_) -> (n1,n2)) xs++{-+************************************************************************+*                                                                      *+\subsection{Tau, sigma and rho}+*                                                                      *+************************************************************************+-}++mkSigmaTy :: [TyCoVarBinder] -> [PredType] -> Type -> Type+mkSigmaTy bndrs theta tau = mkForAllTys bndrs (mkPhiTy theta tau)++-- | Make a sigma ty where all type variables are 'Inferred'. That is,+-- they cannot be used with visible type application.+mkInfSigmaTy :: [TyCoVar] -> [PredType] -> Type -> Type+mkInfSigmaTy tyvars theta ty = mkSigmaTy (mkTyCoVarBinders Inferred tyvars) theta ty++-- | Make a sigma ty where all type variables are "specified". That is,+-- they can be used with visible type application+mkSpecSigmaTy :: [TyVar] -> [PredType] -> Type -> Type+mkSpecSigmaTy tyvars preds ty = mkSigmaTy (mkTyCoVarBinders Specified tyvars) preds ty++mkPhiTy :: [PredType] -> Type -> Type+mkPhiTy = mkInvisFunTys++---------------+getDFunTyKey :: Type -> OccName -- Get some string from a type, to be used to+                                -- construct a dictionary function name+getDFunTyKey ty | Just ty' <- coreView ty = getDFunTyKey ty'+getDFunTyKey (TyVarTy tv)            = getOccName tv+getDFunTyKey (TyConApp tc _)         = getOccName tc+getDFunTyKey (LitTy x)               = getDFunTyLitKey x+getDFunTyKey (AppTy fun _)           = getDFunTyKey fun+getDFunTyKey (FunTy {})              = getOccName funTyCon+getDFunTyKey (ForAllTy _ t)          = getDFunTyKey t+getDFunTyKey (CastTy ty _)           = getDFunTyKey ty+getDFunTyKey t@(CoercionTy _)        = pprPanic "getDFunTyKey" (ppr t)++getDFunTyLitKey :: TyLit -> OccName+getDFunTyLitKey (NumTyLit n) = mkOccName Name.varName (show n)+getDFunTyLitKey (StrTyLit n) = mkOccName Name.varName (show n)  -- hm++{- *********************************************************************+*                                                                      *+           Building types+*                                                                      *+********************************************************************* -}++-- ToDo: I think we need Tc versions of these+-- Reason: mkCastTy checks isReflexiveCastTy, which checks+--         for equality; and that has a different answer+--         depending on whether or not Type = Constraint++mkTcAppTys :: Type -> [Type] -> Type+mkTcAppTys = mkAppTys++mkTcAppTy :: Type -> Type -> Type+mkTcAppTy = mkAppTy++mkTcCastTy :: Type -> Coercion -> Type+mkTcCastTy = mkCastTy   -- Do we need a tc version of mkCastTy?++{-+************************************************************************+*                                                                      *+\subsection{Expanding and splitting}+*                                                                      *+************************************************************************++These tcSplit functions are like their non-Tc analogues, but+        *) they do not look through newtypes++However, they are non-monadic and do not follow through mutable type+variables.  It's up to you to make sure this doesn't matter.+-}++-- | Splits a forall type into a list of 'TyBinder's and the inner type.+-- Always succeeds, even if it returns an empty list.+tcSplitPiTys :: Type -> ([TyBinder], Type)+tcSplitPiTys ty+  = ASSERT( all isTyBinder (fst sty) ) sty+  where sty = splitPiTys ty++-- | Splits a type into a TyBinder and a body, if possible. Panics otherwise+tcSplitPiTy_maybe :: Type -> Maybe (TyBinder, Type)+tcSplitPiTy_maybe ty+  = ASSERT( isMaybeTyBinder sty ) sty+  where+    sty = splitPiTy_maybe ty+    isMaybeTyBinder (Just (t,_)) = isTyBinder t+    isMaybeTyBinder _            = True++tcSplitForAllTy_maybe :: Type -> Maybe (TyVarBinder, Type)+tcSplitForAllTy_maybe ty | Just ty' <- tcView ty = tcSplitForAllTy_maybe ty'+tcSplitForAllTy_maybe (ForAllTy tv ty) = ASSERT( isTyVarBinder tv ) Just (tv, ty)+tcSplitForAllTy_maybe _                = Nothing++-- | Like 'tcSplitPiTys', but splits off only named binders,+-- returning just the tycovars.+tcSplitForAllTys :: Type -> ([TyVar], Type)+tcSplitForAllTys ty+  = ASSERT( all isTyVar (fst sty) ) sty+  where sty = splitForAllTys ty++-- | Like 'tcSplitForAllTys', but only splits a 'ForAllTy' if+-- @'sameVis' argf supplied_argf@ is 'True', where @argf@ is the visibility+-- of the @ForAllTy@'s binder and @supplied_argf@ is the visibility provided+-- as an argument to this function.+tcSplitForAllTysSameVis :: ArgFlag -> Type -> ([TyVar], Type)+tcSplitForAllTysSameVis supplied_argf ty = ASSERT( all isTyVar (fst sty) ) sty+  where sty = splitForAllTysSameVis supplied_argf ty++-- | Like 'tcSplitForAllTys', but splits off only named binders.+tcSplitForAllVarBndrs :: Type -> ([TyVarBinder], Type)+tcSplitForAllVarBndrs ty = ASSERT( all isTyVarBinder (fst sty)) sty+  where sty = splitForAllVarBndrs ty++-- | Is this a ForAllTy with a named binder?+tcIsForAllTy :: Type -> Bool+tcIsForAllTy ty | Just ty' <- tcView ty = tcIsForAllTy ty'+tcIsForAllTy (ForAllTy {}) = True+tcIsForAllTy _             = False++tcSplitPredFunTy_maybe :: Type -> Maybe (PredType, Type)+-- Split off the first predicate argument from a type+tcSplitPredFunTy_maybe ty+  | Just ty' <- tcView ty = tcSplitPredFunTy_maybe ty'+tcSplitPredFunTy_maybe (FunTy { ft_af = InvisArg+                              , ft_arg = arg, ft_res = res })+  = Just (arg, res)+tcSplitPredFunTy_maybe _+  = Nothing++tcSplitPhiTy :: Type -> (ThetaType, Type)+tcSplitPhiTy ty+  = split ty []+  where+    split ty ts+      = case tcSplitPredFunTy_maybe ty of+          Just (pred, ty) -> split ty (pred:ts)+          Nothing         -> (reverse ts, ty)++-- | Split a sigma type into its parts.+tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type)+tcSplitSigmaTy ty = case tcSplitForAllTys ty of+                        (tvs, rho) -> case tcSplitPhiTy rho of+                                        (theta, tau) -> (tvs, theta, tau)++-- | Split a sigma type into its parts, going underneath as many @ForAllTy@s+-- as possible. For example, given this type synonym:+--+-- @+-- type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t+-- @+--+-- if you called @tcSplitSigmaTy@ on this type:+--+-- @+-- forall s t a b. Each s t a b => Traversal s t a b+-- @+--+-- then it would return @([s,t,a,b], [Each s t a b], Traversal s t a b)@. But+-- if you instead called @tcSplitNestedSigmaTys@ on the type, it would return+-- @([s,t,a,b,f], [Each s t a b, Applicative f], (a -> f b) -> s -> f t)@.+tcSplitNestedSigmaTys :: Type -> ([TyVar], ThetaType, Type)+-- NB: This is basically a pure version of deeplyInstantiate (from Inst) that+-- doesn't compute an HsWrapper.+tcSplitNestedSigmaTys ty+    -- If there's a forall, split it apart and try splitting the rho type+    -- underneath it.+  | Just (arg_tys, tvs1, theta1, rho1) <- tcDeepSplitSigmaTy_maybe ty+  = let (tvs2, theta2, rho2) = tcSplitNestedSigmaTys rho1+    in (tvs1 ++ tvs2, theta1 ++ theta2, mkVisFunTys arg_tys rho2)+    -- If there's no forall, we're done.+  | otherwise = ([], [], ty)++-----------------------+tcDeepSplitSigmaTy_maybe+  :: TcSigmaType -> Maybe ([TcType], [TyVar], ThetaType, TcSigmaType)+-- Looks for a *non-trivial* quantified type, under zero or more function arrows+-- By "non-trivial" we mean either tyvars or constraints are non-empty++tcDeepSplitSigmaTy_maybe ty+  | Just (arg_ty, res_ty)           <- tcSplitFunTy_maybe ty+  , Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe res_ty+  = Just (arg_ty:arg_tys, tvs, theta, rho)++  | (tvs, theta, rho) <- tcSplitSigmaTy ty+  , not (null tvs && null theta)+  = Just ([], tvs, theta, rho)++  | otherwise = Nothing++-----------------------+tcTyConAppTyCon :: Type -> TyCon+tcTyConAppTyCon ty+  = case tcTyConAppTyCon_maybe ty of+      Just tc -> tc+      Nothing -> pprPanic "tcTyConAppTyCon" (pprType ty)++-- | Like 'tcRepSplitTyConApp_maybe', but only returns the 'TyCon'.+tcTyConAppTyCon_maybe :: Type -> Maybe TyCon+tcTyConAppTyCon_maybe ty+  | Just ty' <- tcView ty = tcTyConAppTyCon_maybe ty'+tcTyConAppTyCon_maybe (TyConApp tc _)+  = Just tc+tcTyConAppTyCon_maybe (FunTy { ft_af = VisArg })+  = Just funTyCon  -- (=>) is /not/ a TyCon in its own right+                   -- C.f. tcRepSplitAppTy_maybe+tcTyConAppTyCon_maybe _+  = Nothing++tcTyConAppArgs :: Type -> [Type]+tcTyConAppArgs ty = case tcSplitTyConApp_maybe ty of+                        Just (_, args) -> args+                        Nothing        -> pprPanic "tcTyConAppArgs" (pprType ty)++tcSplitTyConApp :: Type -> (TyCon, [Type])+tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of+                        Just stuff -> stuff+                        Nothing    -> pprPanic "tcSplitTyConApp" (pprType ty)++-----------------------+tcSplitFunTys :: Type -> ([Type], Type)+tcSplitFunTys ty = case tcSplitFunTy_maybe ty of+                        Nothing        -> ([], ty)+                        Just (arg,res) -> (arg:args, res')+                                       where+                                          (args,res') = tcSplitFunTys res++tcSplitFunTy_maybe :: Type -> Maybe (Type, Type)+tcSplitFunTy_maybe ty+  | Just ty' <- tcView ty = tcSplitFunTy_maybe ty'+tcSplitFunTy_maybe (FunTy { ft_af = af, ft_arg = arg, ft_res = res })+  | VisArg <- af = Just (arg, res)+tcSplitFunTy_maybe _ = Nothing+        -- Note the VisArg guard+        -- Consider     (?x::Int) => Bool+        -- We don't want to treat this as a function type!+        -- A concrete example is test tc230:+        --      f :: () -> (?p :: ()) => () -> ()+        --+        --      g = f () ()++tcSplitFunTysN :: Arity                      -- n: Number of desired args+               -> TcRhoType+               -> Either Arity               -- Number of missing arrows+                        ([TcSigmaType],      -- Arg types (always N types)+                         TcSigmaType)        -- The rest of the type+-- ^ Split off exactly the specified number argument types+-- Returns+--  (Left m) if there are 'm' missing arrows in the type+--  (Right (tys,res)) if the type looks like t1 -> ... -> tn -> res+tcSplitFunTysN n ty+ | n == 0+ = Right ([], ty)+ | Just (arg,res) <- tcSplitFunTy_maybe ty+ = case tcSplitFunTysN (n-1) res of+     Left m            -> Left m+     Right (args,body) -> Right (arg:args, body)+ | otherwise+ = Left n++tcSplitFunTy :: Type -> (Type, Type)+tcSplitFunTy  ty = expectJust "tcSplitFunTy" (tcSplitFunTy_maybe ty)++tcFunArgTy :: Type -> Type+tcFunArgTy    ty = fst (tcSplitFunTy ty)++tcFunResultTy :: Type -> Type+tcFunResultTy ty = snd (tcSplitFunTy ty)++-- | Strips off n *visible* arguments and returns the resulting type+tcFunResultTyN :: HasDebugCallStack => Arity -> Type -> Type+tcFunResultTyN n ty+  | Right (_, res_ty) <- tcSplitFunTysN n ty+  = res_ty+  | otherwise+  = pprPanic "tcFunResultTyN" (ppr n <+> ppr ty)++-----------------------+tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)+tcSplitAppTy_maybe ty | Just ty' <- tcView ty = tcSplitAppTy_maybe ty'+tcSplitAppTy_maybe ty = tcRepSplitAppTy_maybe ty++tcSplitAppTy :: Type -> (Type, Type)+tcSplitAppTy ty = case tcSplitAppTy_maybe ty of+                    Just stuff -> stuff+                    Nothing    -> pprPanic "tcSplitAppTy" (pprType ty)++tcSplitAppTys :: Type -> (Type, [Type])+tcSplitAppTys ty+  = go ty []+  where+    go ty args = case tcSplitAppTy_maybe ty of+                   Just (ty', arg) -> go ty' (arg:args)+                   Nothing         -> (ty,args)++-- | Returns the number of arguments in the given type, without+-- looking through synonyms. This is used only for error reporting.+-- We don't look through synonyms because of #11313.+tcRepGetNumAppTys :: Type -> Arity+tcRepGetNumAppTys = length . snd . repSplitAppTys++-----------------------+-- | If the type is a tyvar, possibly under a cast, returns it, along+-- with the coercion. Thus, the co is :: kind tv ~N kind type+tcGetCastedTyVar_maybe :: Type -> Maybe (TyVar, CoercionN)+tcGetCastedTyVar_maybe ty | Just ty' <- tcView ty = tcGetCastedTyVar_maybe ty'+tcGetCastedTyVar_maybe (CastTy (TyVarTy tv) co) = Just (tv, co)+tcGetCastedTyVar_maybe (TyVarTy tv)             = Just (tv, mkNomReflCo (tyVarKind tv))+tcGetCastedTyVar_maybe _                        = Nothing++tcGetTyVar_maybe :: Type -> Maybe TyVar+tcGetTyVar_maybe ty | Just ty' <- tcView ty = tcGetTyVar_maybe ty'+tcGetTyVar_maybe (TyVarTy tv)   = Just tv+tcGetTyVar_maybe _              = Nothing++tcGetTyVar :: String -> Type -> TyVar+tcGetTyVar msg ty+  = case tcGetTyVar_maybe ty of+     Just tv -> tv+     Nothing -> pprPanic msg (ppr ty)++tcIsTyVarTy :: Type -> Bool+tcIsTyVarTy ty | Just ty' <- tcView ty = tcIsTyVarTy ty'+tcIsTyVarTy (CastTy ty _) = tcIsTyVarTy ty  -- look through casts, as+                                            -- this is only used for+                                            -- e.g., FlexibleContexts+tcIsTyVarTy (TyVarTy _)   = True+tcIsTyVarTy _             = False++-----------------------+tcSplitDFunTy :: Type -> ([TyVar], [Type], Class, [Type])+-- Split the type of a dictionary function+-- We don't use tcSplitSigmaTy,  because a DFun may (with NDP)+-- have non-Pred arguments, such as+--     df :: forall m. (forall b. Eq b => Eq (m b)) -> C m+--+-- Also NB splitFunTys, not tcSplitFunTys;+-- the latter specifically stops at PredTy arguments,+-- and we don't want to do that here+tcSplitDFunTy ty+  = case tcSplitForAllTys ty   of { (tvs, rho)    ->+    case splitFunTys rho       of { (theta, tau)  ->+    case tcSplitDFunHead tau   of { (clas, tys)   ->+    (tvs, theta, clas, tys) }}}++tcSplitDFunHead :: Type -> (Class, [Type])+tcSplitDFunHead = getClassPredTys++tcSplitMethodTy :: Type -> ([TyVar], PredType, Type)+-- A class method (selector) always has a type like+--   forall as. C as => blah+-- So if the class looks like+--   class C a where+--     op :: forall b. (Eq a, Ix b) => a -> b+-- the class method type looks like+--  op :: forall a. C a => forall b. (Eq a, Ix b) => a -> b+--+-- tcSplitMethodTy just peels off the outer forall and+-- that first predicate+tcSplitMethodTy ty+  | (sel_tyvars,sel_rho) <- tcSplitForAllTys ty+  , Just (first_pred, local_meth_ty) <- tcSplitPredFunTy_maybe sel_rho+  = (sel_tyvars, first_pred, local_meth_ty)+  | otherwise+  = pprPanic "tcSplitMethodTy" (ppr ty)+++{- *********************************************************************+*                                                                      *+            Type equalities+*                                                                      *+********************************************************************* -}++tcEqKind :: HasDebugCallStack => TcKind -> TcKind -> Bool+tcEqKind = tcEqType++tcEqType :: HasDebugCallStack => TcType -> TcType -> Bool+-- tcEqType is a proper implements the same Note [Non-trivial definitional+-- equality] (in TyCoRep) as `eqType`, but Type.eqType believes (* ==+-- Constraint), and that is NOT what we want in the type checker!+tcEqType ty1 ty2+  =  tc_eq_type False False ki1 ki2+  && tc_eq_type False False ty1 ty2+  where+    ki1 = tcTypeKind ty1+    ki2 = tcTypeKind ty2++-- | Just like 'tcEqType', but will return True for types of different kinds+-- as long as their non-coercion structure is identical.+tcEqTypeNoKindCheck :: TcType -> TcType -> Bool+tcEqTypeNoKindCheck ty1 ty2+  = tc_eq_type False False ty1 ty2++-- | Like 'tcEqType', but returns True if the /visible/ part of the types+-- are equal, even if they are really unequal (in the invisible bits)+tcEqTypeVis :: TcType -> TcType -> Bool+tcEqTypeVis ty1 ty2 = tc_eq_type False True ty1 ty2++-- | Like 'pickyEqTypeVis', but returns a Bool for convenience+pickyEqType :: TcType -> TcType -> Bool+-- Check when two types _look_ the same, _including_ synonyms.+-- So (pickyEqType String [Char]) returns False+-- This ignores kinds and coercions, because this is used only for printing.+pickyEqType ty1 ty2 = tc_eq_type True False ty1 ty2++++-- | Real worker for 'tcEqType'. No kind check!+tc_eq_type :: Bool          -- ^ True <=> do not expand type synonyms+           -> Bool          -- ^ True <=> compare visible args only+           -> Type -> Type+           -> Bool+-- Flags False, False is the usual setting for tc_eq_type+tc_eq_type keep_syns vis_only orig_ty1 orig_ty2+  = go orig_env orig_ty1 orig_ty2+  where+    go :: RnEnv2 -> Type -> Type -> Bool+    go env t1 t2 | not keep_syns, Just t1' <- tcView t1 = go env t1' t2+    go env t1 t2 | not keep_syns, Just t2' <- tcView t2 = go env t1 t2'++    go env (TyVarTy tv1) (TyVarTy tv2)+      = rnOccL env tv1 == rnOccR env tv2++    go _   (LitTy lit1) (LitTy lit2)+      = lit1 == lit2++    go env (ForAllTy (Bndr tv1 vis1) ty1)+           (ForAllTy (Bndr tv2 vis2) ty2)+      =  vis1 == vis2+      && (vis_only || go env (varType tv1) (varType tv2))+      && go (rnBndr2 env tv1 tv2) ty1 ty2++    -- Make sure we handle all FunTy cases since falling through to the+    -- AppTy case means that tcRepSplitAppTy_maybe may see an unzonked+    -- kind variable, which causes things to blow up.+    go env (FunTy _ arg1 res1) (FunTy _ arg2 res2)+      = go env arg1 arg2 && go env res1 res2+    go env ty (FunTy _ arg res) = eqFunTy env arg res ty+    go env (FunTy _ arg res) ty = eqFunTy env arg res ty++      -- See Note [Equality on AppTys] in Type+    go env (AppTy s1 t1)        ty2+      | Just (s2, t2) <- tcRepSplitAppTy_maybe ty2+      = go env s1 s2 && go env t1 t2+    go env ty1                  (AppTy s2 t2)+      | Just (s1, t1) <- tcRepSplitAppTy_maybe ty1+      = go env s1 s2 && go env t1 t2++    go env (TyConApp tc1 ts1)   (TyConApp tc2 ts2)+      = tc1 == tc2 && gos env (tc_vis tc1) ts1 ts2++    go env (CastTy t1 _)   t2              = go env t1 t2+    go env t1              (CastTy t2 _)   = go env t1 t2+    go _   (CoercionTy {}) (CoercionTy {}) = True++    go _ _ _ = False++    gos _   _         []       []      = True+    gos env (ig:igs) (t1:ts1) (t2:ts2) = (ig || go env t1 t2)+                                      && gos env igs ts1 ts2+    gos _ _ _ _ = False++    tc_vis :: TyCon -> [Bool]  -- True for the fields we should ignore+    tc_vis tc | vis_only  = inviss ++ repeat False    -- Ignore invisibles+              | otherwise = repeat False              -- Ignore nothing+       -- The repeat False is necessary because tycons+       -- can legitimately be oversaturated+      where+        bndrs = tyConBinders tc+        inviss  = map isInvisibleTyConBinder bndrs++    orig_env = mkRnEnv2 $ mkInScopeSet $ tyCoVarsOfTypes [orig_ty1, orig_ty2]++    -- @eqFunTy arg res ty@ is True when @ty@ equals @FunTy arg res@. This is+    -- sometimes hard to know directly because @ty@ might have some casts+    -- obscuring the FunTy. And 'splitAppTy' is difficult because we can't+    -- always extract a RuntimeRep (see Note [xyz]) if the kind of the arg or+    -- res is unzonked/unflattened. Thus this function, which handles this+    -- corner case.+    eqFunTy :: RnEnv2 -> Type -> Type -> Type -> Bool+               -- Last arg is /not/ FunTy+    eqFunTy env arg res ty@(AppTy{}) = get_args ty []+      where+        get_args :: Type -> [Type] -> Bool+        get_args (AppTy f x)       args = get_args f (x:args)+        get_args (CastTy t _)      args = get_args t args+        get_args (TyConApp tc tys) args+          | tc == funTyCon+          , [_, _, arg', res'] <- tys ++ args+          = go env arg arg' && go env res res'+        get_args _ _    = False+    eqFunTy _ _ _ _     = False++{- *********************************************************************+*                                                                      *+                       Predicate types+*                                                                      *+************************************************************************++Deconstructors and tests on predicate types++Note [Kind polymorphic type classes]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+    class C f where...   -- C :: forall k. k -> Constraint+    g :: forall (f::*). C f => f -> f++Here the (C f) in the signature is really (C * f), and we+don't want to complain that the * isn't a type variable!+-}++isTyVarClassPred :: PredType -> Bool+isTyVarClassPred ty = case getClassPredTys_maybe ty of+    Just (_, tys) -> all isTyVarTy tys+    _             -> False++-------------------------+checkValidClsArgs :: Bool -> Class -> [KindOrType] -> Bool+-- If the Bool is True (flexible contexts), return True (i.e. ok)+-- Otherwise, check that the type (not kind) args are all headed by a tyvar+--   E.g. (Eq a) accepted, (Eq (f a)) accepted, but (Eq Int) rejected+-- This function is here rather than in TcValidity because it is+-- called from TcSimplify, which itself is imported by TcValidity+checkValidClsArgs flexible_contexts cls kts+  | flexible_contexts = True+  | otherwise         = all hasTyVarHead tys+  where+    tys = filterOutInvisibleTypes (classTyCon cls) kts++hasTyVarHead :: Type -> Bool+-- Returns true of (a t1 .. tn), where 'a' is a type variable+hasTyVarHead ty                 -- Haskell 98 allows predicates of form+  | tcIsTyVarTy ty = True       --      C (a ty1 .. tyn)+  | otherwise                   -- where a is a type variable+  = case tcSplitAppTy_maybe ty of+       Just (ty, _) -> hasTyVarHead ty+       Nothing      -> False++evVarPred :: EvVar -> PredType+evVarPred var+  = ASSERT2( isEvVarType var_ty, ppr var <+> dcolon <+> ppr var_ty )+    var_ty+ where+    var_ty = varType var++------------------+-- | When inferring types, should we quantify over a given predicate?+-- Generally true of classes; generally false of equality constraints.+-- Equality constraints that mention quantified type variables and+-- implicit variables complicate the story. See Notes+-- [Inheriting implicit parameters] and [Quantifying over equality constraints]+pickQuantifiablePreds+  :: TyVarSet           -- Quantifying over these+  -> TcThetaType        -- Proposed constraints to quantify+  -> TcThetaType        -- A subset that we can actually quantify+-- This function decides whether a particular constraint should be+-- quantified over, given the type variables that are being quantified+pickQuantifiablePreds qtvs theta+  = let flex_ctxt = True in  -- Quantify over non-tyvar constraints, even without+                             -- -XFlexibleContexts: see #10608, #10351+         -- flex_ctxt <- xoptM Opt_FlexibleContexts+    mapMaybe (pick_me flex_ctxt) theta+  where+    pick_me flex_ctxt pred+      = case classifyPredType pred of++          ClassPred cls tys+            | Just {} <- isCallStackPred cls tys+              -- NEVER infer a CallStack constraint.  Otherwise we let+              -- the constraints bubble up to be solved from the outer+              -- context, or be defaulted when we reach the top-level.+              -- See Note [Overview of implicit CallStacks]+            -> Nothing++            | isIPClass cls+            -> Just pred -- See note [Inheriting implicit parameters]++            | pick_cls_pred flex_ctxt cls tys+            -> Just pred++          EqPred eq_rel ty1 ty2+            | quantify_equality eq_rel ty1 ty2+            , Just (cls, tys) <- boxEqPred eq_rel ty1 ty2+              -- boxEqPred: See Note [Lift equality constaints when quantifying]+            , pick_cls_pred flex_ctxt cls tys+            -> Just (mkClassPred cls tys)++          IrredPred ty+            | tyCoVarsOfType ty `intersectsVarSet` qtvs+            -> Just pred++          _ -> Nothing+++    pick_cls_pred flex_ctxt cls tys+      = tyCoVarsOfTypes tys `intersectsVarSet` qtvs+        && (checkValidClsArgs flex_ctxt cls tys)+           -- Only quantify over predicates that checkValidType+           -- will pass!  See #10351.++    -- See Note [Quantifying over equality constraints]+    quantify_equality NomEq  ty1 ty2 = quant_fun ty1 || quant_fun ty2+    quantify_equality ReprEq _   _   = True++    quant_fun ty+      = case tcSplitTyConApp_maybe ty of+          Just (tc, tys) | isTypeFamilyTyCon tc+                         -> tyCoVarsOfTypes tys `intersectsVarSet` qtvs+          _ -> False++boxEqPred :: EqRel -> Type -> Type -> Maybe (Class, [Type])+-- Given (t1 ~# t2) or (t1 ~R# t2) return the boxed version+--       (t1 ~ t2)  or (t1 `Coercible` t2)+boxEqPred eq_rel ty1 ty2+  = case eq_rel of+      NomEq  | homo_kind -> Just (eqClass,        [k1,     ty1, ty2])+             | otherwise -> Just (heqClass,       [k1, k2, ty1, ty2])+      ReprEq | homo_kind -> Just (coercibleClass, [k1,     ty1, ty2])+             | otherwise -> Nothing -- Sigh: we do not have hererogeneous Coercible+                                    --       so we can't abstract over it+                                    -- Nothing fundamental: we could add it+ where+   k1 = tcTypeKind ty1+   k2 = tcTypeKind ty2+   homo_kind = k1 `tcEqType` k2++pickCapturedPreds+  :: TyVarSet           -- Quantifying over these+  -> TcThetaType        -- Proposed constraints to quantify+  -> TcThetaType        -- A subset that we can actually quantify+-- A simpler version of pickQuantifiablePreds, used to winnow down+-- the inferred constraints of a group of bindings, into those for+-- one particular identifier+pickCapturedPreds qtvs theta+  = filter captured theta+  where+    captured pred = isIPPred pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs)+++-- Superclasses++type PredWithSCs a = (PredType, [PredType], a)++mkMinimalBySCs :: forall a. (a -> PredType) -> [a] -> [a]+-- Remove predicates that+--+--   - are the same as another predicate+--+--   - can be deduced from another by superclasses,+--+--   - are a reflexive equality (e.g  * ~ *)+--     (see Note [Remove redundant provided dicts] in TcPatSyn)+--+-- The result is a subset of the input.+-- The 'a' is just paired up with the PredType;+--   typically it might be a dictionary Id+mkMinimalBySCs get_pred xs = go preds_with_scs []+ where+   preds_with_scs :: [PredWithSCs a]+   preds_with_scs = [ (pred, pred : transSuperClasses pred, x)+                    | x <- xs+                    , let pred = get_pred x ]++   go :: [PredWithSCs a]   -- Work list+      -> [PredWithSCs a]   -- Accumulating result+      -> [a]+   go [] min_preds+     = reverse (map thdOf3 min_preds)+       -- The 'reverse' isn't strictly necessary, but it+       -- means that the results are returned in the same+       -- order as the input, which is generally saner+   go (work_item@(p,_,_) : work_list) min_preds+     | EqPred _ t1 t2 <- classifyPredType p+     , t1 `tcEqType` t2   -- See TcPatSyn+                          -- Note [Remove redundant provided dicts]+     = go work_list min_preds+     | p `in_cloud` work_list || p `in_cloud` min_preds+     = go work_list min_preds+     | otherwise+     = go work_list (work_item : min_preds)++   in_cloud :: PredType -> [PredWithSCs a] -> Bool+   in_cloud p ps = or [ p `tcEqType` p' | (_, scs, _) <- ps, p' <- scs ]++transSuperClasses :: PredType -> [PredType]+-- (transSuperClasses p) returns (p's superclasses) not including p+-- Stop if you encounter the same class again+-- See Note [Expanding superclasses]+transSuperClasses p+  = go emptyNameSet p+  where+    go :: NameSet -> PredType -> [PredType]+    go rec_clss p+       | ClassPred cls tys <- classifyPredType p+       , let cls_nm = className cls+       , not (cls_nm `elemNameSet` rec_clss)+       , let rec_clss' | isCTupleClass cls = rec_clss+                       | otherwise         = rec_clss `extendNameSet` cls_nm+       = [ p' | sc <- immSuperClasses cls tys+              , p'  <- sc : go rec_clss' sc ]+       | otherwise+       = []++immSuperClasses :: Class -> [Type] -> [PredType]+immSuperClasses cls tys+  = substTheta (zipTvSubst tyvars tys) sc_theta+  where+    (tyvars,sc_theta,_,_) = classBigSig cls++isImprovementPred :: PredType -> Bool+-- Either it's an equality, or has some functional dependency+isImprovementPred ty+  = case classifyPredType ty of+      EqPred NomEq t1 t2 -> not (t1 `tcEqType` t2)+      EqPred ReprEq _ _  -> False+      ClassPred cls _    -> classHasFds cls+      IrredPred {}       -> True -- Might have equalities after reduction?+      ForAllPred {}      -> False++-- | Is the equality+--        a ~r ...a....+-- definitely insoluble or not?+--      a ~r Maybe a      -- Definitely insoluble+--      a ~N ...(F a)...  -- Not definitely insoluble+--                        -- Perhaps (F a) reduces to Int+--      a ~R ...(N a)...  -- Not definitely insoluble+--                        -- Perhaps newtype N a = MkN Int+-- See Note [Occurs check error] in+-- TcCanonical for the motivation for this function.+isInsolubleOccursCheck :: EqRel -> TcTyVar -> TcType -> Bool+isInsolubleOccursCheck eq_rel tv ty+  = go ty+  where+    go ty | Just ty' <- tcView ty = go ty'+    go (TyVarTy tv') = tv == tv' || go (tyVarKind tv')+    go (LitTy {})    = False+    go (AppTy t1 t2) = case eq_rel of  -- See Note [AppTy and ReprEq]+                         NomEq  -> go t1 || go t2+                         ReprEq -> go t1+    go (FunTy _ t1 t2) = go t1 || go t2+    go (ForAllTy (Bndr tv' _) inner_ty)+      | tv' == tv = False+      | otherwise = go (varType tv') || go inner_ty+    go (CastTy ty _)  = go ty   -- ToDo: what about the coercion+    go (CoercionTy _) = False   -- ToDo: what about the coercion+    go (TyConApp tc tys)+      | isGenerativeTyCon tc role = any go tys+      | otherwise                 = any go (drop (tyConArity tc) tys)+         -- (a ~ F b a), where F has arity 1,+         -- has an insoluble occurs check++    role = eqRelRole eq_rel++{- Note [Expanding superclasses]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When we expand superclasses, we use the following algorithm:++transSuperClasses( C tys ) returns the transitive superclasses+                           of (C tys), not including C itself++For example+  class C a b => D a b+  class D b a => C a b++Then+  transSuperClasses( Ord ty )  = [Eq ty]+  transSuperClasses( C ta tb ) = [D tb ta, C tb ta]++Notice that in the recursive-superclass case we include C again at+the end of the chain.  One could exclude C in this case, but+the code is more awkward and there seems no good reason to do so.+(However C.f. TcCanonical.mk_strict_superclasses, which /does/+appear to do so.)++The algorithm is expand( so_far, pred ):++ 1. If pred is not a class constraint, return empty set+       Otherwise pred = C ts+ 2. If C is in so_far, return empty set (breaks loops)+ 3. Find the immediate superclasses constraints of (C ts)+ 4. For each such sc_pred, return (sc_pred : expand( so_far+C, D ss )++Notice that++ * With normal Haskell-98 classes, the loop-detector will never bite,+   so we'll get all the superclasses.++ * We need the loop-breaker in case we have UndecidableSuperClasses on++ * Since there is only a finite number of distinct classes, expansion+   must terminate.++ * The loop breaking is a bit conservative. Notably, a tuple class+   could contain many times without threatening termination:+      (Eq a, (Ord a, Ix a))+   And this is try of any class that we can statically guarantee+   as non-recursive (in some sense).  For now, we just make a special+   case for tuples.  Something better would be cool.++See also TcTyDecls.checkClassCycles.++Note [Lift equality constaints when quantifying]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We can't quantify over a constraint (t1 ~# t2) because that isn't a+predicate type; see Note [Types for coercions, predicates, and evidence]+in Type.hs.++So we have to 'lift' it to (t1 ~ t2).  Similarly (~R#) must be lifted+to Coercible.++This tiresome lifting is the reason that pick_me (in+pickQuantifiablePreds) returns a Maybe rather than a Bool.++Note [Quantifying over equality constraints]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Should we quantify over an equality constraint (s ~ t)?  In general, we don't.+Doing so may simply postpone a type error from the function definition site to+its call site.  (At worst, imagine (Int ~ Bool)).++However, consider this+         forall a. (F [a] ~ Int) => blah+Should we quantify over the (F [a] ~ Int)?  Perhaps yes, because at the call+site we will know 'a', and perhaps we have instance  F [Bool] = Int.+So we *do* quantify over a type-family equality where the arguments mention+the quantified variables.++Note [Inheriting implicit parameters]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider this:++        f x = (x::Int) + ?y++where f is *not* a top-level binding.+From the RHS of f we'll get the constraint (?y::Int).+There are two types we might infer for f:++        f :: Int -> Int++(so we get ?y from the context of f's definition), or++        f :: (?y::Int) => Int -> Int++At first you might think the first was better, because then+?y behaves like a free variable of the definition, rather than+having to be passed at each call site.  But of course, the WHOLE+IDEA is that ?y should be passed at each call site (that's what+dynamic binding means) so we'd better infer the second.++BOTTOM LINE: when *inferring types* you must quantify over implicit+parameters, *even if* they don't mention the bound type variables.+Reason: because implicit parameters, uniquely, have local instance+declarations. See pickQuantifiablePreds.++Note [Quantifying over equality constraints]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Should we quantify over an equality constraint (s ~ t)?  In general, we don't.+Doing so may simply postpone a type error from the function definition site to+its call site.  (At worst, imagine (Int ~ Bool)).++However, consider this+         forall a. (F [a] ~ Int) => blah+Should we quantify over the (F [a] ~ Int).  Perhaps yes, because at the call+site we will know 'a', and perhaps we have instance  F [Bool] = Int.+So we *do* quantify over a type-family equality where the arguments mention+the quantified variables.++************************************************************************+*                                                                      *+      Classifying types+*                                                                      *+************************************************************************+-}++isSigmaTy :: TcType -> Bool+-- isSigmaTy returns true of any qualified type.  It doesn't+-- *necessarily* have any foralls.  E.g+--        f :: (?x::Int) => Int -> Int+isSigmaTy ty | Just ty' <- tcView ty = isSigmaTy ty'+isSigmaTy (ForAllTy {})                = True+isSigmaTy (FunTy { ft_af = InvisArg }) = True+isSigmaTy _                            = False++isRhoTy :: TcType -> Bool   -- True of TcRhoTypes; see Note [TcRhoType]+isRhoTy ty | Just ty' <- tcView ty = isRhoTy ty'+isRhoTy (ForAllTy {})                          = False+isRhoTy (FunTy { ft_af = VisArg, ft_res = r }) = isRhoTy r+isRhoTy _                                      = True++-- | Like 'isRhoTy', but also says 'True' for 'Infer' types+isRhoExpTy :: ExpType -> Bool+isRhoExpTy (Check ty) = isRhoTy ty+isRhoExpTy (Infer {}) = True++isOverloadedTy :: Type -> Bool+-- Yes for a type of a function that might require evidence-passing+-- Used only by bindLocalMethods+isOverloadedTy ty | Just ty' <- tcView ty = isOverloadedTy ty'+isOverloadedTy (ForAllTy _  ty)             = isOverloadedTy ty+isOverloadedTy (FunTy { ft_af = InvisArg }) = True+isOverloadedTy _                            = False++isFloatTy, isDoubleTy, isIntegerTy, isIntTy, isWordTy, isBoolTy,+    isUnitTy, isCharTy, isAnyTy :: Type -> Bool+isFloatTy      = is_tc floatTyConKey+isDoubleTy     = is_tc doubleTyConKey+isIntegerTy    = is_tc integerTyConKey+isIntTy        = is_tc intTyConKey+isWordTy       = is_tc wordTyConKey+isBoolTy       = is_tc boolTyConKey+isUnitTy       = is_tc unitTyConKey+isCharTy       = is_tc charTyConKey+isAnyTy        = is_tc anyTyConKey++-- | Does a type represent a floating-point number?+isFloatingTy :: Type -> Bool+isFloatingTy ty = isFloatTy ty || isDoubleTy ty++-- | Is a type 'String'?+isStringTy :: Type -> Bool+isStringTy ty+  = case tcSplitTyConApp_maybe ty of+      Just (tc, [arg_ty]) -> tc == listTyCon && isCharTy arg_ty+      _                   -> False++-- | Is a type a 'CallStack'?+isCallStackTy :: Type -> Bool+isCallStackTy ty+  | Just tc <- tyConAppTyCon_maybe ty+  = tc `hasKey` callStackTyConKey+  | otherwise+  = False++-- | Is a 'PredType' a 'CallStack' implicit parameter?+--+-- If so, return the name of the parameter.+isCallStackPred :: Class -> [Type] -> Maybe FastString+isCallStackPred cls tys+  | [ty1, ty2] <- tys+  , isIPClass cls+  , isCallStackTy ty2+  = isStrLitTy ty1+  | otherwise+  = Nothing++hasIPPred :: PredType -> Bool+hasIPPred pred+  = case classifyPredType pred of+      ClassPred cls tys+        | isIPClass     cls -> True+        | isCTupleClass cls -> any hasIPPred tys+      _other -> False++is_tc :: Unique -> Type -> Bool+-- Newtypes are opaque to this+is_tc uniq ty = case tcSplitTyConApp_maybe ty of+                        Just (tc, _) -> uniq == getUnique tc+                        Nothing      -> False++-- | Does the given tyvar appear at the head of a chain of applications+--     (a t1 ... tn)+isTyVarHead :: TcTyVar -> TcType -> Bool+isTyVarHead tv (TyVarTy tv')   = tv == tv'+isTyVarHead tv (AppTy fun _)   = isTyVarHead tv fun+isTyVarHead tv (CastTy ty _)   = isTyVarHead tv ty+isTyVarHead _ (TyConApp {})    = False+isTyVarHead _  (LitTy {})      = False+isTyVarHead _  (ForAllTy {})   = False+isTyVarHead _  (FunTy {})      = False+isTyVarHead _  (CoercionTy {}) = False+++{- Note [AppTy and ReprEq]+~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider   a ~R# b a+           a ~R# a b++The former is /not/ a definite error; we might instantiate 'b' with Id+   newtype Id a = MkId a+but the latter /is/ a definite error.++On the other hand, with nominal equality, both are definite errors+-}++isRigidTy :: TcType -> Bool+isRigidTy ty+  | Just (tc,_) <- tcSplitTyConApp_maybe ty = isGenerativeTyCon tc Nominal+  | Just {} <- tcSplitAppTy_maybe ty        = True+  | isForAllTy ty                           = True+  | otherwise                               = False+++{-+************************************************************************+*                                                                      *+\subsection{Misc}+*                                                                      *+************************************************************************++Note [Visible type application]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+GHC implements a generalisation of the algorithm described in the+"Visible Type Application" paper (available from+http://www.cis.upenn.edu/~sweirich/publications.html). A key part+of that algorithm is to distinguish user-specified variables from inferred+variables. For example, the following should typecheck:++  f :: forall a b. a -> b -> b+  f = const id++  g = const id++  x = f @Int @Bool 5 False+  y = g 5 @Bool False++The idea is that we wish to allow visible type application when we are+instantiating a specified, fixed variable. In practice, specified, fixed+variables are either written in a type signature (or+annotation), OR are imported from another module. (We could do better here,+for example by doing SCC analysis on parts of a module and considering any+type from outside one's SCC to be fully specified, but this is very confusing to+users. The simple rule above is much more straightforward and predictable.)++So, both of f's quantified variables are specified and may be instantiated.+But g has no type signature, so only id's variable is specified (because id+is imported). We write the type of g as forall {a}. a -> forall b. b -> b.+Note that the a is in braces, meaning it cannot be instantiated with+visible type application.++Tracking specified vs. inferred variables is done conveniently by a field+in TyBinder.++-}++deNoteType :: Type -> Type+-- Remove all *outermost* type synonyms and other notes+deNoteType ty | Just ty' <- coreView ty = deNoteType ty'+deNoteType ty = ty++{-+Find the free tycons and classes of a type.  This is used in the front+end of the compiler.+-}++{-+************************************************************************+*                                                                      *+\subsection[TysWiredIn-ext-type]{External types}+*                                                                      *+************************************************************************++The compiler's foreign function interface supports the passing of a+restricted set of types as arguments and results (the restricting factor+being the )+-}++tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type)+-- (tcSplitIOType_maybe t) returns Just (IO,t',co)+--              if co : t ~ IO t'+--              returns Nothing otherwise+tcSplitIOType_maybe ty+  = case tcSplitTyConApp_maybe ty of+        Just (io_tycon, [io_res_ty])+         | io_tycon `hasKey` ioTyConKey ->+            Just (io_tycon, io_res_ty)+        _ ->+            Nothing++isFFITy :: Type -> Bool+-- True for any TyCon that can possibly be an arg or result of an FFI call+isFFITy ty = isValid (checkRepTyCon legalFFITyCon ty)++isFFIArgumentTy :: DynFlags -> Safety -> Type -> Validity+-- Checks for valid argument type for a 'foreign import'+isFFIArgumentTy dflags safety ty+   = checkRepTyCon (legalOutgoingTyCon dflags safety) ty++isFFIExternalTy :: Type -> Validity+-- Types that are allowed as arguments of a 'foreign export'+isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty++isFFIImportResultTy :: DynFlags -> Type -> Validity+isFFIImportResultTy dflags ty+  = checkRepTyCon (legalFIResultTyCon dflags) ty++isFFIExportResultTy :: Type -> Validity+isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty++isFFIDynTy :: Type -> Type -> Validity+-- The type in a foreign import dynamic must be Ptr, FunPtr, or a newtype of+-- either, and the wrapped function type must be equal to the given type.+-- We assume that all types have been run through normaliseFfiType, so we don't+-- need to worry about expanding newtypes here.+isFFIDynTy expected ty+    -- Note [Foreign import dynamic]+    -- In the example below, expected would be 'CInt -> IO ()', while ty would+    -- be 'FunPtr (CDouble -> IO ())'.+    | Just (tc, [ty']) <- splitTyConApp_maybe ty+    , tyConUnique tc `elem` [ptrTyConKey, funPtrTyConKey]+    , eqType ty' expected+    = IsValid+    | otherwise+    = NotValid (vcat [ text "Expected: Ptr/FunPtr" <+> pprParendType expected <> comma+                     , text "  Actual:" <+> ppr ty ])++isFFILabelTy :: Type -> Validity+-- The type of a foreign label must be Ptr, FunPtr, or a newtype of either.+isFFILabelTy ty = checkRepTyCon ok ty+  where+    ok tc | tc `hasKey` funPtrTyConKey || tc `hasKey` ptrTyConKey+          = IsValid+          | otherwise+          = NotValid (text "A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a)")++isFFIPrimArgumentTy :: DynFlags -> Type -> Validity+-- Checks for valid argument type for a 'foreign import prim'+-- Currently they must all be simple unlifted types, or the well-known type+-- Any, which can be used to pass the address to a Haskell object on the heap to+-- the foreign function.+isFFIPrimArgumentTy dflags ty+  | isAnyTy ty = IsValid+  | otherwise  = checkRepTyCon (legalFIPrimArgTyCon dflags) ty++isFFIPrimResultTy :: DynFlags -> Type -> Validity+-- Checks for valid result type for a 'foreign import prim' Currently+-- it must be an unlifted type, including unboxed tuples, unboxed+-- sums, or the well-known type Any.+isFFIPrimResultTy dflags ty+  | isAnyTy ty = IsValid+  | otherwise = checkRepTyCon (legalFIPrimResultTyCon dflags) ty++isFunPtrTy :: Type -> Bool+isFunPtrTy ty+  | Just (tc, [_]) <- splitTyConApp_maybe ty+  = tc `hasKey` funPtrTyConKey+  | otherwise+  = False++-- normaliseFfiType gets run before checkRepTyCon, so we don't+-- need to worry about looking through newtypes or type functions+-- here; that's already been taken care of.+checkRepTyCon :: (TyCon -> Validity) -> Type -> Validity+checkRepTyCon check_tc ty+  = case splitTyConApp_maybe ty of+      Just (tc, tys)+        | isNewTyCon tc -> NotValid (hang msg 2 (mk_nt_reason tc tys $$ nt_fix))+        | otherwise     -> case check_tc tc of+                             IsValid        -> IsValid+                             NotValid extra -> NotValid (msg $$ extra)+      Nothing -> NotValid (quotes (ppr ty) <+> text "is not a data type")+  where+    msg = quotes (ppr ty) <+> text "cannot be marshalled in a foreign call"+    mk_nt_reason tc tys+      | null tys  = text "because its data constructor is not in scope"+      | otherwise = text "because the data constructor for"+                    <+> quotes (ppr tc) <+> text "is not in scope"+    nt_fix = text "Possible fix: import the data constructor to bring it into scope"++{-+Note [Foreign import dynamic]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A dynamic stub must be of the form 'FunPtr ft -> ft' where ft is any foreign+type.  Similarly, a wrapper stub must be of the form 'ft -> IO (FunPtr ft)'.++We use isFFIDynTy to check whether a signature is well-formed. For example,+given a (illegal) declaration like:++foreign import ccall "dynamic"+  foo :: FunPtr (CDouble -> IO ()) -> CInt -> IO ()++isFFIDynTy will compare the 'FunPtr' type 'CDouble -> IO ()' with the curried+result type 'CInt -> IO ()', and return False, as they are not equal.+++----------------------------------------------+These chaps do the work; they are not exported+----------------------------------------------+-}++legalFEArgTyCon :: TyCon -> Validity+legalFEArgTyCon tc+  -- It's illegal to make foreign exports that take unboxed+  -- arguments.  The RTS API currently can't invoke such things.  --SDM 7/2000+  = boxedMarshalableTyCon tc++legalFIResultTyCon :: DynFlags -> TyCon -> Validity+legalFIResultTyCon dflags tc+  | tc == unitTyCon         = IsValid+  | otherwise               = marshalableTyCon dflags tc++legalFEResultTyCon :: TyCon -> Validity+legalFEResultTyCon tc+  | tc == unitTyCon         = IsValid+  | otherwise               = boxedMarshalableTyCon tc++legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Validity+-- Checks validity of types going from Haskell -> external world+legalOutgoingTyCon dflags _ tc+  = marshalableTyCon dflags tc++legalFFITyCon :: TyCon -> Validity+-- True for any TyCon that can possibly be an arg or result of an FFI call+legalFFITyCon tc+  | isUnliftedTyCon tc = IsValid+  | tc == unitTyCon    = IsValid+  | otherwise          = boxedMarshalableTyCon tc++marshalableTyCon :: DynFlags -> TyCon -> Validity+marshalableTyCon dflags tc+  | isUnliftedTyCon tc+  , not (isUnboxedTupleTyCon tc || isUnboxedSumTyCon tc)+  , not (null (tyConPrimRep tc)) -- Note [Marshalling void]+  = validIfUnliftedFFITypes dflags+  | otherwise+  = boxedMarshalableTyCon tc++boxedMarshalableTyCon :: TyCon -> Validity+boxedMarshalableTyCon tc+   | getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey+                         , int32TyConKey, int64TyConKey+                         , wordTyConKey, word8TyConKey, word16TyConKey+                         , word32TyConKey, word64TyConKey+                         , floatTyConKey, doubleTyConKey+                         , ptrTyConKey, funPtrTyConKey+                         , charTyConKey+                         , stablePtrTyConKey+                         , boolTyConKey+                         ]+  = IsValid++  | otherwise = NotValid empty++legalFIPrimArgTyCon :: DynFlags -> TyCon -> Validity+-- Check args of 'foreign import prim', only allow simple unlifted types.+-- Strictly speaking it is unnecessary to ban unboxed tuples and sums here since+-- currently they're of the wrong kind to use in function args anyway.+legalFIPrimArgTyCon dflags tc+  | isUnliftedTyCon tc+  , not (isUnboxedTupleTyCon tc || isUnboxedSumTyCon tc)+  = validIfUnliftedFFITypes dflags+  | otherwise+  = NotValid unlifted_only++legalFIPrimResultTyCon :: DynFlags -> TyCon -> Validity+-- Check result type of 'foreign import prim'. Allow simple unlifted+-- types and also unboxed tuple and sum result types.+legalFIPrimResultTyCon dflags tc+  | isUnliftedTyCon tc+  , isUnboxedTupleTyCon tc || isUnboxedSumTyCon tc+     || not (null (tyConPrimRep tc))   -- Note [Marshalling void]+  = validIfUnliftedFFITypes dflags++  | otherwise+  = NotValid unlifted_only++unlifted_only :: MsgDoc+unlifted_only = text "foreign import prim only accepts simple unlifted types"++validIfUnliftedFFITypes :: DynFlags -> Validity+validIfUnliftedFFITypes dflags+  | xopt LangExt.UnliftedFFITypes dflags =  IsValid+  | otherwise = NotValid (text "To marshal unlifted types, use UnliftedFFITypes")++{-+Note [Marshalling void]+~~~~~~~~~~~~~~~~~~~~~~~+We don't treat State# (whose PrimRep is VoidRep) as marshalable.+In turn that means you can't write+        foreign import foo :: Int -> State# RealWorld++Reason: the back end falls over with panic "primRepHint:VoidRep";+        and there is no compelling reason to permit it+-}++{-+************************************************************************+*                                                                      *+        The "Paterson size" of a type+*                                                                      *+************************************************************************+-}++{-+Note [Paterson conditions on PredTypes]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We are considering whether *class* constraints terminate+(see Note [Paterson conditions]). Precisely, the Paterson conditions+would have us check that "the constraint has fewer constructors and variables+(taken together and counting repetitions) than the head.".++However, we can be a bit more refined by looking at which kind of constraint+this actually is. There are two main tricks:++ 1. It seems like it should be OK not to count the tuple type constructor+    for a PredType like (Show a, Eq a) :: Constraint, since we don't+    count the "implicit" tuple in the ThetaType itself.++    In fact, the Paterson test just checks *each component* of the top level+    ThetaType against the size bound, one at a time. By analogy, it should be+    OK to return the size of the *largest* tuple component as the size of the+    whole tuple.++ 2. Once we get into an implicit parameter or equality we+    can't get back to a class constraint, so it's safe+    to say "size 0".  See #4200.++NB: we don't want to detect PredTypes in sizeType (and then call+sizePred on them), or we might get an infinite loop if that PredType+is irreducible. See #5581.+-}++type TypeSize = IntWithInf++sizeType :: Type -> TypeSize+-- Size of a type: the number of variables and constructors+-- Ignore kinds altogether+sizeType = go+  where+    go ty | Just exp_ty <- tcView ty = go exp_ty+    go (TyVarTy {})              = 1+    go (TyConApp tc tys)+      | isTypeFamilyTyCon tc     = infinity  -- Type-family applications can+                                             -- expand to any arbitrary size+      | otherwise                = sizeTypes (filterOutInvisibleTypes tc tys) + 1+                                   -- Why filter out invisible args?  I suppose any+                                   -- size ordering is sound, but why is this better?+                                   -- I came across this when investigating #14010.+    go (LitTy {})                = 1+    go (FunTy _ arg res)         = go arg + go res + 1+    go (AppTy fun arg)           = go fun + go arg+    go (ForAllTy (Bndr tv vis) ty)+        | isVisibleArgFlag vis   = go (tyVarKind tv) + go ty + 1+        | otherwise              = go ty + 1+    go (CastTy ty _)             = go ty+    go (CoercionTy {})           = 0++sizeTypes :: [Type] -> TypeSize+sizeTypes tys = sum (map sizeType tys)++-----------------------------------------------------------------------------------+-----------------------------------------------------------------------------------+-----------------------+-- | For every arg a tycon can take, the returned list says True if the argument+-- is taken visibly, and False otherwise. Ends with an infinite tail of Trues to+-- allow for oversaturation.+tcTyConVisibilities :: TyCon -> [Bool]+tcTyConVisibilities tc = tc_binder_viss ++ tc_return_kind_viss ++ repeat True+  where+    tc_binder_viss      = map isVisibleTyConBinder (tyConBinders tc)+    tc_return_kind_viss = map isVisibleBinder (fst $ tcSplitPiTys (tyConResKind tc))++-- | If the tycon is applied to the types, is the next argument visible?+isNextTyConArgVisible :: TyCon -> [Type] -> Bool+isNextTyConArgVisible tc tys+  = tcTyConVisibilities tc `getNth` length tys++-- | Should this type be applied to a visible argument?+isNextArgVisible :: TcType -> Bool+isNextArgVisible ty+  | Just (bndr, _) <- tcSplitPiTy_maybe ty = isVisibleBinder bndr+  | otherwise                              = True+    -- this second case might happen if, say, we have an unzonked TauTv.+    -- But TauTvs can't range over types that take invisible arguments
+ compiler/typecheck/TcType.hs-boot view
@@ -0,0 +1,8 @@+module TcType where+import Outputable( SDoc )++data MetaDetails++data TcTyVarDetails+pprTcTyVarDetails :: TcTyVarDetails -> SDoc+vanillaSkolemTv :: TcTyVarDetails
+ compiler/types/Class.hs view
@@ -0,0 +1,359 @@+-- (c) The University of Glasgow 2006+-- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998+--+-- The @Class@ datatype++{-# LANGUAGE CPP #-}++module Class (+        Class,+        ClassOpItem,+        ClassATItem(..),+        ClassMinimalDef,+        DefMethInfo, pprDefMethInfo,++        FunDep, pprFundeps, pprFunDep,++        mkClass, mkAbstractClass, classTyVars, classArity,+        classKey, className, classATs, classATItems, classTyCon, classMethods,+        classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta,+        classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, classHasFds,+        isAbstractClass,+    ) where++#include "HsVersions.h"++import GhcPrelude++import {-# SOURCE #-} TyCon     ( TyCon )+import {-# SOURCE #-} TyCoRep   ( Type, PredType, pprType )+import Var+import Name+import BasicTypes+import Unique+import Util+import SrcLoc+import Outputable+import BooleanFormula (BooleanFormula, mkTrue)++import qualified Data.Data as Data++{-+************************************************************************+*                                                                      *+\subsection[Class-basic]{@Class@: basic definition}+*                                                                      *+************************************************************************++A @Class@ corresponds to a Greek kappa in the static semantics:+-}++data Class+  = Class {+        classTyCon :: TyCon,    -- The data type constructor for+                                -- dictionaries of this class+                                -- See Note [ATyCon for classes] in TyCoRep++        className :: Name,              -- Just the cached name of the TyCon+        classKey  :: Unique,            -- Cached unique of TyCon++        classTyVars  :: [TyVar],        -- The class kind and type variables;+                                        -- identical to those of the TyCon+           -- If you want visibility info, look at the classTyCon+           -- This field is redundant because it's duplicated in the+           -- classTyCon, but classTyVars is used quite often, so maybe+           -- it's a bit faster to cache it here++        classFunDeps :: [FunDep TyVar],  -- The functional dependencies++        classBody :: ClassBody -- Superclasses, ATs, methods++     }++--  | e.g.+--+-- >  class C a b c | a b -> c, a c -> b where...+--+--  Here fun-deps are [([a,b],[c]), ([a,c],[b])]+--+--  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'',++-- For details on above see note [Api annotations] in ApiAnnotation+type FunDep a = ([a],[a])++type ClassOpItem = (Id, DefMethInfo)+        -- Selector function; contains unfolding+        -- Default-method info++type DefMethInfo = Maybe (Name, DefMethSpec Type)+   -- Nothing                    No default method+   -- Just ($dm, VanillaDM)      A polymorphic default method, name $dm+   -- Just ($gm, GenericDM ty)   A generic default method, name $gm, type ty+   --                              The generic dm type is *not* quantified+   --                              over the class variables; ie has the+   --                              class variables free++data ClassATItem+  = ATI TyCon         -- See Note [Associated type tyvar names]+        (Maybe (Type, SrcSpan))+                      -- Default associated type (if any) from this template+                      -- Note [Associated type defaults]++type ClassMinimalDef = BooleanFormula Name -- Required methods++data ClassBody+  = AbstractClass+  | ConcreteClass {+        -- Superclasses: eg: (F a ~ b, F b ~ G a, Eq a, Show b)+        -- We need value-level selectors for both the dictionary+        -- superclasses and the equality superclasses+        cls_sc_theta :: [PredType],     -- Immediate superclasses,+        cls_sc_sel_ids :: [Id],          -- Selector functions to extract the+                                        --   superclasses from a+                                        --   dictionary of this class+        -- Associated types+        cls_ats :: [ClassATItem],  -- Associated type families++        -- Class operations (methods, not superclasses)+        cls_ops :: [ClassOpItem],  -- Ordered by tag++        -- Minimal complete definition+        cls_min_def :: ClassMinimalDef+    }+    -- TODO: maybe super classes should be allowed in abstract class definitions++classMinimalDef :: Class -> ClassMinimalDef+classMinimalDef Class{ classBody = ConcreteClass{ cls_min_def = d } } = d+classMinimalDef _ = mkTrue -- TODO: make sure this is the right direction++{-+Note [Associated type defaults]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The following is an example of associated type defaults:+   class C a where+     data D a r++     type F x a b :: *+     type F p q r = (p,q)->r    -- Default++Note that++ * The TyCons for the associated types *share type variables* with the+   class, so that we can tell which argument positions should be+   instantiated in an instance decl.  (The first for 'D', the second+   for 'F'.)++ * We can have default definitions only for *type* families,+   not data families++ * In the default decl, the "patterns" should all be type variables,+   but (in the source language) they don't need to be the same as in+   the 'type' decl signature or the class.  It's more like a+   free-standing 'type instance' declaration.++ * HOWEVER, in the internal ClassATItem we rename the RHS to match the+   tyConTyVars of the family TyCon.  So in the example above we'd get+   a ClassATItem of+        ATI F ((x,a) -> b)+   So the tyConTyVars of the family TyCon bind the free vars of+   the default Type rhs++The @mkClass@ function fills in the indirect superclasses.++The SrcSpan is for the entire original declaration.+-}++mkClass :: Name -> [TyVar]+        -> [FunDep TyVar]+        -> [PredType] -> [Id]+        -> [ClassATItem]+        -> [ClassOpItem]+        -> ClassMinimalDef+        -> TyCon+        -> Class++mkClass cls_name tyvars fds super_classes superdict_sels at_stuff+        op_stuff mindef tycon+  = Class { classKey     = nameUnique cls_name,+            className    = cls_name,+                -- NB:  tyConName tycon = cls_name,+                -- But it takes a module loop to assert it here+            classTyVars  = tyvars,+            classFunDeps = fds,+            classBody = ConcreteClass {+                    cls_sc_theta = super_classes,+                    cls_sc_sel_ids = superdict_sels,+                    cls_ats  = at_stuff,+                    cls_ops  = op_stuff,+                    cls_min_def = mindef+                },+            classTyCon   = tycon }++mkAbstractClass :: Name -> [TyVar]+        -> [FunDep TyVar]+        -> TyCon+        -> Class++mkAbstractClass cls_name tyvars fds tycon+  = Class { classKey     = nameUnique cls_name,+            className    = cls_name,+                -- NB:  tyConName tycon = cls_name,+                -- But it takes a module loop to assert it here+            classTyVars  = tyvars,+            classFunDeps = fds,+            classBody = AbstractClass,+            classTyCon   = tycon }++{-+Note [Associated type tyvar names]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The TyCon of an associated type should use the same variable names as its+parent class. Thus+    class C a b where+      type F b x a :: *+We make F use the same Name for 'a' as C does, and similary 'b'.++The reason for this is when checking instances it's easier to match+them up, to ensure they match.  Eg+    instance C Int [d] where+      type F [d] x Int = ....+we should make sure that the first and third args match the instance+header.++Having the same variables for class and tycon is also used in checkValidRoles+(in TcTyClsDecls) when checking a class's roles.+++************************************************************************+*                                                                      *+\subsection[Class-selectors]{@Class@: simple selectors}+*                                                                      *+************************************************************************++The rest of these functions are just simple selectors.+-}++classArity :: Class -> Arity+classArity clas = length (classTyVars clas)+        -- Could memoise this++classAllSelIds :: Class -> [Id]+-- Both superclass-dictionary and method selectors+classAllSelIds c@(Class { classBody = ConcreteClass { cls_sc_sel_ids = sc_sels }})+  = sc_sels ++ classMethods c+classAllSelIds c = ASSERT( null (classMethods c) ) []++classSCSelIds :: Class -> [Id]+-- Both superclass-dictionary and method selectors+classSCSelIds (Class { classBody = ConcreteClass { cls_sc_sel_ids = sc_sels }})+  = sc_sels+classSCSelIds c = ASSERT( null (classMethods c) ) []++classSCSelId :: Class -> Int -> Id+-- Get the n'th superclass selector Id+-- where n is 0-indexed, and counts+--    *all* superclasses including equalities+classSCSelId (Class { classBody = ConcreteClass { cls_sc_sel_ids = sc_sels } }) n+  = ASSERT( n >= 0 && lengthExceeds sc_sels n )+    sc_sels !! n+classSCSelId c n = pprPanic "classSCSelId" (ppr c <+> ppr n)++classMethods :: Class -> [Id]+classMethods (Class { classBody = ConcreteClass { cls_ops = op_stuff } })+  = [op_sel | (op_sel, _) <- op_stuff]+classMethods _ = []++classOpItems :: Class -> [ClassOpItem]+classOpItems (Class { classBody = ConcreteClass { cls_ops = op_stuff }})+  = op_stuff+classOpItems _ = []++classATs :: Class -> [TyCon]+classATs (Class { classBody = ConcreteClass { cls_ats = at_stuff } })+  = [tc | ATI tc _ <- at_stuff]+classATs _ = []++classATItems :: Class -> [ClassATItem]+classATItems (Class { classBody = ConcreteClass { cls_ats = at_stuff }})+  = at_stuff+classATItems _ = []++classSCTheta :: Class -> [PredType]+classSCTheta (Class { classBody = ConcreteClass { cls_sc_theta = theta_stuff }})+  = theta_stuff+classSCTheta _ = []++classTvsFds :: Class -> ([TyVar], [FunDep TyVar])+classTvsFds c = (classTyVars c, classFunDeps c)++classHasFds :: Class -> Bool+classHasFds (Class { classFunDeps = fds }) = not (null fds)++classBigSig :: Class -> ([TyVar], [PredType], [Id], [ClassOpItem])+classBigSig (Class {classTyVars = tyvars,+                    classBody = AbstractClass})+  = (tyvars, [], [], [])+classBigSig (Class {classTyVars = tyvars,+                    classBody = ConcreteClass {+                        cls_sc_theta = sc_theta,+                        cls_sc_sel_ids = sc_sels,+                        cls_ops  = op_stuff+                    }})+  = (tyvars, sc_theta, sc_sels, op_stuff)++classExtraBigSig :: Class -> ([TyVar], [FunDep TyVar], [PredType], [Id], [ClassATItem], [ClassOpItem])+classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,+                         classBody = AbstractClass})+  = (tyvars, fundeps, [], [], [], [])+classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,+                         classBody = ConcreteClass {+                             cls_sc_theta = sc_theta, cls_sc_sel_ids = sc_sels,+                             cls_ats = ats, cls_ops = op_stuff+                         }})+  = (tyvars, fundeps, sc_theta, sc_sels, ats, op_stuff)++isAbstractClass :: Class -> Bool+isAbstractClass Class{ classBody = AbstractClass } = True+isAbstractClass _ = False++{-+************************************************************************+*                                                                      *+\subsection[Class-instances]{Instance declarations for @Class@}+*                                                                      *+************************************************************************++We compare @Classes@ by their keys (which include @Uniques@).+-}++instance Eq Class where+    c1 == c2 = classKey c1 == classKey c2+    c1 /= c2 = classKey c1 /= classKey c2++instance Uniquable Class where+    getUnique c = classKey c++instance NamedThing Class where+    getName clas = className clas++instance Outputable Class where+    ppr c = ppr (getName c)++pprDefMethInfo :: DefMethInfo -> SDoc+pprDefMethInfo Nothing                  = empty   -- No default method+pprDefMethInfo (Just (n, VanillaDM))    = text "Default method" <+> ppr n+pprDefMethInfo (Just (n, GenericDM ty)) = text "Generic default method"+                                          <+> ppr n <+> dcolon <+> pprType ty++pprFundeps :: Outputable a => [FunDep a] -> SDoc+pprFundeps []  = empty+pprFundeps fds = hsep (vbar : punctuate comma (map pprFunDep fds))++pprFunDep :: Outputable a => FunDep a -> SDoc+pprFunDep (us, vs) = hsep [interppSP us, arrow, interppSP vs]++instance Data.Data Class where+    -- don't traverse?+    toConstr _   = abstractConstr "Class"+    gunfold _ _  = error "gunfold"+    dataTypeOf _ = mkNoRepType "Class"
+ compiler/types/CoAxiom.hs view
@@ -0,0 +1,576 @@+-- (c) The University of Glasgow 2012++{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable, GADTs, KindSignatures,+             ScopedTypeVariables, StandaloneDeriving, RoleAnnotations #-}++-- | Module for coercion axioms, used to represent type family instances+-- and newtypes++module CoAxiom (+       BranchFlag, Branched, Unbranched, BranchIndex, Branches(..),+       manyBranches, unbranched,+       fromBranches, numBranches,+       mapAccumBranches,++       CoAxiom(..), CoAxBranch(..),++       toBranchedAxiom, toUnbranchedAxiom,+       coAxiomName, coAxiomArity, coAxiomBranches,+       coAxiomTyCon, isImplicitCoAxiom, coAxiomNumPats,+       coAxiomNthBranch, coAxiomSingleBranch_maybe, coAxiomRole,+       coAxiomSingleBranch, coAxBranchTyVars, coAxBranchCoVars,+       coAxBranchRoles,+       coAxBranchLHS, coAxBranchRHS, coAxBranchSpan, coAxBranchIncomps,+       placeHolderIncomps,++       Role(..), fsFromRole,++       CoAxiomRule(..), TypeEqn,+       BuiltInSynFamily(..), trivialBuiltInFamily+       ) where++import GhcPrelude++import {-# SOURCE #-} TyCoRep ( Type, pprType )+import {-# SOURCE #-} TyCon ( TyCon )+import Outputable+import FastString+import Name+import Unique+import Var+import Util+import Binary+import Pair+import BasicTypes+import Data.Typeable ( Typeable )+import SrcLoc+import qualified Data.Data as Data+import Data.Array+import Data.List ( mapAccumL )++#include "HsVersions.h"++{-+Note [Coercion axiom branches]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In order to allow closed type families, an axiom needs to contain an+ordered list of alternatives, called branches. The kind of the coercion built+from an axiom is determined by which index is used when building the coercion+from the axiom.++For example, consider the axiom derived from the following declaration:++type family F a where+  F [Int] = Bool+  F [a]   = Double+  F (a b) = Char++This will give rise to this axiom:++axF :: {                                         F [Int] ~ Bool+       ; forall (a :: *).                        F [a]   ~ Double+       ; forall (k :: *) (a :: k -> *) (b :: k). F (a b) ~ Char+       }++The axiom is used with the AxiomInstCo constructor of Coercion. If we wish+to have a coercion showing that F (Maybe Int) ~ Char, it will look like++axF[2] <*> <Maybe> <Int> :: F (Maybe Int) ~ Char+-- or, written using concrete-ish syntax --+AxiomInstCo axF 2 [Refl *, Refl Maybe, Refl Int]++Note that the index is 0-based.++For type-checking, it is also necessary to check that no previous pattern+can unify with the supplied arguments. After all, it is possible that some+of the type arguments are lambda-bound type variables whose instantiation may+cause an earlier match among the branches. We wish to prohibit this behavior,+so the type checker rules out the choice of a branch where a previous branch+can unify. See also [Apartness] in FamInstEnv.hs.++For example, the following is malformed, where 'a' is a lambda-bound type+variable:++axF[2] <*> <a> <Bool> :: F (a Bool) ~ Char++Why? Because a might be instantiated with [], meaning that branch 1 should+apply, not branch 2. This is a vital consistency check; without it, we could+derive Int ~ Bool, and that is a Bad Thing.++Note [Branched axioms]+~~~~~~~~~~~~~~~~~~~~~~+Although a CoAxiom has the capacity to store many branches, in certain cases,+we want only one. These cases are in data/newtype family instances, newtype+coercions, and type family instances.+Furthermore, these unbranched axioms are used in a+variety of places throughout GHC, and it would difficult to generalize all of+that code to deal with branched axioms, especially when the code can be sure+of the fact that an axiom is indeed a singleton. At the same time, it seems+dangerous to assume singlehood in various places through GHC.++The solution to this is to label a CoAxiom with a phantom type variable+declaring whether it is known to be a singleton or not. The branches+are stored using a special datatype, declared below, that ensures that the+type variable is accurate.++************************************************************************+*                                                                      *+                    Branches+*                                                                      *+************************************************************************+-}++type BranchIndex = Int  -- The index of the branch in the list of branches+                        -- Counting from zero++-- promoted data type+data BranchFlag = Branched | Unbranched+type Branched = 'Branched+type Unbranched = 'Unbranched+-- By using type synonyms for the promoted constructors, we avoid needing+-- DataKinds and the promotion quote in client modules. This also means that+-- we don't need to export the term-level constructors, which should never be used.++newtype Branches (br :: BranchFlag)+  = MkBranches { unMkBranches :: Array BranchIndex CoAxBranch }+type role Branches nominal++manyBranches :: [CoAxBranch] -> Branches Branched+manyBranches brs = ASSERT( snd bnds >= fst bnds )+                   MkBranches (listArray bnds brs)+  where+    bnds = (0, length brs - 1)++unbranched :: CoAxBranch -> Branches Unbranched+unbranched br = MkBranches (listArray (0, 0) [br])++toBranched :: Branches br -> Branches Branched+toBranched = MkBranches . unMkBranches++toUnbranched :: Branches br -> Branches Unbranched+toUnbranched (MkBranches arr) = ASSERT( bounds arr == (0,0) )+                                MkBranches arr++fromBranches :: Branches br -> [CoAxBranch]+fromBranches = elems . unMkBranches++branchesNth :: Branches br -> BranchIndex -> CoAxBranch+branchesNth (MkBranches arr) n = arr ! n++numBranches :: Branches br -> Int+numBranches (MkBranches arr) = snd (bounds arr) + 1++-- | The @[CoAxBranch]@ passed into the mapping function is a list of+-- all previous branches, reversed+mapAccumBranches :: ([CoAxBranch] -> CoAxBranch -> CoAxBranch)+                  -> Branches br -> Branches br+mapAccumBranches f (MkBranches arr)+  = MkBranches (listArray (bounds arr) (snd $ mapAccumL go [] (elems arr)))+  where+    go :: [CoAxBranch] -> CoAxBranch -> ([CoAxBranch], CoAxBranch)+    go prev_branches cur_branch = ( cur_branch : prev_branches+                                  , f prev_branches cur_branch )+++{-+************************************************************************+*                                                                      *+                    Coercion axioms+*                                                                      *+************************************************************************++Note [Storing compatibility]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+During axiom application, we need to be aware of which branches are compatible+with which others. The full explanation is in Note [Compatibility] in+FamInstEnv. (The code is placed there to avoid a dependency from CoAxiom on+the unification algorithm.) Although we could theoretically compute+compatibility on the fly, this is silly, so we store it in a CoAxiom.++Specifically, each branch refers to all other branches with which it is+incompatible. This list might well be empty, and it will always be for the+first branch of any axiom.++CoAxBranches that do not (yet) belong to a CoAxiom should have a panic thunk+stored in cab_incomps. The incompatibilities are properly a property of the+axiom as a whole, and they are computed only when the final axiom is built.++During serialization, the list is converted into a list of the indices+of the branches.+-}++-- | A 'CoAxiom' is a \"coercion constructor\", i.e. a named equality axiom.++-- If you edit this type, you may need to update the GHC formalism+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs+data CoAxiom br+  = CoAxiom                   -- Type equality axiom.+    { co_ax_unique   :: Unique        -- Unique identifier+    , co_ax_name     :: Name          -- Name for pretty-printing+    , co_ax_role     :: Role          -- Role of the axiom's equality+    , co_ax_tc       :: TyCon         -- The head of the LHS patterns+                                      -- e.g.  the newtype or family tycon+    , co_ax_branches :: Branches br   -- The branches that form this axiom+    , co_ax_implicit :: Bool          -- True <=> the axiom is "implicit"+                                      -- See Note [Implicit axioms]+         -- INVARIANT: co_ax_implicit == True implies length co_ax_branches == 1.+    }++data CoAxBranch+  = CoAxBranch+    { cab_loc      :: SrcSpan       -- Location of the defining equation+                                    -- See Note [CoAxiom locations]+    , cab_tvs      :: [TyVar]       -- Bound type variables; not necessarily fresh+    , cab_eta_tvs  :: [TyVar]       -- Eta-reduced tyvars+                                    -- See Note [CoAxBranch type variables]+                                    -- cab_tvs and cab_lhs may be eta-reduded; see+                                    -- Note [Eta reduction for data families]+    , cab_cvs      :: [CoVar]       -- Bound coercion variables+                                    -- Always empty, for now.+                                    -- See Note [Constraints in patterns]+                                    -- in TcTyClsDecls+    , cab_roles    :: [Role]        -- See Note [CoAxBranch roles]+    , cab_lhs      :: [Type]        -- Type patterns to match against+                                    -- See Note [CoAxiom saturation]+    , cab_rhs      :: Type          -- Right-hand side of the equality+    , cab_incomps  :: [CoAxBranch]  -- The previous incompatible branches+                                    -- See Note [Storing compatibility]+    }+  deriving Data.Data++toBranchedAxiom :: CoAxiom br -> CoAxiom Branched+toBranchedAxiom (CoAxiom unique name role tc branches implicit)+  = CoAxiom unique name role tc (toBranched branches) implicit++toUnbranchedAxiom :: CoAxiom br -> CoAxiom Unbranched+toUnbranchedAxiom (CoAxiom unique name role tc branches implicit)+  = CoAxiom unique name role tc (toUnbranched branches) implicit++coAxiomNumPats :: CoAxiom br -> Int+coAxiomNumPats = length . coAxBranchLHS . (flip coAxiomNthBranch 0)++coAxiomNthBranch :: CoAxiom br -> BranchIndex -> CoAxBranch+coAxiomNthBranch (CoAxiom { co_ax_branches = bs }) index+  = branchesNth bs index++coAxiomArity :: CoAxiom br -> BranchIndex -> Arity+coAxiomArity ax index+  = length tvs + length cvs+  where+    CoAxBranch { cab_tvs = tvs, cab_cvs = cvs } = coAxiomNthBranch ax index++coAxiomName :: CoAxiom br -> Name+coAxiomName = co_ax_name++coAxiomRole :: CoAxiom br -> Role+coAxiomRole = co_ax_role++coAxiomBranches :: CoAxiom br -> Branches br+coAxiomBranches = co_ax_branches++coAxiomSingleBranch_maybe :: CoAxiom br -> Maybe CoAxBranch+coAxiomSingleBranch_maybe (CoAxiom { co_ax_branches = MkBranches arr })+  | snd (bounds arr) == 0+  = Just $ arr ! 0+  | otherwise+  = Nothing++coAxiomSingleBranch :: CoAxiom Unbranched -> CoAxBranch+coAxiomSingleBranch (CoAxiom { co_ax_branches = MkBranches arr })+  = arr ! 0++coAxiomTyCon :: CoAxiom br -> TyCon+coAxiomTyCon = co_ax_tc++coAxBranchTyVars :: CoAxBranch -> [TyVar]+coAxBranchTyVars = cab_tvs++coAxBranchCoVars :: CoAxBranch -> [CoVar]+coAxBranchCoVars = cab_cvs++coAxBranchLHS :: CoAxBranch -> [Type]+coAxBranchLHS = cab_lhs++coAxBranchRHS :: CoAxBranch -> Type+coAxBranchRHS = cab_rhs++coAxBranchRoles :: CoAxBranch -> [Role]+coAxBranchRoles = cab_roles++coAxBranchSpan :: CoAxBranch -> SrcSpan+coAxBranchSpan = cab_loc++isImplicitCoAxiom :: CoAxiom br -> Bool+isImplicitCoAxiom = co_ax_implicit++coAxBranchIncomps :: CoAxBranch -> [CoAxBranch]+coAxBranchIncomps = cab_incomps++-- See Note [Compatibility checking] in FamInstEnv+placeHolderIncomps :: [CoAxBranch]+placeHolderIncomps = panic "placeHolderIncomps"++{- Note [CoAxiom saturation]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+* When co++Note [CoAxBranch type variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In the case of a CoAxBranch of an associated type-family instance,+we use the *same* type variables (where possible) as the+enclosing class or instance.  Consider++  instance C Int [z] where+     type F Int [z] = ...   -- Second param must be [z]++In the CoAxBranch in the instance decl (F Int [z]) we use the+same 'z', so that it's easy to check that that type is the same+as that in the instance header.++So, unlike FamInsts, there is no expectation that the cab_tvs+are fresh wrt each other, or any other CoAxBranch.++Note [CoAxBranch roles]+~~~~~~~~~~~~~~~~~~~~~~~+Consider this code:++  newtype Age = MkAge Int+  newtype Wrap a = MkWrap a++  convert :: Wrap Age -> Int+  convert (MkWrap (MkAge i)) = i++We want this to compile to:++  NTCo:Wrap :: forall a. Wrap a ~R a+  NTCo:Age  :: Age ~R Int+  convert = \x -> x |> (NTCo:Wrap[0] NTCo:Age[0])++But, note that NTCo:Age is at role R. Thus, we need to be able to pass+coercions at role R into axioms. However, we don't *always* want to be able to+do this, as it would be disastrous with type families. The solution is to+annotate the arguments to the axiom with roles, much like we annotate tycon+tyvars. Where do these roles get set? Newtype axioms inherit their roles from+the newtype tycon; family axioms are all at role N.++Note [CoAxiom locations]+~~~~~~~~~~~~~~~~~~~~~~~~+The source location of a CoAxiom is stored in two places in the+datatype tree.+  * The first is in the location info buried in the Name of the+    CoAxiom. This span includes all of the branches of a branched+    CoAxiom.+  * The second is in the cab_loc fields of the CoAxBranches.++In the case of a single branch, we can extract the source location of+the branch from the name of the CoAxiom. In other cases, we need an+explicit SrcSpan to correctly store the location of the equation+giving rise to the FamInstBranch.++Note [Implicit axioms]+~~~~~~~~~~~~~~~~~~~~~~+See also Note [Implicit TyThings] in HscTypes+* A CoAxiom arising from data/type family instances is not "implicit".+  That is, it has its own IfaceAxiom declaration in an interface file++* The CoAxiom arising from a newtype declaration *is* "implicit".+  That is, it does not have its own IfaceAxiom declaration in an+  interface file; instead the CoAxiom is generated by type-checking+  the newtype declaration++Note [Eta reduction for data families]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider this+   data family T a b :: *+   newtype instance T Int a = MkT (IO a) deriving( Monad )+We'd like this to work.++From the 'newtype instance' you might think we'd get:+   newtype TInt a = MkT (IO a)+   axiom ax1 a :: T Int a ~ TInt a   -- The newtype-instance part+   axiom ax2 a :: TInt a ~ IO a      -- The newtype part++But now what can we do?  We have this problem+   Given:   d  :: Monad IO+   Wanted:  d' :: Monad (T Int) = d |> ????+What coercion can we use for the ???++Solution: eta-reduce both axioms, thus:+   axiom ax1 :: T Int ~ TInt+   axiom ax2 :: TInt ~ IO+Now+   d' = d |> Monad (sym (ax2 ; ax1))++----- Bottom line ------++For a CoAxBranch for a data family instance with representation+TyCon rep_tc:++  - cab_tvs (of its CoAxiom) may be shorter+    than tyConTyVars of rep_tc.++  - cab_lhs may be shorter than tyConArity of the family tycon+       i.e. LHS is unsaturated++  - cab_rhs will be (rep_tc cab_tvs)+       i.e. RHS is un-saturated++  - This eta reduction happens for data instances as well+    as newtype instances. Here we want to eta-reduce the data family axiom.++  - This eta-reduction is done in TcInstDcls.tcDataFamInstDecl.++But for a /type/ family+  - cab_lhs has the exact arity of the family tycon++There are certain situations (e.g., pretty-printing) where it is necessary to+deal with eta-expanded data family instances. For these situations, the+cab_eta_tvs field records the stuff that has been eta-reduced away.+So if we have+    axiom forall a b. F [a->b] = D b a+and cab_eta_tvs is [p,q], then the original user-written definition+looked like+    axiom forall a b p q. F [a->b] p q = D b a p q+(See #9692, #14179, and #15845 for examples of what can go wrong if+we don't eta-expand when showing things to the user.)++(See also Note [Newtype eta] in TyCon.  This is notionally separate+and deals with the axiom connecting a newtype with its representation+type; but it too is eta-reduced.)+-}++instance Eq (CoAxiom br) where+    a == b = getUnique a == getUnique b+    a /= b = getUnique a /= getUnique b++instance Uniquable (CoAxiom br) where+    getUnique = co_ax_unique++instance Outputable (CoAxiom br) where+    ppr = ppr . getName++instance NamedThing (CoAxiom br) where+    getName = co_ax_name++instance Typeable br => Data.Data (CoAxiom br) where+    -- don't traverse?+    toConstr _   = abstractConstr "CoAxiom"+    gunfold _ _  = error "gunfold"+    dataTypeOf _ = mkNoRepType "CoAxiom"++instance Outputable CoAxBranch where+  ppr (CoAxBranch { cab_loc = loc+                  , cab_lhs = lhs+                  , cab_rhs = rhs }) =+    text "CoAxBranch" <+> parens (ppr loc) <> colon+      <+> brackets (fsep (punctuate comma (map pprType lhs)))+      <+> text "=>" <+> pprType rhs++{-+************************************************************************+*                                                                      *+                    Roles+*                                                                      *+************************************************************************++Roles are defined here to avoid circular dependencies.+-}++-- See Note [Roles] in Coercion+-- defined here to avoid cyclic dependency with Coercion+--+-- Order of constructors matters: the Ord instance coincides with the *super*typing+-- relation on roles.+data Role = Nominal | Representational | Phantom+  deriving (Eq, Ord, Data.Data)++-- These names are slurped into the parser code. Changing these strings+-- will change the **surface syntax** that GHC accepts! If you want to+-- change only the pretty-printing, do some replumbing. See+-- mkRoleAnnotDecl in RdrHsSyn+fsFromRole :: Role -> FastString+fsFromRole Nominal          = fsLit "nominal"+fsFromRole Representational = fsLit "representational"+fsFromRole Phantom          = fsLit "phantom"++instance Outputable Role where+  ppr = ftext . fsFromRole++instance Binary Role where+  put_ bh Nominal          = putByte bh 1+  put_ bh Representational = putByte bh 2+  put_ bh Phantom          = putByte bh 3++  get bh = do tag <- getByte bh+              case tag of 1 -> return Nominal+                          2 -> return Representational+                          3 -> return Phantom+                          _ -> panic ("get Role " ++ show tag)++{-+************************************************************************+*                                                                      *+                    CoAxiomRule+              Rules for building Evidence+*                                                                      *+************************************************************************++Conditional axioms.  The general idea is that a `CoAxiomRule` looks like this:++    forall as. (r1 ~ r2, s1 ~ s2) => t1 ~ t2++My intention is to reuse these for both (~) and (~#).+The short-term plan is to use this datatype to represent the type-nat axioms.+In the longer run, it may be good to unify this and `CoAxiom`,+as `CoAxiom` is the special case when there are no assumptions.+-}++-- | A more explicit representation for `t1 ~ t2`.+type TypeEqn = Pair Type++-- | For now, we work only with nominal equality.+data CoAxiomRule = CoAxiomRule+  { coaxrName      :: FastString+  , coaxrAsmpRoles :: [Role]    -- roles of parameter equations+  , coaxrRole      :: Role      -- role of resulting equation+  , coaxrProves    :: [TypeEqn] -> Maybe TypeEqn+        -- ^ coaxrProves returns @Nothing@ when it doesn't like+        -- the supplied arguments.  When this happens in a coercion+        -- that means that the coercion is ill-formed, and Core Lint+        -- checks for that.+  }++instance Data.Data CoAxiomRule where+  -- don't traverse?+  toConstr _   = abstractConstr "CoAxiomRule"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "CoAxiomRule"++instance Uniquable CoAxiomRule where+  getUnique = getUnique . coaxrName++instance Eq CoAxiomRule where+  x == y = coaxrName x == coaxrName y++instance Ord CoAxiomRule where+  compare x y = compare (coaxrName x) (coaxrName y)++instance Outputable CoAxiomRule where+  ppr = ppr . coaxrName+++-- Type checking of built-in families+data BuiltInSynFamily = BuiltInSynFamily+  { sfMatchFam      :: [Type] -> Maybe (CoAxiomRule, [Type], Type)+  , sfInteractTop   :: [Type] -> Type -> [TypeEqn]+  , sfInteractInert :: [Type] -> Type ->+                       [Type] -> Type -> [TypeEqn]+  }++-- Provides default implementations that do nothing.+trivialBuiltInFamily :: BuiltInSynFamily+trivialBuiltInFamily = BuiltInSynFamily+  { sfMatchFam      = \_ -> Nothing+  , sfInteractTop   = \_ _ -> []+  , sfInteractInert = \_ _ _ _ -> []+  }
+ compiler/types/Coercion.hs view
@@ -0,0 +1,2820 @@+{-+(c) The University of Glasgow 2006+-}++{-# LANGUAGE RankNTypes, CPP, MultiWayIf, FlexibleContexts, BangPatterns,+             ScopedTypeVariables #-}++-- | Module for (a) type kinds and (b) type coercions,+-- as used in System FC. See 'CoreSyn.Expr' for+-- more on System FC and how coercions fit into it.+--+module Coercion (+        -- * Main data type+        Coercion, CoercionN, CoercionR, CoercionP, MCoercion(..), MCoercionR,+        UnivCoProvenance, CoercionHole(..), coHoleCoVar, setCoHoleCoVar,+        LeftOrRight(..),+        Var, CoVar, TyCoVar,+        Role(..), ltRole,++        -- ** Functions over coercions+        coVarTypes, coVarKind, coVarKindsTypesRole, coVarRole,+        coercionType, coercionKind, coercionKinds,+        mkCoercionType,+        coercionRole, coercionKindRole,++        -- ** Constructing coercions+        mkGReflCo, mkReflCo, mkRepReflCo, mkNomReflCo,+        mkCoVarCo, mkCoVarCos,+        mkAxInstCo, mkUnbranchedAxInstCo,+        mkAxInstRHS, mkUnbranchedAxInstRHS,+        mkAxInstLHS, mkUnbranchedAxInstLHS,+        mkPiCo, mkPiCos, mkCoCast,+        mkSymCo, mkTransCo, mkTransMCo,+        mkNthCo, nthCoRole, mkLRCo,+        mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo,+        mkForAllCo, mkForAllCos, mkHomoForAllCos,+        mkPhantomCo,+        mkUnsafeCo, mkHoleCo, mkUnivCo, mkSubCo,+        mkAxiomInstCo, mkProofIrrelCo,+        downgradeRole, maybeSubCo, mkAxiomRuleCo,+        mkGReflRightCo, mkGReflLeftCo, mkCoherenceLeftCo, mkCoherenceRightCo,+        mkKindCo, castCoercionKind, castCoercionKindI,++        mkHeteroCoercionType,++        -- ** Decomposition+        instNewTyCon_maybe,++        NormaliseStepper, NormaliseStepResult(..), composeSteppers,+        mapStepResult, unwrapNewTypeStepper,+        topNormaliseNewType_maybe, topNormaliseTypeX,++        decomposeCo, decomposeFunCo, decomposePiCos, getCoVar_maybe,+        splitTyConAppCo_maybe,+        splitAppCo_maybe,+        splitFunCo_maybe,+        splitForAllCo_maybe,+        splitForAllCo_ty_maybe, splitForAllCo_co_maybe,++        nthRole, tyConRolesX, tyConRolesRepresentational, setNominalRole_maybe,++        pickLR,++        isGReflCo, isReflCo, isReflCo_maybe, isGReflCo_maybe, isReflexiveCo, isReflexiveCo_maybe,+        isReflCoVar_maybe,++        -- ** Coercion variables+        mkCoVar, isCoVar, coVarName, setCoVarName, setCoVarUnique,+        isCoVar_maybe,++        -- ** Free variables+        tyCoVarsOfCo, tyCoVarsOfCos, coVarsOfCo,+        tyCoFVsOfCo, tyCoFVsOfCos, tyCoVarsOfCoDSet,+        coercionSize,++        -- ** Substitution+        CvSubstEnv, emptyCvSubstEnv,+        lookupCoVar,+        substCo, substCos, substCoVar, substCoVars, substCoWith,+        substCoVarBndr,+        extendTvSubstAndInScope, getCvSubstEnv,++        -- ** Lifting+        liftCoSubst, liftCoSubstTyVar, liftCoSubstWith, liftCoSubstWithEx,+        emptyLiftingContext, extendLiftingContext, extendLiftingContextAndInScope,+        liftCoSubstVarBndrUsing, isMappedByLC,++        mkSubstLiftingContext, zapLiftingContext,+        substForAllCoBndrUsingLC, lcTCvSubst, lcInScopeSet,++        LiftCoEnv, LiftingContext(..), liftEnvSubstLeft, liftEnvSubstRight,+        substRightCo, substLeftCo, swapLiftCoEnv, lcSubstLeft, lcSubstRight,++        -- ** Comparison+        eqCoercion, eqCoercionX,++        -- ** Forcing evaluation of coercions+        seqCo,++        -- * Pretty-printing+        pprCo, pprParendCo,+        pprCoAxiom, pprCoAxBranch, pprCoAxBranchLHS,+        pprCoAxBranchUser, tidyCoAxBndrsForUser,+        etaExpandCoAxBranch,++        -- * Tidying+        tidyCo, tidyCos,++        -- * Other+        promoteCoercion, buildCoercion,++        simplifyArgsWorker+       ) where++#include "HsVersions.h"++import {-# SOURCE #-} ToIface (toIfaceTyCon, tidyToIfaceTcArgs)++import GhcPrelude++import IfaceType+import TyCoRep+import Type+import TyCon+import CoAxiom+import Var+import VarEnv+import VarSet+import Name hiding ( varName )+import Util+import BasicTypes+import Outputable+import Unique+import Pair+import SrcLoc+import PrelNames+import TysPrim          ( eqPhantPrimTyCon )+import ListSetOps+import Maybes+import UniqFM++import Control.Monad (foldM, zipWithM)+import Data.Function ( on )+import Data.Char( isDigit )++{-+%************************************************************************+%*                                                                      *+     -- The coercion arguments always *precisely* saturate+     -- arity of (that branch of) the CoAxiom.  If there are+     -- any left over, we use AppCo.  See+     -- See [Coercion axioms applied to coercions] in TyCoRep++\subsection{Coercion variables}+%*                                                                      *+%************************************************************************+-}++coVarName :: CoVar -> Name+coVarName = varName++setCoVarUnique :: CoVar -> Unique -> CoVar+setCoVarUnique = setVarUnique++setCoVarName :: CoVar -> Name -> CoVar+setCoVarName   = setVarName++{-+%************************************************************************+%*                                                                      *+                   Pretty-printing CoAxioms+%*                                                                      *+%************************************************************************++Defined here to avoid module loops. CoAxiom is loaded very early on.++-}++etaExpandCoAxBranch :: CoAxBranch -> ([TyVar], [Type], Type)+-- Return the (tvs,lhs,rhs) after eta-expanding,+-- to the way in which the axiom was originally written+-- See Note [Eta reduction for data families] in CoAxiom+etaExpandCoAxBranch (CoAxBranch { cab_tvs = tvs+                                , cab_eta_tvs = eta_tvs+                                , cab_lhs = lhs+                                , cab_rhs = rhs })+  -- ToDo: what about eta_cvs?+  = (tvs ++ eta_tvs, lhs ++ eta_tys, mkAppTys rhs eta_tys)+ where+    eta_tys = mkTyVarTys eta_tvs++pprCoAxiom :: CoAxiom br -> SDoc+-- Used in debug-printing only+pprCoAxiom ax@(CoAxiom { co_ax_tc = tc, co_ax_branches = branches })+  = hang (text "axiom" <+> ppr ax <+> dcolon)+       2 (vcat (map (pprCoAxBranchUser tc) (fromBranches branches)))++pprCoAxBranchUser :: TyCon -> CoAxBranch -> SDoc+-- Used when printing injectivity errors (FamInst.makeInjectivityErrors)+-- and inaccessible branches (TcValidity.inaccessibleCoAxBranch)+-- This happens in error messages: don't print the RHS of a data+--   family axiom, which is meaningless to a user+pprCoAxBranchUser tc br+  | isDataFamilyTyCon tc = pprCoAxBranchLHS tc br+  | otherwise            = pprCoAxBranch    tc br++pprCoAxBranchLHS :: TyCon -> CoAxBranch -> SDoc+-- Print the family-instance equation when reporting+--   a conflict between equations (FamInst.conflictInstErr)+-- For type families the RHS is important; for data families not so.+--   Indeed for data families the RHS is a mysterious internal+--   type constructor, so we suppress it (#14179)+-- See FamInstEnv Note [Family instance overlap conflicts]+pprCoAxBranchLHS = ppr_co_ax_branch pp_rhs+  where+    pp_rhs _ _ = empty++pprCoAxBranch :: TyCon -> CoAxBranch -> SDoc+pprCoAxBranch = ppr_co_ax_branch ppr_rhs+  where+    ppr_rhs env rhs = equals <+> pprPrecTypeX env topPrec rhs++ppr_co_ax_branch :: (TidyEnv -> Type -> SDoc)+                 -> TyCon -> CoAxBranch -> SDoc+ppr_co_ax_branch ppr_rhs fam_tc branch+  = foldr1 (flip hangNotEmpty 2)+    [ pprUserForAll (mkTyCoVarBinders Inferred bndrs')+         -- See Note [Printing foralls in type family instances] in IfaceType+    , pp_lhs <+> ppr_rhs tidy_env ee_rhs+    , text "-- Defined" <+> pp_loc ]+  where+    loc = coAxBranchSpan branch+    pp_loc | isGoodSrcSpan loc = text "at" <+> ppr (srcSpanStart loc)+           | otherwise         = text "in" <+> ppr loc++    -- Eta-expand LHS and RHS types, because sometimes data family+    -- instances are eta-reduced.+    -- See Note [Eta reduction for data families] in FamInstEnv.+    (ee_tvs, ee_lhs, ee_rhs) = etaExpandCoAxBranch branch++    pp_lhs = pprIfaceTypeApp topPrec (toIfaceTyCon fam_tc)+                             (tidyToIfaceTcArgs tidy_env fam_tc ee_lhs)++    (tidy_env, bndrs') = tidyCoAxBndrsForUser emptyTidyEnv ee_tvs++tidyCoAxBndrsForUser :: TidyEnv -> [Var] -> (TidyEnv, [Var])+-- Tidy wildcards "_1", "_2" to "_", and do not return them+-- in the list of binders to be printed+-- This is so that in error messages we see+--     forall a. F _ [a] _ = ...+-- rather than+--     forall a _1 _2. F _1 [a] _2 = ...+--+-- This is a rather disgusting function+tidyCoAxBndrsForUser init_env tcvs+  = (tidy_env, reverse tidy_bndrs)+  where+    (tidy_env, tidy_bndrs) = foldl tidy_one (init_env, []) tcvs++    tidy_one (env@(occ_env, subst), rev_bndrs') bndr+      | is_wildcard bndr = (env_wild, rev_bndrs')+      | otherwise        = (env',     bndr' : rev_bndrs')+      where+        (env', bndr') = tidyVarBndr env bndr+        env_wild = (occ_env, extendVarEnv subst bndr wild_bndr)+        wild_bndr = setVarName bndr $+                    tidyNameOcc (varName bndr) (mkTyVarOcc "_")+                    -- Tidy the binder to "_"++    is_wildcard :: Var -> Bool+    is_wildcard tv = case occNameString (getOccName tv) of+                       ('_' : rest) -> all isDigit rest+                       _            -> False++{-+%************************************************************************+%*                                                                      *+        Destructing coercions+%*                                                                      *+%************************************************************************++Note [Function coercions]+~~~~~~~~~~~~~~~~~~~~~~~~~+Remember that+  (->) :: forall r1 r2. TYPE r1 -> TYPE r2 -> TYPE LiftedRep++Hence+  FunCo r co1 co2 :: (s1->t1) ~r (s2->t2)+is short for+  TyConAppCo (->) co_rep1 co_rep2 co1 co2+where co_rep1, co_rep2 are the coercions on the representations.+-}+++-- | This breaks a 'Coercion' with type @T A B C ~ T D E F@ into+-- a list of 'Coercion's of kinds @A ~ D@, @B ~ E@ and @E ~ F@. Hence:+--+-- > decomposeCo 3 c [r1, r2, r3] = [nth r1 0 c, nth r2 1 c, nth r3 2 c]+decomposeCo :: Arity -> Coercion+            -> [Role]  -- the roles of the output coercions+                       -- this must have at least as many+                       -- entries as the Arity provided+            -> [Coercion]+decomposeCo arity co rs+  = [mkNthCo r n co | (n,r) <- [0..(arity-1)] `zip` rs ]+           -- Remember, Nth is zero-indexed++decomposeFunCo :: HasDebugCallStack+               => Role      -- Role of the input coercion+               -> Coercion  -- Input coercion+               -> (Coercion, Coercion)+-- Expects co :: (s1 -> t1) ~ (s2 -> t2)+-- Returns (co1 :: s1~s2, co2 :: t1~t2)+-- See Note [Function coercions] for the "2" and "3"+decomposeFunCo r co = ASSERT2( all_ok, ppr co )+                      (mkNthCo r 2 co, mkNthCo r 3 co)+  where+    Pair s1t1 s2t2 = coercionKind co+    all_ok = isFunTy s1t1 && isFunTy s2t2++{- Note [Pushing a coercion into a pi-type]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have this:+    (f |> co) t1 .. tn+Then we want to push the coercion into the arguments, so as to make+progress. For example of why you might want to do so, see Note+[Respecting definitional equality] in TyCoRep.++This is done by decomposePiCos.  Specifically, if+    decomposePiCos co [t1,..,tn] = ([co1,...,cok], cor)+then+    (f |> co) t1 .. tn   =   (f (t1 |> co1) ... (tk |> cok)) |> cor) t(k+1) ... tn++Notes:++* k can be smaller than n! That is decomposePiCos can return *fewer*+  coercions than there are arguments (ie k < n), if the kind provided+  doesn't have enough binders.++* If there is a type error, we might see+       (f |> co) t1+  where co :: (forall a. ty) ~ (ty1 -> ty2)+  Here 'co' is insoluble, but we don't want to crash in decoposePiCos.+  So decomposePiCos carefully tests both sides of the coercion to check+  they are both foralls or both arrows.  Not doing this caused #15343.+-}++decomposePiCos :: HasDebugCallStack+               => CoercionN -> Pair Type  -- Coercion and its kind+               -> [Type]+               -> ([CoercionN], CoercionN)+-- See Note [Pushing a coercion into a pi-type]+decomposePiCos orig_co (Pair orig_k1 orig_k2) orig_args+  = go [] (orig_subst,orig_k1) orig_co (orig_subst,orig_k2) orig_args+  where+    orig_subst = mkEmptyTCvSubst $ mkInScopeSet $+                 tyCoVarsOfTypes orig_args `unionVarSet` tyCoVarsOfCo orig_co++    go :: [CoercionN]      -- accumulator for argument coercions, reversed+       -> (TCvSubst,Kind)  -- Lhs kind of coercion+       -> CoercionN        -- coercion originally applied to the function+       -> (TCvSubst,Kind)  -- Rhs kind of coercion+       -> [Type]           -- Arguments to that function+       -> ([CoercionN], Coercion)+    -- Invariant:  co :: subst1(k2) ~ subst2(k2)++    go acc_arg_cos (subst1,k1) co (subst2,k2) (ty:tys)+      | Just (a, t1) <- splitForAllTy_maybe k1+      , Just (b, t2) <- splitForAllTy_maybe k2+        -- know     co :: (forall a:s1.t1) ~ (forall b:s2.t2)+        --    function :: forall a:s1.t1   (the function is not passed to decomposePiCos)+        --           a :: s1+        --           b :: s2+        --          ty :: s2+        -- need arg_co :: s2 ~ s1+        --      res_co :: t1[ty |> arg_co / a] ~ t2[ty / b]+      = let arg_co  = mkNthCo Nominal 0 (mkSymCo co)+            res_co  = mkInstCo co (mkGReflLeftCo Nominal ty arg_co)+            subst1' = extendTCvSubst subst1 a (ty `CastTy` arg_co)+            subst2' = extendTCvSubst subst2 b ty+        in+        go (arg_co : acc_arg_cos) (subst1', t1) res_co (subst2', t2) tys++      | Just (_s1, t1) <- splitFunTy_maybe k1+      , Just (_s2, t2) <- splitFunTy_maybe k2+        -- know     co :: (s1 -> t1) ~ (s2 -> t2)+        --    function :: s1 -> t1+        --          ty :: s2+        -- need arg_co :: s2 ~ s1+        --      res_co :: t1 ~ t2+      = let (sym_arg_co, res_co) = decomposeFunCo Nominal co+            arg_co               = mkSymCo sym_arg_co+        in+        go (arg_co : acc_arg_cos) (subst1,t1) res_co (subst2,t2) tys++      | not (isEmptyTCvSubst subst1) || not (isEmptyTCvSubst subst2)+      = go acc_arg_cos (zapTCvSubst subst1, substTy subst1 k1)+                       co+                       (zapTCvSubst subst2, substTy subst1 k2)+                       (ty:tys)++      -- tys might not be empty, if the left-hand type of the original coercion+      -- didn't have enough binders+    go acc_arg_cos _ki1 co _ki2 _tys = (reverse acc_arg_cos, co)++-- | Attempts to obtain the type variable underlying a 'Coercion'+getCoVar_maybe :: Coercion -> Maybe CoVar+getCoVar_maybe (CoVarCo cv) = Just cv+getCoVar_maybe _            = Nothing++-- | Attempts to tease a coercion apart into a type constructor and the application+-- of a number of coercion arguments to that constructor+splitTyConAppCo_maybe :: Coercion -> Maybe (TyCon, [Coercion])+splitTyConAppCo_maybe co+  | Just (ty, r) <- isReflCo_maybe co+  = do { (tc, tys) <- splitTyConApp_maybe ty+       ; let args = zipWith mkReflCo (tyConRolesX r tc) tys+       ; return (tc, args) }+splitTyConAppCo_maybe (TyConAppCo _ tc cos) = Just (tc, cos)+splitTyConAppCo_maybe (FunCo _ arg res)     = Just (funTyCon, cos)+  where cos = [mkRuntimeRepCo arg, mkRuntimeRepCo res, arg, res]+splitTyConAppCo_maybe _                     = Nothing++-- first result has role equal to input; third result is Nominal+splitAppCo_maybe :: Coercion -> Maybe (Coercion, Coercion)+-- ^ Attempt to take a coercion application apart.+splitAppCo_maybe (AppCo co arg) = Just (co, arg)+splitAppCo_maybe (TyConAppCo r tc args)+  | args `lengthExceeds` tyConArity tc+  , Just (args', arg') <- snocView args+  = Just ( mkTyConAppCo r tc args', arg' )++  | not (mustBeSaturated tc)+    -- Never create unsaturated type family apps!+  , Just (args', arg') <- snocView args+  , Just arg'' <- setNominalRole_maybe (nthRole r tc (length args')) arg'+  = Just ( mkTyConAppCo r tc args', arg'' )+       -- Use mkTyConAppCo to preserve the invariant+       --  that identity coercions are always represented by Refl++splitAppCo_maybe co+  | Just (ty, r) <- isReflCo_maybe co+  , Just (ty1, ty2) <- splitAppTy_maybe ty+  = Just (mkReflCo r ty1, mkNomReflCo ty2)+splitAppCo_maybe _ = Nothing++splitFunCo_maybe :: Coercion -> Maybe (Coercion, Coercion)+splitFunCo_maybe (FunCo _ arg res) = Just (arg, res)+splitFunCo_maybe _ = Nothing++splitForAllCo_maybe :: Coercion -> Maybe (TyCoVar, Coercion, Coercion)+splitForAllCo_maybe (ForAllCo tv k_co co) = Just (tv, k_co, co)+splitForAllCo_maybe _                     = Nothing++-- | Like 'splitForAllCo_maybe', but only returns Just for tyvar binder+splitForAllCo_ty_maybe :: Coercion -> Maybe (TyVar, Coercion, Coercion)+splitForAllCo_ty_maybe (ForAllCo tv k_co co)+  | isTyVar tv = Just (tv, k_co, co)+splitForAllCo_ty_maybe _ = Nothing++-- | Like 'splitForAllCo_maybe', but only returns Just for covar binder+splitForAllCo_co_maybe :: Coercion -> Maybe (CoVar, Coercion, Coercion)+splitForAllCo_co_maybe (ForAllCo cv k_co co)+  | isCoVar cv = Just (cv, k_co, co)+splitForAllCo_co_maybe _ = Nothing++-------------------------------------------------------+-- and some coercion kind stuff++coVarTypes :: HasDebugCallStack => CoVar -> Pair Type+coVarTypes cv+  | (_, _, ty1, ty2, _) <- coVarKindsTypesRole cv+  = Pair ty1 ty2++coVarKindsTypesRole :: HasDebugCallStack => CoVar -> (Kind,Kind,Type,Type,Role)+coVarKindsTypesRole cv+ | Just (tc, [k1,k2,ty1,ty2]) <- splitTyConApp_maybe (varType cv)+ = let role+         | tc `hasKey` eqPrimTyConKey     = Nominal+         | tc `hasKey` eqReprPrimTyConKey = Representational+         | otherwise                      = panic "coVarKindsTypesRole"+   in (k1,k2,ty1,ty2,role)+ | otherwise = pprPanic "coVarKindsTypesRole, non coercion variable"+                        (ppr cv $$ ppr (varType cv))++coVarKind :: CoVar -> Type+coVarKind cv+  = ASSERT( isCoVar cv )+    varType cv++coVarRole :: CoVar -> Role+coVarRole cv+  | tc `hasKey` eqPrimTyConKey+  = Nominal+  | tc `hasKey` eqReprPrimTyConKey+  = Representational+  | otherwise+  = pprPanic "coVarRole: unknown tycon" (ppr cv <+> dcolon <+> ppr (varType cv))++  where+    tc = case tyConAppTyCon_maybe (varType cv) of+           Just tc0 -> tc0+           Nothing  -> pprPanic "coVarRole: not tyconapp" (ppr cv)++-- | Makes a coercion type from two types: the types whose equality+-- is proven by the relevant 'Coercion'+mkCoercionType :: Role -> Type -> Type -> Type+mkCoercionType Nominal          = mkPrimEqPred+mkCoercionType Representational = mkReprPrimEqPred+mkCoercionType Phantom          = \ty1 ty2 ->+  let ki1 = typeKind ty1+      ki2 = typeKind ty2+  in+  TyConApp eqPhantPrimTyCon [ki1, ki2, ty1, ty2]++mkHeteroCoercionType :: Role -> Kind -> Kind -> Type -> Type -> Type+mkHeteroCoercionType Nominal          = mkHeteroPrimEqPred+mkHeteroCoercionType Representational = mkHeteroReprPrimEqPred+mkHeteroCoercionType Phantom          = panic "mkHeteroCoercionType"++-- | Given a coercion @co1 :: (a :: TYPE r1) ~ (b :: TYPE r2)@,+-- produce a coercion @rep_co :: r1 ~ r2@.+mkRuntimeRepCo :: HasDebugCallStack => Coercion -> Coercion+mkRuntimeRepCo co+  = mkNthCo Nominal 0 kind_co+  where+    kind_co = mkKindCo co  -- kind_co :: TYPE r1 ~ TYPE r2+                           -- (up to silliness with Constraint)++isReflCoVar_maybe :: Var -> Maybe Coercion+-- If cv :: t~t then isReflCoVar_maybe cv = Just (Refl t)+-- Works on all kinds of Vars, not just CoVars+isReflCoVar_maybe cv+  | isCoVar cv+  , Pair ty1 ty2 <- coVarTypes cv+  , ty1 `eqType` ty2+  = Just (mkReflCo (coVarRole cv) ty1)+  | otherwise+  = Nothing++-- | Tests if this coercion is obviously a generalized reflexive coercion.+-- Guaranteed to work very quickly.+isGReflCo :: Coercion -> Bool+isGReflCo (GRefl{}) = True+isGReflCo (Refl{})  = True -- Refl ty == GRefl N ty MRefl+isGReflCo _         = False++-- | Tests if this MCoercion is obviously generalized reflexive+-- Guaranteed to work very quickly.+isGReflMCo :: MCoercion -> Bool+isGReflMCo MRefl = True+isGReflMCo (MCo co) | isGReflCo co = True+isGReflMCo _ = False++-- | Tests if this coercion is obviously reflexive. Guaranteed to work+-- very quickly. Sometimes a coercion can be reflexive, but not obviously+-- so. c.f. 'isReflexiveCo'+isReflCo :: Coercion -> Bool+isReflCo (Refl{}) = True+isReflCo (GRefl _ _ mco) | isGReflMCo mco = True+isReflCo _ = False++-- | Returns the type coerced if this coercion is a generalized reflexive+-- coercion. Guaranteed to work very quickly.+isGReflCo_maybe :: Coercion -> Maybe (Type, Role)+isGReflCo_maybe (GRefl r ty _) = Just (ty, r)+isGReflCo_maybe (Refl ty)      = Just (ty, Nominal)+isGReflCo_maybe _ = Nothing++-- | Returns the type coerced if this coercion is reflexive. Guaranteed+-- to work very quickly. Sometimes a coercion can be reflexive, but not+-- obviously so. c.f. 'isReflexiveCo_maybe'+isReflCo_maybe :: Coercion -> Maybe (Type, Role)+isReflCo_maybe (Refl ty) = Just (ty, Nominal)+isReflCo_maybe (GRefl r ty mco) | isGReflMCo mco = Just (ty, r)+isReflCo_maybe _ = Nothing++-- | Slowly checks if the coercion is reflexive. Don't call this in a loop,+-- as it walks over the entire coercion.+isReflexiveCo :: Coercion -> Bool+isReflexiveCo = isJust . isReflexiveCo_maybe++-- | Extracts the coerced type from a reflexive coercion. This potentially+-- walks over the entire coercion, so avoid doing this in a loop.+isReflexiveCo_maybe :: Coercion -> Maybe (Type, Role)+isReflexiveCo_maybe (Refl ty) = Just (ty, Nominal)+isReflexiveCo_maybe (GRefl r ty mco) | isGReflMCo mco = Just (ty, r)+isReflexiveCo_maybe co+  | ty1 `eqType` ty2+  = Just (ty1, r)+  | otherwise+  = Nothing+  where (Pair ty1 ty2, r) = coercionKindRole co++{-+%************************************************************************+%*                                                                      *+            Building coercions+%*                                                                      *+%************************************************************************++These "smart constructors" maintain the invariants listed in the definition+of Coercion, and they perform very basic optimizations.++Note [Role twiddling functions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++There are a plethora of functions for twiddling roles:++mkSubCo: Requires a nominal input coercion and always produces a+representational output. This is used when you (the programmer) are sure you+know exactly that role you have and what you want.++downgradeRole_maybe: This function takes both the input role and the output role+as parameters. (The *output* role comes first!) It can only *downgrade* a+role -- that is, change it from N to R or P, or from R to P. This one-way+behavior is why there is the "_maybe". If an upgrade is requested, this+function produces Nothing. This is used when you need to change the role of a+coercion, but you're not sure (as you're writing the code) of which roles are+involved.++This function could have been written using coercionRole to ascertain the role+of the input. But, that function is recursive, and the caller of downgradeRole_maybe+often knows the input role. So, this is more efficient.++downgradeRole: This is just like downgradeRole_maybe, but it panics if the+conversion isn't a downgrade.++setNominalRole_maybe: This is the only function that can *upgrade* a coercion.+The result (if it exists) is always Nominal. The input can be at any role. It+works on a "best effort" basis, as it should never be strictly necessary to+upgrade a coercion during compilation. It is currently only used within GHC in+splitAppCo_maybe. In order to be a proper inverse of mkAppCo, the second+coercion that splitAppCo_maybe returns must be nominal. But, it's conceivable+that splitAppCo_maybe is operating over a TyConAppCo that uses a+representational coercion. Hence the need for setNominalRole_maybe.+splitAppCo_maybe, in turn, is used only within coercion optimization -- thus,+it is not absolutely critical that setNominalRole_maybe be complete.++Note that setNominalRole_maybe will never upgrade a phantom UnivCo. Phantom+UnivCos are perfectly type-safe, whereas representational and nominal ones are+not. Indeed, `unsafeCoerce` is implemented via a representational UnivCo.+(Nominal ones are no worse than representational ones, so this function *will*+change a UnivCo Representational to a UnivCo Nominal.)++Conal Elliott also came across a need for this function while working with the+GHC API, as he was decomposing Core casts. The Core casts use representational+coercions, as they must, but his use case required nominal coercions (he was+building a GADT). So, that's why this function is exported from this module.++One might ask: shouldn't downgradeRole_maybe just use setNominalRole_maybe as+appropriate? I (Richard E.) have decided not to do this, because upgrading a+role is bizarre and a caller should have to ask for this behavior explicitly.++-}++-- | Make a generalized reflexive coercion+mkGReflCo :: Role -> Type -> MCoercionN -> Coercion+mkGReflCo r ty mco+  | isGReflMCo mco = if r == Nominal then Refl ty+                     else GRefl r ty MRefl+  | otherwise    = GRefl r ty mco++-- | Make a reflexive coercion+mkReflCo :: Role -> Type -> Coercion+mkReflCo Nominal ty = Refl ty+mkReflCo r       ty = GRefl r ty MRefl++-- | Make a representational reflexive coercion+mkRepReflCo :: Type -> Coercion+mkRepReflCo ty = GRefl Representational ty MRefl++-- | Make a nominal reflexive coercion+mkNomReflCo :: Type -> Coercion+mkNomReflCo = Refl++-- | Apply a type constructor to a list of coercions. It is the+-- caller's responsibility to get the roles correct on argument coercions.+mkTyConAppCo :: HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion+mkTyConAppCo r tc cos+  | tc `hasKey` funTyConKey+  , [_rep1, _rep2, co1, co2] <- cos   -- See Note [Function coercions]+  = -- (a :: TYPE ra) -> (b :: TYPE rb)  ~  (c :: TYPE rc) -> (d :: TYPE rd)+    -- rep1 :: ra  ~  rc        rep2 :: rb  ~  rd+    -- co1  :: a   ~  c         co2  :: b   ~  d+    mkFunCo r co1 co2++               -- Expand type synonyms+  | Just (tv_co_prs, rhs_ty, leftover_cos) <- expandSynTyCon_maybe tc cos+  = mkAppCos (liftCoSubst r (mkLiftingContext tv_co_prs) rhs_ty) leftover_cos++  | Just tys_roles <- traverse isReflCo_maybe cos+  = mkReflCo r (mkTyConApp tc (map fst tys_roles))+  -- See Note [Refl invariant]++  | otherwise = TyConAppCo r tc cos++-- | Build a function 'Coercion' from two other 'Coercion's. That is,+-- given @co1 :: a ~ b@ and @co2 :: x ~ y@ produce @co :: (a -> x) ~ (b -> y)@.+mkFunCo :: Role -> Coercion -> Coercion -> Coercion+mkFunCo r co1 co2+    -- See Note [Refl invariant]+  | Just (ty1, _) <- isReflCo_maybe co1+  , Just (ty2, _) <- isReflCo_maybe co2+  = mkReflCo r (mkVisFunTy ty1 ty2)+  | otherwise = FunCo r co1 co2++-- | Apply a 'Coercion' to another 'Coercion'.+-- The second coercion must be Nominal, unless the first is Phantom.+-- If the first is Phantom, then the second can be either Phantom or Nominal.+mkAppCo :: Coercion     -- ^ :: t1 ~r t2+        -> Coercion     -- ^ :: s1 ~N s2, where s1 :: k1, s2 :: k2+        -> Coercion     -- ^ :: t1 s1 ~r t2 s2+mkAppCo co arg+  | Just (ty1, r) <- isReflCo_maybe co+  , Just (ty2, _) <- isReflCo_maybe arg+  = mkReflCo r (mkAppTy ty1 ty2)++  | Just (ty1, r) <- isReflCo_maybe co+  , Just (tc, tys) <- splitTyConApp_maybe ty1+    -- Expand type synonyms; a TyConAppCo can't have a type synonym (#9102)+  = mkTyConAppCo r tc (zip_roles (tyConRolesX r tc) tys)+  where+    zip_roles (r1:_)  []            = [downgradeRole r1 Nominal arg]+    zip_roles (r1:rs) (ty1:tys)     = mkReflCo r1 ty1 : zip_roles rs tys+    zip_roles _       _             = panic "zip_roles" -- but the roles are infinite...++mkAppCo (TyConAppCo r tc args) arg+  = case r of+      Nominal          -> mkTyConAppCo Nominal tc (args ++ [arg])+      Representational -> mkTyConAppCo Representational tc (args ++ [arg'])+        where new_role = (tyConRolesRepresentational tc) !! (length args)+              arg'     = downgradeRole new_role Nominal arg+      Phantom          -> mkTyConAppCo Phantom tc (args ++ [toPhantomCo arg])+mkAppCo co arg = AppCo co  arg+-- Note, mkAppCo is careful to maintain invariants regarding+-- where Refl constructors appear; see the comments in the definition+-- of Coercion and the Note [Refl invariant] in TyCoRep.++-- | Applies multiple 'Coercion's to another 'Coercion', from left to right.+-- See also 'mkAppCo'.+mkAppCos :: Coercion+         -> [Coercion]+         -> Coercion+mkAppCos co1 cos = foldl' mkAppCo co1 cos++{- Note [Unused coercion variable in ForAllCo]++See Note [Unused coercion variable in ForAllTy] in TyCoRep for the motivation for+checking coercion variable in types.+To lift the design choice to (ForAllCo cv kind_co body_co), we have two options:++(1) In mkForAllCo, we check whether cv is a coercion variable+    and whether it is not used in body_co. If so we construct a FunCo.+(2) We don't do this check in mkForAllCo.+    In coercionKind, we use mkTyCoForAllTy to perform the check and construct+    a FunTy when necessary.++We chose (2) for two reasons:++* for a coercion, all that matters is its kind, So ForAllCo or FunCo does not+  make a difference.+* even if cv occurs in body_co, it is possible that cv does not occur in the kind+  of body_co. Therefore the check in coercionKind is inevitable.++The last wrinkle is that there are restrictions around the use of the cv in the+coercion, as described in Section 5.8.5.2 of Richard's thesis. The idea is that+we cannot prove that the type system is consistent with unrestricted use of this+cv; the consistency proof uses an untyped rewrite relation that works over types+with all coercions and casts removed. So, we can allow the cv to appear only in+positions that are erased. As an approximation of this (and keeping close to the+published theory), we currently allow the cv only within the type in a Refl node+and under a GRefl node (including in the Coercion stored in a GRefl). It's+possible other places are OK, too, but this is a safe approximation.++Sadly, with heterogeneous equality, this restriction might be able to be violated;+Richard's thesis is unable to prove that it isn't. Specifically, the liftCoSubst+function might create an invalid coercion. Because a violation of the+restriction might lead to a program that "goes wrong", it is checked all the time,+even in a production compiler and without -dcore-list. We *have* proved that the+problem does not occur with homogeneous equality, so this check can be dropped+once ~# is made to be homogeneous.+-}+++-- | Make a Coercion from a tycovar, a kind coercion, and a body coercion.+-- The kind of the tycovar should be the left-hand kind of the kind coercion.+-- See Note [Unused coercion variable in ForAllCo]+mkForAllCo :: TyCoVar -> CoercionN -> Coercion -> Coercion+mkForAllCo v kind_co co+  | ASSERT( varType v `eqType` (pFst $ coercionKind kind_co)) True+  , ASSERT( isTyVar v || almostDevoidCoVarOfCo v co) True+  , Just (ty, r) <- isReflCo_maybe co+  , isGReflCo kind_co+  = mkReflCo r (mkTyCoInvForAllTy v ty)+  | otherwise+  = ForAllCo v kind_co co++-- | Like 'mkForAllCo', but the inner coercion shouldn't be an obvious+-- reflexive coercion. For example, it is guaranteed in 'mkForAllCos'.+-- The kind of the tycovar should be the left-hand kind of the kind coercion.+mkForAllCo_NoRefl :: TyCoVar -> CoercionN -> Coercion -> Coercion+mkForAllCo_NoRefl v kind_co co+  | ASSERT( varType v `eqType` (pFst $ coercionKind kind_co)) True+  , ASSERT( isTyVar v || almostDevoidCoVarOfCo v co) True+  , ASSERT( not (isReflCo co)) True+  , isCoVar v+  , not (v `elemVarSet` tyCoVarsOfCo co)+  = FunCo (coercionRole co) kind_co co+  | otherwise+  = ForAllCo v kind_co co++-- | Make nested ForAllCos+mkForAllCos :: [(TyCoVar, CoercionN)] -> Coercion -> Coercion+mkForAllCos bndrs co+  | Just (ty, r ) <- isReflCo_maybe co+  = let (refls_rev'd, non_refls_rev'd) = span (isReflCo . snd) (reverse bndrs) in+    foldl' (flip $ uncurry mkForAllCo_NoRefl)+           (mkReflCo r (mkTyCoInvForAllTys (reverse (map fst refls_rev'd)) ty))+           non_refls_rev'd+  | otherwise+  = foldr (uncurry mkForAllCo_NoRefl) co bndrs++-- | Make a Coercion quantified over a type/coercion variable;+-- the variable has the same type in both sides of the coercion+mkHomoForAllCos :: [TyCoVar] -> Coercion -> Coercion+mkHomoForAllCos vs co+  | Just (ty, r) <- isReflCo_maybe co+  = mkReflCo r (mkTyCoInvForAllTys vs ty)+  | otherwise+  = mkHomoForAllCos_NoRefl vs co++-- | Like 'mkHomoForAllCos', but the inner coercion shouldn't be an obvious+-- reflexive coercion. For example, it is guaranteed in 'mkHomoForAllCos'.+mkHomoForAllCos_NoRefl :: [TyCoVar] -> Coercion -> Coercion+mkHomoForAllCos_NoRefl vs orig_co+  = ASSERT( not (isReflCo orig_co))+    foldr go orig_co vs+  where+    go v co = mkForAllCo_NoRefl v (mkNomReflCo (varType v)) co++mkCoVarCo :: CoVar -> Coercion+-- cv :: s ~# t+-- See Note [mkCoVarCo]+mkCoVarCo cv = CoVarCo cv++mkCoVarCos :: [CoVar] -> [Coercion]+mkCoVarCos = map mkCoVarCo++{- Note [mkCoVarCo]+~~~~~~~~~~~~~~~~~~~+In the past, mkCoVarCo optimised (c :: t~t) to (Refl t).  That is+valid (although see Note [Unbound RULE binders] in Rules), but+it's a relatively expensive test and perhaps better done in+optCoercion.  Not a big deal either way.+-}++-- | Extract a covar, if possible. This check is dirty. Be ashamed+-- of yourself. (It's dirty because it cares about the structure of+-- a coercion, which is morally reprehensible.)+isCoVar_maybe :: Coercion -> Maybe CoVar+isCoVar_maybe (CoVarCo cv) = Just cv+isCoVar_maybe _            = Nothing++mkAxInstCo :: Role -> CoAxiom br -> BranchIndex -> [Type] -> [Coercion]+           -> Coercion+-- mkAxInstCo can legitimately be called over-staturated;+-- i.e. with more type arguments than the coercion requires+mkAxInstCo role ax index tys cos+  | arity == n_tys = downgradeRole role ax_role $+                     mkAxiomInstCo ax_br index (rtys `chkAppend` cos)+  | otherwise      = ASSERT( arity < n_tys )+                     downgradeRole role ax_role $+                     mkAppCos (mkAxiomInstCo ax_br index+                                             (ax_args `chkAppend` cos))+                              leftover_args+  where+    n_tys         = length tys+    ax_br         = toBranchedAxiom ax+    branch        = coAxiomNthBranch ax_br index+    tvs           = coAxBranchTyVars branch+    arity         = length tvs+    arg_roles     = coAxBranchRoles branch+    rtys          = zipWith mkReflCo (arg_roles ++ repeat Nominal) tys+    (ax_args, leftover_args)+                  = splitAt arity rtys+    ax_role       = coAxiomRole ax++-- worker function+mkAxiomInstCo :: CoAxiom Branched -> BranchIndex -> [Coercion] -> Coercion+mkAxiomInstCo ax index args+  = ASSERT( args `lengthIs` coAxiomArity ax index )+    AxiomInstCo ax index args++-- to be used only with unbranched axioms+mkUnbranchedAxInstCo :: Role -> CoAxiom Unbranched+                     -> [Type] -> [Coercion] -> Coercion+mkUnbranchedAxInstCo role ax tys cos+  = mkAxInstCo role ax 0 tys cos++mkAxInstRHS :: CoAxiom br -> BranchIndex -> [Type] -> [Coercion] -> Type+-- Instantiate the axiom with specified types,+-- returning the instantiated RHS+-- A companion to mkAxInstCo:+--    mkAxInstRhs ax index tys = snd (coercionKind (mkAxInstCo ax index tys))+mkAxInstRHS ax index tys cos+  = ASSERT( tvs `equalLength` tys1 )+    mkAppTys rhs' tys2+  where+    branch       = coAxiomNthBranch ax index+    tvs          = coAxBranchTyVars branch+    cvs          = coAxBranchCoVars branch+    (tys1, tys2) = splitAtList tvs tys+    rhs'         = substTyWith tvs tys1 $+                   substTyWithCoVars cvs cos $+                   coAxBranchRHS branch++mkUnbranchedAxInstRHS :: CoAxiom Unbranched -> [Type] -> [Coercion] -> Type+mkUnbranchedAxInstRHS ax = mkAxInstRHS ax 0++-- | Return the left-hand type of the axiom, when the axiom is instantiated+-- at the types given.+mkAxInstLHS :: CoAxiom br -> BranchIndex -> [Type] -> [Coercion] -> Type+mkAxInstLHS ax index tys cos+  = ASSERT( tvs `equalLength` tys1 )+    mkTyConApp fam_tc (lhs_tys `chkAppend` tys2)+  where+    branch       = coAxiomNthBranch ax index+    tvs          = coAxBranchTyVars branch+    cvs          = coAxBranchCoVars branch+    (tys1, tys2) = splitAtList tvs tys+    lhs_tys      = substTysWith tvs tys1 $+                   substTysWithCoVars cvs cos $+                   coAxBranchLHS branch+    fam_tc       = coAxiomTyCon ax++-- | Instantiate the left-hand side of an unbranched axiom+mkUnbranchedAxInstLHS :: CoAxiom Unbranched -> [Type] -> [Coercion] -> Type+mkUnbranchedAxInstLHS ax = mkAxInstLHS ax 0++-- | Manufacture an unsafe coercion from thin air.+--   Currently (May 14) this is used only to implement the+--   @unsafeCoerce#@ primitive.  Optimise by pushing+--   down through type constructors.+mkUnsafeCo :: Role -> Type -> Type -> Coercion+mkUnsafeCo role ty1 ty2+  = mkUnivCo UnsafeCoerceProv role ty1 ty2++-- | Make a coercion from a coercion hole+mkHoleCo :: CoercionHole -> Coercion+mkHoleCo h = HoleCo h++-- | Make a universal coercion between two arbitrary types.+mkUnivCo :: UnivCoProvenance+         -> Role       -- ^ role of the built coercion, "r"+         -> Type       -- ^ t1 :: k1+         -> Type       -- ^ t2 :: k2+         -> Coercion   -- ^ :: t1 ~r t2+mkUnivCo prov role ty1 ty2+  | ty1 `eqType` ty2 = mkReflCo role ty1+  | otherwise        = UnivCo prov role ty1 ty2++-- | Create a symmetric version of the given 'Coercion' that asserts+--   equality between the same types but in the other "direction", so+--   a kind of @t1 ~ t2@ becomes the kind @t2 ~ t1@.+mkSymCo :: Coercion -> Coercion++-- Do a few simple optimizations, but don't bother pushing occurrences+-- of symmetry to the leaves; the optimizer will take care of that.+mkSymCo co | isReflCo co          = co+mkSymCo    (SymCo co)             = co+mkSymCo    (SubCo (SymCo co))     = SubCo co+mkSymCo co                        = SymCo co++-- | Create a new 'Coercion' by composing the two given 'Coercion's transitively.+--   (co1 ; co2)+mkTransCo :: Coercion -> Coercion -> Coercion+mkTransCo co1 co2 | isReflCo co1 = co2+                  | isReflCo co2 = co1+mkTransCo (GRefl r t1 (MCo co1)) (GRefl _ _ (MCo co2))+  = GRefl r t1 (MCo $ mkTransCo co1 co2)+mkTransCo co1 co2                 = TransCo co1 co2++-- | Compose two MCoercions via transitivity+mkTransMCo :: MCoercion -> MCoercion -> MCoercion+mkTransMCo MRefl     co2       = co2+mkTransMCo co1       MRefl     = co1+mkTransMCo (MCo co1) (MCo co2) = MCo (mkTransCo co1 co2)++mkNthCo :: HasDebugCallStack+        => Role  -- The role of the coercion you're creating+        -> Int   -- Zero-indexed+        -> Coercion+        -> Coercion+mkNthCo r n co+  = ASSERT2( good_call, bad_call_msg )+    go r n co+  where+    Pair ty1 ty2 = coercionKind co++    go r 0 co+      | Just (ty, _) <- isReflCo_maybe co+      , Just (tv, _) <- splitForAllTy_maybe ty+      = -- works for both tyvar and covar+        ASSERT( r == Nominal )+        mkNomReflCo (varType tv)++    go r n co+      | Just (ty, r0) <- isReflCo_maybe co+      , let tc = tyConAppTyCon ty+      = ASSERT2( ok_tc_app ty n, ppr n $$ ppr ty )+        ASSERT( nthRole r0 tc n == r )+        mkReflCo r (tyConAppArgN n ty)+      where ok_tc_app :: Type -> Int -> Bool+            ok_tc_app ty n+              | Just (_, tys) <- splitTyConApp_maybe ty+              = tys `lengthExceeds` n+              | isForAllTy ty  -- nth:0 pulls out a kind coercion from a hetero forall+              = n == 0+              | otherwise+              = False++    go r 0 (ForAllCo _ kind_co _)+      = ASSERT( r == Nominal )+        kind_co+      -- If co :: (forall a1:k1. t1) ~ (forall a2:k2. t2)+      -- then (nth 0 co :: k1 ~N k2)+      -- If co :: (forall a1:t1 ~ t2. t1) ~ (forall a2:t3 ~ t4. t2)+      -- then (nth 0 co :: (t1 ~ t2) ~N (t3 ~ t4))++    go r n co@(FunCo r0 arg res)+      -- See Note [Function coercions]+      -- If FunCo _ arg_co res_co ::   (s1:TYPE sk1 -> s2:TYPE sk2)+      --                             ~ (t1:TYPE tk1 -> t2:TYPE tk2)+      -- Then we want to behave as if co was+      --    TyConAppCo argk_co resk_co arg_co res_co+      -- where+      --    argk_co :: sk1 ~ tk1  =  mkNthCo 0 (mkKindCo arg_co)+      --    resk_co :: sk2 ~ tk2  =  mkNthCo 0 (mkKindCo res_co)+      --                             i.e. mkRuntimeRepCo+      = case n of+          0 -> ASSERT( r == Nominal ) mkRuntimeRepCo arg+          1 -> ASSERT( r == Nominal ) mkRuntimeRepCo res+          2 -> ASSERT( r == r0 )      arg+          3 -> ASSERT( r == r0 )      res+          _ -> pprPanic "mkNthCo(FunCo)" (ppr n $$ ppr co)++    go r n (TyConAppCo r0 tc arg_cos) = ASSERT2( r == nthRole r0 tc n+                                                    , (vcat [ ppr tc+                                                            , ppr arg_cos+                                                            , ppr r0+                                                            , ppr n+                                                            , ppr r ]) )+                                             arg_cos `getNth` n++    go r n co =+      NthCo r n co++    -- Assertion checking+    bad_call_msg = vcat [ text "Coercion =" <+> ppr co+                        , text "LHS ty =" <+> ppr ty1+                        , text "RHS ty =" <+> ppr ty2+                        , text "n =" <+> ppr n, text "r =" <+> ppr r+                        , text "coercion role =" <+> ppr (coercionRole co) ]+    good_call+      -- If the Coercion passed in is between forall-types, then the Int must+      -- be 0 and the role must be Nominal.+      | Just (_tv1, _) <- splitForAllTy_maybe ty1+      , Just (_tv2, _) <- splitForAllTy_maybe ty2+      = n == 0 && r == Nominal++      -- If the Coercion passed in is between T tys and T tys', then the Int+      -- must be less than the length of tys/tys' (which must be the same+      -- lengths).+      --+      -- If the role of the Coercion is nominal, then the role passed in must+      -- be nominal. If the role of the Coercion is representational, then the+      -- role passed in must be tyConRolesRepresentational T !! n. If the role+      -- of the Coercion is Phantom, then the role passed in must be Phantom.+      --+      -- See also Note [NthCo Cached Roles] if you're wondering why it's+      -- blaringly obvious that we should be *computing* this role instead of+      -- passing it in.+      | Just (tc1, tys1) <- splitTyConApp_maybe ty1+      , Just (tc2, tys2) <- splitTyConApp_maybe ty2+      , tc1 == tc2+      = let len1 = length tys1+            len2 = length tys2+            good_role = case coercionRole co of+                          Nominal -> r == Nominal+                          Representational -> r == (tyConRolesRepresentational tc1 !! n)+                          Phantom -> r == Phantom+        in len1 == len2 && n < len1 && good_role++      | otherwise+      = True++++-- | If you're about to call @mkNthCo r n co@, then @r@ should be+-- whatever @nthCoRole n co@ returns.+nthCoRole :: Int -> Coercion -> Role+nthCoRole n co+  | Just (tc, _) <- splitTyConApp_maybe lty+  = nthRole r tc n++  | Just _ <- splitForAllTy_maybe lty+  = Nominal++  | otherwise+  = pprPanic "nthCoRole" (ppr co)++  where+    (Pair lty _, r) = coercionKindRole co++mkLRCo :: LeftOrRight -> Coercion -> Coercion+mkLRCo lr co+  | Just (ty, eq) <- isReflCo_maybe co+  = mkReflCo eq (pickLR lr (splitAppTy ty))+  | otherwise+  = LRCo lr co++-- | Instantiates a 'Coercion'.+mkInstCo :: Coercion -> Coercion -> Coercion+mkInstCo (ForAllCo tcv _kind_co body_co) co+  | Just (arg, _) <- isReflCo_maybe co+      -- works for both tyvar and covar+  = substCoUnchecked (zipTCvSubst [tcv] [arg]) body_co+mkInstCo co arg = InstCo co arg++-- | Given @ty :: k1@, @co :: k1 ~ k2@,+-- produces @co' :: ty ~r (ty |> co)@+mkGReflRightCo :: Role -> Type -> CoercionN -> Coercion+mkGReflRightCo r ty co+  | isGReflCo co = mkReflCo r ty+    -- the kinds of @k1@ and @k2@ are the same, thus @isGReflCo@+    -- instead of @isReflCo@+  | otherwise = GRefl r ty (MCo co)++-- | Given @ty :: k1@, @co :: k1 ~ k2@,+-- produces @co' :: (ty |> co) ~r ty@+mkGReflLeftCo :: Role -> Type -> CoercionN -> Coercion+mkGReflLeftCo r ty co+  | isGReflCo co = mkReflCo r ty+    -- the kinds of @k1@ and @k2@ are the same, thus @isGReflCo@+    -- instead of @isReflCo@+  | otherwise    = mkSymCo $ GRefl r ty (MCo co)++-- | Given @ty :: k1@, @co :: k1 ~ k2@, @co2:: ty ~r ty'@,+-- produces @co' :: (ty |> co) ~r ty'+-- It is not only a utility function, but it saves allocation when co+-- is a GRefl coercion.+mkCoherenceLeftCo :: Role -> Type -> CoercionN -> Coercion -> Coercion+mkCoherenceLeftCo r ty co co2+  | isGReflCo co = co2+  | otherwise = (mkSymCo $ GRefl r ty (MCo co)) `mkTransCo` co2++-- | Given @ty :: k1@, @co :: k1 ~ k2@, @co2:: ty' ~r ty@,+-- produces @co' :: ty' ~r (ty |> co)+-- It is not only a utility function, but it saves allocation when co+-- is a GRefl coercion.+mkCoherenceRightCo :: Role -> Type -> CoercionN -> Coercion -> Coercion+mkCoherenceRightCo r ty co co2+  | isGReflCo co = co2+  | otherwise = co2 `mkTransCo` GRefl r ty (MCo co)++-- | Given @co :: (a :: k) ~ (b :: k')@ produce @co' :: k ~ k'@.+mkKindCo :: Coercion -> Coercion+mkKindCo co | Just (ty, _) <- isReflCo_maybe co = Refl (typeKind ty)+mkKindCo (GRefl _ _ (MCo co)) = co+mkKindCo (UnivCo (PhantomProv h) _ _ _)    = h+mkKindCo (UnivCo (ProofIrrelProv h) _ _ _) = h+mkKindCo co+  | Pair ty1 ty2 <- coercionKind co+       -- generally, calling coercionKind during coercion creation is a bad idea,+       -- as it can lead to exponential behavior. But, we don't have nested mkKindCos,+       -- so it's OK here.+  , let tk1 = typeKind ty1+        tk2 = typeKind ty2+  , tk1 `eqType` tk2+  = Refl tk1+  | otherwise+  = KindCo co++mkSubCo :: Coercion -> Coercion+-- Input coercion is Nominal, result is Representational+-- see also Note [Role twiddling functions]+mkSubCo (Refl ty) = GRefl Representational ty MRefl+mkSubCo (GRefl Nominal ty co) = GRefl Representational ty co+mkSubCo (TyConAppCo Nominal tc cos)+  = TyConAppCo Representational tc (applyRoles tc cos)+mkSubCo (FunCo Nominal arg res)+  = FunCo Representational+          (downgradeRole Representational Nominal arg)+          (downgradeRole Representational Nominal res)+mkSubCo co = ASSERT2( coercionRole co == Nominal, ppr co <+> ppr (coercionRole co) )+             SubCo co++-- | Changes a role, but only a downgrade. See Note [Role twiddling functions]+downgradeRole_maybe :: Role   -- ^ desired role+                    -> Role   -- ^ current role+                    -> Coercion -> Maybe Coercion+-- In (downgradeRole_maybe dr cr co) it's a precondition that+--                                   cr = coercionRole co++downgradeRole_maybe Nominal          Nominal          co = Just co+downgradeRole_maybe Nominal          _                _  = Nothing++downgradeRole_maybe Representational Nominal          co = Just (mkSubCo co)+downgradeRole_maybe Representational Representational co = Just co+downgradeRole_maybe Representational Phantom          _  = Nothing++downgradeRole_maybe Phantom          Phantom          co = Just co+downgradeRole_maybe Phantom          _                co = Just (toPhantomCo co)++-- | Like 'downgradeRole_maybe', but panics if the change isn't a downgrade.+-- See Note [Role twiddling functions]+downgradeRole :: Role  -- desired role+              -> Role  -- current role+              -> Coercion -> Coercion+downgradeRole r1 r2 co+  = case downgradeRole_maybe r1 r2 co of+      Just co' -> co'+      Nothing  -> pprPanic "downgradeRole" (ppr co)++-- | If the EqRel is ReprEq, makes a SubCo; otherwise, does nothing.+-- Note that the input coercion should always be nominal.+maybeSubCo :: EqRel -> Coercion -> Coercion+maybeSubCo NomEq  = id+maybeSubCo ReprEq = mkSubCo+++mkAxiomRuleCo :: CoAxiomRule -> [Coercion] -> Coercion+mkAxiomRuleCo = AxiomRuleCo++-- | Make a "coercion between coercions".+mkProofIrrelCo :: Role       -- ^ role of the created coercion, "r"+               -> Coercion   -- ^ :: phi1 ~N phi2+               -> Coercion   -- ^ g1 :: phi1+               -> Coercion   -- ^ g2 :: phi2+               -> Coercion   -- ^ :: g1 ~r g2++-- if the two coercion prove the same fact, I just don't care what+-- the individual coercions are.+mkProofIrrelCo r co g  _ | isGReflCo co  = mkReflCo r (mkCoercionTy g)+  -- kco is a kind coercion, thus @isGReflCo@ rather than @isReflCo@+mkProofIrrelCo r kco        g1 g2 = mkUnivCo (ProofIrrelProv kco) r+                                             (mkCoercionTy g1) (mkCoercionTy g2)++{-+%************************************************************************+%*                                                                      *+   Roles+%*                                                                      *+%************************************************************************+-}++-- | Converts a coercion to be nominal, if possible.+-- See Note [Role twiddling functions]+setNominalRole_maybe :: Role -- of input coercion+                     -> Coercion -> Maybe Coercion+setNominalRole_maybe r co+  | r == Nominal = Just co+  | otherwise = setNominalRole_maybe_helper co+  where+    setNominalRole_maybe_helper (SubCo co)  = Just co+    setNominalRole_maybe_helper co@(Refl _) = Just co+    setNominalRole_maybe_helper (GRefl _ ty co) = Just $ GRefl Nominal ty co+    setNominalRole_maybe_helper (TyConAppCo Representational tc cos)+      = do { cos' <- zipWithM setNominalRole_maybe (tyConRolesX Representational tc) cos+           ; return $ TyConAppCo Nominal tc cos' }+    setNominalRole_maybe_helper (FunCo Representational co1 co2)+      = do { co1' <- setNominalRole_maybe Representational co1+           ; co2' <- setNominalRole_maybe Representational co2+           ; return $ FunCo Nominal co1' co2'+           }+    setNominalRole_maybe_helper (SymCo co)+      = SymCo <$> setNominalRole_maybe_helper co+    setNominalRole_maybe_helper (TransCo co1 co2)+      = TransCo <$> setNominalRole_maybe_helper co1 <*> setNominalRole_maybe_helper co2+    setNominalRole_maybe_helper (AppCo co1 co2)+      = AppCo <$> setNominalRole_maybe_helper co1 <*> pure co2+    setNominalRole_maybe_helper (ForAllCo tv kind_co co)+      = ForAllCo tv kind_co <$> setNominalRole_maybe_helper co+    setNominalRole_maybe_helper (NthCo _r n co)+      -- NB, this case recurses via setNominalRole_maybe, not+      -- setNominalRole_maybe_helper!+      = NthCo Nominal n <$> setNominalRole_maybe (coercionRole co) co+    setNominalRole_maybe_helper (InstCo co arg)+      = InstCo <$> setNominalRole_maybe_helper co <*> pure arg+    setNominalRole_maybe_helper (UnivCo prov _ co1 co2)+      | case prov of UnsafeCoerceProv -> True   -- it's always unsafe+                     PhantomProv _    -> False  -- should always be phantom+                     ProofIrrelProv _ -> True   -- it's always safe+                     PluginProv _     -> False  -- who knows? This choice is conservative.+      = Just $ UnivCo prov Nominal co1 co2+    setNominalRole_maybe_helper _ = Nothing++-- | Make a phantom coercion between two types. The coercion passed+-- in must be a nominal coercion between the kinds of the+-- types.+mkPhantomCo :: Coercion -> Type -> Type -> Coercion+mkPhantomCo h t1 t2+  = mkUnivCo (PhantomProv h) Phantom t1 t2++-- takes any coercion and turns it into a Phantom coercion+toPhantomCo :: Coercion -> Coercion+toPhantomCo co+  = mkPhantomCo (mkKindCo co) ty1 ty2+  where Pair ty1 ty2 = coercionKind co++-- Convert args to a TyConAppCo Nominal to the same TyConAppCo Representational+applyRoles :: TyCon -> [Coercion] -> [Coercion]+applyRoles tc cos+  = zipWith (\r -> downgradeRole r Nominal) (tyConRolesRepresentational tc) cos++-- the Role parameter is the Role of the TyConAppCo+-- defined here because this is intimately concerned with the implementation+-- of TyConAppCo+-- Always returns an infinite list (with a infinite tail of Nominal)+tyConRolesX :: Role -> TyCon -> [Role]+tyConRolesX Representational tc = tyConRolesRepresentational tc+tyConRolesX role             _  = repeat role++-- Returns the roles of the parameters of a tycon, with an infinite tail+-- of Nominal+tyConRolesRepresentational :: TyCon -> [Role]+tyConRolesRepresentational tc = tyConRoles tc ++ repeat Nominal++nthRole :: Role -> TyCon -> Int -> Role+nthRole Nominal _ _ = Nominal+nthRole Phantom _ _ = Phantom+nthRole Representational tc n+  = (tyConRolesRepresentational tc) `getNth` n++ltRole :: Role -> Role -> Bool+-- Is one role "less" than another?+--     Nominal < Representational < Phantom+ltRole Phantom          _       = False+ltRole Representational Phantom = True+ltRole Representational _       = False+ltRole Nominal          Nominal = False+ltRole Nominal          _       = True++-------------------------------++-- | like mkKindCo, but aggressively & recursively optimizes to avoid using+-- a KindCo constructor. The output role is nominal.+promoteCoercion :: Coercion -> CoercionN++-- First cases handles anything that should yield refl.+promoteCoercion co = case co of++    _ | ki1 `eqType` ki2+      -> mkNomReflCo (typeKind ty1)+     -- no later branch should return refl+     --    The ASSERT( False )s throughout+     -- are these cases explicitly, but they should never fire.++    Refl _ -> ASSERT( False )+              mkNomReflCo ki1++    GRefl _ _ MRefl -> ASSERT( False )+                       mkNomReflCo ki1++    GRefl _ _ (MCo co) -> co++    TyConAppCo _ tc args+      | Just co' <- instCoercions (mkNomReflCo (tyConKind tc)) args+      -> co'+      | otherwise+      -> mkKindCo co++    AppCo co1 arg+      | Just co' <- instCoercion (coercionKind (mkKindCo co1))+                                 (promoteCoercion co1) arg+      -> co'+      | otherwise+      -> mkKindCo co++    ForAllCo tv _ g+      | isTyVar tv+      -> promoteCoercion g++    ForAllCo _ _ _+      -> ASSERT( False )+         mkNomReflCo liftedTypeKind+      -- See Note [Weird typing rule for ForAllTy] in Type++    FunCo _ _ _+      -> ASSERT( False )+         mkNomReflCo liftedTypeKind++    CoVarCo {}     -> mkKindCo co+    HoleCo {}      -> mkKindCo co+    AxiomInstCo {} -> mkKindCo co+    AxiomRuleCo {} -> mkKindCo co++    UnivCo UnsafeCoerceProv _ t1 t2   -> mkUnsafeCo Nominal (typeKind t1) (typeKind t2)+    UnivCo (PhantomProv kco) _ _ _    -> kco+    UnivCo (ProofIrrelProv kco) _ _ _ -> kco+    UnivCo (PluginProv _) _ _ _       -> mkKindCo co++    SymCo g+      -> mkSymCo (promoteCoercion g)++    TransCo co1 co2+      -> mkTransCo (promoteCoercion co1) (promoteCoercion co2)++    NthCo _ n co1+      | Just (_, args) <- splitTyConAppCo_maybe co1+      , args `lengthExceeds` n+      -> promoteCoercion (args !! n)++      | Just _ <- splitForAllCo_maybe co+      , n == 0+      -> ASSERT( False ) mkNomReflCo liftedTypeKind++      | otherwise+      -> mkKindCo co++    LRCo lr co1+      | Just (lco, rco) <- splitAppCo_maybe co1+      -> case lr of+           CLeft  -> promoteCoercion lco+           CRight -> promoteCoercion rco++      | otherwise+      -> mkKindCo co++    InstCo g _+      | isForAllTy_ty ty1+      -> ASSERT( isForAllTy_ty ty2 )+         promoteCoercion g+      | otherwise+      -> ASSERT( False)+         mkNomReflCo liftedTypeKind+           -- See Note [Weird typing rule for ForAllTy] in Type++    KindCo _+      -> ASSERT( False )+         mkNomReflCo liftedTypeKind++    SubCo g+      -> promoteCoercion g++  where+    Pair ty1 ty2 = coercionKind co+    ki1 = typeKind ty1+    ki2 = typeKind ty2++-- | say @g = promoteCoercion h@. Then, @instCoercion g w@ yields @Just g'@,+-- where @g' = promoteCoercion (h w)@.+-- fails if this is not possible, if @g@ coerces between a forall and an ->+-- or if second parameter has a representational role and can't be used+-- with an InstCo.+instCoercion :: Pair Type -- g :: lty ~ rty+             -> CoercionN  -- ^  must be nominal+             -> Coercion+             -> Maybe CoercionN+instCoercion (Pair lty rty) g w+  | (isForAllTy_ty lty && isForAllTy_ty rty)+  || (isForAllTy_co lty && isForAllTy_co rty)+  , Just w' <- setNominalRole_maybe (coercionRole w) w+    -- g :: (forall t1. t2) ~ (forall t1. t3)+    -- w :: s1 ~ s2+    -- returns mkInstCo g w' :: t2 [t1 |-> s1 ] ~ t3 [t1 |-> s2]+  = Just $ mkInstCo g w'+  | isFunTy lty && isFunTy rty+    -- g :: (t1 -> t2) ~ (t3 -> t4)+    -- returns t2 ~ t4+  = Just $ mkNthCo Nominal 3 g -- extract result type, which is the 4th argument to (->)+  | otherwise -- one forall, one funty...+  = Nothing++-- | Repeated use of 'instCoercion'+instCoercions :: CoercionN -> [Coercion] -> Maybe CoercionN+instCoercions g ws+  = let arg_ty_pairs = map coercionKind ws in+    snd <$> foldM go (coercionKind g, g) (zip arg_ty_pairs ws)+  where+    go :: (Pair Type, Coercion) -> (Pair Type, Coercion)+       -> Maybe (Pair Type, Coercion)+    go (g_tys, g) (w_tys, w)+      = do { g' <- instCoercion g_tys g w+           ; return (piResultTy <$> g_tys <*> w_tys, g') }++-- | Creates a new coercion with both of its types casted by different casts+-- @castCoercionKind g r t1 t2 h1 h2@, where @g :: t1 ~r t2@,+-- has type @(t1 |> h1) ~r (t2 |> h2)@.+-- @h1@ and @h2@ must be nominal.+castCoercionKind :: Coercion -> Role -> Type -> Type+                 -> CoercionN -> CoercionN -> Coercion+castCoercionKind g r t1 t2 h1 h2+  = mkCoherenceRightCo r t2 h2 (mkCoherenceLeftCo r t1 h1 g)++-- | Creates a new coercion with both of its types casted by different casts+-- @castCoercionKind g h1 h2@, where @g :: t1 ~r t2@,+-- has type @(t1 |> h1) ~r (t2 |> h2)@.+-- @h1@ and @h2@ must be nominal.+-- It calls @coercionKindRole@, so it's quite inefficient (which 'I' stands for)+-- Use @castCoercionKind@ instead if @t1@, @t2@, and @r@ are known beforehand.+castCoercionKindI :: Coercion -> CoercionN -> CoercionN -> Coercion+castCoercionKindI g h1 h2+  = mkCoherenceRightCo r t2 h2 (mkCoherenceLeftCo r t1 h1 g)+  where (Pair t1 t2, r) = coercionKindRole g++-- See note [Newtype coercions] in TyCon++mkPiCos :: Role -> [Var] -> Coercion -> Coercion+mkPiCos r vs co = foldr (mkPiCo r) co vs++-- | Make a forall 'Coercion', where both types related by the coercion+-- are quantified over the same variable.+mkPiCo  :: Role -> Var -> Coercion -> Coercion+mkPiCo r v co | isTyVar v = mkHomoForAllCos [v] co+              | isCoVar v = ASSERT( not (v `elemVarSet` tyCoVarsOfCo co) )+                  -- We didn't call mkForAllCo here because if v does not appear+                  -- in co, the argement coercion will be nominal. But here we+                  -- want it to be r. It is only called in 'mkPiCos', which is+                  -- only used in SimplUtils, where we are sure for+                  -- now (Aug 2018) v won't occur in co.+                            mkFunCo r (mkReflCo r (varType v)) co+              | otherwise = mkFunCo r (mkReflCo r (varType v)) co++-- mkCoCast (c :: s1 ~?r t1) (g :: (s1 ~?r t1) ~#R (s2 ~?r t2)) :: s2 ~?r t2+-- The first coercion might be lifted or unlifted; thus the ~? above+-- Lifted and unlifted equalities take different numbers of arguments,+-- so we have to make sure to supply the right parameter to decomposeCo.+-- Also, note that the role of the first coercion is the same as the role of+-- the equalities related by the second coercion. The second coercion is+-- itself always representational.+mkCoCast :: Coercion -> CoercionR -> Coercion+mkCoCast c g+  | (g2:g1:_) <- reverse co_list+  = mkSymCo g1 `mkTransCo` c `mkTransCo` g2++  | otherwise+  = pprPanic "mkCoCast" (ppr g $$ ppr (coercionKind g))+  where+    -- g  :: (s1 ~# t1) ~# (s2 ~# t2)+    -- g1 :: s1 ~# s2+    -- g2 :: t1 ~# t2+    (tc, _) = splitTyConApp (pFst $ coercionKind g)+    co_list = decomposeCo (tyConArity tc) g (tyConRolesRepresentational tc)++{-+%************************************************************************+%*                                                                      *+            Newtypes+%*                                                                      *+%************************************************************************+-}++-- | If @co :: T ts ~ rep_ty@ then:+--+-- > instNewTyCon_maybe T ts = Just (rep_ty, co)+--+-- Checks for a newtype, and for being saturated+instNewTyCon_maybe :: TyCon -> [Type] -> Maybe (Type, Coercion)+instNewTyCon_maybe tc tys+  | Just (tvs, ty, co_tc) <- unwrapNewTyConEtad_maybe tc  -- Check for newtype+  , tvs `leLength` tys                                    -- Check saturated enough+  = Just (applyTysX tvs ty tys, mkUnbranchedAxInstCo Representational co_tc tys [])+  | otherwise+  = Nothing++{-+************************************************************************+*                                                                      *+         Type normalisation+*                                                                      *+************************************************************************+-}++-- | A function to check if we can reduce a type by one step. Used+-- with 'topNormaliseTypeX'.+type NormaliseStepper ev = RecTcChecker+                         -> TyCon     -- tc+                         -> [Type]    -- tys+                         -> NormaliseStepResult ev++-- | The result of stepping in a normalisation function.+-- See 'topNormaliseTypeX'.+data NormaliseStepResult ev+  = NS_Done   -- ^ Nothing more to do+  | NS_Abort  -- ^ Utter failure. The outer function should fail too.+  | NS_Step RecTcChecker Type ev    -- ^ We stepped, yielding new bits;+                                    -- ^ ev is evidence;+                                    -- Usually a co :: old type ~ new type++mapStepResult :: (ev1 -> ev2)+              -> NormaliseStepResult ev1 -> NormaliseStepResult ev2+mapStepResult f (NS_Step rec_nts ty ev) = NS_Step rec_nts ty (f ev)+mapStepResult _ NS_Done                 = NS_Done+mapStepResult _ NS_Abort                = NS_Abort++-- | Try one stepper and then try the next, if the first doesn't make+-- progress.+-- So if it returns NS_Done, it means that both steppers are satisfied+composeSteppers :: NormaliseStepper ev -> NormaliseStepper ev+                -> NormaliseStepper ev+composeSteppers step1 step2 rec_nts tc tys+  = case step1 rec_nts tc tys of+      success@(NS_Step {}) -> success+      NS_Done              -> step2 rec_nts tc tys+      NS_Abort             -> NS_Abort++-- | A 'NormaliseStepper' that unwraps newtypes, careful not to fall into+-- a loop. If it would fall into a loop, it produces 'NS_Abort'.+unwrapNewTypeStepper :: NormaliseStepper Coercion+unwrapNewTypeStepper rec_nts tc tys+  | Just (ty', co) <- instNewTyCon_maybe tc tys+  = case checkRecTc rec_nts tc of+      Just rec_nts' -> NS_Step rec_nts' ty' co+      Nothing       -> NS_Abort++  | otherwise+  = NS_Done++-- | A general function for normalising the top-level of a type. It continues+-- to use the provided 'NormaliseStepper' until that function fails, and then+-- this function returns. The roles of the coercions produced by the+-- 'NormaliseStepper' must all be the same, which is the role returned from+-- the call to 'topNormaliseTypeX'.+--+-- Typically ev is Coercion.+--+-- If topNormaliseTypeX step plus ty = Just (ev, ty')+-- then ty ~ev1~ t1 ~ev2~ t2 ... ~evn~ ty'+-- and ev = ev1 `plus` ev2 `plus` ... `plus` evn+-- If it returns Nothing then no newtype unwrapping could happen+topNormaliseTypeX :: NormaliseStepper ev -> (ev -> ev -> ev)+                  -> Type -> Maybe (ev, Type)+topNormaliseTypeX stepper plus ty+ | Just (tc, tys) <- splitTyConApp_maybe ty+ , NS_Step rec_nts ty' ev <- stepper initRecTc tc tys+ = go rec_nts ev ty'+ | otherwise+ = Nothing+ where+    go rec_nts ev ty+      | Just (tc, tys) <- splitTyConApp_maybe ty+      = case stepper rec_nts tc tys of+          NS_Step rec_nts' ty' ev' -> go rec_nts' (ev `plus` ev') ty'+          NS_Done  -> Just (ev, ty)+          NS_Abort -> Nothing++      | otherwise+      = Just (ev, ty)++topNormaliseNewType_maybe :: Type -> Maybe (Coercion, Type)+-- ^ Sometimes we want to look through a @newtype@ and get its associated coercion.+-- This function strips off @newtype@ layers enough to reveal something that isn't+-- a @newtype@.  Specifically, here's the invariant:+--+-- > topNormaliseNewType_maybe rec_nts ty = Just (co, ty')+--+-- then (a)  @co : ty0 ~ ty'@.+--      (b)  ty' is not a newtype.+--+-- The function returns @Nothing@ for non-@newtypes@,+-- or unsaturated applications+--+-- This function does *not* look through type families, because it has no access to+-- the type family environment. If you do have that at hand, consider to use+-- topNormaliseType_maybe, which should be a drop-in replacement for+-- topNormaliseNewType_maybe+-- If topNormliseNewType_maybe ty = Just (co, ty'), then co : ty ~R ty'+topNormaliseNewType_maybe ty+  = topNormaliseTypeX unwrapNewTypeStepper mkTransCo ty++{-+%************************************************************************+%*                                                                      *+                   Comparison of coercions+%*                                                                      *+%************************************************************************+-}++-- | Syntactic equality of coercions+eqCoercion :: Coercion -> Coercion -> Bool+eqCoercion = eqType `on` coercionType++-- | Compare two 'Coercion's, with respect to an RnEnv2+eqCoercionX :: RnEnv2 -> Coercion -> Coercion -> Bool+eqCoercionX env = eqTypeX env `on` coercionType++{-+%************************************************************************+%*                                                                      *+                   "Lifting" substitution+           [(TyCoVar,Coercion)] -> Type -> Coercion+%*                                                                      *+%************************************************************************++Note [Lifting coercions over types: liftCoSubst]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The KPUSH rule deals with this situation+   data T a = K (a -> Maybe a)+   g :: T t1 ~ T t2+   x :: t1 -> Maybe t1++   case (K @t1 x) |> g of+     K (y:t2 -> Maybe t2) -> rhs++We want to push the coercion inside the constructor application.+So we do this++   g' :: t1~t2  =  Nth 0 g++   case K @t2 (x |> g' -> Maybe g') of+     K (y:t2 -> Maybe t2) -> rhs++The crucial operation is that we+  * take the type of K's argument: a -> Maybe a+  * and substitute g' for a+thus giving *coercion*.  This is what liftCoSubst does.++In the presence of kind coercions, this is a bit+of a hairy operation. So, we refer you to the paper introducing kind coercions,+available at www.cis.upenn.edu/~sweirich/papers/fckinds-extended.pdf++Note [extendLiftingContextEx]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider we have datatype+  K :: \/k. \/a::k. P -> T k  -- P be some type+  g :: T k1 ~ T k2++  case (K @k1 @t1 x) |> g of+    K y -> rhs++We want to push the coercion inside the constructor application.+We first get the coercion mapped by the universal type variable k:+   lc = k |-> Nth 0 g :: k1~k2++Here, the important point is that the kind of a is coerced, and P might be+dependent on the existential type variable a.+Thus we first get the coercion of a's kind+   g2 = liftCoSubst lc k :: k1 ~ k2++Then we store a new mapping into the lifting context+   lc2 = a |-> (t1 ~ t1 |> g2), lc++So later when we can correctly deal with the argument type P+   liftCoSubst lc2 P :: P [k|->k1][a|->t1] ~ P[k|->k2][a |-> (t1|>g2)]++This is exactly what extendLiftingContextEx does.+* For each (tyvar:k, ty) pair, we product the mapping+    tyvar |-> (ty ~ ty |> (liftCoSubst lc k))+* For each (covar:s1~s2, ty) pair, we produce the mapping+    covar |-> (co ~ co')+    co' = Sym (liftCoSubst lc s1) ;; covar ;; liftCoSubst lc s2 :: s1'~s2'++This follows the lifting context extension definition in the+"FC with Explicit Kind Equality" paper.+-}++-- ----------------------------------------------------+-- See Note [Lifting coercions over types: liftCoSubst]+-- ----------------------------------------------------++data LiftingContext = LC TCvSubst LiftCoEnv+  -- in optCoercion, we need to lift when optimizing InstCo.+  -- See Note [Optimising InstCo] in OptCoercion+  -- We thus propagate the substitution from OptCoercion here.++instance Outputable LiftingContext where+  ppr (LC _ env) = hang (text "LiftingContext:") 2 (ppr env)++type LiftCoEnv = VarEnv Coercion+     -- Maps *type variables* to *coercions*.+     -- That's the whole point of this function!+     -- Also maps coercion variables to ProofIrrelCos.++-- like liftCoSubstWith, but allows for existentially-bound types as well+liftCoSubstWithEx :: Role          -- desired role for output coercion+                  -> [TyVar]       -- universally quantified tyvars+                  -> [Coercion]    -- coercions to substitute for those+                  -> [TyCoVar]     -- existentially quantified tycovars+                  -> [Type]        -- types and coercions to be bound to ex vars+                  -> (Type -> Coercion, [Type]) -- (lifting function, converted ex args)+liftCoSubstWithEx role univs omegas exs rhos+  = let theta = mkLiftingContext (zipEqual "liftCoSubstWithExU" univs omegas)+        psi   = extendLiftingContextEx theta (zipEqual "liftCoSubstWithExX" exs rhos)+    in (ty_co_subst psi role, substTys (lcSubstRight psi) (mkTyCoVarTys exs))++liftCoSubstWith :: Role -> [TyCoVar] -> [Coercion] -> Type -> Coercion+liftCoSubstWith r tvs cos ty+  = liftCoSubst r (mkLiftingContext $ zipEqual "liftCoSubstWith" tvs cos) ty++-- | @liftCoSubst role lc ty@ produces a coercion (at role @role@)+-- that coerces between @lc_left(ty)@ and @lc_right(ty)@, where+-- @lc_left@ is a substitution mapping type variables to the left-hand+-- types of the mapped coercions in @lc@, and similar for @lc_right@.+liftCoSubst :: HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion+liftCoSubst r lc@(LC subst env) ty+  | isEmptyVarEnv env = mkReflCo r (substTy subst ty)+  | otherwise         = ty_co_subst lc r ty++emptyLiftingContext :: InScopeSet -> LiftingContext+emptyLiftingContext in_scope = LC (mkEmptyTCvSubst in_scope) emptyVarEnv++mkLiftingContext :: [(TyCoVar,Coercion)] -> LiftingContext+mkLiftingContext pairs+  = LC (mkEmptyTCvSubst $ mkInScopeSet $ tyCoVarsOfCos (map snd pairs))+       (mkVarEnv pairs)++mkSubstLiftingContext :: TCvSubst -> LiftingContext+mkSubstLiftingContext subst = LC subst emptyVarEnv++-- | Extend a lifting context with a new mapping.+extendLiftingContext :: LiftingContext  -- ^ original LC+                     -> TyCoVar         -- ^ new variable to map...+                     -> Coercion        -- ^ ...to this lifted version+                     -> LiftingContext+    -- mappings to reflexive coercions are just substitutions+extendLiftingContext (LC subst env) tv arg+  | Just (ty, _) <- isReflCo_maybe arg+  = LC (extendTCvSubst subst tv ty) env+  | otherwise+  = LC subst (extendVarEnv env tv arg)++-- | Extend a lifting context with a new mapping, and extend the in-scope set+extendLiftingContextAndInScope :: LiftingContext  -- ^ Original LC+                               -> TyCoVar         -- ^ new variable to map...+                               -> Coercion        -- ^ to this coercion+                               -> LiftingContext+extendLiftingContextAndInScope (LC subst env) tv co+  = extendLiftingContext (LC (extendTCvInScopeSet subst (tyCoVarsOfCo co)) env) tv co++-- | Extend a lifting context with existential-variable bindings.+-- See Note [extendLiftingContextEx]+extendLiftingContextEx :: LiftingContext    -- ^ original lifting context+                       -> [(TyCoVar,Type)]  -- ^ ex. var / value pairs+                       -> LiftingContext+-- Note that this is more involved than extendLiftingContext. That function+-- takes a coercion to extend with, so it's assumed that the caller has taken+-- into account any of the kind-changing stuff worried about here.+extendLiftingContextEx lc [] = lc+extendLiftingContextEx lc@(LC subst env) ((v,ty):rest)+-- This function adds bindings for *Nominal* coercions. Why? Because it+-- works with existentially bound variables, which are considered to have+-- nominal roles.+  | isTyVar v+  = let lc' = LC (subst `extendTCvInScopeSet` tyCoVarsOfType ty)+                 (extendVarEnv env v $+                  mkGReflRightCo Nominal+                                 ty+                                 (ty_co_subst lc Nominal (tyVarKind v)))+    in extendLiftingContextEx lc' rest+  | CoercionTy co <- ty+  = -- co      :: s1 ~r s2+    -- lift_s1 :: s1 ~r s1'+    -- lift_s2 :: s2 ~r s2'+    -- kco     :: (s1 ~r s2) ~N (s1' ~r s2')+    ASSERT( isCoVar v )+    let (_, _, s1, s2, r) = coVarKindsTypesRole v+        lift_s1 = ty_co_subst lc r s1+        lift_s2 = ty_co_subst lc r s2+        kco     = mkTyConAppCo Nominal (equalityTyCon r)+                               [ mkKindCo lift_s1, mkKindCo lift_s2+                               , lift_s1         , lift_s2          ]+        lc'     = LC (subst `extendTCvInScopeSet` tyCoVarsOfCo co)+                     (extendVarEnv env v+                        (mkProofIrrelCo Nominal kco co $+                          (mkSymCo lift_s1) `mkTransCo` co `mkTransCo` lift_s2))+    in extendLiftingContextEx lc' rest+  | otherwise+  = pprPanic "extendLiftingContextEx" (ppr v <+> text "|->" <+> ppr ty)+++-- | Erase the environments in a lifting context+zapLiftingContext :: LiftingContext -> LiftingContext+zapLiftingContext (LC subst _) = LC (zapTCvSubst subst) emptyVarEnv++-- | Like 'substForAllCoBndr', but works on a lifting context+substForAllCoBndrUsingLC :: Bool+                            -> (Coercion -> Coercion)+                            -> LiftingContext -> TyCoVar -> Coercion+                            -> (LiftingContext, TyCoVar, Coercion)+substForAllCoBndrUsingLC sym sco (LC subst lc_env) tv co+  = (LC subst' lc_env, tv', co')+  where+    (subst', tv', co') = substForAllCoBndrUsing sym sco subst tv co++-- | The \"lifting\" operation which substitutes coercions for type+--   variables in a type to produce a coercion.+--+--   For the inverse operation, see 'liftCoMatch'+ty_co_subst :: LiftingContext -> Role -> Type -> Coercion+ty_co_subst lc role ty+  = go role ty+  where+    go :: Role -> Type -> Coercion+    go r ty                | Just ty' <- coreView ty+                           = go r ty'+    go Phantom ty          = lift_phantom ty+    go r (TyVarTy tv)      = expectJust "ty_co_subst bad roles" $+                             liftCoSubstTyVar lc r tv+    go r (AppTy ty1 ty2)   = mkAppCo (go r ty1) (go Nominal ty2)+    go r (TyConApp tc tys) = mkTyConAppCo r tc (zipWith go (tyConRolesX r tc) tys)+    go r (FunTy _ ty1 ty2) = mkFunCo r (go r ty1) (go r ty2)+    go r t@(ForAllTy (Bndr v _) ty)+       = let (lc', v', h) = liftCoSubstVarBndr lc v+             body_co = ty_co_subst lc' r ty in+         if isTyVar v' || almostDevoidCoVarOfCo v' body_co+           -- Lifting a ForAllTy over a coercion variable could fail as ForAllCo+           -- imposes an extra restriction on where a covar can appear. See last+           -- wrinkle in Note [Unused coercion variable in ForAllCo].+           -- We specifically check for this and panic because we know that+           -- there's a hole in the type system here, and we'd rather panic than+           -- fall into it.+         then mkForAllCo v' h body_co+         else pprPanic "ty_co_subst: covar is not almost devoid" (ppr t)+    go r ty@(LitTy {})     = ASSERT( r == Nominal )+                             mkNomReflCo ty+    go r (CastTy ty co)    = castCoercionKindI (go r ty) (substLeftCo lc co)+                                                         (substRightCo lc co)+    go r (CoercionTy co)   = mkProofIrrelCo r kco (substLeftCo lc co)+                                                  (substRightCo lc co)+      where kco = go Nominal (coercionType co)++    lift_phantom ty = mkPhantomCo (go Nominal (typeKind ty))+                                  (substTy (lcSubstLeft  lc) ty)+                                  (substTy (lcSubstRight lc) ty)++{-+Note [liftCoSubstTyVar]+~~~~~~~~~~~~~~~~~~~~~~~~~+This function can fail if a coercion in the environment is of too low a role.++liftCoSubstTyVar is called from two places: in liftCoSubst (naturally), and+also in matchAxiom in OptCoercion. From liftCoSubst, the so-called lifting+lemma guarantees that the roles work out. If we fail in this+case, we really should panic -- something is deeply wrong. But, in matchAxiom,+failing is fine. matchAxiom is trying to find a set of coercions+that match, but it may fail, and this is healthy behavior.+-}++-- See Note [liftCoSubstTyVar]+liftCoSubstTyVar :: LiftingContext -> Role -> TyVar -> Maybe Coercion+liftCoSubstTyVar (LC subst env) r v+  | Just co_arg <- lookupVarEnv env v+  = downgradeRole_maybe r (coercionRole co_arg) co_arg++  | otherwise+  = Just $ mkReflCo r (substTyVar subst v)++{- Note [liftCoSubstVarBndr]++callback:+  We want 'liftCoSubstVarBndrUsing' to be general enough to be reused in+  FamInstEnv, therefore the input arg 'fun' returns a pair with polymophic type+  in snd.+  However in 'liftCoSubstVarBndr', we don't need the snd, so we use unit and+  ignore the fourth component of the return value.++liftCoSubstTyVarBndrUsing:+  Given+    forall tv:k. t+  We want to get+    forall (tv:k1) (kind_co :: k1 ~ k2) body_co++  We lift the kind k to get the kind_co+    kind_co = ty_co_subst k :: k1 ~ k2++  Now in the LiftingContext, we add the new mapping+    tv |-> (tv :: k1) ~ ((tv |> kind_co) :: k2)++liftCoSubstCoVarBndrUsing:+  Given+    forall cv:(s1 ~ s2). t+  We want to get+    forall (cv:s1'~s2') (kind_co :: (s1'~s2') ~ (t1 ~ t2)) body_co++  We lift s1 and s2 respectively to get+    eta1 :: s1' ~ t1+    eta2 :: s2' ~ t2+  And+    kind_co = TyConAppCo Nominal (~#) eta1 eta2++  Now in the liftingContext, we add the new mapping+    cv |-> (cv :: s1' ~ s2') ~ ((sym eta1;cv;eta2) :: t1 ~ t2)+-}++-- See Note [liftCoSubstVarBndr]+liftCoSubstVarBndr :: LiftingContext -> TyCoVar+                   -> (LiftingContext, TyCoVar, Coercion)+liftCoSubstVarBndr lc tv+  = let (lc', tv', h, _) = liftCoSubstVarBndrUsing callback lc tv in+    (lc', tv', h)+  where+    callback lc' ty' = (ty_co_subst lc' Nominal ty', ())++-- the callback must produce a nominal coercion+liftCoSubstVarBndrUsing :: (LiftingContext -> Type -> (CoercionN, a))+                           -> LiftingContext -> TyCoVar+                           -> (LiftingContext, TyCoVar, CoercionN, a)+liftCoSubstVarBndrUsing fun lc old_var+  | isTyVar old_var+  = liftCoSubstTyVarBndrUsing fun lc old_var+  | otherwise+  = liftCoSubstCoVarBndrUsing fun lc old_var++-- Works for tyvar binder+liftCoSubstTyVarBndrUsing :: (LiftingContext -> Type -> (CoercionN, a))+                           -> LiftingContext -> TyVar+                           -> (LiftingContext, TyVar, CoercionN, a)+liftCoSubstTyVarBndrUsing fun lc@(LC subst cenv) old_var+  = ASSERT( isTyVar old_var )+    ( LC (subst `extendTCvInScope` new_var) new_cenv+    , new_var, eta, stuff )+  where+    old_kind     = tyVarKind old_var+    (eta, stuff) = fun lc old_kind+    Pair k1 _    = coercionKind eta+    new_var      = uniqAway (getTCvInScope subst) (setVarType old_var k1)++    lifted   = mkGReflRightCo Nominal (TyVarTy new_var) eta+               -- :: new_var ~ new_var |> eta+    new_cenv = extendVarEnv cenv old_var lifted++-- Works for covar binder+liftCoSubstCoVarBndrUsing :: (LiftingContext -> Type -> (CoercionN, a))+                           -> LiftingContext -> CoVar+                           -> (LiftingContext, CoVar, CoercionN, a)+liftCoSubstCoVarBndrUsing fun lc@(LC subst cenv) old_var+  = ASSERT( isCoVar old_var )+    ( LC (subst `extendTCvInScope` new_var) new_cenv+    , new_var, kind_co, stuff )+  where+    old_kind     = coVarKind old_var+    (eta, stuff) = fun lc old_kind+    Pair k1 _    = coercionKind eta+    new_var      = uniqAway (getTCvInScope subst) (setVarType old_var k1)++    -- old_var :: s1  ~r s2+    -- eta     :: (s1' ~r s2') ~N (t1 ~r t2)+    -- eta1    :: s1' ~r t1+    -- eta2    :: s2' ~r t2+    -- co1     :: s1' ~r s2'+    -- co2     :: t1  ~r t2+    -- kind_co :: (s1' ~r s2') ~N (t1 ~r t2)+    -- lifted  :: co1 ~N co2++    role   = coVarRole old_var+    eta'   = downgradeRole role Nominal eta+    eta1   = mkNthCo role 2 eta'+    eta2   = mkNthCo role 3 eta'++    co1     = mkCoVarCo new_var+    co2     = mkSymCo eta1 `mkTransCo` co1 `mkTransCo` eta2+    kind_co = mkTyConAppCo Nominal (equalityTyCon role)+                           [ mkKindCo co1, mkKindCo co2+                           , co1         , co2          ]+    lifted  = mkProofIrrelCo Nominal kind_co co1 co2++    new_cenv = extendVarEnv cenv old_var lifted++-- | Is a var in the domain of a lifting context?+isMappedByLC :: TyCoVar -> LiftingContext -> Bool+isMappedByLC tv (LC _ env) = tv `elemVarEnv` env++-- If [a |-> g] is in the substitution and g :: t1 ~ t2, substitute a for t1+-- If [a |-> (g1, g2)] is in the substitution, substitute a for g1+substLeftCo :: LiftingContext -> Coercion -> Coercion+substLeftCo lc co+  = substCo (lcSubstLeft lc) co++-- Ditto, but for t2 and g2+substRightCo :: LiftingContext -> Coercion -> Coercion+substRightCo lc co+  = substCo (lcSubstRight lc) co++-- | Apply "sym" to all coercions in a 'LiftCoEnv'+swapLiftCoEnv :: LiftCoEnv -> LiftCoEnv+swapLiftCoEnv = mapVarEnv mkSymCo++lcSubstLeft :: LiftingContext -> TCvSubst+lcSubstLeft (LC subst lc_env) = liftEnvSubstLeft subst lc_env++lcSubstRight :: LiftingContext -> TCvSubst+lcSubstRight (LC subst lc_env) = liftEnvSubstRight subst lc_env++liftEnvSubstLeft :: TCvSubst -> LiftCoEnv -> TCvSubst+liftEnvSubstLeft = liftEnvSubst pFst++liftEnvSubstRight :: TCvSubst -> LiftCoEnv -> TCvSubst+liftEnvSubstRight = liftEnvSubst pSnd++liftEnvSubst :: (forall a. Pair a -> a) -> TCvSubst -> LiftCoEnv -> TCvSubst+liftEnvSubst selector subst lc_env+  = composeTCvSubst (TCvSubst emptyInScopeSet tenv cenv) subst+  where+    pairs            = nonDetUFMToList lc_env+                       -- It's OK to use nonDetUFMToList here because we+                       -- immediately forget the ordering by creating+                       -- a VarEnv+    (tpairs, cpairs) = partitionWith ty_or_co pairs+    tenv             = mkVarEnv_Directly tpairs+    cenv             = mkVarEnv_Directly cpairs++    ty_or_co :: (Unique, Coercion) -> Either (Unique, Type) (Unique, Coercion)+    ty_or_co (u, co)+      | Just equality_co <- isCoercionTy_maybe equality_ty+      = Right (u, equality_co)+      | otherwise+      = Left (u, equality_ty)+      where+        equality_ty = selector (coercionKind co)++-- | Extract the underlying substitution from the LiftingContext+lcTCvSubst :: LiftingContext -> TCvSubst+lcTCvSubst (LC subst _) = subst++-- | Get the 'InScopeSet' from a 'LiftingContext'+lcInScopeSet :: LiftingContext -> InScopeSet+lcInScopeSet (LC subst _) = getTCvInScope subst++{-+%************************************************************************+%*                                                                      *+            Sequencing on coercions+%*                                                                      *+%************************************************************************+-}++seqMCo :: MCoercion -> ()+seqMCo MRefl    = ()+seqMCo (MCo co) = seqCo co++seqCo :: Coercion -> ()+seqCo (Refl ty)                 = seqType ty+seqCo (GRefl r ty mco)          = r `seq` seqType ty `seq` seqMCo mco+seqCo (TyConAppCo r tc cos)     = r `seq` tc `seq` seqCos cos+seqCo (AppCo co1 co2)           = seqCo co1 `seq` seqCo co2+seqCo (ForAllCo tv k co)        = seqType (varType tv) `seq` seqCo k+                                                       `seq` seqCo co+seqCo (FunCo r co1 co2)         = r `seq` seqCo co1 `seq` seqCo co2+seqCo (CoVarCo cv)              = cv `seq` ()+seqCo (HoleCo h)                = coHoleCoVar h `seq` ()+seqCo (AxiomInstCo con ind cos) = con `seq` ind `seq` seqCos cos+seqCo (UnivCo p r t1 t2)+  = seqProv p `seq` r `seq` seqType t1 `seq` seqType t2+seqCo (SymCo co)                = seqCo co+seqCo (TransCo co1 co2)         = seqCo co1 `seq` seqCo co2+seqCo (NthCo r n co)            = r `seq` n `seq` seqCo co+seqCo (LRCo lr co)              = lr `seq` seqCo co+seqCo (InstCo co arg)           = seqCo co `seq` seqCo arg+seqCo (KindCo co)               = seqCo co+seqCo (SubCo co)                = seqCo co+seqCo (AxiomRuleCo _ cs)        = seqCos cs++seqProv :: UnivCoProvenance -> ()+seqProv UnsafeCoerceProv    = ()+seqProv (PhantomProv co)    = seqCo co+seqProv (ProofIrrelProv co) = seqCo co+seqProv (PluginProv _)      = ()++seqCos :: [Coercion] -> ()+seqCos []       = ()+seqCos (co:cos) = seqCo co `seq` seqCos cos++{-+%************************************************************************+%*                                                                      *+             The kind of a type, and of a coercion+%*                                                                      *+%************************************************************************+-}++coercionType :: Coercion -> Type+coercionType co = case coercionKindRole co of+  (Pair ty1 ty2, r) -> mkCoercionType r ty1 ty2++------------------+-- | If it is the case that+--+-- > c :: (t1 ~ t2)+--+-- i.e. the kind of @c@ relates @t1@ and @t2@, then @coercionKind c = Pair t1 t2@.++coercionKind :: Coercion -> Pair Type+coercionKind co =+  go co+  where+    go (Refl ty) = Pair ty ty+    go (GRefl _ ty MRefl) = Pair ty ty+    go (GRefl _ ty (MCo co1)) = Pair ty (mkCastTy ty co1)+    go (TyConAppCo _ tc cos)= mkTyConApp tc <$> (sequenceA $ map go cos)+    go (AppCo co1 co2)      = mkAppTy <$> go co1 <*> go co2+    go co@(ForAllCo tv1 k_co co1) -- works for both tyvar and covar+       | isGReflCo k_co           = mkTyCoInvForAllTy tv1 <$> go co1+         -- kind_co always has kind @Type@, thus @isGReflCo@+       | otherwise                = go_forall empty_subst co+       where+         empty_subst = mkEmptyTCvSubst (mkInScopeSet $ tyCoVarsOfCo co)+    go (FunCo _ co1 co2)    = mkVisFunTy <$> go co1 <*> go co2+    go (CoVarCo cv)         = coVarTypes cv+    go (HoleCo h)           = coVarTypes (coHoleCoVar h)+    go (AxiomInstCo ax ind cos)+      | CoAxBranch { cab_tvs = tvs, cab_cvs = cvs+                   , cab_lhs = lhs, cab_rhs = rhs } <- coAxiomNthBranch ax ind+      , let Pair tycos1 tycos2 = sequenceA (map go cos)+            (tys1, cotys1) = splitAtList tvs tycos1+            (tys2, cotys2) = splitAtList tvs tycos2+            cos1           = map stripCoercionTy cotys1+            cos2           = map stripCoercionTy cotys2+      = ASSERT( cos `equalLength` (tvs ++ cvs) )+                  -- Invariant of AxiomInstCo: cos should+                  -- exactly saturate the axiom branch+        Pair (substTyWith tvs tys1 $+              substTyWithCoVars cvs cos1 $+              mkTyConApp (coAxiomTyCon ax) lhs)+             (substTyWith tvs tys2 $+              substTyWithCoVars cvs cos2 rhs)+    go (UnivCo _ _ ty1 ty2)   = Pair ty1 ty2+    go (SymCo co)             = swap $ go co+    go (TransCo co1 co2)      = Pair (pFst $ go co1) (pSnd $ go co2)+    go g@(NthCo _ d co)+      | Just argss <- traverse tyConAppArgs_maybe tys+      = ASSERT( and $ (`lengthExceeds` d) <$> argss )+        (`getNth` d) <$> argss++      | d == 0+      , Just splits <- traverse splitForAllTy_maybe tys+      = (tyVarKind . fst) <$> splits++      | otherwise+      = pprPanic "coercionKind" (ppr g)+      where+        tys = go co+    go (LRCo lr co)         = (pickLR lr . splitAppTy) <$> go co+    go (InstCo aco arg)     = go_app aco [arg]+    go (KindCo co)          = typeKind <$> go co+    go (SubCo co)           = go co+    go (AxiomRuleCo ax cos) = expectJust "coercionKind" $+                              coaxrProves ax (map go cos)++    go_app :: Coercion -> [Coercion] -> Pair Type+    -- Collect up all the arguments and apply all at once+    -- See Note [Nested InstCos]+    go_app (InstCo co arg) args = go_app co (arg:args)+    go_app co              args = piResultTys <$> go co <*> (sequenceA $ map go args)++    go_forall subst (ForAllCo tv1 k_co co)+      -- See Note [Nested ForAllCos]+      | isTyVar tv1+      = mkInvForAllTy <$> Pair tv1 tv2 <*> go_forall subst' co+      where+        Pair _ k2 = go k_co+        tv2       = setTyVarKind tv1 (substTy subst k2)+        subst' | isGReflCo k_co = extendTCvInScope subst tv1+                 -- kind_co always has kind @Type@, thus @isGReflCo@+               | otherwise      = extendTvSubst (extendTCvInScope subst tv2) tv1 $+                                  TyVarTy tv2 `mkCastTy` mkSymCo k_co+    go_forall subst (ForAllCo cv1 k_co co)+      | isCoVar cv1+      = mkTyCoInvForAllTy <$> Pair cv1 cv2 <*> go_forall subst' co+      where+        Pair _ k2 = go k_co+        r         = coVarRole cv1+        eta1      = mkNthCo r 2 (downgradeRole r Nominal k_co)+        eta2      = mkNthCo r 3 (downgradeRole r Nominal k_co)++        -- k_co :: (t1 ~r t2) ~N (s1 ~r s2)+        -- k1    = t1 ~r t2+        -- k2    = s1 ~r s2+        -- cv1  :: t1 ~r t2+        -- cv2  :: s1 ~r s2+        -- eta1 :: t1 ~r s1+        -- eta2 :: t2 ~r s2+        -- n_subst  = (eta1 ; cv2 ; sym eta2) :: t1 ~r t2++        cv2     = setVarType cv1 (substTy subst k2)+        n_subst = eta1 `mkTransCo` (mkCoVarCo cv2) `mkTransCo` (mkSymCo eta2)+        subst'  | isReflCo k_co = extendTCvInScope subst cv1+                | otherwise     = extendCvSubst (extendTCvInScope subst cv2)+                                                cv1 n_subst++    go_forall subst other_co+      -- when other_co is not a ForAllCo+      = substTy subst `pLiftSnd` go other_co++{-++Note [Nested ForAllCos]+~~~~~~~~~~~~~~~~~~~~~~~++Suppose we need `coercionKind (ForAllCo a1 (ForAllCo a2 ... (ForAllCo an+co)...) )`.   We do not want to perform `n` single-type-variable+substitutions over the kind of `co`; rather we want to do one substitution+which substitutes for all of `a1`, `a2` ... simultaneously.  If we do one+at a time we get the performance hole reported in #11735.++Solution: gather up the type variables for nested `ForAllCos`, and+substitute for them all at once.  Remarkably, for #11735 this single+change reduces /total/ compile time by a factor of more than ten.++-}++-- | Apply 'coercionKind' to multiple 'Coercion's+coercionKinds :: [Coercion] -> Pair [Type]+coercionKinds tys = sequenceA $ map coercionKind tys++-- | Get a coercion's kind and role.+coercionKindRole :: Coercion -> (Pair Type, Role)+coercionKindRole co = (coercionKind co, coercionRole co)++-- | Retrieve the role from a coercion.+coercionRole :: Coercion -> Role+coercionRole = go+  where+    go (Refl _) = Nominal+    go (GRefl r _ _) = r+    go (TyConAppCo r _ _) = r+    go (AppCo co1 _) = go co1+    go (ForAllCo _ _ co) = go co+    go (FunCo r _ _) = r+    go (CoVarCo cv) = coVarRole cv+    go (HoleCo h)   = coVarRole (coHoleCoVar h)+    go (AxiomInstCo ax _ _) = coAxiomRole ax+    go (UnivCo _ r _ _)  = r+    go (SymCo co) = go co+    go (TransCo co1 _co2) = go co1+    go (NthCo r _d _co) = r+    go (LRCo {}) = Nominal+    go (InstCo co _) = go co+    go (KindCo {}) = Nominal+    go (SubCo _) = Representational+    go (AxiomRuleCo ax _) = coaxrRole ax++{-+Note [Nested InstCos]+~~~~~~~~~~~~~~~~~~~~~+In #5631 we found that 70% of the entire compilation time was+being spent in coercionKind!  The reason was that we had+   (g @ ty1 @ ty2 .. @ ty100)    -- The "@s" are InstCos+where+   g :: forall a1 a2 .. a100. phi+If we deal with the InstCos one at a time, we'll do this:+   1.  Find the kind of (g @ ty1 .. @ ty99) : forall a100. phi'+   2.  Substitute phi'[ ty100/a100 ], a single tyvar->type subst+But this is a *quadratic* algorithm, and the blew up #5631.+So it's very important to do the substitution simultaneously;+cf Type.piResultTys (which in fact we call here).++-}++-- | Assuming that two types are the same, ignoring coercions, find+-- a nominal coercion between the types. This is useful when optimizing+-- transitivity over coercion applications, where splitting two+-- AppCos might yield different kinds. See Note [EtaAppCo] in OptCoercion.+buildCoercion :: Type -> Type -> CoercionN+buildCoercion orig_ty1 orig_ty2 = go orig_ty1 orig_ty2+  where+    go ty1 ty2 | Just ty1' <- coreView ty1 = go ty1' ty2+               | Just ty2' <- coreView ty2 = go ty1 ty2'++    go (CastTy ty1 co) ty2+      = let co' = go ty1 ty2+            r = coercionRole co'+        in  mkCoherenceLeftCo r ty1 co co'++    go ty1 (CastTy ty2 co)+      = let co' = go ty1 ty2+            r = coercionRole co'+        in  mkCoherenceRightCo r ty2 co co'++    go ty1@(TyVarTy tv1) _tyvarty+      = ASSERT( case _tyvarty of+                  { TyVarTy tv2 -> tv1 == tv2+                  ; _           -> False      } )+        mkNomReflCo ty1++    go (FunTy { ft_arg = arg1, ft_res = res1 })+       (FunTy { ft_arg = arg2, ft_res = res2 })+      = mkFunCo Nominal (go arg1 arg2) (go res1 res2)++    go (TyConApp tc1 args1) (TyConApp tc2 args2)+      = ASSERT( tc1 == tc2 )+        mkTyConAppCo Nominal tc1 (zipWith go args1 args2)++    go (AppTy ty1a ty1b) ty2+      | Just (ty2a, ty2b) <- repSplitAppTy_maybe ty2+      = mkAppCo (go ty1a ty2a) (go ty1b ty2b)++    go ty1 (AppTy ty2a ty2b)+      | Just (ty1a, ty1b) <- repSplitAppTy_maybe ty1+      = mkAppCo (go ty1a ty2a) (go ty1b ty2b)++    go (ForAllTy (Bndr tv1 _flag1) ty1) (ForAllTy (Bndr tv2 _flag2) ty2)+      | isTyVar tv1+      = ASSERT( isTyVar tv2 )+        mkForAllCo tv1 kind_co (go ty1 ty2')+      where kind_co  = go (tyVarKind tv1) (tyVarKind tv2)+            in_scope = mkInScopeSet $ tyCoVarsOfType ty2 `unionVarSet` tyCoVarsOfCo kind_co+            ty2'     = substTyWithInScope in_scope [tv2]+                         [mkTyVarTy tv1 `mkCastTy` kind_co]+                         ty2++    go (ForAllTy (Bndr cv1 _flag1) ty1) (ForAllTy (Bndr cv2 _flag2) ty2)+      = ASSERT( isCoVar cv1 && isCoVar cv2 )+        mkForAllCo cv1 kind_co (go ty1 ty2')+      where s1 = varType cv1+            s2 = varType cv2+            kind_co = go s1 s2++            -- s1 = t1 ~r t2+            -- s2 = t3 ~r t4+            -- kind_co :: (t1 ~r t2) ~N (t3 ~r t4)+            -- eta1 :: t1 ~r t3+            -- eta2 :: t2 ~r t4++            r    = coVarRole cv1+            kind_co' = downgradeRole r Nominal kind_co+            eta1 = mkNthCo r 2 kind_co'+            eta2 = mkNthCo r 3 kind_co'++            subst = mkEmptyTCvSubst $ mkInScopeSet $+                      tyCoVarsOfType ty2 `unionVarSet` tyCoVarsOfCo kind_co+            ty2'  = substTy (extendCvSubst subst cv2 $ mkSymCo eta1 `mkTransCo`+                                                       mkCoVarCo cv1 `mkTransCo`+                                                       eta2)+                            ty2++    go ty1@(LitTy lit1) _lit2+      = ASSERT( case _lit2 of+                  { LitTy lit2 -> lit1 == lit2+                  ; _          -> False        } )+        mkNomReflCo ty1++    go (CoercionTy co1) (CoercionTy co2)+      = mkProofIrrelCo Nominal kind_co co1 co2+      where+        kind_co = go (coercionType co1) (coercionType co2)++    go ty1 ty2+      = pprPanic "buildKindCoercion" (vcat [ ppr orig_ty1, ppr orig_ty2+                                           , ppr ty1, ppr ty2 ])++{-+%************************************************************************+%*                                                                      *+       Simplifying types+%*                                                                      *+%************************************************************************++The function below morally belongs in TcFlatten, but it is used also in+FamInstEnv, and so lives here.++Note [simplifyArgsWorker]+~~~~~~~~~~~~~~~~~~~~~~~~~+Invariant (F2) of Note [Flattening] says that flattening is homogeneous.+This causes some trouble when flattening a function applied to a telescope+of arguments, perhaps with dependency. For example, suppose++  type family F :: forall (j :: Type) (k :: Type). Maybe j -> Either j k -> Bool -> [k]++and we wish to flatten the args of (with kind applications explicit)++  F a b (Just a c) (Right a b d) False++where all variables are skolems and++  a :: Type+  b :: Type+  c :: a+  d :: k++  [G] aco :: a ~ fa+  [G] bco :: b ~ fb+  [G] cco :: c ~ fc+  [G] dco :: d ~ fd++The first step is to flatten all the arguments. This is done before calling+simplifyArgsWorker. We start from++  a+  b+  Just a c+  Right a b d+  False++and get++  (fa,                             co1 :: fa ~ a)+  (fb,                             co2 :: fb ~ b)+  (Just fa (fc |> aco) |> co6,     co3 :: (Just fa (fc |> aco) |> co6) ~ (Just a c))+  (Right fa fb (fd |> bco) |> co7, co4 :: (Right fa fb (fd |> bco) |> co7) ~ (Right a b d))+  (False,                          co5 :: False ~ False)++where+  co6 :: Maybe fa ~ Maybe a+  co7 :: Either fa fb ~ Either a b++We now process the flattened args in left-to-right order. The first two args+need no further processing. But now consider the third argument. Let f3 = the flattened+result, Just fa (fc |> aco) |> co6.+This f3 flattened argument has kind (Maybe a), due to+(F2). And yet, when we build the application (F fa fb ...), we need this+argument to have kind (Maybe fa), not (Maybe a). We must cast this argument.+The coercion to use is+determined by the kind of F: we see in F's kind that the third argument has+kind Maybe j. Critically, we also know that the argument corresponding to j+(in our example, a) flattened with a coercion co1. We can thus know the+coercion needed for the 3rd argument is (Maybe (sym co1)), thus building+(f3 |> Maybe (sym co1))++More generally, we must use the Lifting Lemma, as implemented in+Coercion.liftCoSubst. As we work left-to-right, any variable that is a+dependent parameter (j and k, in our example) gets mapped in a lifting context+to the coercion that is output from flattening the corresponding argument (co1+and co2, in our example). Then, after flattening later arguments, we lift the+kind of these arguments in the lifting context that we've be building up.+This coercion is then used to keep the result of flattening well-kinded.++Working through our example, this is what happens:++  1. Extend the (empty) LC with [j |-> co1]. No new casting must be done,+     because the binder associated with the first argument has a closed type (no+     variables).++  2. Extend the LC with [k |-> co2]. No casting to do.++  3. Lifting the kind (Maybe j) with our LC+     yields co8 :: Maybe fa ~ Maybe a. Use (f3 |> sym co8) as the argument to+     F.++  4. Lifting the kind (Either j k) with our LC+     yields co9 :: Either fa fb ~ Either a b. Use (f4 |> sym co9) as the 4th+     argument to F, where f4 is the flattened form of argument 4, written above.++  5. We lift Bool with our LC, getting <Bool>;+     casting has no effect.++We're now almost done, but the new application (F fa fb (f3 |> sym co8) (f4 > sym co9) False)+has the wrong kind. Its kind is [fb], instead of the original [b].+So we must use our LC one last time to lift the result kind [k],+getting res_co :: [fb] ~ [b], and we cast our result.++Accordingly, the final result is++  F fa fb (Just fa (fc |> aco) |> Maybe (sym aco) |> sym (Maybe (sym aco)))+          (Right fa fb (fd |> bco) |> Either (sym aco) (sym bco) |> sym (Either (sym aco) (sym bco)))+          False+            |> [sym bco]++The res_co (in this case, [sym bco])+is returned as the third return value from simplifyArgsWorker.++Note [Last case in simplifyArgsWorker]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In writing simplifyArgsWorker's `go`, we know here that args cannot be empty,+because that case is first. We've run out of+binders. But perhaps inner_ki is a tyvar that has been instantiated with a+Π-type.++Here is an example.++  a :: forall (k :: Type). k -> k+  type family Star+  Proxy :: forall j. j -> Type+  axStar :: Star ~ Type+  type family NoWay :: Bool+  axNoWay :: NoWay ~ False+  bo :: Type+  [G] bc :: bo ~ Bool   (in inert set)++  co :: (forall j. j -> Type) ~ (forall (j :: Star). (j |> axStar) -> Star)+  co = forall (j :: sym axStar). (<j> -> sym axStar)++  We are flattening:+  a (forall (j :: Star). (j |> axStar) -> Star)   -- 1+    (Proxy |> co)                                 -- 2+    (bo |> sym axStar)                            -- 3+    (NoWay |> sym bc)                             -- 4+      :: Star++First, we flatten all the arguments (before simplifyArgsWorker), like so:++    (forall j. j -> Type, co1 :: (forall j. j -> Type) ~+                                 (forall (j :: Star). (j |> axStar) -> Star))  -- 1+    (Proxy |> co,         co2 :: (Proxy |> co) ~ (Proxy |> co))                -- 2+    (Bool |> sym axStar,  co3 :: (Bool |> sym axStar) ~ (bo |> sym axStar))    -- 3+    (False |> sym bc,     co4 :: (False |> sym bc) ~ (NoWay |> sym bc))        -- 4++Then we do the process described in Note [simplifyArgsWorker].++1. Lifting Type (the kind of the first arg) gives us a reflexive coercion, so we+   don't use it. But we do build a lifting context [k -> co1] (where co1 is a+   result of flattening an argument, written above).++2. Lifting k gives us co1, so the second argument becomes (Proxy |> co |> sym co1).+   This is not a dependent argument, so we don't extend the lifting context.++Now we need to deal with argument (3). After flattening, should we tack on a homogenizing+coercion? The way we normally tell is to lift the kind of the binder.+But here, the remainder of the kind of `a` that we're left with+after processing two arguments is just `k`.++The way forward is look up k in the lifting context, getting co1. If we're at+all well-typed, co1 will be a coercion between Π-types, with at least one binder.+So, let's+decompose co1 with decomposePiCos. This decomposition needs arguments to use+to instantiate any kind parameters. Look at the type of co1. If we just+decomposed it, we would end up with coercions whose types include j, which is+out of scope here. Accordingly, decomposePiCos takes a list of types whose+kinds are the *right-hand* types in the decomposed coercion. (See comments on+decomposePiCos.) Because the flattened types have unflattened kinds (because+flattening is homogeneous), passing the list of flattened types to decomposePiCos+just won't do: later arguments' kinds won't be as expected. So we need to get+the *unflattened* types to pass to decomposePiCos. We can do this easily enough+by taking the kind of the argument coercions, passed in originally.++(Alternative 1: We could re-engineer decomposePiCos to deal with this situation.+But that function is already gnarly, and taking the right-hand types is correct+at its other call sites, which are much more common than this one.)++(Alternative 2: We could avoid calling decomposePiCos entirely, integrating its+behavior into simplifyArgsWorker. This would work, I think, but then all of the+complication of decomposePiCos would end up layered on top of all the complication+here. Please, no.)++(Alternative 3: We could pass the unflattened arguments into simplifyArgsWorker+so that we don't have to recreate them. But that would complicate the interface+of this function to handle a very dark, dark corner case. Better to keep our+demons to ourselves here instead of exposing them to callers. This decision is+easily reversed if there is ever any performance trouble due to the call of+coercionKind.)++So we now call++  decomposePiCos co1+                 (Pair (forall j. j -> Type) (forall (j :: Star). (j |> axStar) -> Star))+                 [bo |> sym axStar, NoWay |> sym bc]++to get++  co5 :: Star ~ Type+  co6 :: (j |> axStar) ~ (j |> co5), substituted to+                              (bo |> sym axStar |> axStar) ~ (bo |> sym axStar |> co5)+                           == bo ~ bo+  res_co :: Type ~ Star++We then use these casts on (the flattened) (3) and (4) to get++  (Bool |> sym axStar |> co5 :: Type)   -- (C3)+  (False |> sym bc |> co6    :: bo)     -- (C4)++We can simplify to++  Bool                        -- (C3)+  (False |> sym bc :: bo)     -- (C4)++Of course, we still must do the processing in Note [simplifyArgsWorker] to finish+the job. We thus want to recur. Our new function kind is the left-hand type of+co1 (gotten, recall, by lifting the variable k that was the return kind of the+original function). Why the left-hand type (as opposed to the right-hand type)?+Because we have casted all the arguments according to decomposePiCos, which gets+us from the right-hand type to the left-hand one. We thus recur with that new+function kind, zapping our lifting context, because we have essentially applied+it.++This recursive call returns ([Bool, False], [...], Refl). The Bool and False+are the correct arguments we wish to return. But we must be careful about the+result coercion: our new, flattened application will have kind Type, but we+want to make sure that the result coercion casts this back to Star. (Why?+Because we started with an application of kind Star, and flattening is homogeneous.)++So, we have to twiddle the result coercion appropriately.++Let's check whether this is well-typed. We know++  a :: forall (k :: Type). k -> k++  a (forall j. j -> Type) :: (forall j. j -> Type) -> forall j. j -> Type++  a (forall j. j -> Type)+    Proxy+      :: forall j. j -> Type++  a (forall j. j -> Type)+    Proxy+    Bool+      :: Bool -> Type++  a (forall j. j -> Type)+    Proxy+    Bool+    False+      :: Type++  a (forall j. j -> Type)+    Proxy+    Bool+    False+     |> res_co+     :: Star++as desired.++Whew.++-}+++-- This is shared between the flattener and the normaliser in FamInstEnv.+-- See Note [simplifyArgsWorker]+{-# INLINE simplifyArgsWorker #-}+simplifyArgsWorker :: [TyCoBinder] -> Kind+                       -- the binders & result kind (not a Π-type) of the function applied to the args+                       -- list of binders can be shorter or longer than the list of args+                   -> TyCoVarSet   -- free vars of the args+                   -> [Role]   -- list of roles, r+                   -> [(Type, Coercion)] -- flattened type arguments, arg+                                         -- each comes with the coercion used to flatten it,+                                         -- with co :: flattened_type ~ original_type+                   -> ([Type], [Coercion], CoercionN)+-- Returns (xis, cos, res_co), where each co :: xi ~ arg,+-- and res_co :: kind (f xis) ~ kind (f tys), where f is the function applied to the args+-- Precondition: if f :: forall bndrs. inner_ki (where bndrs and inner_ki are passed in),+-- then (f orig_tys) is well kinded. Note that (f flattened_tys) might *not* be well-kinded.+-- Massaging the flattened_tys in order to make (f flattened_tys) well-kinded is what this+-- function is all about. That is, (f xis), where xis are the returned arguments, *is*+-- well kinded.+simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs+                   orig_roles orig_simplified_args+  = go [] [] orig_lc orig_ki_binders orig_inner_ki orig_roles orig_simplified_args+  where+    orig_lc = emptyLiftingContext $ mkInScopeSet $ orig_fvs++    go :: [Type]      -- Xis accumulator, in reverse order+       -> [Coercion]  -- Coercions accumulator, in reverse order+                      -- These are in 1-to-1 correspondence+       -> LiftingContext  -- mapping from tyvars to flattening coercions+       -> [TyCoBinder]    -- Unsubsted binders of function's kind+       -> Kind        -- Unsubsted result kind of function (not a Pi-type)+       -> [Role]      -- Roles at which to flatten these ...+       -> [(Type, Coercion)]  -- flattened arguments, with their flattening coercions+       -> ([Type], [Coercion], CoercionN)+    go acc_xis acc_cos lc binders inner_ki _ []+      = (reverse acc_xis, reverse acc_cos, kind_co)+      where+        final_kind = mkPiTys binders inner_ki+        kind_co = liftCoSubst Nominal lc final_kind++    go acc_xis acc_cos lc (binder:binders) inner_ki (role:roles) ((xi,co):args)+      = -- By Note [Flattening] in TcFlatten invariant (F2),+         -- tcTypeKind(xi) = tcTypeKind(ty). But, it's possible that xi will be+         -- used as an argument to a function whose kind is different, if+         -- earlier arguments have been flattened to new types. We thus+         -- need a coercion (kind_co :: old_kind ~ new_kind).+         --+         -- The bangs here have been observed to improve performance+         -- significantly in optimized builds.+         let kind_co = mkSymCo $+               liftCoSubst Nominal lc (tyCoBinderType binder)+             !casted_xi = xi `mkCastTy` kind_co+             casted_co =  mkCoherenceLeftCo role xi kind_co co++         -- now, extend the lifting context with the new binding+             !new_lc | Just tv <- tyCoBinderVar_maybe binder+                     = extendLiftingContextAndInScope lc tv casted_co+                     | otherwise+                     = lc+         in+         go (casted_xi : acc_xis)+            (casted_co : acc_cos)+            new_lc+            binders+            inner_ki+            roles+            args+++      -- See Note [Last case in simplifyArgsWorker]+    go acc_xis acc_cos lc [] inner_ki roles args+      | Just k   <- getTyVar_maybe inner_ki+      , Just co1 <- liftCoSubstTyVar lc Nominal k+      = let co1_kind              = coercionKind co1+            unflattened_tys       = map (pSnd . coercionKind . snd) args+            (arg_cos, res_co)     = decomposePiCos co1 co1_kind unflattened_tys+            casted_args           = ASSERT2( equalLength args arg_cos+                                           , ppr args $$ ppr arg_cos )+                                    [ (casted_xi, casted_co)+                                    | ((xi, co), arg_co, role) <- zip3 args arg_cos roles+                                    , let casted_xi = xi `mkCastTy` arg_co+                                          casted_co = mkCoherenceLeftCo role xi arg_co co ]+               -- In general decomposePiCos can return fewer cos than tys,+               -- but not here; because we're well typed, there will be enough+               -- binders. Note that decomposePiCos does substitutions, so even+               -- if the original substitution results in something ending with+               -- ... -> k, that k will be substituted to perhaps reveal more+               -- binders.+            zapped_lc             = zapLiftingContext lc+            Pair flattened_kind _ = co1_kind+            (bndrs, new_inner)    = splitPiTys flattened_kind++            (xis_out, cos_out, res_co_out)+              = go acc_xis acc_cos zapped_lc bndrs new_inner roles casted_args+        in+        (xis_out, cos_out, res_co_out `mkTransCo` res_co)++    go _ _ _ _ _ _ _ = panic+        "simplifyArgsWorker wandered into deeper water than usual"+           -- This debug information is commented out because leaving it in+           -- causes a ~2% increase in allocations in T9872d.+           -- That's independent of the analagous case in flatten_args_fast+           -- in TcFlatten:+           -- each of these causes a 2% increase on its own, so commenting them+           -- both out gives a 4% decrease in T9872d.+           {-++             (vcat [ppr orig_binders,+                    ppr orig_inner_ki,+                    ppr (take 10 orig_roles), -- often infinite!+                    ppr orig_tys])+           -}
+ compiler/types/Coercion.hs-boot view
@@ -0,0 +1,52 @@+{-# LANGUAGE FlexibleContexts #-}++module Coercion where++import GhcPrelude++import {-# SOURCE #-} TyCoRep+import {-# SOURCE #-} TyCon++import BasicTypes ( LeftOrRight )+import CoAxiom+import Var+import Pair+import Util++mkReflCo :: Role -> Type -> Coercion+mkTyConAppCo :: HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion+mkAppCo :: Coercion -> Coercion -> Coercion+mkForAllCo :: TyCoVar -> Coercion -> Coercion -> Coercion+mkFunCo :: Role -> Coercion -> Coercion -> Coercion+mkCoVarCo :: CoVar -> Coercion+mkAxiomInstCo :: CoAxiom Branched -> BranchIndex -> [Coercion] -> Coercion+mkPhantomCo :: Coercion -> Type -> Type -> Coercion+mkUnsafeCo :: Role -> Type -> Type -> Coercion+mkUnivCo :: UnivCoProvenance -> Role -> Type -> Type -> Coercion+mkSymCo :: Coercion -> Coercion+mkTransCo :: Coercion -> Coercion -> Coercion+mkNthCo :: HasDebugCallStack => Role -> Int -> Coercion -> Coercion+mkLRCo :: LeftOrRight -> Coercion -> Coercion+mkInstCo :: Coercion -> Coercion -> Coercion+mkGReflCo :: Role -> Type -> MCoercionN -> Coercion+mkNomReflCo :: Type -> Coercion+mkKindCo :: Coercion -> Coercion+mkSubCo :: Coercion -> Coercion+mkProofIrrelCo :: Role -> Coercion -> Coercion -> Coercion -> Coercion+mkAxiomRuleCo :: CoAxiomRule -> [Coercion] -> Coercion++isGReflCo :: Coercion -> Bool+isReflCo :: Coercion -> Bool+isReflexiveCo :: Coercion -> Bool+decomposePiCos :: HasDebugCallStack => Coercion -> Pair Type -> [Type] -> ([Coercion], Coercion)+coVarKindsTypesRole :: HasDebugCallStack => CoVar -> (Kind, Kind, Type, Type, Role)+coVarRole :: CoVar -> Role++mkCoercionType :: Role -> Type -> Type -> Type++data LiftingContext+liftCoSubst :: HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion+seqCo :: Coercion -> ()++coercionKind :: Coercion -> Pair Type+coercionType :: Coercion -> Type
+ compiler/types/FamInstEnv.hs view
@@ -0,0 +1,1754 @@+-- (c) The University of Glasgow 2006+--+-- FamInstEnv: Type checked family instance declarations++{-# LANGUAGE CPP, GADTs, ScopedTypeVariables, BangPatterns, TupleSections #-}++module FamInstEnv (+        FamInst(..), FamFlavor(..), famInstAxiom, famInstTyCon, famInstRHS,+        famInstsRepTyCons, famInstRepTyCon_maybe, dataFamInstRepTyCon,+        pprFamInst, pprFamInsts,+        mkImportedFamInst,++        FamInstEnvs, FamInstEnv, emptyFamInstEnv, emptyFamInstEnvs,+        extendFamInstEnv, extendFamInstEnvList,+        famInstEnvElts, famInstEnvSize, familyInstances,++        -- * CoAxioms+        mkCoAxBranch, mkBranchedCoAxiom, mkUnbranchedCoAxiom, mkSingleCoAxiom,+        mkNewTypeCoAxiom,++        FamInstMatch(..),+        lookupFamInstEnv, lookupFamInstEnvConflicts, lookupFamInstEnvByTyCon,++        isDominatedBy, apartnessCheck,++        -- Injectivity+        InjectivityCheckResult(..),+        lookupFamInstEnvInjectivityConflicts, injectiveBranches,++        -- Normalisation+        topNormaliseType, topNormaliseType_maybe,+        normaliseType, normaliseTcApp, normaliseTcArgs,+        reduceTyFamApp_maybe,++        -- Flattening+        flattenTys+    ) where++#include "HsVersions.h"++import GhcPrelude++import Unify+import Type+import TyCoRep+import TyCon+import Coercion+import CoAxiom+import VarSet+import VarEnv+import Name+import PrelNames ( eqPrimTyConKey )+import UniqDFM+import Outputable+import Maybes+import CoreMap+import Unique+import Util+import Var+import Pair+import SrcLoc+import FastString+import Control.Monad+import Data.List( mapAccumL )+import Data.Array( Array, assocs )++{-+************************************************************************+*                                                                      *+          Type checked family instance heads+*                                                                      *+************************************************************************++Note [FamInsts and CoAxioms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+* CoAxioms and FamInsts are just like+  DFunIds  and ClsInsts++* A CoAxiom is a System-FC thing: it can relate any two types++* A FamInst is a Haskell source-language thing, corresponding+  to a type/data family instance declaration.+    - The FamInst contains a CoAxiom, which is the evidence+      for the instance++    - The LHS of the CoAxiom is always of form F ty1 .. tyn+      where F is a type family+-}++data FamInst  -- See Note [FamInsts and CoAxioms]+  = FamInst { fi_axiom  :: CoAxiom Unbranched -- The new coercion axiom+                                              -- introduced by this family+                                              -- instance+                 -- INVARIANT: apart from freshening (see below)+                 --    fi_tvs = cab_tvs of the (single) axiom branch+                 --    fi_cvs = cab_cvs ...ditto...+                 --    fi_tys = cab_lhs ...ditto...+                 --    fi_rhs = cab_rhs ...ditto...++            , fi_flavor :: FamFlavor++            -- Everything below here is a redundant,+            -- cached version of the two things above+            -- except that the TyVars are freshened+            , fi_fam   :: Name          -- Family name++                -- Used for "rough matching"; same idea as for class instances+                -- See Note [Rough-match field] in InstEnv+            , fi_tcs   :: [Maybe Name]  -- Top of type args+                -- INVARIANT: fi_tcs = roughMatchTcs fi_tys++            -- Used for "proper matching"; ditto+            , fi_tvs :: [TyVar]      -- Template tyvars for full match+            , fi_cvs :: [CoVar]      -- Template covars for full match+                 -- Like ClsInsts, these variables are always fresh+                 -- See Note [Template tyvars are fresh] in InstEnv++            , fi_tys    :: [Type]       --   The LHS type patterns+            -- May be eta-reduced; see Note [Eta reduction for data families]++            , fi_rhs :: Type         --   the RHS, with its freshened vars+            }++data FamFlavor+  = SynFamilyInst         -- A synonym family+  | DataFamilyInst TyCon  -- A data family, with its representation TyCon++{-+Note [Arity of data families]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Data family instances might legitimately be over- or under-saturated.++Under-saturation has two potential causes:+ U1) Eta reduction. See Note [Eta reduction for data families].+ U2) When the user has specified a return kind instead of written out patterns.+     Example:++       data family Sing (a :: k)+       data instance Sing :: Bool -> Type++     The data family tycon Sing has an arity of 2, the k and the a. But+     the data instance has only one pattern, Bool (standing in for k).+     This instance is equivalent to `data instance Sing (a :: Bool)`, but+     without the last pattern, we have an under-saturated data family instance.+     On its own, this example is not compelling enough to add support for+     under-saturation, but U1 makes this feature more compelling.++Over-saturation is also possible:+  O1) If the data family's return kind is a type variable (see also #12369),+      an instance might legitimately have more arguments than the family.+      Example:++        data family Fix :: (Type -> k) -> k+        data instance Fix f = MkFix1 (f (Fix f))+        data instance Fix f x = MkFix2 (f (Fix f x) x)++      In the first instance here, the k in the data family kind is chosen to+      be Type. In the second, it's (Type -> Type).++      However, we require that any over-saturation is eta-reducible. That is,+      we require that any extra patterns be bare unrepeated type variables;+      see Note [Eta reduction for data families]. Accordingly, the FamInst+      is never over-saturated.++Why can we allow such flexibility for data families but not for type families?+Because data families can be decomposed -- that is, they are generative and+injective. A Type family is neither and so always must be applied to all its+arguments.+-}++-- Obtain the axiom of a family instance+famInstAxiom :: FamInst -> CoAxiom Unbranched+famInstAxiom = fi_axiom++-- Split the left-hand side of the FamInst+famInstSplitLHS :: FamInst -> (TyCon, [Type])+famInstSplitLHS (FamInst { fi_axiom = axiom, fi_tys = lhs })+  = (coAxiomTyCon axiom, lhs)++-- Get the RHS of the FamInst+famInstRHS :: FamInst -> Type+famInstRHS = fi_rhs++-- Get the family TyCon of the FamInst+famInstTyCon :: FamInst -> TyCon+famInstTyCon = coAxiomTyCon . famInstAxiom++-- Return the representation TyCons introduced by data family instances, if any+famInstsRepTyCons :: [FamInst] -> [TyCon]+famInstsRepTyCons fis = [tc | FamInst { fi_flavor = DataFamilyInst tc } <- fis]++-- Extracts the TyCon for this *data* (or newtype) instance+famInstRepTyCon_maybe :: FamInst -> Maybe TyCon+famInstRepTyCon_maybe fi+  = case fi_flavor fi of+       DataFamilyInst tycon -> Just tycon+       SynFamilyInst        -> Nothing++dataFamInstRepTyCon :: FamInst -> TyCon+dataFamInstRepTyCon fi+  = case fi_flavor fi of+       DataFamilyInst tycon -> tycon+       SynFamilyInst        -> pprPanic "dataFamInstRepTyCon" (ppr fi)++{-+************************************************************************+*                                                                      *+        Pretty printing+*                                                                      *+************************************************************************+-}++instance NamedThing FamInst where+   getName = coAxiomName . fi_axiom++instance Outputable FamInst where+   ppr = pprFamInst++pprFamInst :: FamInst -> SDoc+-- Prints the FamInst as a family instance declaration+-- NB: This function, FamInstEnv.pprFamInst, is used only for internal,+--     debug printing. See PprTyThing.pprFamInst for printing for the user+pprFamInst (FamInst { fi_flavor = flavor, fi_axiom = ax+                    , fi_tvs = tvs, fi_tys = tys, fi_rhs = rhs })+  = hang (ppr_tc_sort <+> text "instance"+             <+> pprCoAxBranchUser (coAxiomTyCon ax) (coAxiomSingleBranch ax))+       2 (whenPprDebug debug_stuff)+  where+    ppr_tc_sort = case flavor of+                     SynFamilyInst             -> text "type"+                     DataFamilyInst tycon+                       | isDataTyCon     tycon -> text "data"+                       | isNewTyCon      tycon -> text "newtype"+                       | isAbstractTyCon tycon -> text "data"+                       | otherwise             -> text "WEIRD" <+> ppr tycon++    debug_stuff = vcat [ text "Coercion axiom:" <+> ppr ax+                       , text "Tvs:" <+> ppr tvs+                       , text "LHS:" <+> ppr tys+                       , text "RHS:" <+> ppr rhs ]++pprFamInsts :: [FamInst] -> SDoc+pprFamInsts finsts = vcat (map pprFamInst finsts)++{-+Note [Lazy axiom match]+~~~~~~~~~~~~~~~~~~~~~~~+It is Vitally Important that mkImportedFamInst is *lazy* in its axiom+parameter. The axiom is loaded lazily, via a forkM, in TcIface. Sometime+later, mkImportedFamInst is called using that axiom. However, the axiom+may itself depend on entities which are not yet loaded as of the time+of the mkImportedFamInst. Thus, if mkImportedFamInst eagerly looks at the+axiom, a dependency loop spontaneously appears and GHC hangs. The solution+is simply for mkImportedFamInst never, ever to look inside of the axiom+until everything else is good and ready to do so. We can assume that this+readiness has been achieved when some other code pulls on the axiom in the+FamInst. Thus, we pattern match on the axiom lazily (in the where clause,+not in the parameter list) and we assert the consistency of names there+also.+-}++-- Make a family instance representation from the information found in an+-- interface file.  In particular, we get the rough match info from the iface+-- (instead of computing it here).+mkImportedFamInst :: Name               -- Name of the family+                  -> [Maybe Name]       -- Rough match info+                  -> CoAxiom Unbranched -- Axiom introduced+                  -> FamInst            -- Resulting family instance+mkImportedFamInst fam mb_tcs axiom+  = FamInst {+      fi_fam    = fam,+      fi_tcs    = mb_tcs,+      fi_tvs    = tvs,+      fi_cvs    = cvs,+      fi_tys    = tys,+      fi_rhs    = rhs,+      fi_axiom  = axiom,+      fi_flavor = flavor }+  where+     -- See Note [Lazy axiom match]+     ~(CoAxBranch { cab_lhs = tys+                  , cab_tvs = tvs+                  , cab_cvs = cvs+                  , cab_rhs = rhs }) = coAxiomSingleBranch axiom++         -- Derive the flavor for an imported FamInst rather disgustingly+         -- Maybe we should store it in the IfaceFamInst?+     flavor = case splitTyConApp_maybe rhs of+                Just (tc, _)+                  | Just ax' <- tyConFamilyCoercion_maybe tc+                  , ax' == axiom+                  -> DataFamilyInst tc+                _ -> SynFamilyInst++{-+************************************************************************+*                                                                      *+                FamInstEnv+*                                                                      *+************************************************************************++Note [FamInstEnv]+~~~~~~~~~~~~~~~~~+A FamInstEnv maps a family name to the list of known instances for that family.++The same FamInstEnv includes both 'data family' and 'type family' instances.+Type families are reduced during type inference, but not data families;+the user explains when to use a data family instance by using constructors+and pattern matching.++Nevertheless it is still useful to have data families in the FamInstEnv:++ - For finding overlaps and conflicts++ - For finding the representation type...see FamInstEnv.topNormaliseType+   and its call site in Simplify++ - In standalone deriving instance Eq (T [Int]) we need to find the+   representation type for T [Int]++Note [Varying number of patterns for data family axioms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For data families, the number of patterns may vary between instances.+For example+   data family T a b+   data instance T Int a = T1 a | T2+   data instance T Bool [a] = T3 a++Then we get a data type for each instance, and an axiom:+   data TInt a = T1 a | T2+   data TBoolList a = T3 a++   axiom ax7   :: T Int ~ TInt   -- Eta-reduced+   axiom ax8 a :: T Bool [a] ~ TBoolList a++These two axioms for T, one with one pattern, one with two;+see Note [Eta reduction for data families]++Note [FamInstEnv determinism]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We turn FamInstEnvs into a list in some places that don't directly affect+the ABI. That happens in family consistency checks and when producing output+for `:info`. Unfortunately that nondeterminism is nonlocal and it's hard+to tell what it affects without following a chain of functions. It's also+easy to accidentally make that nondeterminism affect the ABI. Furthermore+the envs should be relatively small, so it should be free to use deterministic+maps here. Testing with nofib and validate detected no difference between+UniqFM and UniqDFM.+See Note [Deterministic UniqFM].+-}++type FamInstEnv = UniqDFM FamilyInstEnv  -- Maps a family to its instances+     -- See Note [FamInstEnv]+     -- See Note [FamInstEnv determinism]++type FamInstEnvs = (FamInstEnv, FamInstEnv)+     -- External package inst-env, Home-package inst-env++newtype FamilyInstEnv+  = FamIE [FamInst]     -- The instances for a particular family, in any order++instance Outputable FamilyInstEnv where+  ppr (FamIE fs) = text "FamIE" <+> vcat (map ppr fs)++-- INVARIANTS:+--  * The fs_tvs are distinct in each FamInst+--      of a range value of the map (so we can safely unify them)++emptyFamInstEnvs :: (FamInstEnv, FamInstEnv)+emptyFamInstEnvs = (emptyFamInstEnv, emptyFamInstEnv)++emptyFamInstEnv :: FamInstEnv+emptyFamInstEnv = emptyUDFM++famInstEnvElts :: FamInstEnv -> [FamInst]+famInstEnvElts fi = [elt | FamIE elts <- eltsUDFM fi, elt <- elts]+  -- See Note [FamInstEnv determinism]++famInstEnvSize :: FamInstEnv -> Int+famInstEnvSize = nonDetFoldUDFM (\(FamIE elt) sum -> sum + length elt) 0+  -- It's OK to use nonDetFoldUDFM here since we're just computing the+  -- size.++familyInstances :: (FamInstEnv, FamInstEnv) -> TyCon -> [FamInst]+familyInstances (pkg_fie, home_fie) fam+  = get home_fie ++ get pkg_fie+  where+    get env = case lookupUDFM env fam of+                Just (FamIE insts) -> insts+                Nothing                      -> []++extendFamInstEnvList :: FamInstEnv -> [FamInst] -> FamInstEnv+extendFamInstEnvList inst_env fis = foldl' extendFamInstEnv inst_env fis++extendFamInstEnv :: FamInstEnv -> FamInst -> FamInstEnv+extendFamInstEnv inst_env+                 ins_item@(FamInst {fi_fam = cls_nm})+  = addToUDFM_C add inst_env cls_nm (FamIE [ins_item])+  where+    add (FamIE items) _ = FamIE (ins_item:items)++{-+************************************************************************+*                                                                      *+                Compatibility+*                                                                      *+************************************************************************++Note [Apartness]+~~~~~~~~~~~~~~~~+In dealing with closed type families, we must be able to check that one type+will never reduce to another. This check is called /apartness/. The check+is always between a target (which may be an arbitrary type) and a pattern.+Here is how we do it:++apart(target, pattern) = not (unify(flatten(target), pattern))++where flatten (implemented in flattenTys, below) converts all type-family+applications into fresh variables. (See Note [Flattening].)++Note [Compatibility]+~~~~~~~~~~~~~~~~~~~~+Two patterns are /compatible/ if either of the following conditions hold:+1) The patterns are apart.+2) The patterns unify with a substitution S, and their right hand sides+equal under that substitution.++For open type families, only compatible instances are allowed. For closed+type families, the story is slightly more complicated. Consider the following:++type family F a where+  F Int = Bool+  F a   = Int++g :: Show a => a -> F a+g x = length (show x)++Should that type-check? No. We need to allow for the possibility that 'a'+might be Int and therefore 'F a' should be Bool. We can simplify 'F a' to Int+only when we can be sure that 'a' is not Int.++To achieve this, after finding a possible match within the equations, we have to+go back to all previous equations and check that, under the+substitution induced by the match, other branches are surely apart. (See+Note [Apartness].) This is similar to what happens with class+instance selection, when we need to guarantee that there is only a match and+no unifiers. The exact algorithm is different here because the+potentially-overlapping group is closed.++As another example, consider this:++type family G x where+  G Int = Bool+  G a   = Double++type family H y+-- no instances++Now, we want to simplify (G (H Char)). We can't, because (H Char) might later+simplify to be Int. So, (G (H Char)) is stuck, for now.++While everything above is quite sound, it isn't as expressive as we'd like.+Consider this:++type family J a where+  J Int = Int+  J a   = a++Can we simplify (J b) to b? Sure we can. Yes, the first equation matches if+b is instantiated with Int, but the RHSs coincide there, so it's all OK.++So, the rule is this: when looking up a branch in a closed type family, we+find a branch that matches the target, but then we make sure that the target+is apart from every previous *incompatible* branch. We don't check the+branches that are compatible with the matching branch, because they are either+irrelevant (clause 1 of compatible) or benign (clause 2 of compatible).++Note [Compatibility of eta-reduced axioms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In newtype instances of data families we eta-reduce the axioms,+See Note [Eta reduction for data families] in FamInstEnv. This means that+we sometimes need to test compatibility of two axioms that were eta-reduced to+different degrees, e.g.:+++data family D a b c+newtype instance D a Int c = DInt (Maybe a)+  -- D a Int ~ Maybe+  -- lhs = [a, Int]+newtype instance D Bool Int Char = DIntChar Float+  -- D Bool Int Char ~ Float+  -- lhs = [Bool, Int, Char]++These are obviously incompatible. We could detect this by saturating+(eta-expanding) the shorter LHS with fresh tyvars until the lists are of+equal length, but instead we can just remove the tail of the longer list, as+those types will simply unify with the freshly introduced tyvars.++By doing this, in case the LHS are unifiable, the yielded substitution won't+mention the tyvars that appear in the tail we dropped off, and we might try+to test equality RHSes of different kinds, but that's fine since this case+occurs only for data families, where the RHS is a unique tycon and the equality+fails anyway.+-}++-- See Note [Compatibility]+compatibleBranches :: CoAxBranch -> CoAxBranch -> Bool+compatibleBranches (CoAxBranch { cab_lhs = lhs1, cab_rhs = rhs1 })+                   (CoAxBranch { cab_lhs = lhs2, cab_rhs = rhs2 })+  = let (commonlhs1, commonlhs2) = zipAndUnzip lhs1 lhs2+             -- See Note [Compatibility of eta-reduced axioms]+    in case tcUnifyTysFG (const BindMe) commonlhs1 commonlhs2 of+      SurelyApart -> True+      Unifiable subst+        | Type.substTyAddInScope subst rhs1 `eqType`+          Type.substTyAddInScope subst rhs2+        -> True+      _ -> False++-- | Result of testing two type family equations for injectiviy.+data InjectivityCheckResult+   = InjectivityAccepted+    -- ^ Either RHSs are distinct or unification of RHSs leads to unification of+    -- LHSs+   | InjectivityUnified CoAxBranch CoAxBranch+    -- ^ RHSs unify but LHSs don't unify under that substitution.  Relevant for+    -- closed type families where equation after unification might be+    -- overlpapped (in which case it is OK if they don't unify).  Constructor+    -- stores axioms after unification.++-- | Check whether two type family axioms don't violate injectivity annotation.+injectiveBranches :: [Bool] -> CoAxBranch -> CoAxBranch+                  -> InjectivityCheckResult+injectiveBranches injectivity+                  ax1@(CoAxBranch { cab_lhs = lhs1, cab_rhs = rhs1 })+                  ax2@(CoAxBranch { cab_lhs = lhs2, cab_rhs = rhs2 })+  -- See Note [Verifying injectivity annotation]. This function implements first+  -- check described there.+  = let getInjArgs  = filterByList injectivity+    in case tcUnifyTyWithTFs True rhs1 rhs2 of -- True = two-way pre-unification+       Nothing -> InjectivityAccepted -- RHS are different, so equations are+                                      -- injective.+       Just subst -> -- RHS unify under a substitution+        let lhs1Subst = Type.substTys subst (getInjArgs lhs1)+            lhs2Subst = Type.substTys subst (getInjArgs lhs2)+        -- If LHSs are equal under the substitution used for RHSs then this pair+        -- of equations does not violate injectivity annotation. If LHSs are not+        -- equal under that substitution then this pair of equations violates+        -- injectivity annotation, but for closed type families it still might+        -- be the case that one LHS after substitution is unreachable.+        in if eqTypes lhs1Subst lhs2Subst+           then InjectivityAccepted+           else InjectivityUnified ( ax1 { cab_lhs = Type.substTys subst lhs1+                                         , cab_rhs = Type.substTy  subst rhs1 })+                                   ( ax2 { cab_lhs = Type.substTys subst lhs2+                                         , cab_rhs = Type.substTy  subst rhs2 })++-- takes a CoAxiom with unknown branch incompatibilities and computes+-- the compatibilities+-- See Note [Storing compatibility] in CoAxiom+computeAxiomIncomps :: [CoAxBranch] -> [CoAxBranch]+computeAxiomIncomps branches+  = snd (mapAccumL go [] branches)+  where+    go :: [CoAxBranch] -> CoAxBranch -> ([CoAxBranch], CoAxBranch)+    go prev_brs cur_br+       = (cur_br : prev_brs, new_br)+       where+         new_br = cur_br { cab_incomps = mk_incomps prev_brs cur_br }++    mk_incomps :: [CoAxBranch] -> CoAxBranch -> [CoAxBranch]+    mk_incomps prev_brs cur_br+       = filter (not . compatibleBranches cur_br) prev_brs++{-+************************************************************************+*                                                                      *+           Constructing axioms+    These functions are here because tidyType / tcUnifyTysFG+    are not available in CoAxiom++    Also computeAxiomIncomps is too sophisticated for CoAxiom+*                                                                      *+************************************************************************++Note [Tidy axioms when we build them]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Like types and classes, we build axioms fully quantified over all+their variables, and tidy them when we build them. For example,+we print out axioms and don't want to print stuff like+    F k k a b = ...+Instead we must tidy those kind variables.  See #7524.++We could instead tidy when we print, but that makes it harder to get+things like injectivity errors to come out right. Danger of+     Type family equation violates injectivity annotation.+     Kind variable ‘k’ cannot be inferred from the right-hand side.+     In the type family equation:+        PolyKindVars @[k1] @[k2] ('[] @k1) = '[] @k2++Note [Always number wildcard types in CoAxBranch]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider the following example (from the DataFamilyInstanceLHS test case):++  data family Sing (a :: k)+  data instance Sing (_ :: MyKind) where+      SingA :: Sing A+      SingB :: Sing B++If we're not careful during tidying, then when this program is compiled with+-ddump-types, we'll get the following information:++  COERCION AXIOMS+    axiom DataFamilyInstanceLHS.D:R:SingMyKind_0 ::+      Sing _ = DataFamilyInstanceLHS.R:SingMyKind_ _++It's misleading to have a wildcard type appearing on the RHS like+that. To avoid this issue, when building a CoAxiom (which is what eventually+gets printed above), we tidy all the variables in an env that already contains+'_'. Thus, any variable named '_' will be renamed, giving us the nicer output+here:++  COERCION AXIOMS+    axiom DataFamilyInstanceLHS.D:R:SingMyKind_0 ::+      Sing _1 = DataFamilyInstanceLHS.R:SingMyKind_ _1++Which is at least legal syntax.++See also Note [CoAxBranch type variables] in CoAxiom; note that we+are tidying (changing OccNames only), not freshening, in accordance with+that Note.+-}++-- all axiom roles are Nominal, as this is only used with type families+mkCoAxBranch :: [TyVar] -- original, possibly stale, tyvars+             -> [TyVar] -- Extra eta tyvars+             -> [CoVar] -- possibly stale covars+             -> [Type]  -- LHS patterns+             -> Type    -- RHS+             -> [Role]+             -> SrcSpan+             -> CoAxBranch+mkCoAxBranch tvs eta_tvs cvs lhs rhs roles loc+  = CoAxBranch { cab_tvs     = tvs'+               , cab_eta_tvs = eta_tvs'+               , cab_cvs     = cvs'+               , cab_lhs     = tidyTypes env lhs+               , cab_roles   = roles+               , cab_rhs     = tidyType env rhs+               , cab_loc     = loc+               , cab_incomps = placeHolderIncomps }+  where+    (env1, tvs')     = tidyVarBndrs init_tidy_env tvs+    (env2, eta_tvs') = tidyVarBndrs env1          eta_tvs+    (env,  cvs')     = tidyVarBndrs env2          cvs+    -- See Note [Tidy axioms when we build them]+    -- See also Note [CoAxBranch type variables] in CoAxiom++    init_occ_env = initTidyOccEnv [mkTyVarOcc "_"]+    init_tidy_env = mkEmptyTidyEnv init_occ_env+    -- See Note [Always number wildcard types in CoAxBranch]++-- all of the following code is here to avoid mutual dependencies with+-- Coercion+mkBranchedCoAxiom :: Name -> TyCon -> [CoAxBranch] -> CoAxiom Branched+mkBranchedCoAxiom ax_name fam_tc branches+  = CoAxiom { co_ax_unique   = nameUnique ax_name+            , co_ax_name     = ax_name+            , co_ax_tc       = fam_tc+            , co_ax_role     = Nominal+            , co_ax_implicit = False+            , co_ax_branches = manyBranches (computeAxiomIncomps branches) }++mkUnbranchedCoAxiom :: Name -> TyCon -> CoAxBranch -> CoAxiom Unbranched+mkUnbranchedCoAxiom ax_name fam_tc branch+  = CoAxiom { co_ax_unique   = nameUnique ax_name+            , co_ax_name     = ax_name+            , co_ax_tc       = fam_tc+            , co_ax_role     = Nominal+            , co_ax_implicit = False+            , co_ax_branches = unbranched (branch { cab_incomps = [] }) }++mkSingleCoAxiom :: Role -> Name+                -> [TyVar] -> [TyVar] -> [CoVar]+                -> TyCon -> [Type] -> Type+                -> CoAxiom Unbranched+-- Make a single-branch CoAxiom, incluidng making the branch itself+-- Used for both type family (Nominal) and data family (Representational)+-- axioms, hence passing in the Role+mkSingleCoAxiom role ax_name tvs eta_tvs cvs fam_tc lhs_tys rhs_ty+  = CoAxiom { co_ax_unique   = nameUnique ax_name+            , co_ax_name     = ax_name+            , co_ax_tc       = fam_tc+            , co_ax_role     = role+            , co_ax_implicit = False+            , co_ax_branches = unbranched (branch { cab_incomps = [] }) }+  where+    branch = mkCoAxBranch tvs eta_tvs cvs lhs_tys rhs_ty+                          (map (const Nominal) tvs)+                          (getSrcSpan ax_name)++-- | Create a coercion constructor (axiom) suitable for the given+--   newtype 'TyCon'. The 'Name' should be that of a new coercion+--   'CoAxiom', the 'TyVar's the arguments expected by the @newtype@ and+--   the type the appropriate right hand side of the @newtype@, with+--   the free variables a subset of those 'TyVar's.+mkNewTypeCoAxiom :: Name -> TyCon -> [TyVar] -> [Role] -> Type -> CoAxiom Unbranched+mkNewTypeCoAxiom name tycon tvs roles rhs_ty+  = CoAxiom { co_ax_unique   = nameUnique name+            , co_ax_name     = name+            , co_ax_implicit = True  -- See Note [Implicit axioms] in TyCon+            , co_ax_role     = Representational+            , co_ax_tc       = tycon+            , co_ax_branches = unbranched (branch { cab_incomps = [] }) }+  where+    branch = mkCoAxBranch tvs [] [] (mkTyVarTys tvs) rhs_ty+                          roles (getSrcSpan name)++{-+************************************************************************+*                                                                      *+                Looking up a family instance+*                                                                      *+************************************************************************++@lookupFamInstEnv@ looks up in a @FamInstEnv@, using a one-way match.+Multiple matches are only possible in case of type families (not data+families), and then, it doesn't matter which match we choose (as the+instances are guaranteed confluent).++We return the matching family instances and the type instance at which it+matches.  For example, if we lookup 'T [Int]' and have a family instance++  data instance T [a] = ..++desugared to++  data :R42T a = ..+  coe :Co:R42T a :: T [a] ~ :R42T a++we return the matching instance '(FamInst{.., fi_tycon = :R42T}, Int)'.+-}++-- when matching a type family application, we get a FamInst,+-- and the list of types the axiom should be applied to+data FamInstMatch = FamInstMatch { fim_instance :: FamInst+                                 , fim_tys      :: [Type]+                                 , fim_cos      :: [Coercion]+                                 }+  -- See Note [Over-saturated matches]++instance Outputable FamInstMatch where+  ppr (FamInstMatch { fim_instance = inst+                    , fim_tys      = tys+                    , fim_cos      = cos })+    = text "match with" <+> parens (ppr inst) <+> ppr tys <+> ppr cos++lookupFamInstEnvByTyCon :: FamInstEnvs -> TyCon -> [FamInst]+lookupFamInstEnvByTyCon (pkg_ie, home_ie) fam_tc+  = get pkg_ie ++ get home_ie+  where+    get ie = case lookupUDFM ie fam_tc of+               Nothing          -> []+               Just (FamIE fis) -> fis++lookupFamInstEnv+    :: FamInstEnvs+    -> TyCon -> [Type]          -- What we are looking for+    -> [FamInstMatch]           -- Successful matches+-- Precondition: the tycon is saturated (or over-saturated)++lookupFamInstEnv+   = lookup_fam_inst_env match+   where+     match _ _ tpl_tys tys = tcMatchTys tpl_tys tys++lookupFamInstEnvConflicts+    :: FamInstEnvs+    -> FamInst          -- Putative new instance+    -> [FamInstMatch]   -- Conflicting matches (don't look at the fim_tys field)+-- E.g. when we are about to add+--    f : type instance F [a] = a->a+-- we do (lookupFamInstConflicts f [b])+-- to find conflicting matches+--+-- Precondition: the tycon is saturated (or over-saturated)++lookupFamInstEnvConflicts envs fam_inst@(FamInst { fi_axiom = new_axiom })+  = lookup_fam_inst_env my_unify envs fam tys+  where+    (fam, tys) = famInstSplitLHS fam_inst+        -- In example above,   fam tys' = F [b]++    my_unify (FamInst { fi_axiom = old_axiom }) tpl_tvs tpl_tys _+       = ASSERT2( tyCoVarsOfTypes tys `disjointVarSet` tpl_tvs,+                  (ppr fam <+> ppr tys) $$+                  (ppr tpl_tvs <+> ppr tpl_tys) )+                -- Unification will break badly if the variables overlap+                -- They shouldn't because we allocate separate uniques for them+         if compatibleBranches (coAxiomSingleBranch old_axiom) new_branch+           then Nothing+           else Just noSubst+      -- Note [Family instance overlap conflicts]++    noSubst = panic "lookupFamInstEnvConflicts noSubst"+    new_branch = coAxiomSingleBranch new_axiom++--------------------------------------------------------------------------------+--                 Type family injectivity checking bits                      --+--------------------------------------------------------------------------------++{- Note [Verifying injectivity annotation]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Injectivity means that the RHS of a type family uniquely determines the LHS (see+Note [Type inference for type families with injectivity]).  User informs about+injectivity using an injectivity annotation and it is GHC's task to verify that+that annotation is correct wrt. to type family equations. Whenever we see a new+equation of a type family we need to make sure that adding this equation to+already known equations of a type family does not violate injectivity annotation+supplied by the user (see Note [Injectivity annotation]).  Of course if the type+family has no injectivity annotation then no check is required.  But if a type+family has injectivity annotation we need to make sure that the following+conditions hold:++1. For each pair of *different* equations of a type family, one of the following+   conditions holds:++   A:  RHSs are different.++   B1: OPEN TYPE FAMILIES: If the RHSs can be unified under some substitution+       then it must be possible to unify the LHSs under the same substitution.+       Example:++          type family FunnyId a = r | r -> a+          type instance FunnyId Int = Int+          type instance FunnyId a = a++       RHSs of these two equations unify under [ a |-> Int ] substitution.+       Under this substitution LHSs are equal therefore these equations don't+       violate injectivity annotation.++   B2: CLOSED TYPE FAMILIES: If the RHSs can be unified under some+       substitution then either the LHSs unify under the same substitution or+       the LHS of the latter equation is overlapped by earlier equations.+       Example 1:++          type family SwapIntChar a = r | r -> a where+              SwapIntChar Int  = Char+              SwapIntChar Char = Int+              SwapIntChar a    = a++       Say we are checking the last two equations. RHSs unify under [ a |->+       Int ] substitution but LHSs don't. So we apply the substitution to LHS+       of last equation and check whether it is overlapped by any of previous+       equations. Since it is overlapped by the first equation we conclude+       that pair of last two equations does not violate injectivity+       annotation.++   A special case of B is when RHSs unify with an empty substitution ie. they+   are identical.++   If any of the above two conditions holds we conclude that the pair of+   equations does not violate injectivity annotation. But if we find a pair+   of equations where neither of the above holds we report that this pair+   violates injectivity annotation because for a given RHS we don't have a+   unique LHS. (Note that (B) actually implies (A).)++   Note that we only take into account these LHS patterns that were declared+   as injective.++2. If a RHS of a type family equation is a bare type variable then+   all LHS variables (including implicit kind variables) also have to be bare.+   In other words, this has to be a sole equation of that type family and it has+   to cover all possible patterns.  So for example this definition will be+   rejected:++      type family W1 a = r | r -> a+      type instance W1 [a] = a++   If it were accepted we could call `W1 [W1 Int]`, which would reduce to+   `W1 Int` and then by injectivity we could conclude that `[W1 Int] ~ Int`,+   which is bogus.++3. If a RHS of a type family equation is a type family application then the type+   family is rejected as not injective.++4. If a LHS type variable that is declared as injective is not mentioned on+   injective position in the RHS then the type family is rejected as not+   injective.  "Injective position" means either an argument to a type+   constructor or argument to a type family on injective position.++See also Note [Injective type families] in TyCon+-}+++-- | Check whether an open type family equation can be added to already existing+-- instance environment without causing conflicts with supplied injectivity+-- annotations.  Returns list of conflicting axioms (type instance+-- declarations).+lookupFamInstEnvInjectivityConflicts+    :: [Bool]         -- injectivity annotation for this type family instance+                      -- INVARIANT: list contains at least one True value+    ->  FamInstEnvs   -- all type instances seens so far+    ->  FamInst       -- new type instance that we're checking+    -> [CoAxBranch]   -- conflicting instance declarations+lookupFamInstEnvInjectivityConflicts injList (pkg_ie, home_ie)+                             fam_inst@(FamInst { fi_axiom = new_axiom })+  -- See Note [Verifying injectivity annotation]. This function implements+  -- check (1.B1) for open type families described there.+  = lookup_inj_fam_conflicts home_ie ++ lookup_inj_fam_conflicts pkg_ie+    where+      fam        = famInstTyCon fam_inst+      new_branch = coAxiomSingleBranch new_axiom++      -- filtering function used by `lookup_inj_fam_conflicts` to check whether+      -- a pair of equations conflicts with the injectivity annotation.+      isInjConflict (FamInst { fi_axiom = old_axiom })+          | InjectivityAccepted <-+            injectiveBranches injList (coAxiomSingleBranch old_axiom) new_branch+          = False -- no conflict+          | otherwise = True++      lookup_inj_fam_conflicts ie+          | isOpenFamilyTyCon fam, Just (FamIE insts) <- lookupUDFM ie fam+          = map (coAxiomSingleBranch . fi_axiom) $+            filter isInjConflict insts+          | otherwise = []+++--------------------------------------------------------------------------------+--                    Type family overlap checking bits                       --+--------------------------------------------------------------------------------++{-+Note [Family instance overlap conflicts]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+- In the case of data family instances, any overlap is fundamentally a+  conflict (as these instances imply injective type mappings).++- In the case of type family instances, overlap is admitted as long as+  the right-hand sides of the overlapping rules coincide under the+  overlap substitution.  eg+       type instance F a Int = a+       type instance F Int b = b+  These two overlap on (F Int Int) but then both RHSs are Int,+  so all is well. We require that they are syntactically equal;+  anything else would be difficult to test for at this stage.+-}++------------------------------------------------------------+-- Might be a one-way match or a unifier+type MatchFun =  FamInst                -- The FamInst template+              -> TyVarSet -> [Type]     --   fi_tvs, fi_tys of that FamInst+              -> [Type]                 -- Target to match against+              -> Maybe TCvSubst++lookup_fam_inst_env'          -- The worker, local to this module+    :: MatchFun+    -> FamInstEnv+    -> TyCon -> [Type]        -- What we are looking for+    -> [FamInstMatch]+lookup_fam_inst_env' match_fun ie fam match_tys+  | isOpenFamilyTyCon fam+  , Just (FamIE insts) <- lookupUDFM ie fam+  = find insts    -- The common case+  | otherwise = []+  where++    find [] = []+    find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs, fi_cvs = tpl_cvs+                        , fi_tys = tpl_tys }) : rest)+        -- Fast check for no match, uses the "rough match" fields+      | instanceCantMatch rough_tcs mb_tcs+      = find rest++        -- Proper check+      | Just subst <- match_fun item (mkVarSet tpl_tvs) tpl_tys match_tys1+      = (FamInstMatch { fim_instance = item+                      , fim_tys      = substTyVars subst tpl_tvs `chkAppend` match_tys2+                      , fim_cos      = ASSERT( all (isJust . lookupCoVar subst) tpl_cvs )+                                       substCoVars subst tpl_cvs+                      })+        : find rest++        -- No match => try next+      | otherwise+      = find rest+      where+        (rough_tcs, match_tys1, match_tys2) = split_tys tpl_tys++      -- Precondition: the tycon is saturated (or over-saturated)++    -- Deal with over-saturation+    -- See Note [Over-saturated matches]+    split_tys tpl_tys+      | isTypeFamilyTyCon fam+      = pre_rough_split_tys++      | otherwise+      = let (match_tys1, match_tys2) = splitAtList tpl_tys match_tys+            rough_tcs = roughMatchTcs match_tys1+        in (rough_tcs, match_tys1, match_tys2)++    (pre_match_tys1, pre_match_tys2) = splitAt (tyConArity fam) match_tys+    pre_rough_split_tys+      = (roughMatchTcs pre_match_tys1, pre_match_tys1, pre_match_tys2)++lookup_fam_inst_env           -- The worker, local to this module+    :: MatchFun+    -> FamInstEnvs+    -> TyCon -> [Type]        -- What we are looking for+    -> [FamInstMatch]         -- Successful matches++-- Precondition: the tycon is saturated (or over-saturated)++lookup_fam_inst_env match_fun (pkg_ie, home_ie) fam tys+  =  lookup_fam_inst_env' match_fun home_ie fam tys+  ++ lookup_fam_inst_env' match_fun pkg_ie  fam tys++{-+Note [Over-saturated matches]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+It's ok to look up an over-saturated type constructor.  E.g.+     type family F a :: * -> *+     type instance F (a,b) = Either (a->b)++The type instance gives rise to a newtype TyCon (at a higher kind+which you can't do in Haskell!):+     newtype FPair a b = FP (Either (a->b))++Then looking up (F (Int,Bool) Char) will return a FamInstMatch+     (FPair, [Int,Bool,Char])+The "extra" type argument [Char] just stays on the end.++We handle data families and type families separately here:++ * For type families, all instances of a type family must have the+   same arity, so we can precompute the split between the match_tys+   and the overflow tys. This is done in pre_rough_split_tys.++ * For data family instances, though, we need to re-split for each+   instance, because the breakdown might be different for each+   instance.  Why?  Because of eta reduction; see+   Note [Eta reduction for data families].+-}++-- checks if one LHS is dominated by a list of other branches+-- in other words, if an application would match the first LHS, it is guaranteed+-- to match at least one of the others. The RHSs are ignored.+-- This algorithm is conservative:+--   True -> the LHS is definitely covered by the others+--   False -> no information+-- It is currently (Oct 2012) used only for generating errors for+-- inaccessible branches. If these errors go unreported, no harm done.+-- This is defined here to avoid a dependency from CoAxiom to Unify+isDominatedBy :: CoAxBranch -> [CoAxBranch] -> Bool+isDominatedBy branch branches+  = or $ map match branches+    where+      lhs = coAxBranchLHS branch+      match (CoAxBranch { cab_lhs = tys })+        = isJust $ tcMatchTys tys lhs++{-+************************************************************************+*                                                                      *+                Choosing an axiom application+*                                                                      *+************************************************************************++The lookupFamInstEnv function does a nice job for *open* type families,+but we also need to handle closed ones when normalising a type:+-}++reduceTyFamApp_maybe :: FamInstEnvs+                     -> Role              -- Desired role of result coercion+                     -> TyCon -> [Type]+                     -> Maybe (Coercion, Type)+-- Attempt to do a *one-step* reduction of a type-family application+--    but *not* newtypes+-- Works on type-synonym families always; data-families only if+--     the role we seek is representational+-- It does *not* normlise the type arguments first, so this may not+--     go as far as you want. If you want normalised type arguments,+--     use normaliseTcArgs first.+--+-- The TyCon can be oversaturated.+-- Works on both open and closed families+--+-- Always returns a *homogeneous* coercion -- type family reductions are always+-- homogeneous+reduceTyFamApp_maybe envs role tc tys+  | Phantom <- role+  = Nothing++  | case role of+      Representational -> isOpenFamilyTyCon     tc+      _                -> isOpenTypeFamilyTyCon tc+       -- If we seek a representational coercion+       -- (e.g. the call in topNormaliseType_maybe) then we can+       -- unwrap data families as well as type-synonym families;+       -- otherwise only type-synonym families+  , FamInstMatch { fim_instance = FamInst { fi_axiom = ax }+                 , fim_tys      = inst_tys+                 , fim_cos      = inst_cos } : _ <- lookupFamInstEnv envs tc tys+      -- NB: Allow multiple matches because of compatible overlap++  = let co = mkUnbranchedAxInstCo role ax inst_tys inst_cos+        ty = pSnd (coercionKind co)+    in Just (co, ty)++  | Just ax <- isClosedSynFamilyTyConWithAxiom_maybe tc+  , Just (ind, inst_tys, inst_cos) <- chooseBranch ax tys+  = let co = mkAxInstCo role ax ind inst_tys inst_cos+        ty = pSnd (coercionKind co)+    in Just (co, ty)++  | Just ax           <- isBuiltInSynFamTyCon_maybe tc+  , Just (coax,ts,ty) <- sfMatchFam ax tys+  = let co = mkAxiomRuleCo coax (zipWith mkReflCo (coaxrAsmpRoles coax) ts)+    in Just (co, ty)++  | otherwise+  = Nothing++-- The axiom can be oversaturated. (Closed families only.)+chooseBranch :: CoAxiom Branched -> [Type]+             -> Maybe (BranchIndex, [Type], [Coercion])  -- found match, with args+chooseBranch axiom tys+  = do { let num_pats = coAxiomNumPats axiom+             (target_tys, extra_tys) = splitAt num_pats tys+             branches = coAxiomBranches axiom+       ; (ind, inst_tys, inst_cos)+           <- findBranch (unMkBranches branches) target_tys+       ; return ( ind, inst_tys `chkAppend` extra_tys, inst_cos ) }++-- The axiom must *not* be oversaturated+findBranch :: Array BranchIndex CoAxBranch+           -> [Type]+           -> Maybe (BranchIndex, [Type], [Coercion])+    -- coercions relate requested types to returned axiom LHS at role N+findBranch branches target_tys+  = foldr go Nothing (assocs branches)+  where+    go :: (BranchIndex, CoAxBranch)+       -> Maybe (BranchIndex, [Type], [Coercion])+       -> Maybe (BranchIndex, [Type], [Coercion])+    go (index, branch) other+      = let (CoAxBranch { cab_tvs = tpl_tvs, cab_cvs = tpl_cvs+                        , cab_lhs = tpl_lhs+                        , cab_incomps = incomps }) = branch+            in_scope = mkInScopeSet (unionVarSets $+                            map (tyCoVarsOfTypes . coAxBranchLHS) incomps)+            -- See Note [Flattening] below+            flattened_target = flattenTys in_scope target_tys+        in case tcMatchTys tpl_lhs target_tys of+        Just subst -- matching worked. now, check for apartness.+          |  apartnessCheck flattened_target branch+          -> -- matching worked & we're apart from all incompatible branches.+             -- success+             ASSERT( all (isJust . lookupCoVar subst) tpl_cvs )+             Just (index, substTyVars subst tpl_tvs, substCoVars subst tpl_cvs)++        -- failure. keep looking+        _ -> other++-- | Do an apartness check, as described in the "Closed Type Families" paper+-- (POPL '14). This should be used when determining if an equation+-- ('CoAxBranch') of a closed type family can be used to reduce a certain target+-- type family application.+apartnessCheck :: [Type]     -- ^ /flattened/ target arguments. Make sure+                             -- they're flattened! See Note [Flattening].+                             -- (NB: This "flat" is a different+                             -- "flat" than is used in TcFlatten.)+               -> CoAxBranch -- ^ the candidate equation we wish to use+                             -- Precondition: this matches the target+               -> Bool       -- ^ True <=> equation can fire+apartnessCheck flattened_target (CoAxBranch { cab_incomps = incomps })+  = all (isSurelyApart+         . tcUnifyTysFG (const BindMe) flattened_target+         . coAxBranchLHS) incomps+  where+    isSurelyApart SurelyApart = True+    isSurelyApart _           = False++{-+************************************************************************+*                                                                      *+                Looking up a family instance+*                                                                      *+************************************************************************++Note [Normalising types]+~~~~~~~~~~~~~~~~~~~~~~~~+The topNormaliseType function removes all occurrences of type families+and newtypes from the top-level structure of a type. normaliseTcApp does+the type family lookup and is fairly straightforward. normaliseType is+a little more involved.++The complication comes from the fact that a type family might be used in the+kind of a variable bound in a forall. We wish to remove this type family+application, but that means coming up with a fresh variable (with the new+kind). Thus, we need a substitution to be built up as we recur through the+type. However, an ordinary TCvSubst just won't do: when we hit a type variable+whose kind has changed during normalisation, we need both the new type+variable *and* the coercion. We could conjure up a new VarEnv with just this+property, but a usable substitution environment already exists:+LiftingContexts from the liftCoSubst family of functions, defined in Coercion.+A LiftingContext maps a type variable to a coercion and a coercion variable to+a pair of coercions. Let's ignore coercion variables for now. Because the+coercion a type variable maps to contains the destination type (via+coercionKind), we don't need to store that destination type separately. Thus,+a LiftingContext has what we need: a map from type variables to (Coercion,+Type) pairs.++We also benefit because we can piggyback on the liftCoSubstVarBndr function to+deal with binders. However, I had to modify that function to work with this+application. Thus, we now have liftCoSubstVarBndrUsing, which takes+a function used to process the kind of the binder. We don't wish+to lift the kind, but instead normalise it. So, we pass in a callback function+that processes the kind of the binder.++After that brilliant explanation of all this, I'm sure you've forgotten the+dangling reference to coercion variables. What do we do with those? Nothing at+all. The point of normalising types is to remove type family applications, but+there's no sense in removing these from coercions. We would just get back a+new coercion witnessing the equality between the same types as the original+coercion. Because coercions are irrelevant anyway, there is no point in doing+this. So, whenever we encounter a coercion, we just say that it won't change.+That's what the CoercionTy case is doing within normalise_type.++Note [Normalisation and type synonyms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We need to be a bit careful about normalising in the presence of type+synonyms (#13035).  Suppose S is a type synonym, and we have+   S t1 t2+If S is family-free (on its RHS) we can just normalise t1 and t2 and+reconstruct (S t1' t2').   Expanding S could not reveal any new redexes+because type families are saturated.++But if S has a type family on its RHS we expand /before/ normalising+the args t1, t2.  If we normalise t1, t2 first, we'll re-normalise them+after expansion, and that can lead to /exponential/ behavour; see #13035.++Notice, though, that expanding first can in principle duplicate t1,t2,+which might contain redexes. I'm sure you could conjure up an exponential+case by that route too, but it hasn't happened in practice yet!+-}++topNormaliseType :: FamInstEnvs -> Type -> Type+topNormaliseType env ty = case topNormaliseType_maybe env ty of+                            Just (_co, ty') -> ty'+                            Nothing         -> ty++topNormaliseType_maybe :: FamInstEnvs -> Type -> Maybe (Coercion, Type)++-- ^ Get rid of *outermost* (or toplevel)+--      * type function redex+--      * data family redex+--      * newtypes+-- returning an appropriate Representational coercion.  Specifically, if+--   topNormaliseType_maybe env ty = Just (co, ty')+-- then+--   (a) co :: ty ~R ty'+--   (b) ty' is not a newtype, and is not a type-family or data-family redex+--+-- However, ty' can be something like (Maybe (F ty)), where+-- (F ty) is a redex.+--+-- Always operates homogeneously: the returned type has the same kind as the+-- original type, and the returned coercion is always homogeneous.+topNormaliseType_maybe env ty+  = do { ((co, mkind_co), nty) <- topNormaliseTypeX stepper combine ty+       ; return $ case mkind_co of+           MRefl       -> (co, nty)+           MCo kind_co -> let nty_casted = nty `mkCastTy` mkSymCo kind_co+                              final_co   = mkCoherenceRightCo Representational nty+                                                              (mkSymCo kind_co) co+                          in (final_co, nty_casted) }+  where+    stepper = unwrapNewTypeStepper' `composeSteppers` tyFamStepper++    combine (c1, mc1) (c2, mc2) = (c1 `mkTransCo` c2, mc1 `mkTransMCo` mc2)++    unwrapNewTypeStepper' :: NormaliseStepper (Coercion, MCoercionN)+    unwrapNewTypeStepper' rec_nts tc tys+      = mapStepResult (, MRefl) $ unwrapNewTypeStepper rec_nts tc tys++      -- second coercion below is the kind coercion relating the original type's kind+      -- to the normalised type's kind+    tyFamStepper :: NormaliseStepper (Coercion, MCoercionN)+    tyFamStepper rec_nts tc tys  -- Try to step a type/data family+      = let (args_co, ntys, res_co) = normaliseTcArgs env Representational tc tys in+        case reduceTyFamApp_maybe env Representational tc ntys of+          Just (co, rhs) -> NS_Step rec_nts rhs (args_co `mkTransCo` co, MCo res_co)+          _              -> NS_Done++---------------+normaliseTcApp :: FamInstEnvs -> Role -> TyCon -> [Type] -> (Coercion, Type)+-- See comments on normaliseType for the arguments of this function+normaliseTcApp env role tc tys+  = initNormM env role (tyCoVarsOfTypes tys) $+    normalise_tc_app tc tys++-- See Note [Normalising types] about the LiftingContext+normalise_tc_app :: TyCon -> [Type] -> NormM (Coercion, Type)+normalise_tc_app tc tys+  | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys+  , not (isFamFreeTyCon tc)  -- Expand and try again+  = -- A synonym with type families in the RHS+    -- Expand and try again+    -- See Note [Normalisation and type synonyms]+    normalise_type (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys')++  | isFamilyTyCon tc+  = -- A type-family application+    do { env <- getEnv+       ; role <- getRole+       ; (args_co, ntys, res_co) <- normalise_tc_args tc tys+       ; case reduceTyFamApp_maybe env role tc ntys of+           Just (first_co, ty')+             -> do { (rest_co,nty) <- normalise_type ty'+                   ; return (assemble_result role nty+                                             (args_co `mkTransCo` first_co `mkTransCo` rest_co)+                                             res_co) }+           _ -> -- No unique matching family instance exists;+                -- we do not do anything+                return (assemble_result role (mkTyConApp tc ntys) args_co res_co) }++  | otherwise+  = -- A synonym with no type families in the RHS; or data type etc+    -- Just normalise the arguments and rebuild+    do { (args_co, ntys, res_co) <- normalise_tc_args tc tys+       ; role <- getRole+       ; return (assemble_result role (mkTyConApp tc ntys) args_co res_co) }++  where+    assemble_result :: Role       -- r, ambient role in NormM monad+                    -> Type       -- nty, result type, possibly of changed kind+                    -> Coercion   -- orig_ty ~r nty, possibly heterogeneous+                    -> CoercionN  -- typeKind(orig_ty) ~N typeKind(nty)+                    -> (Coercion, Type)   -- (co :: orig_ty ~r nty_casted, nty_casted)+                                          -- where nty_casted has same kind as orig_ty+    assemble_result r nty orig_to_nty kind_co+      = ( final_co, nty_old_kind )+      where+        nty_old_kind = nty `mkCastTy` mkSymCo kind_co+        final_co     = mkCoherenceRightCo r nty (mkSymCo kind_co) orig_to_nty++---------------+-- | Normalise arguments to a tycon+normaliseTcArgs :: FamInstEnvs          -- ^ env't with family instances+                -> Role                 -- ^ desired role of output coercion+                -> TyCon                -- ^ tc+                -> [Type]               -- ^ tys+                -> (Coercion, [Type], CoercionN)+                                        -- ^ co :: tc tys ~ tc new_tys+                                        -- NB: co might not be homogeneous+                                        -- last coercion :: kind(tc tys) ~ kind(tc new_tys)+normaliseTcArgs env role tc tys+  = initNormM env role (tyCoVarsOfTypes tys) $+    normalise_tc_args tc tys++normalise_tc_args :: TyCon -> [Type]             -- tc tys+                  -> NormM (Coercion, [Type], CoercionN)+                  -- (co, new_tys), where+                  -- co :: tc tys ~ tc new_tys; might not be homogeneous+                  -- res_co :: typeKind(tc tys) ~N typeKind(tc new_tys)+normalise_tc_args tc tys+  = do { role <- getRole+       ; (args_cos, nargs, res_co) <- normalise_args (tyConKind tc) (tyConRolesX role tc) tys+       ; return (mkTyConAppCo role tc args_cos, nargs, res_co) }++---------------+normaliseType :: FamInstEnvs+              -> Role  -- desired role of coercion+              -> Type -> (Coercion, Type)+normaliseType env role ty+  = initNormM env role (tyCoVarsOfType ty) $ normalise_type ty++normalise_type :: Type                     -- old type+               -> NormM (Coercion, Type)   -- (coercion, new type), where+                                           -- co :: old-type ~ new_type+-- Normalise the input type, by eliminating *all* type-function redexes+-- but *not* newtypes (which are visible to the programmer)+-- Returns with Refl if nothing happens+-- Does nothing to newtypes+-- The returned coercion *must* be *homogeneous*+-- See Note [Normalising types]+-- Try not to disturb type synonyms if possible++normalise_type ty+  = go ty+  where+    go (TyConApp tc tys) = normalise_tc_app tc tys+    go ty@(LitTy {})     = do { r <- getRole+                              ; return (mkReflCo r ty, ty) }++    go (AppTy ty1 ty2) = go_app_tys ty1 [ty2]++    go ty@(FunTy { ft_arg = ty1, ft_res = ty2 })+      = do { (co1, nty1) <- go ty1+           ; (co2, nty2) <- go ty2+           ; r <- getRole+           ; return (mkFunCo r co1 co2, ty { ft_arg = nty1, ft_res = nty2 }) }+    go (ForAllTy (Bndr tcvar vis) ty)+      = do { (lc', tv', h, ki') <- normalise_var_bndr tcvar+           ; (co, nty)          <- withLC lc' $ normalise_type ty+           ; let tv2 = setTyVarKind tv' ki'+           ; return (mkForAllCo tv' h co, ForAllTy (Bndr tv2 vis) nty) }+    go (TyVarTy tv)    = normalise_tyvar tv+    go (CastTy ty co)+      = do { (nco, nty) <- go ty+           ; lc <- getLC+           ; let co' = substRightCo lc co+           ; return (castCoercionKind nco Nominal ty nty co co'+                    , mkCastTy nty co') }+    go (CoercionTy co)+      = do { lc <- getLC+           ; r <- getRole+           ; let right_co = substRightCo lc co+           ; return ( mkProofIrrelCo r+                         (liftCoSubst Nominal lc (coercionType co))+                         co right_co+                    , mkCoercionTy right_co ) }++    go_app_tys :: Type   -- function+               -> [Type] -- args+               -> NormM (Coercion, Type)+    -- cf. TcFlatten.flatten_app_ty_args+    go_app_tys (AppTy ty1 ty2) tys = go_app_tys ty1 (ty2 : tys)+    go_app_tys fun_ty arg_tys+      = do { (fun_co, nfun) <- go fun_ty+           ; case tcSplitTyConApp_maybe nfun of+               Just (tc, xis) ->+                 do { (second_co, nty) <- go (mkTyConApp tc (xis ++ arg_tys))+                   -- flatten_app_ty_args avoids redundantly processing the xis,+                   -- but that's a much more performance-sensitive function.+                   -- This type normalisation is not called in a loop.+                    ; return (mkAppCos fun_co (map mkNomReflCo arg_tys) `mkTransCo` second_co, nty) }+               Nothing ->+                 do { (args_cos, nargs, res_co) <- normalise_args (typeKind nfun)+                                                                  (repeat Nominal)+                                                                  arg_tys+                    ; role <- getRole+                    ; let nty = mkAppTys nfun nargs+                          nco = mkAppCos fun_co args_cos+                          nty_casted = nty `mkCastTy` mkSymCo res_co+                          final_co = mkCoherenceRightCo role nty (mkSymCo res_co) nco+                    ; return (final_co, nty_casted) } }++normalise_args :: Kind    -- of the function+               -> [Role]  -- roles at which to normalise args+               -> [Type]  -- args+               -> NormM ([Coercion], [Type], Coercion)+-- returns (cos, xis, res_co), where each xi is the normalised+-- version of the corresponding type, each co is orig_arg ~ xi,+-- and the res_co :: kind(f orig_args) ~ kind(f xis)+-- NB: The xis might *not* have the same kinds as the input types,+-- but the resulting application *will* be well-kinded+-- cf. TcFlatten.flatten_args_slow+normalise_args fun_ki roles args+  = do { normed_args <- zipWithM normalise1 roles args+       ; let (xis, cos, res_co) = simplifyArgsWorker ki_binders inner_ki fvs roles normed_args+       ; return (map mkSymCo cos, xis, mkSymCo res_co) }+  where+    (ki_binders, inner_ki) = splitPiTys fun_ki+    fvs = tyCoVarsOfTypes args++    -- flattener conventions are different from ours+    impedance_match :: NormM (Coercion, Type) -> NormM (Type, Coercion)+    impedance_match action = do { (co, ty) <- action+                                ; return (ty, mkSymCo co) }++    normalise1 role ty+      = impedance_match $ withRole role $ normalise_type ty++normalise_tyvar :: TyVar -> NormM (Coercion, Type)+normalise_tyvar tv+  = ASSERT( isTyVar tv )+    do { lc <- getLC+       ; r  <- getRole+       ; return $ case liftCoSubstTyVar lc r tv of+           Just co -> (co, pSnd $ coercionKind co)+           Nothing -> (mkReflCo r ty, ty) }+  where ty = mkTyVarTy tv++normalise_var_bndr :: TyCoVar -> NormM (LiftingContext, TyCoVar, Coercion, Kind)+normalise_var_bndr tcvar+  -- works for both tvar and covar+  = do { lc1 <- getLC+       ; env <- getEnv+       ; let callback lc ki = runNormM (normalise_type ki) env lc Nominal+       ; return $ liftCoSubstVarBndrUsing callback lc1 tcvar }++-- | a monad for the normalisation functions, reading 'FamInstEnvs',+-- a 'LiftingContext', and a 'Role'.+newtype NormM a = NormM { runNormM ::+                            FamInstEnvs -> LiftingContext -> Role -> a }++initNormM :: FamInstEnvs -> Role+          -> TyCoVarSet   -- the in-scope variables+          -> NormM a -> a+initNormM env role vars (NormM thing_inside)+  = thing_inside env lc role+  where+    in_scope = mkInScopeSet vars+    lc       = emptyLiftingContext in_scope++getRole :: NormM Role+getRole = NormM (\ _ _ r -> r)++getLC :: NormM LiftingContext+getLC = NormM (\ _ lc _ -> lc)++getEnv :: NormM FamInstEnvs+getEnv = NormM (\ env _ _ -> env)++withRole :: Role -> NormM a -> NormM a+withRole r thing = NormM $ \ envs lc _old_r -> runNormM thing envs lc r++withLC :: LiftingContext -> NormM a -> NormM a+withLC lc thing = NormM $ \ envs _old_lc r -> runNormM thing envs lc r++instance Monad NormM where+  ma >>= fmb = NormM $ \env lc r ->+               let a = runNormM ma env lc r in+               runNormM (fmb a) env lc r++instance Functor NormM where+  fmap = liftM+instance Applicative NormM where+  pure x = NormM $ \ _ _ _ -> x+  (<*>)  = ap++{-+************************************************************************+*                                                                      *+              Flattening+*                                                                      *+************************************************************************++Note [Flattening]+~~~~~~~~~~~~~~~~~+As described in "Closed type families with overlapping equations"+http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/axioms-extended.pdf+we need to flatten core types before unifying them, when checking for "surely-apart"+against earlier equations of a closed type family.+Flattening means replacing all top-level uses of type functions with+fresh variables, *taking care to preserve sharing*. That is, the type+(Either (F a b) (F a b)) should flatten to (Either c c), never (Either+c d).++Here is a nice example of why it's all necessary:++  type family F a b where+    F Int Bool = Char+    F a   b    = Double+  type family G a         -- open, no instances++How do we reduce (F (G Float) (G Float))? The first equation clearly doesn't match,+while the second equation does. But, before reducing, we must make sure that the+target can never become (F Int Bool). Well, no matter what G Float becomes, it+certainly won't become *both* Int and Bool, so indeed we're safe reducing+(F (G Float) (G Float)) to Double.++This is necessary not only to get more reductions (which we might be+willing to give up on), but for substitutivity. If we have (F x x), we+can see that (F x x) can reduce to Double. So, it had better be the+case that (F blah blah) can reduce to Double, no matter what (blah)+is!  Flattening as done below ensures this.++flattenTys is defined here because of module dependencies.+-}++data FlattenEnv = FlattenEnv { fe_type_map :: TypeMap TyVar+                             , fe_subst    :: TCvSubst }++emptyFlattenEnv :: InScopeSet -> FlattenEnv+emptyFlattenEnv in_scope+  = FlattenEnv { fe_type_map = emptyTypeMap+               , fe_subst    = mkEmptyTCvSubst in_scope }++-- See Note [Flattening]+flattenTys :: InScopeSet -> [Type] -> [Type]+flattenTys in_scope tys = snd $ coreFlattenTys env tys+  where+    -- when we hit a type function, we replace it with a fresh variable+    -- but, we need to make sure that this fresh variable isn't mentioned+    -- *anywhere* in the types we're flattening, even if locally-bound in+    -- a forall. That way, we can ensure consistency both within and outside+    -- of that forall.+    all_in_scope = in_scope `extendInScopeSetSet` allTyCoVarsInTys tys+    env          = emptyFlattenEnv all_in_scope++coreFlattenTys :: FlattenEnv -> [Type] -> (FlattenEnv, [Type])+coreFlattenTys = go []+  where+    go rtys env []         = (env, reverse rtys)+    go rtys env (ty : tys)+      = let (env', ty') = coreFlattenTy env ty in+        go (ty' : rtys) env' tys++coreFlattenTy :: FlattenEnv -> Type -> (FlattenEnv, Type)+coreFlattenTy = go+  where+    go env ty | Just ty' <- coreView ty = go env ty'++    go env (TyVarTy tv)    = (env, substTyVar (fe_subst env) tv)+    go env (AppTy ty1 ty2) = let (env1, ty1') = go env  ty1+                                 (env2, ty2') = go env1 ty2 in+                             (env2, AppTy ty1' ty2')+    go env (TyConApp tc tys)+         -- NB: Don't just check if isFamilyTyCon: this catches *data* families,+         -- which are generative and thus can be preserved during flattening+      | not (isGenerativeTyCon tc Nominal)+      = let (env', tv) = coreFlattenTyFamApp env tc tys in+        (env', mkTyVarTy tv)++      | otherwise+      = let (env', tys') = coreFlattenTys env tys in+        (env', mkTyConApp tc tys')++    go env ty@(FunTy { ft_arg = ty1, ft_res = ty2 })+      = let (env1, ty1') = go env  ty1+            (env2, ty2') = go env1 ty2 in+        (env2, ty { ft_arg = ty1', ft_res = ty2' })++    go env (ForAllTy (Bndr tv vis) ty)+      = let (env1, tv') = coreFlattenVarBndr env tv+            (env2, ty') = go env1 ty in+        (env2, ForAllTy (Bndr tv' vis) ty')++    go env ty@(LitTy {}) = (env, ty)++    go env (CastTy ty co) = let (env1, ty') = go env ty+                                (env2, co') = coreFlattenCo env1 co in+                            (env2, CastTy ty' co')++    go env (CoercionTy co) = let (env', co') = coreFlattenCo env co in+                             (env', CoercionTy co')++-- when flattening, we don't care about the contents of coercions.+-- so, just return a fresh variable of the right (flattened) type+coreFlattenCo :: FlattenEnv -> Coercion -> (FlattenEnv, Coercion)+coreFlattenCo env co+  = (env2, mkCoVarCo covar)+  where+    (env1, kind') = coreFlattenTy env (coercionType co)+    fresh_name    = mkFlattenFreshCoName+    subst1        = fe_subst env1+    in_scope      = getTCvInScope subst1+    covar         = uniqAway in_scope (mkCoVar fresh_name kind')+    env2          = env1 { fe_subst = subst1 `extendTCvInScope` covar }++coreFlattenVarBndr :: FlattenEnv -> TyCoVar -> (FlattenEnv, TyCoVar)+coreFlattenVarBndr env tv+  | kind' `eqType` kind+  = ( env { fe_subst = extendTCvSubst old_subst tv (mkTyCoVarTy tv) }+             -- override any previous binding for tv+    , tv)++  | otherwise+  = let new_tv    = uniqAway (getTCvInScope old_subst) (setVarType tv kind')+        new_subst = extendTCvSubstWithClone old_subst tv new_tv+    in+    (env' { fe_subst = new_subst }, new_tv)+  where+    kind          = varType tv+    (env', kind') = coreFlattenTy env kind+    old_subst     = fe_subst env++coreFlattenTyFamApp :: FlattenEnv+                    -> TyCon         -- type family tycon+                    -> [Type]        -- args+                    -> (FlattenEnv, TyVar)+coreFlattenTyFamApp env fam_tc fam_args+  = case lookupTypeMap type_map fam_ty of+      Just tv -> (env, tv)+              -- we need fresh variables here, but this is called far from+              -- any good source of uniques. So, we just use the fam_tc's unique+              -- and trust uniqAway to avoid clashes. Recall that the in_scope set+              -- contains *all* tyvars, even locally bound ones elsewhere in the+              -- overall type, so this really is fresh.+      Nothing -> let tyvar_name = mkFlattenFreshTyName fam_tc+                     tv = uniqAway (getTCvInScope subst) $+                          mkTyVar tyvar_name (typeKind fam_ty)+                     env' = env { fe_type_map = extendTypeMap type_map fam_ty tv+                                , fe_subst = extendTCvInScope subst tv }+                 in (env', tv)+  where fam_ty   = mkTyConApp fam_tc fam_args+        FlattenEnv { fe_type_map = type_map+                   , fe_subst = subst } = env++-- | Get the set of all type/coercion variables mentioned anywhere in the list+-- of types. These variables are not necessarily free.+allTyCoVarsInTys :: [Type] -> VarSet+allTyCoVarsInTys []       = emptyVarSet+allTyCoVarsInTys (ty:tys) = allTyCoVarsInTy ty `unionVarSet` allTyCoVarsInTys tys++-- | Get the set of all type/coercion variables mentioned anywhere in a type.+allTyCoVarsInTy :: Type -> VarSet+allTyCoVarsInTy = go+  where+    go (TyVarTy tv)      = unitVarSet tv+    go (TyConApp _ tys)  = allTyCoVarsInTys tys+    go (AppTy ty1 ty2)   = (go ty1) `unionVarSet` (go ty2)+    go (FunTy _ ty1 ty2) = (go ty1) `unionVarSet` (go ty2)+    go (ForAllTy (Bndr tv _) ty) = unitVarSet tv     `unionVarSet`+                                   go (tyVarKind tv) `unionVarSet`+                                   go ty+                                   -- Don't remove the tv from the set!+    go (LitTy {})        = emptyVarSet+    go (CastTy ty co)    = go ty `unionVarSet` go_co co+    go (CoercionTy co)   = go_co co++    go_mco MRefl    = emptyVarSet+    go_mco (MCo co) = go_co co++    go_co (Refl ty)             = go ty+    go_co (GRefl _ ty mco)      = go ty `unionVarSet` go_mco mco+    go_co (TyConAppCo _ _ args) = go_cos args+    go_co (AppCo co arg)        = go_co co `unionVarSet` go_co arg+    go_co (ForAllCo tv h co)+      = unionVarSets [unitVarSet tv, go_co co, go_co h]+    go_co (FunCo _ c1 c2)       = go_co c1 `unionVarSet` go_co c2+    go_co (CoVarCo cv)          = unitVarSet cv+    go_co (HoleCo h)            = unitVarSet (coHoleCoVar h)+    go_co (AxiomInstCo _ _ cos) = go_cos cos+    go_co (UnivCo p _ t1 t2)    = go_prov p `unionVarSet` go t1 `unionVarSet` go t2+    go_co (SymCo co)            = go_co co+    go_co (TransCo c1 c2)       = go_co c1 `unionVarSet` go_co c2+    go_co (NthCo _ _ co)        = go_co co+    go_co (LRCo _ co)           = go_co co+    go_co (InstCo co arg)       = go_co co `unionVarSet` go_co arg+    go_co (KindCo co)           = go_co co+    go_co (SubCo co)            = go_co co+    go_co (AxiomRuleCo _ cs)    = go_cos cs++    go_cos = foldr (unionVarSet . go_co) emptyVarSet++    go_prov UnsafeCoerceProv    = emptyVarSet+    go_prov (PhantomProv co)    = go_co co+    go_prov (ProofIrrelProv co) = go_co co+    go_prov (PluginProv _)      = emptyVarSet++mkFlattenFreshTyName :: Uniquable a => a -> Name+mkFlattenFreshTyName unq+  = mkSysTvName (getUnique unq) (fsLit "flt")++mkFlattenFreshCoName :: Name+mkFlattenFreshCoName+  = mkSystemVarName (deriveUnique eqPrimTyConKey 71) (fsLit "flc")
+ compiler/types/InstEnv.hs view
@@ -0,0 +1,1027 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[InstEnv]{Utilities for typechecking instance declarations}++The bits common to TcInstDcls and TcDeriv.+-}++{-# LANGUAGE CPP, DeriveDataTypeable #-}++module InstEnv (+        DFunId, InstMatch, ClsInstLookupResult,+        OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,+        ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances,+        instanceHead, instanceSig, mkLocalInstance, mkImportedInstance,+        instanceDFunId, tidyClsInstDFun, instanceRoughTcs,+        fuzzyClsInstCmp, orphNamesOfClsInst,++        InstEnvs(..), VisibleOrphanModules, InstEnv,+        emptyInstEnv, extendInstEnv,+        deleteFromInstEnv, deleteDFunFromInstEnv,+        identicalClsInstHead,+        extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv, instEnvElts,+        memberInstEnv,+        instIsVisible,+        classInstances, instanceBindFun,+        instanceCantMatch, roughMatchTcs,+        isOverlappable, isOverlapping, isIncoherent+    ) where++#include "HsVersions.h"++import GhcPrelude++import TcType -- InstEnv is really part of the type checker,+              -- and depends on TcType in many ways+import CoreSyn ( IsOrphan(..), isOrphan, chooseOrphanAnchor )+import Module+import Class+import Var+import VarSet+import Name+import NameSet+import Unify+import Outputable+import ErrUtils+import BasicTypes+import UniqDFM+import Util+import Id+import Data.Data        ( Data )+import Data.Maybe       ( isJust, isNothing )++{-+************************************************************************+*                                                                      *+           ClsInst: the data type for type-class instances+*                                                                      *+************************************************************************+-}++-- | A type-class instance. Note that there is some tricky laziness at work+-- here. See Note [ClsInst laziness and the rough-match fields] for more+-- details.+data ClsInst+  = ClsInst {   -- Used for "rough matching"; see+                -- Note [ClsInst laziness and the rough-match fields]+                -- INVARIANT: is_tcs = roughMatchTcs is_tys+               is_cls_nm :: Name        -- ^ Class name+             , is_tcs  :: [Maybe Name]  -- ^ Top of type args++               -- | @is_dfun_name = idName . is_dfun@.+               --+               -- We use 'is_dfun_name' for the visibility check,+               -- 'instIsVisible', which needs to know the 'Module' which the+               -- dictionary is defined in. However, we cannot use the 'Module'+               -- attached to 'is_dfun' since doing so would mean we would+               -- potentially pull in an entire interface file unnecessarily.+               -- This was the cause of #12367.+             , is_dfun_name :: Name++                -- Used for "proper matching"; see Note [Proper-match fields]+             , is_tvs  :: [TyVar]       -- Fresh template tyvars for full match+                                        -- See Note [Template tyvars are fresh]+             , is_cls  :: Class         -- The real class+             , is_tys  :: [Type]        -- Full arg types (mentioning is_tvs)+                -- INVARIANT: is_dfun Id has type+                --      forall is_tvs. (...) => is_cls is_tys+                -- (modulo alpha conversion)++             , is_dfun :: DFunId -- See Note [Haddock assumptions]++             , is_flag :: OverlapFlag   -- See detailed comments with+                                        -- the decl of BasicTypes.OverlapFlag+             , is_orphan :: IsOrphan+    }+  deriving Data++-- | A fuzzy comparison function for class instances, intended for sorting+-- instances before displaying them to the user.+fuzzyClsInstCmp :: ClsInst -> ClsInst -> Ordering+fuzzyClsInstCmp x y =+    stableNameCmp (is_cls_nm x) (is_cls_nm y) `mappend`+    mconcat (map cmp (zip (is_tcs x) (is_tcs y)))+  where+    cmp (Nothing, Nothing) = EQ+    cmp (Nothing, Just _) = LT+    cmp (Just _, Nothing) = GT+    cmp (Just x, Just y) = stableNameCmp x y++isOverlappable, isOverlapping, isIncoherent :: ClsInst -> Bool+isOverlappable i = hasOverlappableFlag (overlapMode (is_flag i))+isOverlapping  i = hasOverlappingFlag  (overlapMode (is_flag i))+isIncoherent   i = hasIncoherentFlag   (overlapMode (is_flag i))++{-+Note [ClsInst laziness and the rough-match fields]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we load 'instance A.C B.T' from A.hi, but suppose that the type B.T is+otherwise unused in the program. Then it's stupid to load B.hi, the data type+declaration for B.T -- and perhaps further instance declarations!++We avoid this as follows:++* is_cls_nm, is_tcs, is_dfun_name are all Names. We can poke them to our heart's+  content.++* Proper-match fields. is_dfun, and its related fields is_tvs, is_cls, is_tys+  contain TyVars, Class, Type, Class etc, and so are all lazy thunks. When we+  poke any of these fields we'll typecheck the DFunId declaration, and hence+  pull in interfaces that it refers to. See Note [Proper-match fields].++* Rough-match fields. During instance lookup, we use the is_cls_nm :: Name and+  is_tcs :: [Maybe Name] fields to perform a "rough match", *without* poking+  inside the DFunId. The rough-match fields allow us to say "definitely does not+  match", based only on Names.++  This laziness is very important; see #12367. Try hard to avoid pulling on+  the structured fields unless you really need the instance.++* Another place to watch is InstEnv.instIsVisible, which needs the module to+  which the ClsInst belongs. We can get this from is_dfun_name.++* In is_tcs,+    Nothing  means that this type arg is a type variable++    (Just n) means that this type arg is a+                TyConApp with a type constructor of n.+                This is always a real tycon, never a synonym!+                (Two different synonyms might match, but two+                different real tycons can't.)+                NB: newtypes are not transparent, though!+-}++{-+Note [Template tyvars are fresh]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The is_tvs field of a ClsInst has *completely fresh* tyvars.+That is, they are+  * distinct from any other ClsInst+  * distinct from any tyvars free in predicates that may+    be looked up in the class instance environment+Reason for freshness: we use unification when checking for overlap+etc, and that requires the tyvars to be distinct.++The invariant is checked by the ASSERT in lookupInstEnv'.++Note [Proper-match fields]+~~~~~~~~~~~~~~~~~~~~~~~~~+The is_tvs, is_cls, is_tys fields are simply cached values, pulled+out (lazily) from the dfun id. They are cached here simply so+that we don't need to decompose the DFunId each time we want+to match it.  The hope is that the rough-match fields mean+that we often never poke the proper-match fields.++However, note that:+ * is_tvs must be a superset of the free vars of is_tys++ * is_tvs, is_tys may be alpha-renamed compared to the ones in+   the dfun Id++Note [Haddock assumptions]+~~~~~~~~~~~~~~~~~~~~~~~~~~+For normal user-written instances, Haddock relies on++ * the SrcSpan of+ * the Name of+ * the is_dfun of+ * an Instance++being equal to++  * the SrcSpan of+  * the instance head type of+  * the InstDecl used to construct the Instance.+-}++instanceDFunId :: ClsInst -> DFunId+instanceDFunId = is_dfun++tidyClsInstDFun :: (DFunId -> DFunId) -> ClsInst -> ClsInst+tidyClsInstDFun tidy_dfun ispec+  = ispec { is_dfun = tidy_dfun (is_dfun ispec) }++instanceRoughTcs :: ClsInst -> [Maybe Name]+instanceRoughTcs = is_tcs+++instance NamedThing ClsInst where+   getName ispec = getName (is_dfun ispec)++instance Outputable ClsInst where+   ppr = pprInstance++pprInstance :: ClsInst -> SDoc+-- Prints the ClsInst as an instance declaration+pprInstance ispec+  = hang (pprInstanceHdr ispec)+       2 (vcat [ text "--" <+> pprDefinedAt (getName ispec)+               , whenPprDebug (ppr (is_dfun ispec)) ])++-- * pprInstanceHdr is used in VStudio to populate the ClassView tree+pprInstanceHdr :: ClsInst -> SDoc+-- Prints the ClsInst as an instance declaration+pprInstanceHdr (ClsInst { is_flag = flag, is_dfun = dfun })+  = text "instance" <+> ppr flag <+> pprSigmaType (idType dfun)++pprInstances :: [ClsInst] -> SDoc+pprInstances ispecs = vcat (map pprInstance ispecs)++instanceHead :: ClsInst -> ([TyVar], Class, [Type])+-- Returns the head, using the fresh tyavs from the ClsInst+instanceHead (ClsInst { is_tvs = tvs, is_tys = tys, is_dfun = dfun })+   = (tvs, cls, tys)+   where+     (_, _, cls, _) = tcSplitDFunTy (idType dfun)++-- | Collects the names of concrete types and type constructors that make+-- up the head of a class instance. For instance, given `class Foo a b`:+--+-- `instance Foo (Either (Maybe Int) a) Bool` would yield+--      [Either, Maybe, Int, Bool]+--+-- Used in the implementation of ":info" in GHCi.+--+-- The 'tcSplitSigmaTy' is because of+--      instance Foo a => Baz T where ...+-- The decl is an orphan if Baz and T are both not locally defined,+--      even if Foo *is* locally defined+orphNamesOfClsInst :: ClsInst -> NameSet+orphNamesOfClsInst (ClsInst { is_cls_nm = cls_nm, is_tys = tys })+  = orphNamesOfTypes tys `unionNameSet` unitNameSet cls_nm++instanceSig :: ClsInst -> ([TyVar], [Type], Class, [Type])+-- Decomposes the DFunId+instanceSig ispec = tcSplitDFunTy (idType (is_dfun ispec))++mkLocalInstance :: DFunId -> OverlapFlag+                -> [TyVar] -> Class -> [Type]+                -> ClsInst+-- Used for local instances, where we can safely pull on the DFunId.+-- Consider using newClsInst instead; this will also warn if+-- the instance is an orphan.+mkLocalInstance dfun oflag tvs cls tys+  = ClsInst { is_flag = oflag, is_dfun = dfun+            , is_tvs = tvs+            , is_dfun_name = dfun_name+            , is_cls = cls, is_cls_nm = cls_name+            , is_tys = tys, is_tcs = roughMatchTcs tys+            , is_orphan = orph+            }+  where+    cls_name = className cls+    dfun_name = idName dfun+    this_mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name+    is_local name = nameIsLocalOrFrom this_mod name++        -- Compute orphanhood.  See Note [Orphans] in InstEnv+    (cls_tvs, fds) = classTvsFds cls+    arg_names = [filterNameSet is_local (orphNamesOfType ty) | ty <- tys]++    -- See Note [When exactly is an instance decl an orphan?]+    orph | is_local cls_name = NotOrphan (nameOccName cls_name)+         | all notOrphan mb_ns  = ASSERT( not (null mb_ns) ) head mb_ns+         | otherwise         = IsOrphan++    notOrphan NotOrphan{} = True+    notOrphan _ = False++    mb_ns :: [IsOrphan]    -- One for each fundep; a locally-defined name+                           -- that is not in the "determined" arguments+    mb_ns | null fds   = [choose_one arg_names]+          | otherwise  = map do_one fds+    do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- cls_tvs `zip` arg_names+                                            , not (tv `elem` rtvs)]++    choose_one nss = chooseOrphanAnchor (unionNameSets nss)++mkImportedInstance :: Name         -- ^ the name of the class+                   -> [Maybe Name] -- ^ the types which the class was applied to+                   -> Name         -- ^ the 'Name' of the dictionary binding+                   -> DFunId       -- ^ the 'Id' of the dictionary.+                   -> OverlapFlag  -- ^ may this instance overlap?+                   -> IsOrphan     -- ^ is this instance an orphan?+                   -> ClsInst+-- Used for imported instances, where we get the rough-match stuff+-- from the interface file+-- The bound tyvars of the dfun are guaranteed fresh, because+-- the dfun has been typechecked out of the same interface file+mkImportedInstance cls_nm mb_tcs dfun_name dfun oflag orphan+  = ClsInst { is_flag = oflag, is_dfun = dfun+            , is_tvs = tvs, is_tys = tys+            , is_dfun_name = dfun_name+            , is_cls_nm = cls_nm, is_cls = cls, is_tcs = mb_tcs+            , is_orphan = orphan }+  where+    (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)++{-+Note [When exactly is an instance decl an orphan?]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+  (see MkIface.instanceToIfaceInst, which implements this)+Roughly speaking, an instance is an orphan if its head (after the =>)+mentions nothing defined in this module.++Functional dependencies complicate the situation though. Consider++  module M where { class C a b | a -> b }++and suppose we are compiling module X:++  module X where+        import M+        data T = ...+        instance C Int T where ...++This instance is an orphan, because when compiling a third module Y we+might get a constraint (C Int v), and we'd want to improve v to T.  So+we must make sure X's instances are loaded, even if we do not directly+use anything from X.++More precisely, an instance is an orphan iff++  If there are no fundeps, then at least of the names in+  the instance head is locally defined.++  If there are fundeps, then for every fundep, at least one of the+  names free in a *non-determined* part of the instance head is+  defined in this module.++(Note that these conditions hold trivially if the class is locally+defined.)+++************************************************************************+*                                                                      *+                InstEnv, ClsInstEnv+*                                                                      *+************************************************************************++A @ClsInstEnv@ all the instances of that class.  The @Id@ inside a+ClsInstEnv mapping is the dfun for that instance.++If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then++        forall a b, C t1 t2 t3  can be constructed by dfun++or, to put it another way, we have++        instance (...) => C t1 t2 t3,  witnessed by dfun+-}++---------------------------------------------------+{-+Note [InstEnv determinism]+~~~~~~~~~~~~~~~~~~~~~~~~~~+We turn InstEnvs into a list in some places that don't directly affect+the ABI. That happens when we create output for `:info`.+Unfortunately that nondeterminism is nonlocal and it's hard to tell what it+affects without following a chain of functions. It's also easy to accidentally+make that nondeterminism affect the ABI. Furthermore the envs should be+relatively small, so it should be free to use deterministic maps here.+Testing with nofib and validate detected no difference between UniqFM and+UniqDFM. See also Note [Deterministic UniqFM]+-}++type InstEnv = UniqDFM ClsInstEnv      -- Maps Class to instances for that class+  -- See Note [InstEnv determinism]++-- | 'InstEnvs' represents the combination of the global type class instance+-- environment, the local type class instance environment, and the set of+-- transitively reachable orphan modules (according to what modules have been+-- directly imported) used to test orphan instance visibility.+data InstEnvs = InstEnvs {+        ie_global  :: InstEnv,               -- External-package instances+        ie_local   :: InstEnv,               -- Home-package instances+        ie_visible :: VisibleOrphanModules   -- Set of all orphan modules transitively+                                             -- reachable from the module being compiled+                                             -- See Note [Instance lookup and orphan instances]+    }++-- | Set of visible orphan modules, according to what modules have been directly+-- imported.  This is based off of the dep_orphs field, which records+-- transitively reachable orphan modules (modules that define orphan instances).+type VisibleOrphanModules = ModuleSet++newtype ClsInstEnv+  = ClsIE [ClsInst]    -- The instances for a particular class, in any order++instance Outputable ClsInstEnv where+  ppr (ClsIE is) = pprInstances is++-- INVARIANTS:+--  * The is_tvs are distinct in each ClsInst+--      of a ClsInstEnv (so we can safely unify them)++-- Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:+--      [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]+-- The "a" in the pattern must be one of the forall'd variables in+-- the dfun type.++emptyInstEnv :: InstEnv+emptyInstEnv = emptyUDFM++instEnvElts :: InstEnv -> [ClsInst]+instEnvElts ie = [elt | ClsIE elts <- eltsUDFM ie, elt <- elts]+  -- See Note [InstEnv determinism]++-- | Test if an instance is visible, by checking that its origin module+-- is in 'VisibleOrphanModules'.+-- See Note [Instance lookup and orphan instances]+instIsVisible :: VisibleOrphanModules -> ClsInst -> Bool+instIsVisible vis_mods ispec+  -- NB: Instances from the interactive package always are visible. We can't+  -- add interactive modules to the set since we keep creating new ones+  -- as a GHCi session progresses.+  = case nameModule_maybe (is_dfun_name ispec) of+      Nothing -> True+      Just mod | isInteractiveModule mod     -> True+               | IsOrphan <- is_orphan ispec -> mod `elemModuleSet` vis_mods+               | otherwise                   -> True++classInstances :: InstEnvs -> Class -> [ClsInst]+classInstances (InstEnvs { ie_global = pkg_ie, ie_local = home_ie, ie_visible = vis_mods }) cls+  = get home_ie ++ get pkg_ie+  where+    get env = case lookupUDFM env cls of+                Just (ClsIE insts) -> filter (instIsVisible vis_mods) insts+                Nothing            -> []++-- | Checks for an exact match of ClsInst in the instance environment.+-- We use this when we do signature checking in TcRnDriver+memberInstEnv :: InstEnv -> ClsInst -> Bool+memberInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm } ) =+    maybe False (\(ClsIE items) -> any (identicalDFunType ins_item) items)+          (lookupUDFM inst_env cls_nm)+ where+  identicalDFunType cls1 cls2 =+    eqType (varType (is_dfun cls1)) (varType (is_dfun cls2))++extendInstEnvList :: InstEnv -> [ClsInst] -> InstEnv+extendInstEnvList inst_env ispecs = foldl' extendInstEnv inst_env ispecs++extendInstEnv :: InstEnv -> ClsInst -> InstEnv+extendInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm })+  = addToUDFM_C add inst_env cls_nm (ClsIE [ins_item])+  where+    add (ClsIE cur_insts) _ = ClsIE (ins_item : cur_insts)++deleteFromInstEnv :: InstEnv -> ClsInst -> InstEnv+deleteFromInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm })+  = adjustUDFM adjust inst_env cls_nm+  where+    adjust (ClsIE items) = ClsIE (filterOut (identicalClsInstHead ins_item) items)++deleteDFunFromInstEnv :: InstEnv -> DFunId -> InstEnv+-- Delete a specific instance fron an InstEnv+deleteDFunFromInstEnv inst_env dfun+  = adjustUDFM adjust inst_env cls+  where+    (_, _, cls, _) = tcSplitDFunTy (idType dfun)+    adjust (ClsIE items) = ClsIE (filterOut same_dfun items)+    same_dfun (ClsInst { is_dfun = dfun' }) = dfun == dfun'++identicalClsInstHead :: ClsInst -> ClsInst -> Bool+-- ^ True when when the instance heads are the same+-- e.g.  both are   Eq [(a,b)]+-- Used for overriding in GHCi+-- Obviously should be insenstive to alpha-renaming+identicalClsInstHead (ClsInst { is_cls_nm = cls_nm1, is_tcs = rough1, is_tys = tys1 })+                     (ClsInst { is_cls_nm = cls_nm2, is_tcs = rough2, is_tys = tys2 })+  =  cls_nm1 == cls_nm2+  && not (instanceCantMatch rough1 rough2)  -- Fast check for no match, uses the "rough match" fields+  && isJust (tcMatchTys tys1 tys2)+  && isJust (tcMatchTys tys2 tys1)++{-+************************************************************************+*                                                                      *+        Looking up an instance+*                                                                      *+************************************************************************++@lookupInstEnv@ looks up in a @InstEnv@, using a one-way match.  Since+the env is kept ordered, the first match must be the only one.  The+thing we are looking up can have an arbitrary "flexi" part.++Note [Instance lookup and orphan instances]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we are compiling a module M, and we have a zillion packages+loaded, and we are looking up an instance for C (T W).  If we find a+match in module 'X' from package 'p', should be "in scope"; that is,++  is p:X in the transitive closure of modules imported from M?++The difficulty is that the "zillion packages" might include ones loaded+through earlier invocations of the GHC API, or earlier module loads in GHCi.+They might not be in the dependencies of M itself; and if not, the instances+in them should not be visible.  #2182, #8427.++There are two cases:+  * If the instance is *not an orphan*, then module X defines C, T, or W.+    And in order for those types to be involved in typechecking M, it+    must be that X is in the transitive closure of M's imports.  So we+    can use the instance.++  * If the instance *is an orphan*, the above reasoning does not apply.+    So we keep track of the set of orphan modules transitively below M;+    this is the ie_visible field of InstEnvs, of type VisibleOrphanModules.++    If module p:X is in this set, then we can use the instance, otherwise+    we can't.++Note [Rules for instance lookup]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+These functions implement the carefully-written rules in the user+manual section on "overlapping instances". At risk of duplication,+here are the rules.  If the rules change, change this text and the+user manual simultaneously.  The link may be this:+http://www.haskell.org/ghc/docs/latest/html/users_guide/glasgow_exts.html#instance-overlap++The willingness to be overlapped or incoherent is a property of the+instance declaration itself, controlled as follows:++ * An instance is "incoherent"+   if it has an INCOHERENT pragma, or+   if it appears in a module compiled with -XIncoherentInstances.++ * An instance is "overlappable"+   if it has an OVERLAPPABLE or OVERLAPS pragma, or+   if it appears in a module compiled with -XOverlappingInstances, or+   if the instance is incoherent.++ * An instance is "overlapping"+   if it has an OVERLAPPING or OVERLAPS pragma, or+   if it appears in a module compiled with -XOverlappingInstances, or+   if the instance is incoherent.+     compiled with -XOverlappingInstances.++Now suppose that, in some client module, we are searching for an instance+of the target constraint (C ty1 .. tyn). The search works like this.++*  Find all instances `I` that *match* the target constraint; that is, the+   target constraint is a substitution instance of `I`. These instance+   declarations are the *candidates*.++*  Eliminate any candidate `IX` for which both of the following hold:++   -  There is another candidate `IY` that is strictly more specific; that+      is, `IY` is a substitution instance of `IX` but not vice versa.++   -  Either `IX` is *overlappable*, or `IY` is *overlapping*. (This+      "either/or" design, rather than a "both/and" design, allow a+      client to deliberately override an instance from a library,+      without requiring a change to the library.)++-  If exactly one non-incoherent candidate remains, select it. If all+   remaining candidates are incoherent, select an arbitrary one.+   Otherwise the search fails (i.e. when more than one surviving+   candidate is not incoherent).++-  If the selected candidate (from the previous step) is incoherent, the+   search succeeds, returning that candidate.++-  If not, find all instances that *unify* with the target constraint,+   but do not *match* it. Such non-candidate instances might match when+   the target constraint is further instantiated. If all of them are+   incoherent, the search succeeds, returning the selected candidate; if+   not, the search fails.++Notice that these rules are not influenced by flag settings in the+client module, where the instances are *used*. These rules make it+possible for a library author to design a library that relies on+overlapping instances without the client having to know.++Note [Overlapping instances]   (NB: these notes are quite old)+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Overlap is permitted, but only in such a way that one can make+a unique choice when looking up.  That is, overlap is only permitted if+one template matches the other, or vice versa.  So this is ok:++  [a]  [Int]++but this is not++  (Int,a)  (b,Int)++If overlap is permitted, the list is kept most specific first, so that+the first lookup is the right choice.+++For now we just use association lists.++\subsection{Avoiding a problem with overlapping}++Consider this little program:++\begin{pseudocode}+     class C a        where c :: a+     class C a => D a where d :: a++     instance C Int where c = 17+     instance D Int where d = 13++     instance C a => C [a] where c = [c]+     instance ({- C [a], -} D a) => D [a] where d = c++     instance C [Int] where c = [37]++     main = print (d :: [Int])+\end{pseudocode}++What do you think `main' prints  (assuming we have overlapping instances, and+all that turned on)?  Well, the instance for `D' at type `[a]' is defined to+be `c' at the same type, and we've got an instance of `C' at `[Int]', so the+answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because+the `C [Int]' instance is more specific).++Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong.  That+was easy ;-)  Let's just consult hugs for good measure.  Wait - if I use old+hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it+doesn't even compile!  What's going on!?++What hugs complains about is the `D [a]' instance decl.++\begin{pseudocode}+     ERROR "mj.hs" (line 10): Cannot build superclass instance+     *** Instance            : D [a]+     *** Context supplied    : D a+     *** Required superclass : C [a]+\end{pseudocode}++You might wonder what hugs is complaining about.  It's saying that you+need to add `C [a]' to the context of the `D [a]' instance (as appears+in comments).  But there's that `C [a]' instance decl one line above+that says that I can reduce the need for a `C [a]' instance to the+need for a `C a' instance, and in this case, I already have the+necessary `C a' instance (since we have `D a' explicitly in the+context, and `C' is a superclass of `D').++Unfortunately, the above reasoning indicates a premature commitment to the+generic `C [a]' instance.  I.e., it prematurely rules out the more specific+instance `C [Int]'.  This is the mistake that ghc-4.06 makes.  The fix is to+add the context that hugs suggests (uncomment the `C [a]'), effectively+deferring the decision about which instance to use.++Now, interestingly enough, 4.04 has this same bug, but it's covered up+in this case by a little known `optimization' that was disabled in+4.06.  Ghc-4.04 silently inserts any missing superclass context into+an instance declaration.  In this case, it silently inserts the `C+[a]', and everything happens to work out.++(See `basicTypes/MkId:mkDictFunId' for the code in question.  Search for+`Mark Jones', although Mark claims no credit for the `optimization' in+question, and would rather it stopped being called the `Mark Jones+optimization' ;-)++So, what's the fix?  I think hugs has it right.  Here's why.  Let's try+something else out with ghc-4.04.  Let's add the following line:++    d' :: D a => [a]+    d' = c++Everyone raise their hand who thinks that `d :: [Int]' should give a+different answer from `d' :: [Int]'.  Well, in ghc-4.04, it does.  The+`optimization' only applies to instance decls, not to regular+bindings, giving inconsistent behavior.++Old hugs had this same bug.  Here's how we fixed it: like GHC, the+list of instances for a given class is ordered, so that more specific+instances come before more generic ones.  For example, the instance+list for C might contain:+    ..., C Int, ..., C a, ...+When we go to look for a `C Int' instance we'll get that one first.+But what if we go looking for a `C b' (`b' is unconstrained)?  We'll+pass the `C Int' instance, and keep going.  But if `b' is+unconstrained, then we don't know yet if the more specific instance+will eventually apply.  GHC keeps going, and matches on the generic `C+a'.  The fix is to, at each step, check to see if there's a reverse+match, and if so, abort the search.  This prevents hugs from+prematurely chosing a generic instance when a more specific one+exists.++--Jeff++BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in+this test.  Suppose the instance envt had+    ..., forall a b. C a a b, ..., forall a b c. C a b c, ...+(still most specific first)+Now suppose we are looking for (C x y Int), where x and y are unconstrained.+        C x y Int  doesn't match the template {a,b} C a a b+but neither does+        C a a b  match the template {x,y} C x y Int+But still x and y might subsequently be unified so they *do* match.++Simple story: unify, don't match.+-}++type DFunInstType = Maybe Type+        -- Just ty   => Instantiate with this type+        -- Nothing   => Instantiate with any type of this tyvar's kind+        -- See Note [DFunInstType: instantiating types]++type InstMatch = (ClsInst, [DFunInstType])++type ClsInstLookupResult+     = ( [InstMatch]     -- Successful matches+       , [ClsInst]       -- These don't match but do unify+       , [InstMatch] )   -- Unsafe overlapped instances under Safe Haskell+                         -- (see Note [Safe Haskell Overlapping Instances] in+                         -- TcSimplify).++{-+Note [DFunInstType: instantiating types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A successful match is a ClsInst, together with the types at which+        the dfun_id in the ClsInst should be instantiated+The instantiating types are (Either TyVar Type)s because the dfun+might have some tyvars that *only* appear in arguments+        dfun :: forall a b. C a b, Ord b => D [a]+When we match this against D [ty], we return the instantiating types+        [Just ty, Nothing]+where the 'Nothing' indicates that 'b' can be freely instantiated.+(The caller instantiates it to a flexi type variable, which will+ presumably later become fixed via functional dependencies.)+-}++-- |Look up an instance in the given instance environment. The given class application must match exactly+-- one instance and the match may not contain any flexi type variables.  If the lookup is unsuccessful,+-- yield 'Left errorMessage'.+lookupUniqueInstEnv :: InstEnvs+                    -> Class -> [Type]+                    -> Either MsgDoc (ClsInst, [Type])+lookupUniqueInstEnv instEnv cls tys+  = case lookupInstEnv False instEnv cls tys of+      ([(inst, inst_tys)], _, _)+             | noFlexiVar -> Right (inst, inst_tys')+             | otherwise  -> Left $ text "flexible type variable:" <+>+                                    (ppr $ mkTyConApp (classTyCon cls) tys)+             where+               inst_tys'  = [ty | Just ty <- inst_tys]+               noFlexiVar = all isJust inst_tys+      _other -> Left $ text "instance not found" <+>+                       (ppr $ mkTyConApp (classTyCon cls) tys)++lookupInstEnv' :: InstEnv          -- InstEnv to look in+               -> VisibleOrphanModules   -- But filter against this+               -> Class -> [Type]  -- What we are looking for+               -> ([InstMatch],    -- Successful matches+                   [ClsInst])      -- These don't match but do unify+                                   -- (no incoherent ones in here)+-- The second component of the result pair happens when we look up+--      Foo [a]+-- in an InstEnv that has entries for+--      Foo [Int]+--      Foo [b]+-- Then which we choose would depend on the way in which 'a'+-- is instantiated.  So we report that Foo [b] is a match (mapping b->a)+-- but Foo [Int] is a unifier.  This gives the caller a better chance of+-- giving a suitable error message++lookupInstEnv' ie vis_mods cls tys+  = lookup ie+  where+    rough_tcs  = roughMatchTcs tys+    all_tvs    = all isNothing rough_tcs++    --------------+    lookup env = case lookupUDFM env cls of+                   Nothing -> ([],[])   -- No instances for this class+                   Just (ClsIE insts) -> find [] [] insts++    --------------+    find ms us [] = (ms, us)+    find ms us (item@(ClsInst { is_tcs = mb_tcs, is_tvs = tpl_tvs+                              , is_tys = tpl_tys }) : rest)+      | not (instIsVisible vis_mods item)+      = find ms us rest  -- See Note [Instance lookup and orphan instances]++        -- Fast check for no match, uses the "rough match" fields+      | instanceCantMatch rough_tcs mb_tcs+      = find ms us rest++      | Just subst <- tcMatchTys tpl_tys tys+      = find ((item, map (lookupTyVar subst) tpl_tvs) : ms) us rest++        -- Does not match, so next check whether the things unify+        -- See Note [Overlapping instances]+        -- Ignore ones that are incoherent: Note [Incoherent instances]+      | isIncoherent item+      = find ms us rest++      | otherwise+      = ASSERT2( tyCoVarsOfTypes tys `disjointVarSet` tpl_tv_set,+                 (ppr cls <+> ppr tys <+> ppr all_tvs) $$+                 (ppr tpl_tvs <+> ppr tpl_tys)+                )+                -- Unification will break badly if the variables overlap+                -- They shouldn't because we allocate separate uniques for them+                -- See Note [Template tyvars are fresh]+        case tcUnifyTys instanceBindFun tpl_tys tys of+            Just _   -> find ms (item:us) rest+            Nothing  -> find ms us        rest+      where+        tpl_tv_set = mkVarSet tpl_tvs++---------------+-- This is the common way to call this function.+lookupInstEnv :: Bool              -- Check Safe Haskell overlap restrictions+              -> InstEnvs          -- External and home package inst-env+              -> Class -> [Type]   -- What we are looking for+              -> ClsInstLookupResult+-- ^ See Note [Rules for instance lookup]+-- ^ See Note [Safe Haskell Overlapping Instances] in TcSimplify+-- ^ See Note [Safe Haskell Overlapping Instances Implementation] in TcSimplify+lookupInstEnv check_overlap_safe+              (InstEnvs { ie_global = pkg_ie+                        , ie_local = home_ie+                        , ie_visible = vis_mods })+              cls+              tys+  = -- pprTrace "lookupInstEnv" (ppr cls <+> ppr tys $$ ppr home_ie) $+    (final_matches, final_unifs, unsafe_overlapped)+  where+    (home_matches, home_unifs) = lookupInstEnv' home_ie vis_mods cls tys+    (pkg_matches,  pkg_unifs)  = lookupInstEnv' pkg_ie  vis_mods cls tys+    all_matches = home_matches ++ pkg_matches+    all_unifs   = home_unifs   ++ pkg_unifs+    final_matches = foldr insert_overlapping [] all_matches+        -- Even if the unifs is non-empty (an error situation)+        -- we still prune the matches, so that the error message isn't+        -- misleading (complaining of multiple matches when some should be+        -- overlapped away)++    unsafe_overlapped+       = case final_matches of+           [match] -> check_safe match+           _       -> []++    -- If the selected match is incoherent, discard all unifiers+    final_unifs = case final_matches of+                    (m:_) | isIncoherent (fst m) -> []+                    _                            -> all_unifs++    -- NOTE [Safe Haskell isSafeOverlap]+    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+    -- We restrict code compiled in 'Safe' mode from overriding code+    -- compiled in any other mode. The rationale is that code compiled+    -- in 'Safe' mode is code that is untrusted by the ghc user. So+    -- we shouldn't let that code change the behaviour of code the+    -- user didn't compile in 'Safe' mode since that's the code they+    -- trust. So 'Safe' instances can only overlap instances from the+    -- same module. A same instance origin policy for safe compiled+    -- instances.+    check_safe (inst,_)+        = case check_overlap_safe && unsafeTopInstance inst of+                -- make sure it only overlaps instances from the same module+                True -> go [] all_matches+                -- most specific is from a trusted location.+                False -> []+        where+            go bad [] = bad+            go bad (i@(x,_):unchecked) =+                if inSameMod x || isOverlappable x+                    then go bad unchecked+                    else go (i:bad) unchecked++            inSameMod b =+                let na = getName $ getName inst+                    la = isInternalName na+                    nb = getName $ getName b+                    lb = isInternalName nb+                in (la && lb) || (nameModule na == nameModule nb)++    -- We consider the most specific instance unsafe when it both:+    --   (1) Comes from a module compiled as `Safe`+    --   (2) Is an orphan instance, OR, an instance for a MPTC+    unsafeTopInstance inst = isSafeOverlap (is_flag inst) &&+        (isOrphan (is_orphan inst) || classArity (is_cls inst) > 1)++---------------+insert_overlapping :: InstMatch -> [InstMatch] -> [InstMatch]+-- ^ Add a new solution, knocking out strictly less specific ones+-- See Note [Rules for instance lookup]+insert_overlapping new_item [] = [new_item]+insert_overlapping new_item@(new_inst,_) (old_item@(old_inst,_) : old_items)+  | new_beats_old        -- New strictly overrides old+  , not old_beats_new+  , new_inst `can_override` old_inst+  = insert_overlapping new_item old_items++  | old_beats_new        -- Old strictly overrides new+  , not new_beats_old+  , old_inst `can_override` new_inst+  = old_item : old_items++  -- Discard incoherent instances; see Note [Incoherent instances]+  | isIncoherent old_inst      -- Old is incoherent; discard it+  = insert_overlapping new_item old_items+  | isIncoherent new_inst      -- New is incoherent; discard it+  = old_item : old_items++  -- Equal or incomparable, and neither is incoherent; keep both+  | otherwise+  = old_item : insert_overlapping new_item old_items+  where++    new_beats_old = new_inst `more_specific_than` old_inst+    old_beats_new = old_inst `more_specific_than` new_inst++    -- `instB` can be instantiated to match `instA`+    -- or the two are equal+    instA `more_specific_than` instB+      = isJust (tcMatchTys (is_tys instB) (is_tys instA))++    instA `can_override` instB+       = isOverlapping instA || isOverlappable instB+       -- Overlap permitted if either the more specific instance+       -- is marked as overlapping, or the more general one is+       -- marked as overlappable.+       -- Latest change described in: #9242.+       -- Previous change: #3877, Dec 10.++{-+Note [Incoherent instances]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+For some classes, the choice of a particular instance does not matter, any one+is good. E.g. consider++        class D a b where { opD :: a -> b -> String }+        instance D Int b where ...+        instance D a Int where ...++        g (x::Int) = opD x x  -- Wanted: D Int Int++For such classes this should work (without having to add an "instance D Int+Int", and using -XOverlappingInstances, which would then work). This is what+-XIncoherentInstances is for: Telling GHC "I don't care which instance you use;+if you can use one, use it."++Should this logic only work when *all* candidates have the incoherent flag, or+even when all but one have it? The right choice is the latter, which can be+justified by comparing the behaviour with how -XIncoherentInstances worked when+it was only about the unify-check (note [Overlapping instances]):++Example:+        class C a b c where foo :: (a,b,c)+        instance C [a] b Int+        instance [incoherent] [Int] b c+        instance [incoherent] C a Int c+Thanks to the incoherent flags,+        [Wanted]  C [a] b Int+works: Only instance one matches, the others just unify, but are marked+incoherent.++So I can write+        (foo :: ([a],b,Int)) :: ([Int], Int, Int).+but if that works then I really want to be able to write+        foo :: ([Int], Int, Int)+as well. Now all three instances from above match. None is more specific than+another, so none is ruled out by the normal overlapping rules. One of them is+not incoherent, but we still want this to compile. Hence the+"all-but-one-logic".++The implementation is in insert_overlapping, where we remove matching+incoherent instances as long as there are others.++++************************************************************************+*                                                                      *+        Binding decisions+*                                                                      *+************************************************************************+-}++instanceBindFun :: TyCoVar -> BindFlag+instanceBindFun tv | isOverlappableTyVar tv = Skolem+                   | otherwise              = BindMe+   -- Note [Binding when looking up instances]++{-+Note [Binding when looking up instances]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When looking up in the instance environment, or family-instance environment,+we are careful about multiple matches, as described above in+Note [Overlapping instances]++The key_tys can contain skolem constants, and we can guarantee that those+are never going to be instantiated to anything, so we should not involve+them in the unification test.  Example:+        class Foo a where { op :: a -> Int }+        instance Foo a => Foo [a]       -- NB overlap+        instance Foo [Int]              -- NB overlap+        data T = forall a. Foo a => MkT a+        f :: T -> Int+        f (MkT x) = op [x,x]+The op [x,x] means we need (Foo [a]).  Without the filterVarSet we'd+complain, saying that the choice of instance depended on the instantiation+of 'a'; but of course it isn't *going* to be instantiated.++We do this only for isOverlappableTyVar skolems.  For example we reject+        g :: forall a => [a] -> Int+        g x = op x+on the grounds that the correct instance depends on the instantiation of 'a'+-}
+ compiler/types/Kind.hs view
@@ -0,0 +1,97 @@+-- (c) The University of Glasgow 2006-2012++{-# LANGUAGE CPP #-}+module Kind (+        -- * Main data type+        Kind,++        -- ** Predicates on Kinds+        isLiftedTypeKind, isUnliftedTypeKind,+        isConstraintKindCon,++        classifiesTypeWithValues,+        isKindLevPoly+       ) where++#include "HsVersions.h"++import GhcPrelude++import {-# SOURCE #-} Type    ( coreView )++import TyCoRep+import TyCon+import PrelNames++import Outputable+import Util+import Data.Maybe( isJust )++{-+************************************************************************+*                                                                      *+        Functions over Kinds+*                                                                      *+************************************************************************++Note [Kind Constraint and kind Type]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The kind Constraint is the kind of classes and other type constraints.+The special thing about types of kind Constraint is that+ * They are displayed with double arrow:+     f :: Ord a => a -> a+ * They are implicitly instantiated at call sites; so the type inference+   engine inserts an extra argument of type (Ord a) at every call site+   to f.++However, once type inference is over, there is *no* distinction between+Constraint and Type. Indeed we can have coercions between the two. Consider+   class C a where+     op :: a -> a+For this single-method class we may generate a newtype, which in turn+generates an axiom witnessing+    C a ~ (a -> a)+so on the left we have Constraint, and on the right we have Type.+See #7451.++Bottom line: although 'Type' and 'Constraint' are distinct TyCons, with+distinct uniques, they are treated as equal at all times except+during type inference.+-}++isConstraintKindCon :: TyCon -> Bool+isConstraintKindCon tc = tyConUnique tc == constraintKindTyConKey++-- | Tests whether the given kind (which should look like @TYPE x@)+-- is something other than a constructor tree (that is, constructors at every node).+-- E.g.  True of   TYPE k, TYPE (F Int)+--       False of  TYPE 'LiftedRep+isKindLevPoly :: Kind -> Bool+isKindLevPoly k = ASSERT2( isLiftedTypeKind k || _is_type, ppr k )+                    -- the isLiftedTypeKind check is necessary b/c of Constraint+                  go k+  where+    go ty | Just ty' <- coreView ty = go ty'+    go TyVarTy{}         = True+    go AppTy{}           = True  -- it can't be a TyConApp+    go (TyConApp tc tys) = isFamilyTyCon tc || any go tys+    go ForAllTy{}        = True+    go (FunTy _ t1 t2)   = go t1 || go t2+    go LitTy{}           = False+    go CastTy{}          = True+    go CoercionTy{}      = True++    _is_type = classifiesTypeWithValues k++-----------------------------------------+--              Subkinding+-- The tc variants are used during type-checking, where ConstraintKind+-- is distinct from all other kinds+-- After type-checking (in core), Constraint and liftedTypeKind are+-- indistinguishable++-- | Does this classify a type allowed to have values? Responds True to things+-- like *, #, TYPE Lifted, TYPE v, Constraint.+classifiesTypeWithValues :: Kind -> Bool+-- ^ True of any sub-kind of OpenTypeKind+classifiesTypeWithValues k = isJust (kindRep_maybe k)
+ compiler/types/OptCoercion.hs view
@@ -0,0 +1,1204 @@+-- (c) The University of Glasgow 2006++{-# LANGUAGE CPP #-}++module OptCoercion ( optCoercion, checkAxInstCo ) where++#include "HsVersions.h"++import GhcPrelude++import DynFlags+import TyCoRep+import Coercion+import Type hiding( substTyVarBndr, substTy )+import TcType       ( exactTyCoVarsOfType )+import TyCon+import CoAxiom+import VarSet+import VarEnv+import Outputable+import FamInstEnv ( flattenTys )+import Pair+import ListSetOps ( getNth )+import Util+import Unify+import InstEnv+import Control.Monad   ( zipWithM )++{-+%************************************************************************+%*                                                                      *+                 Optimising coercions+%*                                                                      *+%************************************************************************++Note [Optimising coercion optimisation]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Looking up a coercion's role or kind is linear in the size of the+coercion. Thus, doing this repeatedly during the recursive descent+of coercion optimisation is disastrous. We must be careful to avoid+doing this if at all possible.++Because it is generally easy to know a coercion's components' roles+from the role of the outer coercion, we pass down the known role of+the input in the algorithm below. We also keep functions opt_co2+and opt_co3 separate from opt_co4, so that the former two do Phantom+checks that opt_co4 can avoid. This is a big win because Phantom coercions+rarely appear within non-phantom coercions -- only in some TyConAppCos+and some AxiomInstCos. We handle these cases specially by calling+opt_co2.++Note [Optimising InstCo]+~~~~~~~~~~~~~~~~~~~~~~~~+(1) tv is a type variable+When we have (InstCo (ForAllCo tv h g) g2), we want to optimise.++Let's look at the typing rules.++h : k1 ~ k2+tv:k1 |- g : t1 ~ t2+-----------------------------+ForAllCo tv h g : (all tv:k1.t1) ~ (all tv:k2.t2[tv |-> tv |> sym h])++g1 : (all tv:k1.t1') ~ (all tv:k2.t2')+g2 : s1 ~ s2+--------------------+InstCo g1 g2 : t1'[tv |-> s1] ~ t2'[tv |-> s2]++We thus want some coercion proving this:++  (t1[tv |-> s1]) ~ (t2[tv |-> s2 |> sym h])++If we substitute the *type* tv for the *coercion*+(g2 ; t2 ~ t2 |> sym h) in g, we'll get this result exactly.+This is bizarre,+though, because we're substituting a type variable with a coercion. However,+this operation already exists: it's called *lifting*, and defined in Coercion.+We just need to enhance the lifting operation to be able to deal with+an ambient substitution, which is why a LiftingContext stores a TCvSubst.++(2) cv is a coercion variable+Now consider we have (InstCo (ForAllCo cv h g) g2), we want to optimise.++h : (t1 ~r t2) ~N (t3 ~r t4)+cv : t1 ~r t2 |- g : t1' ~r2 t2'+n1 = nth r 2 (downgradeRole r N h) :: t1 ~r t3+n2 = nth r 3 (downgradeRole r N h) :: t2 ~r t4+------------------------------------------------+ForAllCo cv h g : (all cv:t1 ~r t2. t1') ~r2+                  (all cv:t3 ~r t4. t2'[cv |-> n1 ; cv ; sym n2])++g1 : (all cv:t1 ~r t2. t1') ~ (all cv: t3 ~r t4. t2')+g2 : h1 ~N h2+h1 : t1 ~r t2+h2 : t3 ~r t4+------------------------------------------------+InstCo g1 g2 : t1'[cv |-> h1] ~ t2'[cv |-> h2]++We thus want some coercion proving this:++  t1'[cv |-> h1] ~ t2'[cv |-> n1 ; h2; sym n2]++So we substitute the coercion variable c for the coercion+(h1 ~N (n1; h2; sym n2)) in g.+-}++optCoercion :: DynFlags -> TCvSubst -> Coercion -> NormalCo+-- ^ optCoercion applies a substitution to a coercion,+--   *and* optimises it to reduce its size+optCoercion dflags env co+  | hasNoOptCoercion dflags = substCo env co+  | otherwise               = optCoercion' env co++optCoercion' :: TCvSubst -> Coercion -> NormalCo+optCoercion' env co+  | debugIsOn+  = let out_co = opt_co1 lc False co+        (Pair in_ty1  in_ty2,  in_role)  = coercionKindRole co+        (Pair out_ty1 out_ty2, out_role) = coercionKindRole out_co+    in+    ASSERT2( substTy env in_ty1 `eqType` out_ty1 &&+             substTy env in_ty2 `eqType` out_ty2 &&+             in_role == out_role+           , text "optCoercion changed types!"+             $$ hang (text "in_co:") 2 (ppr co)+             $$ hang (text "in_ty1:") 2 (ppr in_ty1)+             $$ hang (text "in_ty2:") 2 (ppr in_ty2)+             $$ hang (text "out_co:") 2 (ppr out_co)+             $$ hang (text "out_ty1:") 2 (ppr out_ty1)+             $$ hang (text "out_ty2:") 2 (ppr out_ty2)+             $$ hang (text "subst:") 2 (ppr env) )+    out_co++  | otherwise         = opt_co1 lc False co+  where+    lc = mkSubstLiftingContext env++type NormalCo    = Coercion+  -- Invariants:+  --  * The substitution has been fully applied+  --  * For trans coercions (co1 `trans` co2)+  --       co1 is not a trans, and neither co1 nor co2 is identity++type NormalNonIdCo = NormalCo  -- Extra invariant: not the identity++-- | Do we apply a @sym@ to the result?+type SymFlag = Bool++-- | Do we force the result to be representational?+type ReprFlag = Bool++-- | Optimize a coercion, making no assumptions. All coercions in+-- the lifting context are already optimized (and sym'd if nec'y)+opt_co1 :: LiftingContext+        -> SymFlag+        -> Coercion -> NormalCo+opt_co1 env sym co = opt_co2 env sym (coercionRole co) co++-- See Note [Optimising coercion optimisation]+-- | Optimize a coercion, knowing the coercion's role. No other assumptions.+opt_co2 :: LiftingContext+        -> SymFlag+        -> Role   -- ^ The role of the input coercion+        -> Coercion -> NormalCo+opt_co2 env sym Phantom co = opt_phantom env sym co+opt_co2 env sym r       co = opt_co3 env sym Nothing r co++-- See Note [Optimising coercion optimisation]+-- | Optimize a coercion, knowing the coercion's non-Phantom role.+opt_co3 :: LiftingContext -> SymFlag -> Maybe Role -> Role -> Coercion -> NormalCo+opt_co3 env sym (Just Phantom)          _ co = opt_phantom env sym co+opt_co3 env sym (Just Representational) r co = opt_co4_wrap env sym True  r co+  -- if mrole is Just Nominal, that can't be a downgrade, so we can ignore+opt_co3 env sym _                       r co = opt_co4_wrap env sym False r co++-- See Note [Optimising coercion optimisation]+-- | Optimize a non-phantom coercion.+opt_co4, opt_co4_wrap :: LiftingContext -> SymFlag -> ReprFlag -> Role -> Coercion -> NormalCo++opt_co4_wrap = opt_co4+{-+opt_co4_wrap env sym rep r co+  = pprTrace "opt_co4_wrap {"+    ( vcat [ text "Sym:" <+> ppr sym+           , text "Rep:" <+> ppr rep+           , text "Role:" <+> ppr r+           , text "Co:" <+> ppr co ]) $+    ASSERT( r == coercionRole co )+    let result = opt_co4 env sym rep r co in+    pprTrace "opt_co4_wrap }" (ppr co $$ text "---" $$ ppr result) $+    result+-}++opt_co4 env _   rep r (Refl ty)+  = ASSERT2( r == Nominal, text "Expected role:" <+> ppr r    $$+                           text "Found role:" <+> ppr Nominal $$+                           text "Type:" <+> ppr ty )+    liftCoSubst (chooseRole rep r) env ty++opt_co4 env _   rep r (GRefl _r ty MRefl)+  = ASSERT2( r == _r, text "Expected role:" <+> ppr r $$+                      text "Found role:" <+> ppr _r   $$+                      text "Type:" <+> ppr ty )+    liftCoSubst (chooseRole rep r) env ty++opt_co4 env sym  rep r (GRefl _r ty (MCo co))+  = ASSERT2( r == _r, text "Expected role:" <+> ppr r $$+                      text "Found role:" <+> ppr _r   $$+                      text "Type:" <+> ppr ty )+    if isGReflCo co || isGReflCo co'+    then liftCoSubst r' env ty+    else wrapSym sym $ mkCoherenceRightCo r' ty' co' (liftCoSubst r' env ty)+  where+    r'  = chooseRole rep r+    ty' = substTy (lcSubstLeft env) ty+    co' = opt_co4 env False False Nominal co++opt_co4 env sym rep r (SymCo co)  = opt_co4_wrap env (not sym) rep r co+  -- surprisingly, we don't have to do anything to the env here. This is+  -- because any "lifting" substitutions in the env are tied to ForAllCos,+  -- which treat their left and right sides differently. We don't want to+  -- exchange them.++opt_co4 env sym rep r g@(TyConAppCo _r tc cos)+  = ASSERT( r == _r )+    case (rep, r) of+      (True, Nominal) ->+        mkTyConAppCo Representational tc+                     (zipWith3 (opt_co3 env sym)+                               (map Just (tyConRolesRepresentational tc))+                               (repeat Nominal)+                               cos)+      (False, Nominal) ->+        mkTyConAppCo Nominal tc (map (opt_co4_wrap env sym False Nominal) cos)+      (_, Representational) ->+                      -- must use opt_co2 here, because some roles may be P+                      -- See Note [Optimising coercion optimisation]+        mkTyConAppCo r tc (zipWith (opt_co2 env sym)+                                   (tyConRolesRepresentational tc)  -- the current roles+                                   cos)+      (_, Phantom) -> pprPanic "opt_co4 sees a phantom!" (ppr g)++opt_co4 env sym rep r (AppCo co1 co2)+  = mkAppCo (opt_co4_wrap env sym rep r co1)+            (opt_co4_wrap env sym False Nominal co2)++opt_co4 env sym rep r (ForAllCo tv k_co co)+  = case optForAllCoBndr env sym tv k_co of+      (env', tv', k_co') -> mkForAllCo tv' k_co' $+                            opt_co4_wrap env' sym rep r co+     -- Use the "mk" functions to check for nested Refls++opt_co4 env sym rep r (FunCo _r co1 co2)+  = ASSERT( r == _r )+    if rep+    then mkFunCo Representational co1' co2'+    else mkFunCo r co1' co2'+  where+    co1' = opt_co4_wrap env sym rep r co1+    co2' = opt_co4_wrap env sym rep r co2++opt_co4 env sym rep r (CoVarCo cv)+  | Just co <- lookupCoVar (lcTCvSubst env) cv+  = opt_co4_wrap (zapLiftingContext env) sym rep r co++  | ty1 `eqType` ty2   -- See Note [Optimise CoVarCo to Refl]+  = mkReflCo (chooseRole rep r) ty1++  | otherwise+  = ASSERT( isCoVar cv1 )+    wrapRole rep r $ wrapSym sym $+    CoVarCo cv1++  where+    Pair ty1 ty2 = coVarTypes cv1++    cv1 = case lookupInScope (lcInScopeSet env) cv of+             Just cv1 -> cv1+             Nothing  -> WARN( True, text "opt_co: not in scope:"+                                     <+> ppr cv $$ ppr env)+                         cv+          -- cv1 might have a substituted kind!++opt_co4 _ _ _ _ (HoleCo h)+  = pprPanic "opt_univ fell into a hole" (ppr h)++opt_co4 env sym rep r (AxiomInstCo con ind cos)+    -- Do *not* push sym inside top-level axioms+    -- e.g. if g is a top-level axiom+    --   g a : f a ~ a+    -- then (sym (g ty)) /= g (sym ty) !!+  = ASSERT( r == coAxiomRole con )+    wrapRole rep (coAxiomRole con) $+    wrapSym sym $+                       -- some sub-cos might be P: use opt_co2+                       -- See Note [Optimising coercion optimisation]+    AxiomInstCo con ind (zipWith (opt_co2 env False)+                                 (coAxBranchRoles (coAxiomNthBranch con ind))+                                 cos)+      -- Note that the_co does *not* have sym pushed into it++opt_co4 env sym rep r (UnivCo prov _r t1 t2)+  = ASSERT( r == _r )+    opt_univ env sym prov (chooseRole rep r) t1 t2++opt_co4 env sym rep r (TransCo co1 co2)+                      -- sym (g `o` h) = sym h `o` sym g+  | sym       = opt_trans in_scope co2' co1'+  | otherwise = opt_trans in_scope co1' co2'+  where+    co1' = opt_co4_wrap env sym rep r co1+    co2' = opt_co4_wrap env sym rep r co2+    in_scope = lcInScopeSet env++opt_co4 env _sym rep r (NthCo _r n co)+  | Just (ty, _) <- isReflCo_maybe co+  , Just (_tc, args) <- ASSERT( r == _r )+                        splitTyConApp_maybe ty+  = liftCoSubst (chooseRole rep r) env (args `getNth` n)+  | Just (ty, _) <- isReflCo_maybe co+  , n == 0+  , Just (tv, _) <- splitForAllTy_maybe ty+      -- works for both tyvar and covar+  = liftCoSubst (chooseRole rep r) env (varType tv)++opt_co4 env sym rep r (NthCo r1 n (TyConAppCo _ _ cos))+  = ASSERT( r == r1 )+    opt_co4_wrap env sym rep r (cos `getNth` n)++opt_co4 env sym rep r (NthCo _r n (ForAllCo _ eta _))+      -- works for both tyvar and covar+  = ASSERT( r == _r )+    ASSERT( n == 0 )+    opt_co4_wrap env sym rep Nominal eta++opt_co4 env sym rep r (NthCo _r n co)+  | TyConAppCo _ _ cos <- co'+  , let nth_co = cos `getNth` n+  = if rep && (r == Nominal)+      -- keep propagating the SubCo+    then opt_co4_wrap (zapLiftingContext env) False True Nominal nth_co+    else nth_co++  | ForAllCo _ eta _ <- co'+  = if rep+    then opt_co4_wrap (zapLiftingContext env) False True Nominal eta+    else eta++  | otherwise+  = wrapRole rep r $ NthCo r n co'+  where+    co' = opt_co1 env sym co++opt_co4 env sym rep r (LRCo lr co)+  | Just pr_co <- splitAppCo_maybe co+  = ASSERT( r == Nominal )+    opt_co4_wrap env sym rep Nominal (pick_lr lr pr_co)+  | Just pr_co <- splitAppCo_maybe co'+  = ASSERT( r == Nominal )+    if rep+    then opt_co4_wrap (zapLiftingContext env) False True Nominal (pick_lr lr pr_co)+    else pick_lr lr pr_co+  | otherwise+  = wrapRole rep Nominal $ LRCo lr co'+  where+    co' = opt_co4_wrap env sym False Nominal co++    pick_lr CLeft  (l, _) = l+    pick_lr CRight (_, r) = r++-- See Note [Optimising InstCo]+opt_co4 env sym rep r (InstCo co1 arg)+    -- forall over type...+  | Just (tv, kind_co, co_body) <- splitForAllCo_ty_maybe co1+  = opt_co4_wrap (extendLiftingContext env tv+                    (mkCoherenceRightCo Nominal t2 (mkSymCo kind_co) sym_arg))+                   -- mkSymCo kind_co :: k1 ~ k2+                   -- sym_arg :: (t1 :: k1) ~ (t2 :: k2)+                   -- tv |-> (t1 :: k1) ~ (((t2 :: k2) |> (sym kind_co)) :: k1)+                 sym rep r co_body++    -- forall over coercion...+  | Just (cv, kind_co, co_body) <- splitForAllCo_co_maybe co1+  , CoercionTy h1 <- t1+  , CoercionTy h2 <- t2+  = let new_co = mk_new_co cv (opt_co4_wrap env sym False Nominal kind_co) h1 h2+    in opt_co4_wrap (extendLiftingContext env cv new_co) sym rep r co_body++    -- See if it is a forall after optimization+    -- If so, do an inefficient one-variable substitution, then re-optimize++    -- forall over type...+  | Just (tv', kind_co', co_body') <- splitForAllCo_ty_maybe co1'+  = opt_co4_wrap (extendLiftingContext (zapLiftingContext env) tv'+                    (mkCoherenceRightCo Nominal t2' (mkSymCo kind_co') arg'))+            False False r' co_body'++    -- forall over coercion...+  | Just (cv', kind_co', co_body') <- splitForAllCo_co_maybe co1'+  , CoercionTy h1' <- t1'+  , CoercionTy h2' <- t2'+  = let new_co = mk_new_co cv' kind_co' h1' h2'+    in opt_co4_wrap (extendLiftingContext (zapLiftingContext env) cv' new_co)+                    False False r' co_body'++  | otherwise = InstCo co1' arg'+  where+    co1'    = opt_co4_wrap env sym rep r co1+    r'      = chooseRole rep r+    arg'    = opt_co4_wrap env sym False Nominal arg+    sym_arg = wrapSym sym arg'++    -- Performance note: don't be alarmed by the two calls to coercionKind+    -- here, as only one call to coercionKind is actually demanded per guard.+    -- t1/t2 are used when checking if co1 is a forall, and t1'/t2' are used+    -- when checking if co1' (i.e., co1 post-optimization) is a forall.+    --+    -- t1/t2 must come from sym_arg, not arg', since it's possible that arg'+    -- might have an extra Sym at the front (after being optimized) that co1+    -- lacks, so we need to use sym_arg to balance the number of Syms. (#15725)+    Pair t1  t2  = coercionKind sym_arg+    Pair t1' t2' = coercionKind arg'++    mk_new_co cv kind_co h1 h2+      = let -- h1 :: (t1 ~ t2)+            -- h2 :: (t3 ~ t4)+            -- kind_co :: (t1 ~ t2) ~ (t3 ~ t4)+            -- n1 :: t1 ~ t3+            -- n2 :: t2 ~ t4+            -- new_co = (h1 :: t1 ~ t2) ~ ((n1;h2;sym n2) :: t1 ~ t2)+            r2  = coVarRole cv+            kind_co' = downgradeRole r2 Nominal kind_co+            n1 = mkNthCo r2 2 kind_co'+            n2 = mkNthCo r2 3 kind_co'+         in mkProofIrrelCo Nominal (Refl (coercionType h1)) h1+                           (n1 `mkTransCo` h2 `mkTransCo` (mkSymCo n2))++opt_co4 env sym _rep r (KindCo co)+  = ASSERT( r == Nominal )+    let kco' = promoteCoercion co in+    case kco' of+      KindCo co' -> promoteCoercion (opt_co1 env sym co')+      _          -> opt_co4_wrap env sym False Nominal kco'+  -- This might be able to be optimized more to do the promotion+  -- and substitution/optimization at the same time++opt_co4 env sym _ r (SubCo co)+  = ASSERT( r == Representational )+    opt_co4_wrap env sym True Nominal co++-- This could perhaps be optimized more.+opt_co4 env sym rep r (AxiomRuleCo co cs)+  = ASSERT( r == coaxrRole co )+    wrapRole rep r $+    wrapSym sym $+    AxiomRuleCo co (zipWith (opt_co2 env False) (coaxrAsmpRoles co) cs)++{- Note [Optimise CoVarCo to Refl]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If we have (c :: t~t) we can optimise it to Refl. That increases the+chances of floating the Refl upwards; e.g. Maybe c --> Refl (Maybe t)++We do so here in optCoercion, not in mkCoVarCo; see Note [mkCoVarCo]+in Coercion.+-}++-------------+-- | Optimize a phantom coercion. The input coercion may not necessarily+-- be a phantom, but the output sure will be.+opt_phantom :: LiftingContext -> SymFlag -> Coercion -> NormalCo+opt_phantom env sym co+  = opt_univ env sym (PhantomProv (mkKindCo co)) Phantom ty1 ty2+  where+    Pair ty1 ty2 = coercionKind co++{- Note [Differing kinds]+   ~~~~~~~~~~~~~~~~~~~~~~+The two types may not have the same kind (although that would be very unusual).+But even if they have the same kind, and the same type constructor, the number+of arguments in a `CoTyConApp` can differ. Consider++  Any :: forall k. k++  Any * Int                      :: *+  Any (*->*) Maybe Int  :: *++Hence the need to compare argument lengths; see #13658+ -}++opt_univ :: LiftingContext -> SymFlag -> UnivCoProvenance -> Role+         -> Type -> Type -> Coercion+opt_univ env sym (PhantomProv h) _r ty1 ty2+  | sym       = mkPhantomCo h' ty2' ty1'+  | otherwise = mkPhantomCo h' ty1' ty2'+  where+    h' = opt_co4 env sym False Nominal h+    ty1' = substTy (lcSubstLeft  env) ty1+    ty2' = substTy (lcSubstRight env) ty2++opt_univ env sym prov role oty1 oty2+  | Just (tc1, tys1) <- splitTyConApp_maybe oty1+  , Just (tc2, tys2) <- splitTyConApp_maybe oty2+  , tc1 == tc2+  , equalLength tys1 tys2 -- see Note [Differing kinds]+      -- NB: prov must not be the two interesting ones (ProofIrrel & Phantom);+      -- Phantom is already taken care of, and ProofIrrel doesn't relate tyconapps+  = let roles    = tyConRolesX role tc1+        arg_cos  = zipWith3 (mkUnivCo prov') roles tys1 tys2+        arg_cos' = zipWith (opt_co4 env sym False) roles arg_cos+    in+    mkTyConAppCo role tc1 arg_cos'++  -- can't optimize the AppTy case because we can't build the kind coercions.++  | Just (tv1, ty1) <- splitForAllTy_ty_maybe oty1+  , Just (tv2, ty2) <- splitForAllTy_ty_maybe oty2+      -- NB: prov isn't interesting here either+  = let k1   = tyVarKind tv1+        k2   = tyVarKind tv2+        eta  = mkUnivCo prov' Nominal k1 k2+          -- eta gets opt'ed soon, but not yet.+        ty2' = substTyWith [tv2] [TyVarTy tv1 `mkCastTy` eta] ty2++        (env', tv1', eta') = optForAllCoBndr env sym tv1 eta+    in+    mkForAllCo tv1' eta' (opt_univ env' sym prov' role ty1 ty2')++  | Just (cv1, ty1) <- splitForAllTy_co_maybe oty1+  , Just (cv2, ty2) <- splitForAllTy_co_maybe oty2+      -- NB: prov isn't interesting here either+  = let k1    = varType cv1+        k2    = varType cv2+        r'    = coVarRole cv1+        eta   = mkUnivCo prov' Nominal k1 k2+        eta_d = downgradeRole r' Nominal eta+          -- eta gets opt'ed soon, but not yet.+        n_co  = (mkSymCo $ mkNthCo r' 2 eta_d) `mkTransCo`+                (mkCoVarCo cv1) `mkTransCo`+                (mkNthCo r' 3 eta_d)+        ty2'  = substTyWithCoVars [cv2] [n_co] ty2++        (env', cv1', eta') = optForAllCoBndr env sym cv1 eta+    in+    mkForAllCo cv1' eta' (opt_univ env' sym prov' role ty1 ty2')++  | otherwise+  = let ty1 = substTyUnchecked (lcSubstLeft  env) oty1+        ty2 = substTyUnchecked (lcSubstRight env) oty2+        (a, b) | sym       = (ty2, ty1)+               | otherwise = (ty1, ty2)+    in+    mkUnivCo prov' role a b++  where+    prov' = case prov of+      UnsafeCoerceProv   -> prov+      PhantomProv kco    -> PhantomProv $ opt_co4_wrap env sym False Nominal kco+      ProofIrrelProv kco -> ProofIrrelProv $ opt_co4_wrap env sym False Nominal kco+      PluginProv _       -> prov++-------------+opt_transList :: InScopeSet -> [NormalCo] -> [NormalCo] -> [NormalCo]+opt_transList is = zipWith (opt_trans is)++opt_trans :: InScopeSet -> NormalCo -> NormalCo -> NormalCo+opt_trans is co1 co2+  | isReflCo co1 = co2+    -- optimize when co1 is a Refl Co+  | otherwise    = opt_trans1 is co1 co2++opt_trans1 :: InScopeSet -> NormalNonIdCo -> NormalCo -> NormalCo+-- First arg is not the identity+opt_trans1 is co1 co2+  | isReflCo co2 = co1+    -- optimize when co2 is a Refl Co+  | otherwise    = opt_trans2 is co1 co2++opt_trans2 :: InScopeSet -> NormalNonIdCo -> NormalNonIdCo -> NormalCo+-- Neither arg is the identity+opt_trans2 is (TransCo co1a co1b) co2+    -- Don't know whether the sub-coercions are the identity+  = opt_trans is co1a (opt_trans is co1b co2)++opt_trans2 is co1 co2+  | Just co <- opt_trans_rule is co1 co2+  = co++opt_trans2 is co1 (TransCo co2a co2b)+  | Just co1_2a <- opt_trans_rule is co1 co2a+  = if isReflCo co1_2a+    then co2b+    else opt_trans1 is co1_2a co2b++opt_trans2 _ co1 co2+  = mkTransCo co1 co2++------+-- Optimize coercions with a top-level use of transitivity.+opt_trans_rule :: InScopeSet -> NormalNonIdCo -> NormalNonIdCo -> Maybe NormalCo++opt_trans_rule is in_co1@(GRefl r1 t1 (MCo co1)) in_co2@(GRefl r2 _ (MCo co2))+  = ASSERT( r1 == r2 )+    fireTransRule "GRefl" in_co1 in_co2 $+    mkGReflRightCo r1 t1 (opt_trans is co1 co2)++-- Push transitivity through matching destructors+opt_trans_rule is in_co1@(NthCo r1 d1 co1) in_co2@(NthCo r2 d2 co2)+  | d1 == d2+  , coercionRole co1 == coercionRole co2+  , co1 `compatible_co` co2+  = ASSERT( r1 == r2 )+    fireTransRule "PushNth" in_co1 in_co2 $+    mkNthCo r1 d1 (opt_trans is co1 co2)++opt_trans_rule is in_co1@(LRCo d1 co1) in_co2@(LRCo d2 co2)+  | d1 == d2+  , co1 `compatible_co` co2+  = fireTransRule "PushLR" in_co1 in_co2 $+    mkLRCo d1 (opt_trans is co1 co2)++-- Push transitivity inside instantiation+opt_trans_rule is in_co1@(InstCo co1 ty1) in_co2@(InstCo co2 ty2)+  | ty1 `eqCoercion` ty2+  , co1 `compatible_co` co2+  = fireTransRule "TrPushInst" in_co1 in_co2 $+    mkInstCo (opt_trans is co1 co2) ty1++opt_trans_rule is in_co1@(UnivCo p1 r1 tyl1 _tyr1)+                  in_co2@(UnivCo p2 r2 _tyl2 tyr2)+  | Just prov' <- opt_trans_prov p1 p2+  = ASSERT( r1 == r2 )+    fireTransRule "UnivCo" in_co1 in_co2 $+    mkUnivCo prov' r1 tyl1 tyr2+  where+    -- if the provenances are different, opt'ing will be very confusing+    opt_trans_prov UnsafeCoerceProv      UnsafeCoerceProv      = Just UnsafeCoerceProv+    opt_trans_prov (PhantomProv kco1)    (PhantomProv kco2)+      = Just $ PhantomProv $ opt_trans is kco1 kco2+    opt_trans_prov (ProofIrrelProv kco1) (ProofIrrelProv kco2)+      = Just $ ProofIrrelProv $ opt_trans is kco1 kco2+    opt_trans_prov (PluginProv str1)     (PluginProv str2)     | str1 == str2 = Just p1+    opt_trans_prov _ _ = Nothing++-- Push transitivity down through matching top-level constructors.+opt_trans_rule is in_co1@(TyConAppCo r1 tc1 cos1) in_co2@(TyConAppCo r2 tc2 cos2)+  | tc1 == tc2+  = ASSERT( r1 == r2 )+    fireTransRule "PushTyConApp" in_co1 in_co2 $+    mkTyConAppCo r1 tc1 (opt_transList is cos1 cos2)++opt_trans_rule is in_co1@(FunCo r1 co1a co1b) in_co2@(FunCo r2 co2a co2b)+  = ASSERT( r1 == r2 )   -- Just like the TyConAppCo/TyConAppCo case+    fireTransRule "PushFun" in_co1 in_co2 $+    mkFunCo r1 (opt_trans is co1a co2a) (opt_trans is co1b co2b)++opt_trans_rule is in_co1@(AppCo co1a co1b) in_co2@(AppCo co2a co2b)+  -- Must call opt_trans_rule_app; see Note [EtaAppCo]+  = opt_trans_rule_app is in_co1 in_co2 co1a [co1b] co2a [co2b]++-- Eta rules+opt_trans_rule is co1@(TyConAppCo r tc cos1) co2+  | Just cos2 <- etaTyConAppCo_maybe tc co2+  = ASSERT( cos1 `equalLength` cos2 )+    fireTransRule "EtaCompL" co1 co2 $+    mkTyConAppCo r tc (opt_transList is cos1 cos2)++opt_trans_rule is co1 co2@(TyConAppCo r tc cos2)+  | Just cos1 <- etaTyConAppCo_maybe tc co1+  = ASSERT( cos1 `equalLength` cos2 )+    fireTransRule "EtaCompR" co1 co2 $+    mkTyConAppCo r tc (opt_transList is cos1 cos2)++opt_trans_rule is co1@(AppCo co1a co1b) co2+  | Just (co2a,co2b) <- etaAppCo_maybe co2+  = opt_trans_rule_app is co1 co2 co1a [co1b] co2a [co2b]++opt_trans_rule is co1 co2@(AppCo co2a co2b)+  | Just (co1a,co1b) <- etaAppCo_maybe co1+  = opt_trans_rule_app is co1 co2 co1a [co1b] co2a [co2b]++-- Push transitivity inside forall+-- forall over types.+opt_trans_rule is co1 co2+  | Just (tv1, eta1, r1) <- splitForAllCo_ty_maybe co1+  , Just (tv2, eta2, r2) <- etaForAllCo_ty_maybe co2+  = push_trans tv1 eta1 r1 tv2 eta2 r2++  | Just (tv2, eta2, r2) <- splitForAllCo_ty_maybe co2+  , Just (tv1, eta1, r1) <- etaForAllCo_ty_maybe co1+  = push_trans tv1 eta1 r1 tv2 eta2 r2++  where+  push_trans tv1 eta1 r1 tv2 eta2 r2+    -- Given:+    --   co1 = /\ tv1 : eta1. r1+    --   co2 = /\ tv2 : eta2. r2+    -- Wanted:+    --   /\tv1 : (eta1;eta2).  (r1; r2[tv2 |-> tv1 |> eta1])+    = fireTransRule "EtaAllTy_ty" co1 co2 $+      mkForAllCo tv1 (opt_trans is eta1 eta2) (opt_trans is' r1 r2')+    where+      is' = is `extendInScopeSet` tv1+      r2' = substCoWithUnchecked [tv2] [mkCastTy (TyVarTy tv1) eta1] r2++-- Push transitivity inside forall+-- forall over coercions.+opt_trans_rule is co1 co2+  | Just (cv1, eta1, r1) <- splitForAllCo_co_maybe co1+  , Just (cv2, eta2, r2) <- etaForAllCo_co_maybe co2+  = push_trans cv1 eta1 r1 cv2 eta2 r2++  | Just (cv2, eta2, r2) <- splitForAllCo_co_maybe co2+  , Just (cv1, eta1, r1) <- etaForAllCo_co_maybe co1+  = push_trans cv1 eta1 r1 cv2 eta2 r2++  where+  push_trans cv1 eta1 r1 cv2 eta2 r2+    -- Given:+    --   co1 = /\ cv1 : eta1. r1+    --   co2 = /\ cv2 : eta2. r2+    -- Wanted:+    --   n1 = nth 2 eta1+    --   n2 = nth 3 eta1+    --   nco = /\ cv1 : (eta1;eta2). (r1; r2[cv2 |-> (sym n1);cv1;n2])+    = fireTransRule "EtaAllTy_co" co1 co2 $+      mkForAllCo cv1 (opt_trans is eta1 eta2) (opt_trans is' r1 r2')+    where+      is'  = is `extendInScopeSet` cv1+      role = coVarRole cv1+      eta1' = downgradeRole role Nominal eta1+      n1   = mkNthCo role 2 eta1'+      n2   = mkNthCo role 3 eta1'+      r2'  = substCo (zipCvSubst [cv2] [(mkSymCo n1) `mkTransCo`+                                        (mkCoVarCo cv1) `mkTransCo` n2])+                    r2++-- Push transitivity inside axioms+opt_trans_rule is co1 co2++  -- See Note [Why call checkAxInstCo during optimisation]+  -- TrPushSymAxR+  | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe+  , True <- sym+  , Just cos2 <- matchAxiom sym con ind co2+  , let newAxInst = AxiomInstCo con ind (opt_transList is (map mkSymCo cos2) cos1)+  , Nothing <- checkAxInstCo newAxInst+  = fireTransRule "TrPushSymAxR" co1 co2 $ SymCo newAxInst++  -- TrPushAxR+  | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe+  , False <- sym+  , Just cos2 <- matchAxiom sym con ind co2+  , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2)+  , Nothing <- checkAxInstCo newAxInst+  = fireTransRule "TrPushAxR" co1 co2 newAxInst++  -- TrPushSymAxL+  | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe+  , True <- sym+  , Just cos1 <- matchAxiom (not sym) con ind co1+  , let newAxInst = AxiomInstCo con ind (opt_transList is cos2 (map mkSymCo cos1))+  , Nothing <- checkAxInstCo newAxInst+  = fireTransRule "TrPushSymAxL" co1 co2 $ SymCo newAxInst++  -- TrPushAxL+  | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe+  , False <- sym+  , Just cos1 <- matchAxiom (not sym) con ind co1+  , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2)+  , Nothing <- checkAxInstCo newAxInst+  = fireTransRule "TrPushAxL" co1 co2 newAxInst++  -- TrPushAxSym/TrPushSymAx+  | Just (sym1, con1, ind1, cos1) <- co1_is_axiom_maybe+  , Just (sym2, con2, ind2, cos2) <- co2_is_axiom_maybe+  , con1 == con2+  , ind1 == ind2+  , sym1 == not sym2+  , let branch = coAxiomNthBranch con1 ind1+        qtvs = coAxBranchTyVars branch ++ coAxBranchCoVars branch+        lhs  = coAxNthLHS con1 ind1+        rhs  = coAxBranchRHS branch+        pivot_tvs = exactTyCoVarsOfType (if sym2 then rhs else lhs)+  , all (`elemVarSet` pivot_tvs) qtvs+  = fireTransRule "TrPushAxSym" co1 co2 $+    if sym2+       -- TrPushAxSym+    then liftCoSubstWith role qtvs (opt_transList is cos1 (map mkSymCo cos2)) lhs+       -- TrPushSymAx+    else liftCoSubstWith role qtvs (opt_transList is (map mkSymCo cos1) cos2) rhs+  where+    co1_is_axiom_maybe = isAxiom_maybe co1+    co2_is_axiom_maybe = isAxiom_maybe co2+    role = coercionRole co1 -- should be the same as coercionRole co2!++opt_trans_rule _ co1 co2        -- Identity rule+  | (Pair ty1 _, r) <- coercionKindRole co1+  , Pair _ ty2 <- coercionKind co2+  , ty1 `eqType` ty2+  = fireTransRule "RedTypeDirRefl" co1 co2 $+    mkReflCo r ty2++opt_trans_rule _ _ _ = Nothing++-- See Note [EtaAppCo]+opt_trans_rule_app :: InScopeSet+                   -> Coercion   -- original left-hand coercion (printing only)+                   -> Coercion   -- original right-hand coercion (printing only)+                   -> Coercion   -- left-hand coercion "function"+                   -> [Coercion] -- left-hand coercion "args"+                   -> Coercion   -- right-hand coercion "function"+                   -> [Coercion] -- right-hand coercion "args"+                   -> Maybe Coercion+opt_trans_rule_app is orig_co1 orig_co2 co1a co1bs co2a co2bs+  | AppCo co1aa co1ab <- co1a+  , Just (co2aa, co2ab) <- etaAppCo_maybe co2a+  = opt_trans_rule_app is orig_co1 orig_co2 co1aa (co1ab:co1bs) co2aa (co2ab:co2bs)++  | AppCo co2aa co2ab <- co2a+  , Just (co1aa, co1ab) <- etaAppCo_maybe co1a+  = opt_trans_rule_app is orig_co1 orig_co2 co1aa (co1ab:co1bs) co2aa (co2ab:co2bs)++  | otherwise+  = ASSERT( co1bs `equalLength` co2bs )+    fireTransRule ("EtaApps:" ++ show (length co1bs)) orig_co1 orig_co2 $+    let Pair _ rt1a = coercionKind co1a+        (Pair lt2a _, rt2a) = coercionKindRole co2a++        Pair _ rt1bs = traverse coercionKind co1bs+        Pair lt2bs _ = traverse coercionKind co2bs+        rt2bs = map coercionRole co2bs++        kcoa = mkKindCo $ buildCoercion lt2a rt1a+        kcobs = map mkKindCo $ zipWith buildCoercion lt2bs rt1bs++        co2a'   = mkCoherenceLeftCo rt2a lt2a kcoa co2a+        co2bs'  = zipWith3 mkGReflLeftCo rt2bs lt2bs kcobs+        co2bs'' = zipWith mkTransCo co2bs' co2bs+    in+    mkAppCos (opt_trans is co1a co2a')+             (zipWith (opt_trans is) co1bs co2bs'')++fireTransRule :: String -> Coercion -> Coercion -> Coercion -> Maybe Coercion+fireTransRule _rule _co1 _co2 res+  = Just res++{-+Note [Conflict checking with AxiomInstCo]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider the following type family and axiom:++type family Equal (a :: k) (b :: k) :: Bool+type instance where+  Equal a a = True+  Equal a b = False+--+Equal :: forall k::*. k -> k -> Bool+axEqual :: { forall k::*. forall a::k. Equal k a a ~ True+           ; forall k::*. forall a::k. forall b::k. Equal k a b ~ False }++We wish to disallow (axEqual[1] <*> <Int> <Int). (Recall that the index is+0-based, so this is the second branch of the axiom.) The problem is that, on+the surface, it seems that (axEqual[1] <*> <Int> <Int>) :: (Equal * Int Int ~+False) and that all is OK. But, all is not OK: we want to use the first branch+of the axiom in this case, not the second. The problem is that the parameters+of the first branch can unify with the supplied coercions, thus meaning that+the first branch should be taken. See also Note [Apartness] in+types/FamInstEnv.hs.++Note [Why call checkAxInstCo during optimisation]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+It is possible that otherwise-good-looking optimisations meet with disaster+in the presence of axioms with multiple equations. Consider++type family Equal (a :: *) (b :: *) :: Bool where+  Equal a a = True+  Equal a b = False+type family Id (a :: *) :: * where+  Id a = a++axEq :: { [a::*].       Equal a a ~ True+        ; [a::*, b::*]. Equal a b ~ False }+axId :: [a::*]. Id a ~ a++co1 = Equal (axId[0] Int) (axId[0] Bool)+  :: Equal (Id Int) (Id Bool) ~  Equal Int Bool+co2 = axEq[1] <Int> <Bool>+  :: Equal Int Bool ~ False++We wish to optimise (co1 ; co2). We end up in rule TrPushAxL, noting that+co2 is an axiom and that matchAxiom succeeds when looking at co1. But, what+happens when we push the coercions inside? We get++co3 = axEq[1] (axId[0] Int) (axId[0] Bool)+  :: Equal (Id Int) (Id Bool) ~ False++which is bogus! This is because the type system isn't smart enough to know+that (Id Int) and (Id Bool) are Surely Apart, as they're headed by type+families. At the time of writing, I (Richard Eisenberg) couldn't think of+a way of detecting this any more efficient than just building the optimised+coercion and checking.++Note [EtaAppCo]+~~~~~~~~~~~~~~~+Suppose we're trying to optimize (co1a co1b ; co2a co2b). Ideally, we'd+like to rewrite this to (co1a ; co2a) (co1b ; co2b). The problem is that+the resultant coercions might not be well kinded. Here is an example (things+labeled with x don't matter in this example):++  k1 :: Type+  k2 :: Type++  a :: k1 -> Type+  b :: k1++  h :: k1 ~ k2++  co1a :: x1 ~ (a |> (h -> <Type>)+  co1b :: x2 ~ (b |> h)++  co2a :: a ~ x3+  co2b :: b ~ x4++First, convince yourself of the following:++  co1a co1b :: x1 x2 ~ (a |> (h -> <Type>)) (b |> h)+  co2a co2b :: a b   ~ x3 x4++  (a |> (h -> <Type>)) (b |> h) `eqType` a b++That last fact is due to Note [Non-trivial definitional equality] in TyCoRep,+where we ignore coercions in types as long as two types' kinds are the same.+In our case, we meet this last condition, because++  (a |> (h -> <Type>)) (b |> h) :: Type+    and+  a b :: Type++So the input coercion (co1a co1b ; co2a co2b) is well-formed. But the+suggested output coercions (co1a ; co2a) and (co1b ; co2b) are not -- the+kinds don't match up.++The solution here is to twiddle the kinds in the output coercions. First, we+need to find coercions++  ak :: kind(a |> (h -> <Type>)) ~ kind(a)+  bk :: kind(b |> h)             ~ kind(b)++This can be done with mkKindCo and buildCoercion. The latter assumes two+types are identical modulo casts and builds a coercion between them.++Then, we build (co1a ; co2a |> sym ak) and (co1b ; co2b |> sym bk) as the+output coercions. These are well-kinded.++Also, note that all of this is done after accumulated any nested AppCo+parameters. This step is to avoid quadratic behavior in calling coercionKind.++The problem described here was first found in dependent/should_compile/dynamic-paper.++-}++-- | Check to make sure that an AxInstCo is internally consistent.+-- Returns the conflicting branch, if it exists+-- See Note [Conflict checking with AxiomInstCo]+checkAxInstCo :: Coercion -> Maybe CoAxBranch+-- defined here to avoid dependencies in Coercion+-- If you edit this function, you may need to update the GHC formalism+-- See Note [GHC Formalism] in CoreLint+checkAxInstCo (AxiomInstCo ax ind cos)+  = let branch       = coAxiomNthBranch ax ind+        tvs          = coAxBranchTyVars branch+        cvs          = coAxBranchCoVars branch+        incomps      = coAxBranchIncomps branch+        (tys, cotys) = splitAtList tvs (map (pFst . coercionKind) cos)+        co_args      = map stripCoercionTy cotys+        subst        = zipTvSubst tvs tys `composeTCvSubst`+                       zipCvSubst cvs co_args+        target   = Type.substTys subst (coAxBranchLHS branch)+        in_scope = mkInScopeSet $+                   unionVarSets (map (tyCoVarsOfTypes . coAxBranchLHS) incomps)+        flattened_target = flattenTys in_scope target in+    check_no_conflict flattened_target incomps+  where+    check_no_conflict :: [Type] -> [CoAxBranch] -> Maybe CoAxBranch+    check_no_conflict _    [] = Nothing+    check_no_conflict flat (b@CoAxBranch { cab_lhs = lhs_incomp } : rest)+         -- See Note [Apartness] in FamInstEnv+      | SurelyApart <- tcUnifyTysFG instanceBindFun flat lhs_incomp+      = check_no_conflict flat rest+      | otherwise+      = Just b+checkAxInstCo _ = Nothing+++-----------+wrapSym :: SymFlag -> Coercion -> Coercion+wrapSym sym co | sym       = mkSymCo co+               | otherwise = co++-- | Conditionally set a role to be representational+wrapRole :: ReprFlag+         -> Role         -- ^ current role+         -> Coercion -> Coercion+wrapRole False _       = id+wrapRole True  current = downgradeRole Representational current++-- | If we require a representational role, return that. Otherwise,+-- return the "default" role provided.+chooseRole :: ReprFlag+           -> Role    -- ^ "default" role+           -> Role+chooseRole True _ = Representational+chooseRole _    r = r++-----------+isAxiom_maybe :: Coercion -> Maybe (Bool, CoAxiom Branched, Int, [Coercion])+isAxiom_maybe (SymCo co)+  | Just (sym, con, ind, cos) <- isAxiom_maybe co+  = Just (not sym, con, ind, cos)+isAxiom_maybe (AxiomInstCo con ind cos)+  = Just (False, con, ind, cos)+isAxiom_maybe _ = Nothing++matchAxiom :: Bool -- True = match LHS, False = match RHS+           -> CoAxiom br -> Int -> Coercion -> Maybe [Coercion]+matchAxiom sym ax@(CoAxiom { co_ax_tc = tc }) ind co+  | CoAxBranch { cab_tvs = qtvs+               , cab_cvs = []   -- can't infer these, so fail if there are any+               , cab_roles = roles+               , cab_lhs = lhs+               , cab_rhs = rhs } <- coAxiomNthBranch ax ind+  , Just subst <- liftCoMatch (mkVarSet qtvs)+                              (if sym then (mkTyConApp tc lhs) else rhs)+                              co+  , all (`isMappedByLC` subst) qtvs+  = zipWithM (liftCoSubstTyVar subst) roles qtvs++  | otherwise+  = Nothing++-------------+compatible_co :: Coercion -> Coercion -> Bool+-- Check whether (co1 . co2) will be well-kinded+compatible_co co1 co2+  = x1 `eqType` x2+  where+    Pair _ x1 = coercionKind co1+    Pair x2 _ = coercionKind co2++-------------+{-+etaForAllCo+~~~~~~~~~~~~~~~~~+(1) etaForAllCo_ty_maybe+Suppose we have++  g : all a1:k1.t1  ~  all a2:k2.t2++but g is *not* a ForAllCo. We want to eta-expand it. So, we do this:++  g' = all a1:(ForAllKindCo g).(InstCo g (a1 ~ a1 |> ForAllKindCo g))++Call the kind coercion h1 and the body coercion h2. We can see that++  h2 : t1 ~ t2[a2 |-> (a1 |> h1)]++According to the typing rule for ForAllCo, we get that++  g' : all a1:k1.t1  ~  all a1:k2.(t2[a2 |-> (a1 |> h1)][a1 |-> a1 |> sym h1])++or++  g' : all a1:k1.t1  ~  all a1:k2.(t2[a2 |-> a1])++as desired.++(2) etaForAllCo_co_maybe+Suppose we have++  g : all c1:(s1~s2). t1 ~ all c2:(s3~s4). t2++Similarly, we do this++  g' = all c1:h1. h2+     : all c1:(s1~s2). t1 ~ all c1:(s3~s4). t2[c2 |-> (sym eta1;c1;eta2)]+                                              [c1 |-> eta1;c1;sym eta2]++Here,++  h1   = mkNthCo Nominal 0 g :: (s1~s2)~(s3~s4)+  eta1 = mkNthCo r 2 h1      :: (s1 ~ s3)+  eta2 = mkNthCo r 3 h1      :: (s2 ~ s4)+  h2   = mkInstCo g (cv1 ~ (sym eta1;c1;eta2))+-}+etaForAllCo_ty_maybe :: Coercion -> Maybe (TyVar, Coercion, Coercion)+-- Try to make the coercion be of form (forall tv:kind_co. co)+etaForAllCo_ty_maybe co+  | Just (tv, kind_co, r) <- splitForAllCo_ty_maybe co+  = Just (tv, kind_co, r)++  | Pair ty1 ty2  <- coercionKind co+  , Just (tv1, _) <- splitForAllTy_ty_maybe ty1+  , isForAllTy_ty ty2+  , let kind_co = mkNthCo Nominal 0 co+  = Just ( tv1, kind_co+         , mkInstCo co (mkGReflRightCo Nominal (TyVarTy tv1) kind_co))++  | otherwise+  = Nothing++etaForAllCo_co_maybe :: Coercion -> Maybe (CoVar, Coercion, Coercion)+-- Try to make the coercion be of form (forall cv:kind_co. co)+etaForAllCo_co_maybe co+  | Just (cv, kind_co, r) <- splitForAllCo_co_maybe co+  = Just (cv, kind_co, r)++  | Pair ty1 ty2  <- coercionKind co+  , Just (cv1, _) <- splitForAllTy_co_maybe ty1+  , isForAllTy_co ty2+  = let kind_co  = mkNthCo Nominal 0 co+        r        = coVarRole cv1+        l_co     = mkCoVarCo cv1+        kind_co' = downgradeRole r Nominal kind_co+        r_co     = (mkSymCo (mkNthCo r 2 kind_co')) `mkTransCo`+                   l_co `mkTransCo`+                   (mkNthCo r 3 kind_co')+    in Just ( cv1, kind_co+            , mkInstCo co (mkProofIrrelCo Nominal kind_co l_co r_co))++  | otherwise+  = Nothing++etaAppCo_maybe :: Coercion -> Maybe (Coercion,Coercion)+-- If possible, split a coercion+--   g :: t1a t1b ~ t2a t2b+-- into a pair of coercions (left g, right g)+etaAppCo_maybe co+  | Just (co1,co2) <- splitAppCo_maybe co+  = Just (co1,co2)+  | (Pair ty1 ty2, Nominal) <- coercionKindRole co+  , Just (_,t1) <- splitAppTy_maybe ty1+  , Just (_,t2) <- splitAppTy_maybe ty2+  , let isco1 = isCoercionTy t1+  , let isco2 = isCoercionTy t2+  , isco1 == isco2+  = Just (LRCo CLeft co, LRCo CRight co)+  | otherwise+  = Nothing++etaTyConAppCo_maybe :: TyCon -> Coercion -> Maybe [Coercion]+-- If possible, split a coercion+--       g :: T s1 .. sn ~ T t1 .. tn+-- into [ Nth 0 g :: s1~t1, ..., Nth (n-1) g :: sn~tn ]+etaTyConAppCo_maybe tc (TyConAppCo _ tc2 cos2)+  = ASSERT( tc == tc2 ) Just cos2++etaTyConAppCo_maybe tc co+  | not (mustBeSaturated tc)+  , (Pair ty1 ty2, r) <- coercionKindRole co+  , Just (tc1, tys1)  <- splitTyConApp_maybe ty1+  , Just (tc2, tys2)  <- splitTyConApp_maybe ty2+  , tc1 == tc2+  , isInjectiveTyCon tc r  -- See Note [NthCo and newtypes] in TyCoRep+  , let n = length tys1+  , tys2 `lengthIs` n      -- This can fail in an erroneous progam+                           -- E.g. T a ~# T a b+                           -- #14607+  = ASSERT( tc == tc1 )+    Just (decomposeCo n co (tyConRolesX r tc1))+    -- NB: n might be <> tyConArity tc+    -- e.g.   data family T a :: * -> *+    --        g :: T a b ~ T c d++  | otherwise+  = Nothing++{-+Note [Eta for AppCo]+~~~~~~~~~~~~~~~~~~~~+Suppose we have+   g :: s1 t1 ~ s2 t2++Then we can't necessarily make+   left  g :: s1 ~ s2+   right g :: t1 ~ t2+because it's possible that+   s1 :: * -> *         t1 :: *+   s2 :: (*->*) -> *    t2 :: * -> *+and in that case (left g) does not have the same+kind on either side.++It's enough to check that+  kind t1 = kind t2+because if g is well-kinded then+  kind (s1 t2) = kind (s2 t2)+and these two imply+  kind s1 = kind s2++-}++optForAllCoBndr :: LiftingContext -> Bool+                -> TyCoVar -> Coercion -> (LiftingContext, TyCoVar, Coercion)+optForAllCoBndr env sym+  = substForAllCoBndrUsingLC sym (opt_co4_wrap env sym False Nominal) env
+ compiler/types/TyCoRep.hs view
@@ -0,0 +1,4142 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1998+\section[TyCoRep]{Type and Coercion - friends' interface}++Note [The Type-related module hierarchy]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+  Class+  CoAxiom+  TyCon    imports Class, CoAxiom+  TyCoRep  imports Class, CoAxiom, TyCon+  TysPrim  imports TyCoRep ( including mkTyConTy )+  Kind     imports TysPrim ( mainly for primitive kinds )+  Type     imports Kind+  Coercion imports Type+-}++-- We expose the relevant stuff from this module via the Type module+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE CPP, DeriveDataTypeable, MultiWayIf, PatternSynonyms, BangPatterns #-}++module TyCoRep (+        TyThing(..), tyThingCategory, pprTyThingCategory, pprShortTyThing,++        -- * Types+        Type( TyVarTy, AppTy, TyConApp, ForAllTy+            , LitTy, CastTy, CoercionTy+            , FunTy, ft_arg, ft_res, ft_af+            ),  -- Export the type synonym FunTy too++        TyLit(..),+        KindOrType, Kind,+        KnotTied,+        PredType, ThetaType,      -- Synonyms+        ArgFlag(..), AnonArgFlag(..), ForallVisFlag(..),++        -- * Coercions+        Coercion(..),+        UnivCoProvenance(..),+        CoercionHole(..), coHoleCoVar, setCoHoleCoVar,+        CoercionN, CoercionR, CoercionP, KindCoercion,+        MCoercion(..), MCoercionR, MCoercionN,++        -- * Functions over types+        mkTyConTy, mkTyVarTy, mkTyVarTys,+        mkTyCoVarTy, mkTyCoVarTys,+        mkFunTy, mkVisFunTy, mkInvisFunTy, mkVisFunTys, mkInvisFunTys,+        mkForAllTy, mkForAllTys,+        mkPiTy, mkPiTys,++        kindRep_maybe, kindRep,+        isLiftedTypeKind, isUnliftedTypeKind,+        isLiftedRuntimeRep, isUnliftedRuntimeRep,+        isRuntimeRepTy, isRuntimeRepVar,+        sameVis,++        -- * Functions over binders+        TyCoBinder(..), TyCoVarBinder, TyBinder,+        binderVar, binderVars, binderType, binderArgFlag,+        delBinderVar,+        isInvisibleArgFlag, isVisibleArgFlag,+        isInvisibleBinder, isVisibleBinder,+        isTyBinder, isNamedBinder,++        -- * Functions over coercions+        pickLR,++        -- * Pretty-printing+        pprType, pprParendType, pprPrecType, pprPrecTypeX,+        pprTypeApp, pprTCvBndr, pprTCvBndrs,+        pprSigmaType,+        pprTheta, pprParendTheta, pprForAll, pprUserForAll,+        pprTyVar, pprTyVars,+        pprThetaArrowTy, pprClassPred,+        pprKind, pprParendKind, pprTyLit,+        PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen,+        pprDataCons, pprWithExplicitKindsWhen,++        pprCo, pprParendCo,++        debugPprType,++        -- * Free variables+        tyCoVarsOfType, tyCoVarsOfTypeDSet, tyCoVarsOfTypes, tyCoVarsOfTypesDSet,+        tyCoFVsBndr, tyCoFVsVarBndr, tyCoFVsVarBndrs,+        tyCoFVsOfType, tyCoVarsOfTypeList,+        tyCoFVsOfTypes, tyCoVarsOfTypesList,+        coVarsOfType, coVarsOfTypes,+        coVarsOfCo, coVarsOfCos,+        tyCoVarsOfCo, tyCoVarsOfCos,+        tyCoVarsOfCoDSet,+        tyCoFVsOfCo, tyCoFVsOfCos,+        tyCoVarsOfCoList, tyCoVarsOfProv,+        almostDevoidCoVarOfCo,+        injectiveVarsOfType, tyConAppNeedsKindSig,++        noFreeVarsOfType, noFreeVarsOfCo,++        -- * Substitutions+        TCvSubst(..), TvSubstEnv, CvSubstEnv,+        emptyTvSubstEnv, emptyCvSubstEnv, composeTCvSubstEnv, composeTCvSubst,+        emptyTCvSubst, mkEmptyTCvSubst, isEmptyTCvSubst,+        mkTCvSubst, mkTvSubst, mkCvSubst,+        getTvSubstEnv,+        getCvSubstEnv, getTCvInScope, getTCvSubstRangeFVs,+        isInScope, notElemTCvSubst,+        setTvSubstEnv, setCvSubstEnv, zapTCvSubst,+        extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,+        extendTCvSubst, extendTCvSubstWithClone,+        extendCvSubst, extendCvSubstWithClone,+        extendTvSubst, extendTvSubstBinderAndInScope, extendTvSubstWithClone,+        extendTvSubstList, extendTvSubstAndInScope,+        extendTCvSubstList,+        unionTCvSubst, zipTyEnv, zipCoEnv, mkTyCoInScopeSet,+        zipTvSubst, zipCvSubst,+        zipTCvSubst,+        mkTvSubstPrs,++        substTyWith, substTyWithCoVars, substTysWith, substTysWithCoVars,+        substCoWith,+        substTy, substTyAddInScope,+        substTyUnchecked, substTysUnchecked, substThetaUnchecked,+        substTyWithUnchecked,+        substCoUnchecked, substCoWithUnchecked,+        substTyWithInScope,+        substTys, substTheta,+        lookupTyVar,+        substCo, substCos, substCoVar, substCoVars, lookupCoVar,+        cloneTyVarBndr, cloneTyVarBndrs,+        substVarBndr, substVarBndrs,+        substTyVarBndr, substTyVarBndrs,+        substCoVarBndr,+        substTyVar, substTyVars, substTyCoVars,+        substForAllCoBndr,+        substVarBndrUsing, substForAllCoBndrUsing,+        checkValidSubst, isValidTCvSubst,++        -- * Tidying type related things up for printing+        tidyType,      tidyTypes,+        tidyOpenType,  tidyOpenTypes,+        tidyOpenKind,+        tidyVarBndr, tidyVarBndrs, tidyFreeTyCoVars, avoidNameClashes,+        tidyOpenTyCoVar, tidyOpenTyCoVars,+        tidyTyCoVarOcc,+        tidyTopType,+        tidyKind,+        tidyCo, tidyCos,+        tidyTyCoVarBinder, tidyTyCoVarBinders,++        -- * Sizes+        typeSize, coercionSize, provSize+    ) where++#include "HsVersions.h"++import GhcPrelude++import {-# SOURCE #-} DataCon( dataConFullSig+                             , dataConUserTyVarBinders+                             , DataCon )+import {-# SOURCE #-} Type( isCoercionTy, mkAppTy, mkCastTy+                          , tyCoVarsOfTypeWellScoped+                          , tyCoVarsOfTypesWellScoped+                          , scopedSort+                          , coreView )+   -- Transitively pulls in a LOT of stuff, better to break the loop++import {-# SOURCE #-} Coercion+import {-# SOURCE #-} ConLike ( ConLike(..), conLikeName )+import {-# SOURCE #-} ToIface( toIfaceTypeX, toIfaceTyLit, toIfaceForAllBndr+                             , toIfaceTyCon, toIfaceTcArgs, toIfaceCoercionX )++-- friends:+import IfaceType+import Var+import VarEnv+import VarSet+import Name hiding ( varName )+import TyCon+import Class+import CoAxiom+import FV++-- others+import BasicTypes ( LeftOrRight(..), PprPrec(..), topPrec, sigPrec, opPrec+                  , funPrec, appPrec, maybeParen, pickLR )+import PrelNames+import Outputable+import DynFlags+import FastString+import Pair+import UniqSupply+import Util+import UniqFM+import UniqSet++-- libraries+import qualified Data.Data as Data hiding ( TyCon )+import Data.List+import Data.IORef ( IORef )   -- for CoercionHole++{-+%************************************************************************+%*                                                                      *+                        TyThing+%*                                                                      *+%************************************************************************++Despite the fact that DataCon has to be imported via a hi-boot route,+this module seems the right place for TyThing, because it's needed for+funTyCon and all the types in TysPrim.++It is also SOURCE-imported into Name.hs+++Note [ATyCon for classes]+~~~~~~~~~~~~~~~~~~~~~~~~~+Both classes and type constructors are represented in the type environment+as ATyCon.  You can tell the difference, and get to the class, with+   isClassTyCon :: TyCon -> Bool+   tyConClass_maybe :: TyCon -> Maybe Class+The Class and its associated TyCon have the same Name.+-}++-- | A global typecheckable-thing, essentially anything that has a name.+-- Not to be confused with a 'TcTyThing', which is also a typecheckable+-- thing but in the *local* context.  See 'TcEnv' for how to retrieve+-- a 'TyThing' given a 'Name'.+data TyThing+  = AnId     Id+  | AConLike ConLike+  | ATyCon   TyCon       -- TyCons and classes; see Note [ATyCon for classes]+  | ACoAxiom (CoAxiom Branched)++instance Outputable TyThing where+  ppr = pprShortTyThing++instance NamedThing TyThing where       -- Can't put this with the type+  getName (AnId id)     = getName id    -- decl, because the DataCon instance+  getName (ATyCon tc)   = getName tc    -- isn't visible there+  getName (ACoAxiom cc) = getName cc+  getName (AConLike cl) = conLikeName cl++pprShortTyThing :: TyThing -> SDoc+-- c.f. PprTyThing.pprTyThing, which prints all the details+pprShortTyThing thing+  = pprTyThingCategory thing <+> quotes (ppr (getName thing))++pprTyThingCategory :: TyThing -> SDoc+pprTyThingCategory = text . capitalise . tyThingCategory++tyThingCategory :: TyThing -> String+tyThingCategory (ATyCon tc)+  | isClassTyCon tc = "class"+  | otherwise       = "type constructor"+tyThingCategory (ACoAxiom _) = "coercion axiom"+tyThingCategory (AnId   _)   = "identifier"+tyThingCategory (AConLike (RealDataCon _)) = "data constructor"+tyThingCategory (AConLike (PatSynCon _))  = "pattern synonym"+++{- **********************************************************************+*                                                                       *+                        Type+*                                                                       *+********************************************************************** -}++-- | The key representation of types within the compiler++type KindOrType = Type -- See Note [Arguments to type constructors]++-- | The key type representing kinds in the compiler.+type Kind = Type++-- If you edit this type, you may need to update the GHC formalism+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs+data Type+  -- See Note [Non-trivial definitional equality]+  = TyVarTy Var -- ^ Vanilla type or kind variable (*never* a coercion variable)++  | AppTy+        Type+        Type            -- ^ Type application to something other than a 'TyCon'. Parameters:+                        --+                        --  1) Function: must /not/ be a 'TyConApp' or 'CastTy',+                        --     must be another 'AppTy', or 'TyVarTy'+                        --     See Note [Respecting definitional equality] (EQ1) about the+                        --     no 'CastTy' requirement+                        --+                        --  2) Argument type++  | TyConApp+        TyCon+        [KindOrType]    -- ^ Application of a 'TyCon', including newtypes /and/ synonyms.+                        -- Invariant: saturated applications of 'FunTyCon' must+                        -- use 'FunTy' and saturated synonyms must use their own+                        -- constructors. However, /unsaturated/ 'FunTyCon's+                        -- do appear as 'TyConApp's.+                        -- Parameters:+                        --+                        -- 1) Type constructor being applied to.+                        --+                        -- 2) Type arguments. Might not have enough type arguments+                        --    here to saturate the constructor.+                        --    Even type synonyms are not necessarily saturated;+                        --    for example unsaturated type synonyms+                        --    can appear as the right hand side of a type synonym.++  | ForAllTy+        {-# UNPACK #-} !TyCoVarBinder+        Type            -- ^ A Π type.++  | FunTy      -- ^ t1 -> t2   Very common, so an important special case+                -- See Note [Function types]+     { ft_af  :: AnonArgFlag  -- Is this (->) or (=>)?+     , ft_arg :: Type           -- Argument type+     , ft_res :: Type }         -- Result type++  | LitTy TyLit     -- ^ Type literals are similar to type constructors.++  | CastTy+        Type+        KindCoercion  -- ^ A kind cast. The coercion is always nominal.+                      -- INVARIANT: The cast is never refl.+                      -- INVARIANT: The Type is not a CastTy (use TransCo instead)+                      -- See Note [Respecting definitional equality] (EQ2) and (EQ3)++  | CoercionTy+        Coercion    -- ^ Injection of a Coercion into a type+                    -- This should only ever be used in the RHS of an AppTy,+                    -- in the list of a TyConApp, when applying a promoted+                    -- GADT data constructor++  deriving Data.Data++-- NOTE:  Other parts of the code assume that type literals do not contain+-- types or type variables.+data TyLit+  = NumTyLit Integer+  | StrTyLit FastString+  deriving (Eq, Ord, Data.Data)+++{- Note [Function types]+~~~~~~~~~~~~~~~~~~~~~~~~+FFunTy is the constructor for a function type.  Lots of things to say+about it!++* FFunTy is the data constructor, meaning "full function type".++* The function type constructor (->) has kind+     (->) :: forall r1 r2. TYPE r1 -> TYPE r2 -> Type LiftedRep+  mkTyConApp ensure that we convert a saturated application+    TyConApp (->) [r1,r2,t1,t2] into FunTy t1 t2+  dropping the 'r1' and 'r2' arguments; they are easily recovered+  from 't1' and 't2'.++* The ft_af field says whether or not this is an invisible argument+     VisArg:   t1 -> t2    Ordinary function type+     InvisArg: t1 => t2    t1 is guaranteed to be a predicate type,+                           i.e. t1 :: Constraint+  See Note [Types for coercions, predicates, and evidence]++  This visibility info makes no difference in Core; it matters+  only when we regard the type as a Haskell source type.++* FunTy is a (unidirectional) pattern synonym that allows+  positional pattern matching (FunTy arg res), ignoring the+  ArgFlag.+-}++{- -----------------------+      Commented out until the pattern match+      checker can handle it; see #16185++      For now we use the CPP macro #define FunTy FFunTy _+      (see HsVersions.h) to allow pattern matching on a+      (positional) FunTy constructor.++{-# COMPLETE FunTy, TyVarTy, AppTy, TyConApp+           , ForAllTy, LitTy, CastTy, CoercionTy :: Type #-}++-- | 'FunTy' is a (uni-directional) pattern synonym for the common+-- case where we want to match on the argument/result type, but+-- ignoring the AnonArgFlag+pattern FunTy :: Type -> Type -> Type+pattern FunTy arg res <- FFunTy { ft_arg = arg, ft_res = res }++       End of commented out block+---------------------------------- -}++{- Note [Types for coercions, predicates, and evidence]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We treat differently:++  (a) Predicate types+        Test: isPredTy+        Binders: DictIds+        Kind: Constraint+        Examples: (Eq a), and (a ~ b)++  (b) Coercion types are primitive, unboxed equalities+        Test: isCoVarTy+        Binders: CoVars (can appear in coercions)+        Kind: TYPE (TupleRep [])+        Examples: (t1 ~# t2) or (t1 ~R# t2)++  (c) Evidence types is the type of evidence manipulated by+      the type constraint solver.+        Test: isEvVarType+        Binders: EvVars+        Kind: Constraint or TYPE (TupleRep [])+        Examples: all coercion types and predicate types++Coercion types and predicate types are mutually exclusive,+but evidence types are a superset of both.++When treated as a user type,++  - Predicates (of kind Constraint) are invisible and are+    implicitly instantiated++  - Coercion types, and non-pred evidence types (i.e. not+    of kind Constrain), are just regular old types, are+    visible, and are not implicitly instantiated.++In a FunTy { ft_af = InvisArg }, the argument type is always+a Predicate type.++Note [Constraints in kinds]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Do we allow a type constructor to have a kind like+   S :: Eq a => a -> Type++No, we do not.  Doing so would mean would need a TyConApp like+   S @k @(d :: Eq k) (ty :: k)+ and we have no way to build, or decompose, evidence like+ (d :: Eq k) at the type level.++But we admit one exception: equality.  We /do/ allow, say,+   MkT :: (a ~ b) => a -> b -> Type a b++Why?  Because we can, without much difficulty.  Moreover+we can promote a GADT data constructor (see TyCon+Note [Promoted data constructors]), like+  data GT a b where+    MkGT : a -> a -> GT a a+so programmers might reasonably expect to be able to+promote MkT as well.++How does this work?++* In TcValidity.checkConstraintsOK we reject kinds that+  have constraints other than (a~b) and (a~~b).++* In Inst.tcInstInvisibleTyBinder we instantiate a call+  of MkT by emitting+     [W] co :: alpha ~# beta+  and producing the elaborated term+     MkT @alpha @beta (Eq# alpha beta co)+  We don't generate a boxed "Wanted"; we generate only a+  regular old /unboxed/ primitive-equality Wanted, and build+  the box on the spot.++* How can we get such a MkT?  By promoting a GADT-style data+  constructor+     data T a b where+       MkT :: (a~b) => a -> b -> T a b+  See DataCon.mkPromotedDataCon+  and Note [Promoted data constructors] in TyCon++* We support both homogeneous (~) and heterogeneous (~~)+  equality.  (See Note [The equality types story]+  in TysPrim for a primer on these equality types.)++* How do we prevent a MkT having an illegal constraint like+  Eq a?  We check for this at use-sites; see TcHsType.tcTyVar,+  specifically dc_theta_illegal_constraint.++* Notice that nothing special happens if+    K :: (a ~# b) => blah+  because (a ~# b) is not a predicate type, and is never+  implicitly instantiated. (Mind you, it's not clear how you+  could creates a type constructor with such a kind.) See+  Note [Types for coercions, predicates, and evidence]++* The existence of promoted MkT with an equality-constraint+  argument is the (only) reason that the AnonTCB constructor+  of TyConBndrVis carries an AnonArgFlag (VisArg/InvisArg).+  For example, when we promote the data constructor+     MkT :: forall a b. (a~b) => a -> b -> T a b+  we get a PromotedDataCon with tyConBinders+      Bndr (a :: Type)  (NamedTCB Inferred)+      Bndr (b :: Type)  (NamedTCB Inferred)+      Bndr (_ :: a ~ b) (AnonTCB InvisArg)+      Bndr (_ :: a)     (AnonTCB VisArg))+      Bndr (_ :: b)     (AnonTCB VisArg))++* One might reasonably wonder who *unpacks* these boxes once they are+  made. After all, there is no type-level `case` construct. The+  surprising answer is that no one ever does. Instead, if a GADT+  constructor is used on the left-hand side of a type family equation,+  that occurrence forces GHC to unify the types in question. For+  example:++  data G a where+    MkG :: G Bool++  type family F (x :: G a) :: a where+    F MkG = False++  When checking the LHS `F MkG`, GHC sees the MkG constructor and then must+  unify F's implicit parameter `a` with Bool. This succeeds, making the equation++    F Bool (MkG @Bool <Bool>) = False++  Note that we never need unpack the coercion. This is because type+  family equations are *not* parametric in their kind variables. That+  is, we could have just said++  type family H (x :: G a) :: a where+    H _ = False++  The presence of False on the RHS also forces `a` to become Bool,+  giving us++    H Bool _ = False++  The fact that any of this works stems from the lack of phase+  separation between types and kinds (unlike the very present phase+  separation between terms and types).++  Once we have the ability to pattern-match on types below top-level,+  this will no longer cut it, but it seems fine for now.+++Note [Arguments to type constructors]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Because of kind polymorphism, in addition to type application we now+have kind instantiation. We reuse the same notations to do so.++For example:++  Just (* -> *) Maybe+  Right * Nat Zero++are represented by:++  TyConApp (PromotedDataCon Just) [* -> *, Maybe]+  TyConApp (PromotedDataCon Right) [*, Nat, (PromotedDataCon Zero)]++Important note: Nat is used as a *kind* and not as a type. This can be+confusing, since type-level Nat and kind-level Nat are identical. We+use the kind of (PromotedDataCon Right) to know if its arguments are+kinds or types.++This kind instantiation only happens in TyConApp currently.++Note [Non-trivial definitional equality]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Is Int |> <*> the same as Int? YES! In order to reduce headaches,+we decide that any reflexive casts in types are just ignored.+(Indeed they must be. See Note [Respecting definitional equality].)+More generally, the `eqType` function, which defines Core's type equality+relation, ignores casts and coercion arguments, as long as the+two types have the same kind. This allows us to be a little sloppier+in keeping track of coercions, which is a good thing. It also means+that eqType does not depend on eqCoercion, which is also a good thing.++Why is this sensible? That is, why is something different than α-equivalence+appropriate for the implementation of eqType?++Anything smaller than ~ and homogeneous is an appropriate definition for+equality. The type safety of FC depends only on ~. Let's say η : τ ~ σ. Any+expression of type τ can be transmuted to one of type σ at any point by+casting. The same is true of expressions of type σ. So in some sense, τ and σ+are interchangeable.++But let's be more precise. If we examine the typing rules of FC (say, those in+https://cs.brynmawr.edu/~rae/papers/2015/equalities/equalities.pdf)+there are several places where the same metavariable is used in two different+premises to a rule. (For example, see Ty_App.) There is an implicit equality+check here. What definition of equality should we use? By convention, we use+α-equivalence. Take any rule with one (or more) of these implicit equality+checks. Then there is an admissible rule that uses ~ instead of the implicit+check, adding in casts as appropriate.++The only problem here is that ~ is heterogeneous. To make the kinds work out+in the admissible rule that uses ~, it is necessary to homogenize the+coercions. That is, if we have η : (τ : κ1) ~ (σ : κ2), then we don't use η;+we use η |> kind η, which is homogeneous.++The effect of this all is that eqType, the implementation of the implicit+equality check, can use any homogeneous relation that is smaller than ~, as+those rules must also be admissible.++A more drawn out argument around all of this is presented in Section 7.2 of+Richard E's thesis (http://cs.brynmawr.edu/~rae/papers/2016/thesis/eisenberg-thesis.pdf).++What would go wrong if we insisted on the casts matching? See the beginning of+Section 8 in the unpublished paper above. Theoretically, nothing at all goes+wrong. But in practical terms, getting the coercions right proved to be+nightmarish. And types would explode: during kind-checking, we often produce+reflexive kind coercions. When we try to cast by these, mkCastTy just discards+them. But if we used an eqType that distinguished between Int and Int |> <*>,+then we couldn't discard -- the output of kind-checking would be enormous,+and we would need enormous casts with lots of CoherenceCo's to straighten+them out.++Would anything go wrong if eqType respected type families? No, not at all. But+that makes eqType rather hard to implement.++Thus, the guideline for eqType is that it should be the largest+easy-to-implement relation that is still smaller than ~ and homogeneous. The+precise choice of relation is somewhat incidental, as long as the smart+constructors and destructors in Type respect whatever relation is chosen.++Another helpful principle with eqType is this:++ (EQ) If (t1 `eqType` t2) then I can replace t1 by t2 anywhere.++This principle also tells us that eqType must relate only types with the+same kinds.++Note [Respecting definitional equality]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Note [Non-trivial definitional equality] introduces the property (EQ).+How is this upheld?++Any function that pattern matches on all the constructors will have to+consider the possibility of CastTy. Presumably, those functions will handle+CastTy appropriately and we'll be OK.++More dangerous are the splitXXX functions. Let's focus on splitTyConApp.+We don't want it to fail on (T a b c |> co). Happily, if we have+  (T a b c |> co) `eqType` (T d e f)+then co must be reflexive. Why? eqType checks that the kinds are equal, as+well as checking that (a `eqType` d), (b `eqType` e), and (c `eqType` f).+By the kind check, we know that (T a b c |> co) and (T d e f) have the same+kind. So the only way that co could be non-reflexive is for (T a b c) to have+a different kind than (T d e f). But because T's kind is closed (all tycon kinds+are closed), the only way for this to happen is that one of the arguments has+to differ, leading to a contradiction. Thus, co is reflexive.++Accordingly, by eliminating reflexive casts, splitTyConApp need not worry+about outermost casts to uphold (EQ). Eliminating reflexive casts is done+in mkCastTy.++Unforunately, that's not the end of the story. Consider comparing+  (T a b c)      =?       (T a b |> (co -> <Type>)) (c |> co)+These two types have the same kind (Type), but the left type is a TyConApp+while the right type is not. To handle this case, we say that the right-hand+type is ill-formed, requiring an AppTy never to have a casted TyConApp+on its left. It is easy enough to pull around the coercions to maintain+this invariant, as done in Type.mkAppTy. In the example above, trying to+form the right-hand type will instead yield (T a b (c |> co |> sym co) |> <Type>).+Both the casts there are reflexive and will be dropped. Huzzah.++This idea of pulling coercions to the right works for splitAppTy as well.++However, there is one hiccup: it's possible that a coercion doesn't relate two+Pi-types. For example, if we have @type family Fun a b where Fun a b = a -> b@,+then we might have (T :: Fun Type Type) and (T |> axFun) Int. That axFun can't+be pulled to the right. But we don't need to pull it: (T |> axFun) Int is not+`eqType` to any proper TyConApp -- thus, leaving it where it is doesn't violate+our (EQ) property.++Lastly, in order to detect reflexive casts reliably, we must make sure not+to have nested casts: we update (t |> co1 |> co2) to (t |> (co1 `TransCo` co2)).++In sum, in order to uphold (EQ), we need the following three invariants:++  (EQ1) No decomposable CastTy to the left of an AppTy, where a decomposable+        cast is one that relates either a FunTy to a FunTy or a+        ForAllTy to a ForAllTy.+  (EQ2) No reflexive casts in CastTy.+  (EQ3) No nested CastTys.+  (EQ4) No CastTy over (ForAllTy (Bndr tyvar vis) body).+        See Note [Weird typing rule for ForAllTy] in Type.++These invariants are all documented above, in the declaration for Type.++Note [Unused coercion variable in ForAllTy]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have+  \(co:t1 ~ t2). e++What type should we give to this expression?+  (1) forall (co:t1 ~ t2) -> t+  (2) (t1 ~ t2) -> t++If co is used in t, (1) should be the right choice.+if co is not used in t, we would like to have (1) and (2) equivalent.++However, we want to keep eqType simple and don't want eqType (1) (2) to return+True in any case.++We decide to always construct (2) if co is not used in t.++Thus in mkLamType, we check whether the variable is a coercion+variable (of type (t1 ~# t2), and whether it is un-used in the+body. If so, it returns a FunTy instead of a ForAllTy.++There are cases we want to skip the check. For example, the check is+unnecessary when it is known from the context that the input variable+is a type variable.  In those cases, we use mkForAllTy.++-}++-- | A type labeled 'KnotTied' might have knot-tied tycons in it. See+-- Note [Type checking recursive type and class declarations] in+-- TcTyClsDecls+type KnotTied ty = ty++{- **********************************************************************+*                                                                       *+                  TyCoBinder and ArgFlag+*                                                                       *+********************************************************************** -}++-- | A 'TyCoBinder' represents an argument to a function. TyCoBinders can be+-- dependent ('Named') or nondependent ('Anon'). They may also be visible or+-- not. See Note [TyCoBinders]+data TyCoBinder+  = Named TyCoVarBinder    -- A type-lambda binder+  | Anon AnonArgFlag Type  -- A term-lambda binder. Type here can be CoercionTy.+                           -- Visibility is determined by the AnonArgFlag+  deriving Data.Data++-- | 'TyBinder' is like 'TyCoBinder', but there can only be 'TyVarBinder'+-- in the 'Named' field.+type TyBinder = TyCoBinder++-- | Remove the binder's variable from the set, if the binder has+-- a variable.+delBinderVar :: VarSet -> TyCoVarBinder -> VarSet+delBinderVar vars (Bndr tv _) = vars `delVarSet` tv++-- | Does this binder bind an invisible argument?+isInvisibleBinder :: TyCoBinder -> Bool+isInvisibleBinder (Named (Bndr _ vis)) = isInvisibleArgFlag vis+isInvisibleBinder (Anon InvisArg _)    = True+isInvisibleBinder (Anon VisArg   _)    = False++-- | Does this binder bind a visible argument?+isVisibleBinder :: TyCoBinder -> Bool+isVisibleBinder = not . isInvisibleBinder++isNamedBinder :: TyCoBinder -> Bool+isNamedBinder (Named {}) = True+isNamedBinder (Anon {})  = False++-- | If its a named binder, is the binder a tyvar?+-- Returns True for nondependent binder.+-- This check that we're really returning a *Ty*Binder (as opposed to a+-- coercion binder). That way, if/when we allow coercion quantification+-- in more places, we'll know we missed updating some function.+isTyBinder :: TyCoBinder -> Bool+isTyBinder (Named bnd) = isTyVarBinder bnd+isTyBinder _ = True++{- Note [TyCoBinders]+~~~~~~~~~~~~~~~~~~~+A ForAllTy contains a TyCoVarBinder.  But a type can be decomposed+to a telescope consisting of a [TyCoBinder]++A TyCoBinder represents the type of binders -- that is, the type of an+argument to a Pi-type. GHC Core currently supports two different+Pi-types:++ * A non-dependent function type,+   written with ->, e.g. ty1 -> ty2+   represented as FunTy ty1 ty2. These are+   lifted to Coercions with the corresponding FunCo.++ * A dependent compile-time-only polytype,+   written with forall, e.g.  forall (a:*). ty+   represented as ForAllTy (Bndr a v) ty++Both Pi-types classify terms/types that take an argument. In other+words, if `x` is either a function or a polytype, `x arg` makes sense+(for an appropriate `arg`).+++Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+* A ForAllTy (used for both types and kinds) contains a TyCoVarBinder.+  Each TyCoVarBinder+      Bndr a tvis+  is equipped with tvis::ArgFlag, which says whether or not arguments+  for this binder should be visible (explicit) in source Haskell.++* A TyCon contains a list of TyConBinders.  Each TyConBinder+      Bndr a cvis+  is equipped with cvis::TyConBndrVis, which says whether or not type+  and kind arguments for this TyCon should be visible (explicit) in+  source Haskell.++This table summarises the visibility rules:+---------------------------------------------------------------------------------------+|                                                      Occurrences look like this+|                             GHC displays type as     in Haskell source code+|--------------------------------------------------------------------------------------+| Bndr a tvis :: TyCoVarBinder, in the binder of ForAllTy for a term+|  tvis :: ArgFlag+|  tvis = Inferred:            f :: forall {a}. type    Arg not allowed:  f+                               f :: forall {co}. type   Arg not allowed:  f+|  tvis = Specified:           f :: forall a. type      Arg optional:     f  or  f @Int+|  tvis = Required:            T :: forall k -> type    Arg required:     T *+|    This last form is illegal in terms: See Note [No Required TyCoBinder in terms]+|+| Bndr k cvis :: TyConBinder, in the TyConBinders of a TyCon+|  cvis :: TyConBndrVis+|  cvis = AnonTCB:             T :: kind -> kind        Required:            T *+|  cvis = NamedTCB Inferred:   T :: forall {k}. kind    Arg not allowed:     T+|                              T :: forall {co}. kind   Arg not allowed:     T+|  cvis = NamedTCB Specified:  T :: forall k. kind      Arg not allowed[1]:  T+|  cvis = NamedTCB Required:   T :: forall k -> kind    Required:            T *+---------------------------------------------------------------------------------------++[1] In types, in the Specified case, it would make sense to allow+    optional kind applications, thus (T @*), but we have not+    yet implemented that++---- In term declarations ----++* Inferred.  Function defn, with no signature:  f1 x = x+  We infer f1 :: forall {a}. a -> a, with 'a' Inferred+  It's Inferred because it doesn't appear in any+  user-written signature for f1++* Specified.  Function defn, with signature (implicit forall):+     f2 :: a -> a; f2 x = x+  So f2 gets the type f2 :: forall a. a -> a, with 'a' Specified+  even though 'a' is not bound in the source code by an explicit forall++* Specified.  Function defn, with signature (explicit forall):+     f3 :: forall a. a -> a; f3 x = x+  So f3 gets the type f3 :: forall a. a -> a, with 'a' Specified++* Inferred/Specified.  Function signature with inferred kind polymorphism.+     f4 :: a b -> Int+  So 'f4' gets the type f4 :: forall {k} (a:k->*) (b:k). a b -> Int+  Here 'k' is Inferred (it's not mentioned in the type),+  but 'a' and 'b' are Specified.++* Specified.  Function signature with explicit kind polymorphism+     f5 :: a (b :: k) -> Int+  This time 'k' is Specified, because it is mentioned explicitly,+  so we get f5 :: forall (k:*) (a:k->*) (b:k). a b -> Int++* Similarly pattern synonyms:+  Inferred - from inferred types (e.g. no pattern type signature)+           - or from inferred kind polymorphism++---- In type declarations ----++* Inferred (k)+     data T1 a b = MkT1 (a b)+  Here T1's kind is  T1 :: forall {k:*}. (k->*) -> k -> *+  The kind variable 'k' is Inferred, since it is not mentioned++  Note that 'a' and 'b' correspond to /Anon/ TyCoBinders in T1's kind,+  and Anon binders don't have a visibility flag. (Or you could think+  of Anon having an implicit Required flag.)++* Specified (k)+     data T2 (a::k->*) b = MkT (a b)+  Here T's kind is  T :: forall (k:*). (k->*) -> k -> *+  The kind variable 'k' is Specified, since it is mentioned in+  the signature.++* Required (k)+     data T k (a::k->*) b = MkT (a b)+  Here T's kind is  T :: forall k:* -> (k->*) -> k -> *+  The kind is Required, since it bound in a positional way in T's declaration+  Every use of T must be explicitly applied to a kind++* Inferred (k1), Specified (k)+     data T a b (c :: k) = MkT (a b) (Proxy c)+  Here T's kind is  T :: forall {k1:*} (k:*). (k1->*) -> k1 -> k -> *+  So 'k' is Specified, because it appears explicitly,+  but 'k1' is Inferred, because it does not++Generally, in the list of TyConBinders for a TyCon,++* Inferred arguments always come first+* Specified, Anon and Required can be mixed++e.g.+  data Foo (a :: Type) :: forall b. (a -> b -> Type) -> Type where ...++Here Foo's TyConBinders are+   [Required 'a', Specified 'b', Anon]+and its kind prints as+   Foo :: forall a -> forall b. (a -> b -> Type) -> Type++See also Note [Required, Specified, and Inferred for types] in TcTyClsDecls++---- Printing -----++ We print forall types with enough syntax to tell you their visibility+ flag.  But this is not source Haskell, and these types may not all+ be parsable.++ Specified: a list of Specified binders is written between `forall` and `.`:+               const :: forall a b. a -> b -> a++ Inferred:  with -fprint-explicit-foralls, Inferred binders are written+            in braces:+               f :: forall {k} (a:k). S k a -> Int+            Otherwise, they are printed like Specified binders.++ Required: binders are put between `forall` and `->`:+              T :: forall k -> *++---- Other points -----++* In classic Haskell, all named binders (that is, the type variables in+  a polymorphic function type f :: forall a. a -> a) have been Inferred.++* Inferred variables correspond to "generalized" variables from the+  Visible Type Applications paper (ESOP'16).++Note [No Required TyCoBinder in terms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We don't allow Required foralls for term variables, including pattern+synonyms and data constructors.  Why?  Because then an application+would need a /compulsory/ type argument (possibly without an "@"?),+thus (f Int); and we don't have concrete syntax for that.++We could change this decision, but Required, Named TyCoBinders are rare+anyway.  (Most are Anons.)++However the type of a term can (just about) have a required quantifier;+see Note [Required quantifiers in the type of a term] in TcExpr.+-}+++{- **********************************************************************+*                                                                       *+                        PredType+*                                                                       *+********************************************************************** -}+++-- | A type of the form @p@ of kind @Constraint@ represents a value whose type is+-- the Haskell predicate @p@, where a predicate is what occurs before+-- the @=>@ in a Haskell type.+--+-- We use 'PredType' as documentation to mark those types that we guarantee to have+-- this kind.+--+-- It can be expanded into its representation, but:+--+-- * The type checker must treat it as opaque+--+-- * The rest of the compiler treats it as transparent+--+-- Consider these examples:+--+-- > f :: (Eq a) => a -> Int+-- > g :: (?x :: Int -> Int) => a -> Int+-- > h :: (r\l) => {r} => {l::Int | r}+--+-- Here the @Eq a@ and @?x :: Int -> Int@ and @r\l@ are all called \"predicates\"+type PredType = Type++-- | A collection of 'PredType's+type ThetaType = [PredType]++{-+(We don't support TREX records yet, but the setup is designed+to expand to allow them.)++A Haskell qualified type, such as that for f,g,h above, is+represented using+        * a FunTy for the double arrow+        * with a type of kind Constraint as the function argument++The predicate really does turn into a real extra argument to the+function.  If the argument has type (p :: Constraint) then the predicate p is+represented by evidence of type p.+++%************************************************************************+%*                                                                      *+            Simple constructors+%*                                                                      *+%************************************************************************++These functions are here so that they can be used by TysPrim,+which in turn is imported by Type+-}++mkTyVarTy  :: TyVar   -> Type+mkTyVarTy v = ASSERT2( isTyVar v, ppr v <+> dcolon <+> ppr (tyVarKind v) )+              TyVarTy v++mkTyVarTys :: [TyVar] -> [Type]+mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy++mkTyCoVarTy :: TyCoVar -> Type+mkTyCoVarTy v+  | isTyVar v+  = TyVarTy v+  | otherwise+  = CoercionTy (CoVarCo v)++mkTyCoVarTys :: [TyCoVar] -> [Type]+mkTyCoVarTys = map mkTyCoVarTy++infixr 3 `mkFunTy`, `mkVisFunTy`, `mkInvisFunTy`      -- Associates to the right++mkFunTy :: AnonArgFlag -> Type -> Type -> Type+mkFunTy af arg res = FunTy { ft_af = af, ft_arg = arg, ft_res = res }++mkVisFunTy, mkInvisFunTy :: Type -> Type -> Type+mkVisFunTy   = mkFunTy VisArg+mkInvisFunTy = mkFunTy InvisArg++-- | Make nested arrow types+mkVisFunTys, mkInvisFunTys :: [Type] -> Type -> Type+mkVisFunTys   tys ty = foldr mkVisFunTy   ty tys+mkInvisFunTys tys ty = foldr mkInvisFunTy ty tys++-- | Like 'mkTyCoForAllTy', but does not check the occurrence of the binder+-- See Note [Unused coercion variable in ForAllTy]+mkForAllTy :: TyCoVar -> ArgFlag -> Type -> Type+mkForAllTy tv vis ty = ForAllTy (Bndr tv vis) ty++-- | Wraps foralls over the type using the provided 'TyCoVar's from left to right+mkForAllTys :: [TyCoVarBinder] -> Type -> Type+mkForAllTys tyvars ty = foldr ForAllTy ty tyvars++mkPiTy:: TyCoBinder -> Type -> Type+mkPiTy (Anon af ty1) ty2        = FunTy { ft_af = af, ft_arg = ty1, ft_res = ty2 }+mkPiTy (Named (Bndr tv vis)) ty = mkForAllTy tv vis ty++mkPiTys :: [TyCoBinder] -> Type -> Type+mkPiTys tbs ty = foldr mkPiTy ty tbs++-- | Create the plain type constructor type which has been applied to no type arguments at all.+mkTyConTy :: TyCon -> Type+mkTyConTy tycon = TyConApp tycon []++{-+Some basic functions, put here to break loops eg with the pretty printer+-}++-- | Extract the RuntimeRep classifier of a type from its kind. For example,+-- @kindRep * = LiftedRep@; Panics if this is not possible.+-- Treats * and Constraint as the same+kindRep :: HasDebugCallStack => Kind -> Type+kindRep k = case kindRep_maybe k of+              Just r  -> r+              Nothing -> pprPanic "kindRep" (ppr k)++-- | Given a kind (TYPE rr), extract its RuntimeRep classifier rr.+-- For example, @kindRep_maybe * = Just LiftedRep@+-- Returns 'Nothing' if the kind is not of form (TYPE rr)+-- Treats * and Constraint as the same+kindRep_maybe :: HasDebugCallStack => Kind -> Maybe Type+kindRep_maybe kind+  | Just kind' <- coreView kind = kindRep_maybe kind'+  | TyConApp tc [arg] <- kind+  , tc `hasKey` tYPETyConKey    = Just arg+  | otherwise                   = Nothing++-- | This version considers Constraint to be the same as *. Returns True+-- if the argument is equivalent to Type/Constraint and False otherwise.+-- See Note [Kind Constraint and kind Type]+isLiftedTypeKind :: Kind -> Bool+isLiftedTypeKind kind+  = case kindRep_maybe kind of+      Just rep -> isLiftedRuntimeRep rep+      Nothing  -> False++-- | Returns True if the kind classifies unlifted types and False otherwise.+-- Note that this returns False for levity-polymorphic kinds, which may+-- be specialized to a kind that classifies unlifted types.+isUnliftedTypeKind :: Kind -> Bool+isUnliftedTypeKind kind+  = case kindRep_maybe kind of+      Just rep -> isUnliftedRuntimeRep rep+      Nothing  -> False++isLiftedRuntimeRep :: Type -> Bool+-- isLiftedRuntimeRep is true of LiftedRep :: RuntimeRep+-- False of type variables (a :: RuntimeRep)+--   and of other reps e.g. (IntRep :: RuntimeRep)+isLiftedRuntimeRep rep+  | Just rep' <- coreView rep          = isLiftedRuntimeRep rep'+  | TyConApp rr_tc args <- rep+  , rr_tc `hasKey` liftedRepDataConKey = ASSERT( null args ) True+  | otherwise                          = False++isUnliftedRuntimeRep :: Type -> Bool+-- True of definitely-unlifted RuntimeReps+-- False of           (LiftedRep :: RuntimeRep)+--   and of variables (a :: RuntimeRep)+isUnliftedRuntimeRep rep+  | Just rep' <- coreView rep = isUnliftedRuntimeRep rep'+  | TyConApp rr_tc _ <- rep   -- NB: args might be non-empty+                              --     e.g. TupleRep [r1, .., rn]+  = isPromotedDataCon rr_tc && not (rr_tc `hasKey` liftedRepDataConKey)+        -- Avoid searching all the unlifted RuntimeRep type cons+        -- In the RuntimeRep data type, only LiftedRep is lifted+        -- But be careful of type families (F tys) :: RuntimeRep+  | otherwise {- Variables, applications -}+  = False++-- | Is this the type 'RuntimeRep'?+isRuntimeRepTy :: Type -> Bool+isRuntimeRepTy ty | Just ty' <- coreView ty = isRuntimeRepTy ty'+isRuntimeRepTy (TyConApp tc args)+  | tc `hasKey` runtimeRepTyConKey = ASSERT( null args ) True+isRuntimeRepTy _ = False++-- | Is a tyvar of type 'RuntimeRep'?+isRuntimeRepVar :: TyVar -> Bool+isRuntimeRepVar = isRuntimeRepTy . tyVarKind++{-+%************************************************************************+%*                                                                      *+            Coercions+%*                                                                      *+%************************************************************************+-}++-- | A 'Coercion' is concrete evidence of the equality/convertibility+-- of two types.++-- If you edit this type, you may need to update the GHC formalism+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs+data Coercion+  -- Each constructor has a "role signature", indicating the way roles are+  -- propagated through coercions.+  --    -  P, N, and R stand for coercions of the given role+  --    -  e stands for a coercion of a specific unknown role+  --           (think "role polymorphism")+  --    -  "e" stands for an explicit role parameter indicating role e.+  --    -   _ stands for a parameter that is not a Role or Coercion.++  -- These ones mirror the shape of types+  = -- Refl :: _ -> N+    Refl Type  -- See Note [Refl invariant]+          -- Invariant: applications of (Refl T) to a bunch of identity coercions+          --            always show up as Refl.+          -- For example  (Refl T) (Refl a) (Refl b) shows up as (Refl (T a b)).++          -- Applications of (Refl T) to some coercions, at least one of+          -- which is NOT the identity, show up as TyConAppCo.+          -- (They may not be fully saturated however.)+          -- ConAppCo coercions (like all coercions other than Refl)+          -- are NEVER the identity.++          -- Use (GRefl Representational ty MRefl), not (SubCo (Refl ty))++  -- GRefl :: "e" -> _ -> Maybe N -> e+  -- See Note [Generalized reflexive coercion]+  | GRefl Role Type MCoercionN  -- See Note [Refl invariant]+          -- Use (Refl ty), not (GRefl Nominal ty MRefl)+          -- Use (GRefl Representational _ _), not (SubCo (GRefl Nominal _ _))++  -- These ones simply lift the correspondingly-named+  -- Type constructors into Coercions++  -- TyConAppCo :: "e" -> _ -> ?? -> e+  -- See Note [TyConAppCo roles]+  | TyConAppCo Role TyCon [Coercion]    -- lift TyConApp+               -- The TyCon is never a synonym;+               -- we expand synonyms eagerly+               -- But it can be a type function++  | AppCo Coercion CoercionN             -- lift AppTy+          -- AppCo :: e -> N -> e++  -- See Note [Forall coercions]+  | ForAllCo TyCoVar KindCoercion Coercion+         -- ForAllCo :: _ -> N -> e -> e++  | FunCo Role Coercion Coercion         -- lift FunTy+         -- FunCo :: "e" -> e -> e -> e+         -- Note: why doesn't FunCo have a AnonArgFlag, like FunTy?+         -- Because the AnonArgFlag has no impact on Core; it is only+         -- there to guide implicit instantiation of Haskell source+         -- types, and that is irrelevant for coercions, which are+         -- Core-only.++  -- These are special+  | CoVarCo CoVar      -- :: _ -> (N or R)+                       -- result role depends on the tycon of the variable's type++    -- AxiomInstCo :: e -> _ -> [N] -> e+  | AxiomInstCo (CoAxiom Branched) BranchIndex [Coercion]+     -- See also [CoAxiom index]+     -- The coercion arguments always *precisely* saturate+     -- arity of (that branch of) the CoAxiom. If there are+     -- any left over, we use AppCo.+     -- See [Coercion axioms applied to coercions]++  | AxiomRuleCo CoAxiomRule [Coercion]+    -- AxiomRuleCo is very like AxiomInstCo, but for a CoAxiomRule+    -- The number coercions should match exactly the expectations+    -- of the CoAxiomRule (i.e., the rule is fully saturated).++  | UnivCo UnivCoProvenance Role Type Type+      -- :: _ -> "e" -> _ -> _ -> e++  | SymCo Coercion             -- :: e -> e+  | TransCo Coercion Coercion  -- :: e -> e -> e++  | NthCo  Role Int Coercion     -- Zero-indexed; decomposes (T t0 ... tn)+    -- :: "e" -> _ -> e0 -> e (inverse of TyConAppCo, see Note [TyConAppCo roles])+    -- Using NthCo on a ForAllCo gives an N coercion always+    -- See Note [NthCo and newtypes]+    --+    -- Invariant:  (NthCo r i co), it is always the case that r = role of (Nth i co)+    -- That is: the role of the entire coercion is redundantly cached here.+    -- See Note [NthCo Cached Roles]++  | LRCo   LeftOrRight CoercionN     -- Decomposes (t_left t_right)+    -- :: _ -> N -> N+  | InstCo Coercion CoercionN+    -- :: e -> N -> e+    -- See Note [InstCo roles]++  -- Extract a kind coercion from a (heterogeneous) type coercion+  -- NB: all kind coercions are Nominal+  | KindCo Coercion+     -- :: e -> N++  | SubCo CoercionN                  -- Turns a ~N into a ~R+    -- :: N -> R++  | HoleCo CoercionHole              -- ^ See Note [Coercion holes]+                                     -- Only present during typechecking+  deriving Data.Data++type CoercionN = Coercion       -- always nominal+type CoercionR = Coercion       -- always representational+type CoercionP = Coercion       -- always phantom+type KindCoercion = CoercionN   -- always nominal++-- | A semantically more meaningful type to represent what may or may not be a+-- useful 'Coercion'.+data MCoercion+  = MRefl+    -- A trivial Reflexivity coercion+  | MCo Coercion+    -- Other coercions+  deriving Data.Data+type MCoercionR = MCoercion+type MCoercionN = MCoercion++instance Outputable MCoercion where+  ppr MRefl    = text "MRefl"+  ppr (MCo co) = text "MCo" <+> ppr co++{-+Note [Refl invariant]+~~~~~~~~~~~~~~~~~~~~~+Invariant 1:++Coercions have the following invariant+     Refl (similar for GRefl r ty MRefl) is always lifted as far as possible.++You might think that a consequencs is:+     Every identity coercions has Refl at the root++But that's not quite true because of coercion variables.  Consider+     g         where g :: Int~Int+     Left h    where h :: Maybe Int ~ Maybe Int+etc.  So the consequence is only true of coercions that+have no coercion variables.++Note [Generalized reflexive coercion]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++GRefl is a generalized reflexive coercion (see #15192). It wraps a kind+coercion, which might be reflexive (MRefl) or any coercion (MCo co). The typing+rules for GRefl:++  ty : k1+  ------------------------------------+  GRefl r ty MRefl: ty ~r ty++  ty : k1       co :: k1 ~ k2+  ------------------------------------+  GRefl r ty (MCo co) : ty ~r ty |> co++Consider we have++   g1 :: s ~r t+   s  :: k1+   g2 :: k1 ~ k2++and we want to construct a coercions co which has type++   (s |> g2) ~r t++We can define++   co = Sym (GRefl r s g2) ; g1++It is easy to see that++   Refl == GRefl Nominal ty MRefl :: ty ~n ty++A nominal reflexive coercion is quite common, so we keep the special form Refl to+save allocation.++Note [Coercion axioms applied to coercions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The reason coercion axioms can be applied to coercions and not just+types is to allow for better optimization.  There are some cases where+we need to be able to "push transitivity inside" an axiom in order to+expose further opportunities for optimization.++For example, suppose we have++  C a : t[a] ~ F a+  g   : b ~ c++and we want to optimize++  sym (C b) ; t[g] ; C c++which has the kind++  F b ~ F c++(stopping through t[b] and t[c] along the way).++We'd like to optimize this to just F g -- but how?  The key is+that we need to allow axioms to be instantiated by *coercions*,+not just by types.  Then we can (in certain cases) push+transitivity inside the axiom instantiations, and then react+opposite-polarity instantiations of the same axiom.  In this+case, e.g., we match t[g] against the LHS of (C c)'s kind, to+obtain the substitution  a |-> g  (note this operation is sort+of the dual of lifting!) and hence end up with++  C g : t[b] ~ F c++which indeed has the same kind as  t[g] ; C c.++Now we have++  sym (C b) ; C g++which can be optimized to F g.++Note [CoAxiom index]+~~~~~~~~~~~~~~~~~~~~+A CoAxiom has 1 or more branches. Each branch has contains a list+of the free type variables in that branch, the LHS type patterns,+and the RHS type for that branch. When we apply an axiom to a list+of coercions, we must choose which branch of the axiom we wish to+use, as the different branches may have different numbers of free+type variables. (The number of type patterns is always the same+among branches, but that doesn't quite concern us here.)++The Int in the AxiomInstCo constructor is the 0-indexed number+of the chosen branch.++Note [Forall coercions]+~~~~~~~~~~~~~~~~~~~~~~~+Constructing coercions between forall-types can be a bit tricky,+because the kinds of the bound tyvars can be different.++The typing rule is:+++  kind_co : k1 ~ k2+  tv1:k1 |- co : t1 ~ t2+  -------------------------------------------------------------------+  ForAllCo tv1 kind_co co : all tv1:k1. t1  ~+                            all tv1:k2. (t2[tv1 |-> tv1 |> sym kind_co])++First, the TyCoVar stored in a ForAllCo is really an optimisation: this field+should be a Name, as its kind is redundant. Thinking of the field as a Name+is helpful in understanding what a ForAllCo means.+The kind of TyCoVar always matches the left-hand kind of the coercion.++The idea is that kind_co gives the two kinds of the tyvar. See how, in the+conclusion, tv1 is assigned kind k1 on the left but kind k2 on the right.++Of course, a type variable can't have different kinds at the same time. So,+we arbitrarily prefer the first kind when using tv1 in the inner coercion+co, which shows that t1 equals t2.++The last wrinkle is that we need to fix the kinds in the conclusion. In+t2, tv1 is assumed to have kind k1, but it has kind k2 in the conclusion of+the rule. So we do a kind-fixing substitution, replacing (tv1:k1) with+(tv1:k2) |> sym kind_co. This substitution is slightly bizarre, because it+mentions the same name with different kinds, but it *is* well-kinded, noting+that `(tv1:k2) |> sym kind_co` has kind k1.++This all really would work storing just a Name in the ForAllCo. But we can't+add Names to, e.g., VarSets, and there generally is just an impedance mismatch+in a bunch of places. So we use tv1. When we need tv2, we can use+setTyVarKind.++Note [Predicate coercions]+~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have+   g :: a~b+How can we coerce between types+   ([c]~a) => [a] -> c+and+   ([c]~b) => [b] -> c+where the equality predicate *itself* differs?++Answer: we simply treat (~) as an ordinary type constructor, so these+types really look like++   ((~) [c] a) -> [a] -> c+   ((~) [c] b) -> [b] -> c++So the coercion between the two is obviously++   ((~) [c] g) -> [g] -> c++Another way to see this to say that we simply collapse predicates to+their representation type (see Type.coreView and Type.predTypeRep).++This collapse is done by mkPredCo; there is no PredCo constructor+in Coercion.  This is important because we need Nth to work on+predicates too:+    Nth 1 ((~) [c] g) = g+See Simplify.simplCoercionF, which generates such selections.++Note [Roles]+~~~~~~~~~~~~+Roles are a solution to the GeneralizedNewtypeDeriving problem, articulated+in #1496. The full story is in docs/core-spec/core-spec.pdf. Also, see+https://gitlab.haskell.org/ghc/ghc/wikis/roles-implementation++Here is one way to phrase the problem:++Given:+newtype Age = MkAge Int+type family F x+type instance F Age = Bool+type instance F Int = Char++This compiles down to:+axAge :: Age ~ Int+axF1 :: F Age ~ Bool+axF2 :: F Int ~ Char++Then, we can make:+(sym (axF1) ; F axAge ; axF2) :: Bool ~ Char++Yikes!++The solution is _roles_, as articulated in "Generative Type Abstraction and+Type-level Computation" (POPL 2010), available at+http://www.seas.upenn.edu/~sweirich/papers/popl163af-weirich.pdf++The specification for roles has evolved somewhat since that paper. For the+current full details, see the documentation in docs/core-spec. Here are some+highlights.++We label every equality with a notion of type equivalence, of which there are+three options: Nominal, Representational, and Phantom. A ground type is+nominally equivalent only with itself. A newtype (which is considered a ground+type in Haskell) is representationally equivalent to its representation.+Anything is "phantomly" equivalent to anything else. We use "N", "R", and "P"+to denote the equivalences.++The axioms above would be:+axAge :: Age ~R Int+axF1 :: F Age ~N Bool+axF2 :: F Age ~N Char++Then, because transitivity applies only to coercions proving the same notion+of equivalence, the above construction is impossible.++However, there is still an escape hatch: we know that any two types that are+nominally equivalent are representationally equivalent as well. This is what+the form SubCo proves -- it "demotes" a nominal equivalence into a+representational equivalence. So, it would seem the following is possible:++sub (sym axF1) ; F axAge ; sub axF2 :: Bool ~R Char   -- WRONG++What saves us here is that the arguments to a type function F, lifted into a+coercion, *must* prove nominal equivalence. So, (F axAge) is ill-formed, and+we are safe.++Roles are attached to parameters to TyCons. When lifting a TyCon into a+coercion (through TyConAppCo), we need to ensure that the arguments to the+TyCon respect their roles. For example:++data T a b = MkT a (F b)++If we know that a1 ~R a2, then we know (T a1 b) ~R (T a2 b). But, if we know+that b1 ~R b2, we know nothing about (T a b1) and (T a b2)! This is because+the type function F branches on b's *name*, not representation. So, we say+that 'a' has role Representational and 'b' has role Nominal. The third role,+Phantom, is for parameters not used in the type's definition. Given the+following definition++data Q a = MkQ Int++the Phantom role allows us to say that (Q Bool) ~R (Q Char), because we+can construct the coercion Bool ~P Char (using UnivCo).++See the paper cited above for more examples and information.++Note [TyConAppCo roles]+~~~~~~~~~~~~~~~~~~~~~~~+The TyConAppCo constructor has a role parameter, indicating the role at+which the coercion proves equality. The choice of this parameter affects+the required roles of the arguments of the TyConAppCo. To help explain+it, assume the following definition:++  type instance F Int = Bool   -- Axiom axF : F Int ~N Bool+  newtype Age = MkAge Int      -- Axiom axAge : Age ~R Int+  data Foo a = MkFoo a         -- Role on Foo's parameter is Representational++TyConAppCo Nominal Foo axF : Foo (F Int) ~N Foo Bool+  For (TyConAppCo Nominal) all arguments must have role Nominal. Why?+  So that Foo Age ~N Foo Int does *not* hold.++TyConAppCo Representational Foo (SubCo axF) : Foo (F Int) ~R Foo Bool+TyConAppCo Representational Foo axAge       : Foo Age     ~R Foo Int+  For (TyConAppCo Representational), all arguments must have the roles+  corresponding to the result of tyConRoles on the TyCon. This is the+  whole point of having roles on the TyCon to begin with. So, we can+  have Foo Age ~R Foo Int, if Foo's parameter has role R.++  If a Representational TyConAppCo is over-saturated (which is otherwise fine),+  the spill-over arguments must all be at Nominal. This corresponds to the+  behavior for AppCo.++TyConAppCo Phantom Foo (UnivCo Phantom Int Bool) : Foo Int ~P Foo Bool+  All arguments must have role Phantom. This one isn't strictly+  necessary for soundness, but this choice removes ambiguity.++The rules here dictate the roles of the parameters to mkTyConAppCo+(should be checked by Lint).++Note [NthCo and newtypes]+~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have++  newtype N a = MkN Int+  type role N representational++This yields axiom++  NTCo:N :: forall a. N a ~R Int++We can then build++  co :: forall a b. N a ~R N b+  co = NTCo:N a ; sym (NTCo:N b)++for any `a` and `b`. Because of the role annotation on N, if we use+NthCo, we'll get out a representational coercion. That is:++  NthCo r 0 co :: forall a b. a ~R b++Yikes! Clearly, this is terrible. The solution is simple: forbid+NthCo to be used on newtypes if the internal coercion is representational.++This is not just some corner case discovered by a segfault somewhere;+it was discovered in the proof of soundness of roles and described+in the "Safe Coercions" paper (ICFP '14).++Note [NthCo Cached Roles]+~~~~~~~~~~~~~~~~~~~~~~~~~+Why do we cache the role of NthCo in the NthCo constructor?+Because computing role(Nth i co) involves figuring out that++  co :: T tys1 ~ T tys2++using coercionKind, and finding (coercionRole co), and then looking+at the tyConRoles of T. Avoiding bad asymptotic behaviour here means+we have to compute the kind and role of a coercion simultaneously,+which makes the code complicated and inefficient.++This only happens for NthCo. Caching the role solves the problem, and+allows coercionKind and coercionRole to be simple.++See #11735++Note [InstCo roles]+~~~~~~~~~~~~~~~~~~~+Here is (essentially) the typing rule for InstCo:++g :: (forall a. t1) ~r (forall a. t2)+w :: s1 ~N s2+------------------------------- InstCo+InstCo g w :: (t1 [a |-> s1]) ~r (t2 [a |-> s2])++Note that the Coercion w *must* be nominal. This is necessary+because the variable a might be used in a "nominal position"+(that is, a place where role inference would require a nominal+role) in t1 or t2. If we allowed w to be representational, we+could get bogus equalities.++A more nuanced treatment might be able to relax this condition+somewhat, by checking if t1 and/or t2 use their bound variables+in nominal ways. If not, having w be representational is OK.+++%************************************************************************+%*                                                                      *+                UnivCoProvenance+%*                                                                      *+%************************************************************************++A UnivCo is a coercion whose proof does not directly express its role+and kind (indeed for some UnivCos, like UnsafeCoerceProv, there /is/+no proof).++The different kinds of UnivCo are described by UnivCoProvenance.  Really+each is entirely separate, but they all share the need to represent their+role and kind, which is done in the UnivCo constructor.++-}++-- | For simplicity, we have just one UnivCo that represents a coercion from+-- some type to some other type, with (in general) no restrictions on the+-- type. The UnivCoProvenance specifies more exactly what the coercion really+-- is and why a program should (or shouldn't!) trust the coercion.+-- It is reasonable to consider each constructor of 'UnivCoProvenance'+-- as a totally independent coercion form; their only commonality is+-- that they don't tell you what types they coercion between. (That info+-- is in the 'UnivCo' constructor of 'Coercion'.+data UnivCoProvenance+  = UnsafeCoerceProv   -- ^ From @unsafeCoerce#@. These are unsound.++  | PhantomProv KindCoercion -- ^ See Note [Phantom coercions]. Only in Phantom+                             -- roled coercions++  | ProofIrrelProv KindCoercion  -- ^ From the fact that any two coercions are+                                 --   considered equivalent. See Note [ProofIrrelProv].+                                 -- Can be used in Nominal or Representational coercions++  | PluginProv String  -- ^ From a plugin, which asserts that this coercion+                       --   is sound. The string is for the use of the plugin.++  deriving Data.Data++instance Outputable UnivCoProvenance where+  ppr UnsafeCoerceProv   = text "(unsafeCoerce#)"+  ppr (PhantomProv _)    = text "(phantom)"+  ppr (ProofIrrelProv _) = text "(proof irrel.)"+  ppr (PluginProv str)   = parens (text "plugin" <+> brackets (text str))++-- | A coercion to be filled in by the type-checker. See Note [Coercion holes]+data CoercionHole+  = CoercionHole { ch_co_var :: CoVar+                       -- See Note [CoercionHoles and coercion free variables]++                 , ch_ref    :: IORef (Maybe Coercion)+                 }++coHoleCoVar :: CoercionHole -> CoVar+coHoleCoVar = ch_co_var++setCoHoleCoVar :: CoercionHole -> CoVar -> CoercionHole+setCoHoleCoVar h cv = h { ch_co_var = cv }++instance Data.Data CoercionHole where+  -- don't traverse?+  toConstr _   = abstractConstr "CoercionHole"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "CoercionHole"++instance Outputable CoercionHole where+  ppr (CoercionHole { ch_co_var = cv }) = braces (ppr cv)+++{- Note [Phantom coercions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+     data T a = T1 | T2+Then we have+     T s ~R T t+for any old s,t. The witness for this is (TyConAppCo T Rep co),+where (co :: s ~P t) is a phantom coercion built with PhantomProv.+The role of the UnivCo is always Phantom.  The Coercion stored is the+(nominal) kind coercion between the types+   kind(s) ~N kind (t)++Note [Coercion holes]+~~~~~~~~~~~~~~~~~~~~~~~~+During typechecking, constraint solving for type classes works by+  - Generate an evidence Id,  d7 :: Num a+  - Wrap it in a Wanted constraint, [W] d7 :: Num a+  - Use the evidence Id where the evidence is needed+  - Solve the constraint later+  - When solved, add an enclosing let-binding  let d7 = .... in ....+    which actually binds d7 to the (Num a) evidence++For equality constraints we use a different strategy.  See Note [The+equality types story] in TysPrim for background on equality constraints.+  - For /boxed/ equality constraints, (t1 ~N t2) and (t1 ~R t2), it's just+    like type classes above. (Indeed, boxed equality constraints *are* classes.)+  - But for /unboxed/ equality constraints (t1 ~R# t2) and (t1 ~N# t2)+    we use a different plan++For unboxed equalities:+  - Generate a CoercionHole, a mutable variable just like a unification+    variable+  - Wrap the CoercionHole in a Wanted constraint; see TcRnTypes.TcEvDest+  - Use the CoercionHole in a Coercion, via HoleCo+  - Solve the constraint later+  - When solved, fill in the CoercionHole by side effect, instead of+    doing the let-binding thing++The main reason for all this is that there may be no good place to let-bind+the evidence for unboxed equalities:++  - We emit constraints for kind coercions, to be used to cast a+    type's kind. These coercions then must be used in types. Because+    they might appear in a top-level type, there is no place to bind+    these (unlifted) coercions in the usual way.++  - A coercion for (forall a. t1) ~ (forall a. t2) will look like+       forall a. (coercion for t1~t2)+    But the coercion for (t1~t2) may mention 'a', and we don't have+    let-bindings within coercions.  We could add them, but coercion+    holes are easier.++  - Moreover, nothing is lost from the lack of let-bindings. For+    dicionaries want to achieve sharing to avoid recomoputing the+    dictionary.  But coercions are entirely erased, so there's little+    benefit to sharing. Indeed, even if we had a let-binding, we+    always inline types and coercions at every use site and drop the+    binding.++Other notes about HoleCo:++ * INVARIANT: CoercionHole and HoleCo are used only during type checking,+   and should never appear in Core. Just like unification variables; a Type+   can contain a TcTyVar, but only during type checking. If, one day, we+   use type-level information to separate out forms that can appear during+   type-checking vs forms that can appear in core proper, holes in Core will+   be ruled out.++ * See Note [CoercionHoles and coercion free variables]++ * Coercion holes can be compared for equality like other coercions:+   by looking at the types coerced.+++Note [CoercionHoles and coercion free variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Why does a CoercionHole contain a CoVar, as well as reference to+fill in?  Because we want to treat that CoVar as a free variable of+the coercion.  See #14584, and Note [What prevents a+constraint from floating] in TcSimplify, item (4):++        forall k. [W] co1 :: t1 ~# t2 |> co2+                  [W] co2 :: k ~# *++Here co2 is a CoercionHole. But we /must/ know that it is free in+co1, because that's all that stops it floating outside the+implication.+++Note [ProofIrrelProv]+~~~~~~~~~~~~~~~~~~~~~+A ProofIrrelProv is a coercion between coercions. For example:++  data G a where+    MkG :: G Bool++In core, we get++  G :: * -> *+  MkG :: forall (a :: *). (a ~ Bool) -> G a++Now, consider 'MkG -- that is, MkG used in a type -- and suppose we want+a proof that ('MkG a1 co1) ~ ('MkG a2 co2). This will have to be++  TyConAppCo Nominal MkG [co3, co4]+  where+    co3 :: co1 ~ co2+    co4 :: a1 ~ a2++Note that+  co1 :: a1 ~ Bool+  co2 :: a2 ~ Bool++Here,+  co3 = UnivCo (ProofIrrelProv co5) Nominal (CoercionTy co1) (CoercionTy co2)+  where+    co5 :: (a1 ~ Bool) ~ (a2 ~ Bool)+    co5 = TyConAppCo Nominal (~#) [<*>, <*>, co4, <Bool>]+++%************************************************************************+%*                                                                      *+                 Free variables of types and coercions+%*                                                                      *+%************************************************************************+-}++{- Note [Free variables of types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The family of functions tyCoVarsOfType, tyCoVarsOfTypes etc, returns+a VarSet that is closed over the types of its variables.  More precisely,+  if    S = tyCoVarsOfType( t )+  and   (a:k) is in S+  then  tyCoVarsOftype( k ) is a subset of S++Example: The tyCoVars of this ((a:* -> k) Int) is {a, k}.++We could /not/ close over the kinds of the variable occurrences, and+instead do so at call sites, but it seems that we always want to do+so, so it's easiest to do it here.++It turns out that getting the free variables of types is performance critical,+so we profiled several versions, exploring different implementation strategies.++1. Baseline version: uses FV naively. Essentially:++   tyCoVarsOfType ty = fvVarSet $ tyCoFVsOfType ty++   This is not nice, because FV introduces some overhead to implement+   determinism, and throught its "interesting var" function, neither of which+   we need here, so they are a complete waste.++2. UnionVarSet version: instead of reusing the FV-based code, we simply used+   VarSets directly, trying to avoid the overhead of FV. E.g.:++   -- FV version:+   tyCoFVsOfType (AppTy fun arg)    a b c = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) a b c++   -- UnionVarSet version:+   tyCoVarsOfType (AppTy fun arg)    = (tyCoVarsOfType fun `unionVarSet` tyCoVarsOfType arg)++   This looks deceptively similar, but while FV internally builds a list- and+   set-generating function, the VarSet functions manipulate sets directly, and+   the latter peforms a lot worse than the naive FV version.++3. Accumulator-style VarSet version: this is what we use now. We do use VarSet+   as our data structure, but delegate the actual work to a new+   ty_co_vars_of_...  family of functions, which use accumulator style and the+   "in-scope set" filter found in the internals of FV, but without the+   determinism overhead.++See #14880.++Note [Closing over free variable kinds]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+tyCoVarsOfType and tyCoFVsOfType, while traversing a type, will also close over+free variable kinds. In previous GHC versions, this happened naively: whenever+we would encounter an occurrence of a free type variable, we would close over+its kind. This, however is wrong for two reasons (see #14880):++1. Efficiency. If we have Proxy (a::k) -> Proxy (a::k) -> Proxy (a::k), then+   we don't want to have to traverse k more than once.++2. Correctness. Imagine we have forall k. b -> k, where b has+   kind k, for some k bound in an outer scope. If we look at b's kind inside+   the forall, we'll collect that k is free and then remove k from the set of+   free variables. This is plain wrong. We must instead compute that b is free+   and then conclude that b's kind is free.++An obvious first approach is to move the closing-over-kinds from the+occurrences of a type variable to after finding the free vars - however, this+turns out to introduce performance regressions, and isn't even entirely+correct.++In fact, it isn't even important *when* we close over kinds; what matters is+that we handle each type var exactly once, and that we do it in the right+context.++So the next approach we tried was to use the "in-scope set" part of FV or the+equivalent argument in the accumulator-style `ty_co_vars_of_type` function, to+say "don't bother with variables we have already closed over". This should work+fine in theory, but the code is complicated and doesn't perform well.++But there is a simpler way, which is implemented here. Consider the two points+above:++1. Efficiency: we now have an accumulator, so the second time we encounter 'a',+   we'll ignore it, certainly not looking at its kind - this is why+   pre-checking set membership before inserting ends up not only being faster,+   but also being correct.++2. Correctness: we have an "in-scope set" (I think we should call it it a+  "bound-var set"), specifying variables that are bound by a forall in the type+  we are traversing; we simply ignore these variables, certainly not looking at+  their kind.++So now consider:++    forall k. b -> k++where b :: k->Type is free; but of course, it's a different k! When looking at+b -> k we'll have k in the bound-var set. So we'll ignore the k. But suppose+this is our first encounter with b; we want the free vars of its kind. But we+want to behave as if we took the free vars of its kind at the end; that is,+with no bound vars in scope.++So the solution is easy. The old code was this:++  ty_co_vars_of_type (TyVarTy v) is acc+    | v `elemVarSet` is  = acc+    | v `elemVarSet` acc = acc+    | otherwise          = ty_co_vars_of_type (tyVarKind v) is (extendVarSet acc v)++Now all we need to do is take the free vars of tyVarKind v *with an empty+bound-var set*, thus:++ty_co_vars_of_type (TyVarTy v) is acc+  | v `elemVarSet` is  = acc+  | v `elemVarSet` acc = acc+  | otherwise          = ty_co_vars_of_type (tyVarKind v) emptyVarSet (extendVarSet acc v)+                                                          ^^^^^^^^^^^++And that's it.++-}++tyCoVarsOfType :: Type -> TyCoVarSet+-- See Note [Free variables of types]+tyCoVarsOfType ty = ty_co_vars_of_type ty emptyVarSet emptyVarSet++tyCoVarsOfTypes :: [Type] -> TyCoVarSet+tyCoVarsOfTypes tys = ty_co_vars_of_types tys emptyVarSet emptyVarSet++ty_co_vars_of_type :: Type -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet+ty_co_vars_of_type (TyVarTy v) is acc+  | v `elemVarSet` is  = acc+  | v `elemVarSet` acc = acc+  | otherwise          = ty_co_vars_of_type (tyVarKind v)+                            emptyVarSet  -- See Note [Closing over free variable kinds]+                            (extendVarSet acc v)++ty_co_vars_of_type (TyConApp _ tys)   is acc = ty_co_vars_of_types tys is acc+ty_co_vars_of_type (LitTy {})         _  acc = acc+ty_co_vars_of_type (AppTy fun arg)    is acc = ty_co_vars_of_type fun is (ty_co_vars_of_type arg is acc)+ty_co_vars_of_type (FunTy _ arg res)  is acc = ty_co_vars_of_type arg is (ty_co_vars_of_type res is acc)+ty_co_vars_of_type (ForAllTy (Bndr tv _) ty) is acc = ty_co_vars_of_type (varType tv) is $+                                                      ty_co_vars_of_type ty (extendVarSet is tv) acc+ty_co_vars_of_type (CastTy ty co)     is acc = ty_co_vars_of_type ty is (ty_co_vars_of_co co is acc)+ty_co_vars_of_type (CoercionTy co)    is acc = ty_co_vars_of_co co is acc++ty_co_vars_of_types :: [Type] -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet+ty_co_vars_of_types []       _  acc = acc+ty_co_vars_of_types (ty:tys) is acc = ty_co_vars_of_type ty is (ty_co_vars_of_types tys is acc)++tyCoVarsOfCo :: Coercion -> TyCoVarSet+-- See Note [Free variables of types]+tyCoVarsOfCo co = ty_co_vars_of_co co emptyVarSet emptyVarSet++tyCoVarsOfCos :: [Coercion] -> TyCoVarSet+tyCoVarsOfCos cos = ty_co_vars_of_cos cos emptyVarSet emptyVarSet+++ty_co_vars_of_co :: Coercion -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet+ty_co_vars_of_co (Refl ty)            is acc = ty_co_vars_of_type ty is acc+ty_co_vars_of_co (GRefl _ ty mco)     is acc = ty_co_vars_of_type ty is $+                                               ty_co_vars_of_mco mco is acc+ty_co_vars_of_co (TyConAppCo _ _ cos) is acc = ty_co_vars_of_cos cos is acc+ty_co_vars_of_co (AppCo co arg)       is acc = ty_co_vars_of_co co is $+                                               ty_co_vars_of_co arg is acc+ty_co_vars_of_co (ForAllCo tv kind_co co) is acc = ty_co_vars_of_co kind_co is $+                                                   ty_co_vars_of_co co (extendVarSet is tv) acc+ty_co_vars_of_co (FunCo _ co1 co2)    is acc = ty_co_vars_of_co co1 is $+                                               ty_co_vars_of_co co2 is acc+ty_co_vars_of_co (CoVarCo v)          is acc = ty_co_vars_of_co_var v is acc+ty_co_vars_of_co (HoleCo h)           is acc = ty_co_vars_of_co_var (coHoleCoVar h) is acc+    -- See Note [CoercionHoles and coercion free variables]+ty_co_vars_of_co (AxiomInstCo _ _ cos) is acc = ty_co_vars_of_cos cos is acc+ty_co_vars_of_co (UnivCo p _ t1 t2)    is acc = ty_co_vars_of_prov p is $+                                                ty_co_vars_of_type t1 is $+                                                ty_co_vars_of_type t2 is acc+ty_co_vars_of_co (SymCo co)          is acc = ty_co_vars_of_co co is acc+ty_co_vars_of_co (TransCo co1 co2)   is acc = ty_co_vars_of_co co1 is $+                                              ty_co_vars_of_co co2 is acc+ty_co_vars_of_co (NthCo _ _ co)      is acc = ty_co_vars_of_co co is acc+ty_co_vars_of_co (LRCo _ co)         is acc = ty_co_vars_of_co co is acc+ty_co_vars_of_co (InstCo co arg)     is acc = ty_co_vars_of_co co is $+                                              ty_co_vars_of_co arg is acc+ty_co_vars_of_co (KindCo co)         is acc = ty_co_vars_of_co co is acc+ty_co_vars_of_co (SubCo co)          is acc = ty_co_vars_of_co co is acc+ty_co_vars_of_co (AxiomRuleCo _ cs)  is acc = ty_co_vars_of_cos cs is acc++ty_co_vars_of_mco :: MCoercion -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet+ty_co_vars_of_mco MRefl    _is acc = acc+ty_co_vars_of_mco (MCo co) is  acc = ty_co_vars_of_co co is acc++ty_co_vars_of_co_var :: CoVar -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet+ty_co_vars_of_co_var v is acc+  | v `elemVarSet` is  = acc+  | v `elemVarSet` acc = acc+  | otherwise          = ty_co_vars_of_type (varType v)+                            emptyVarSet  -- See Note [Closing over free variable kinds]+                            (extendVarSet acc v)++ty_co_vars_of_cos :: [Coercion] -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet+ty_co_vars_of_cos []       _  acc = acc+ty_co_vars_of_cos (co:cos) is acc = ty_co_vars_of_co co is (ty_co_vars_of_cos cos is acc)++tyCoVarsOfProv :: UnivCoProvenance -> TyCoVarSet+tyCoVarsOfProv prov = ty_co_vars_of_prov prov emptyVarSet emptyVarSet++ty_co_vars_of_prov :: UnivCoProvenance -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet+ty_co_vars_of_prov (PhantomProv co)    is acc = ty_co_vars_of_co co is acc+ty_co_vars_of_prov (ProofIrrelProv co) is acc = ty_co_vars_of_co co is acc+ty_co_vars_of_prov UnsafeCoerceProv    _  acc = acc+ty_co_vars_of_prov (PluginProv _)      _  acc = acc++-- | Generates an in-scope set from the free variables in a list of types+-- and a list of coercions+mkTyCoInScopeSet :: [Type] -> [Coercion] -> InScopeSet+mkTyCoInScopeSet tys cos+  = mkInScopeSet (ty_co_vars_of_types tys emptyVarSet $+                  ty_co_vars_of_cos   cos emptyVarSet emptyVarSet)++-- | `tyCoFVsOfType` that returns free variables of a type in a deterministic+-- set. For explanation of why using `VarSet` is not deterministic see+-- Note [Deterministic FV] in FV.+tyCoVarsOfTypeDSet :: Type -> DTyCoVarSet+-- See Note [Free variables of types]+tyCoVarsOfTypeDSet ty = fvDVarSet $ tyCoFVsOfType ty++-- | `tyCoFVsOfType` that returns free variables of a type in deterministic+-- order. For explanation of why using `VarSet` is not deterministic see+-- Note [Deterministic FV] in FV.+tyCoVarsOfTypeList :: Type -> [TyCoVar]+-- See Note [Free variables of types]+tyCoVarsOfTypeList ty = fvVarList $ tyCoFVsOfType ty++-- | Returns free variables of types, including kind variables as+-- a non-deterministic set. For type synonyms it does /not/ expand the+-- synonym.+tyCoVarsOfTypesSet :: TyVarEnv Type -> TyCoVarSet+-- See Note [Free variables of types]+tyCoVarsOfTypesSet tys = tyCoVarsOfTypes $ nonDetEltsUFM tys+  -- It's OK to use nonDetEltsUFM here because we immediately forget the+  -- ordering by returning a set++-- | Returns free variables of types, including kind variables as+-- a deterministic set. For type synonyms it does /not/ expand the+-- synonym.+tyCoVarsOfTypesDSet :: [Type] -> DTyCoVarSet+-- See Note [Free variables of types]+tyCoVarsOfTypesDSet tys = fvDVarSet $ tyCoFVsOfTypes tys++-- | Returns free variables of types, including kind variables as+-- a deterministically ordered list. For type synonyms it does /not/ expand the+-- synonym.+tyCoVarsOfTypesList :: [Type] -> [TyCoVar]+-- See Note [Free variables of types]+tyCoVarsOfTypesList tys = fvVarList $ tyCoFVsOfTypes tys++-- | The worker for `tyCoFVsOfType` and `tyCoFVsOfTypeList`.+-- The previous implementation used `unionVarSet` which is O(n+m) and can+-- make the function quadratic.+-- It's exported, so that it can be composed with+-- other functions that compute free variables.+-- See Note [FV naming conventions] in FV.+--+-- Eta-expanded because that makes it run faster (apparently)+-- See Note [FV eta expansion] in FV for explanation.+tyCoFVsOfType :: Type -> FV+-- See Note [Free variables of types]+tyCoFVsOfType (TyVarTy v)        f bound_vars (acc_list, acc_set)+  | not (f v) = (acc_list, acc_set)+  | v `elemVarSet` bound_vars = (acc_list, acc_set)+  | v `elemVarSet` acc_set = (acc_list, acc_set)+  | otherwise = tyCoFVsOfType (tyVarKind v) f+                               emptyVarSet   -- See Note [Closing over free variable kinds]+                               (v:acc_list, extendVarSet acc_set v)+tyCoFVsOfType (TyConApp _ tys)   f bound_vars acc = tyCoFVsOfTypes tys f bound_vars acc+tyCoFVsOfType (LitTy {})         f bound_vars acc = emptyFV f bound_vars acc+tyCoFVsOfType (AppTy fun arg)    f bound_vars acc = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) f bound_vars acc+tyCoFVsOfType (FunTy _ arg res)  f bound_vars acc = (tyCoFVsOfType arg `unionFV` tyCoFVsOfType res) f bound_vars acc+tyCoFVsOfType (ForAllTy bndr ty) f bound_vars acc = tyCoFVsBndr bndr (tyCoFVsOfType ty)  f bound_vars acc+tyCoFVsOfType (CastTy ty co)     f bound_vars acc = (tyCoFVsOfType ty `unionFV` tyCoFVsOfCo co) f bound_vars acc+tyCoFVsOfType (CoercionTy co)    f bound_vars acc = tyCoFVsOfCo co f bound_vars acc++tyCoFVsBndr :: TyCoVarBinder -> FV -> FV+-- Free vars of (forall b. <thing with fvs>)+tyCoFVsBndr (Bndr tv _) fvs = tyCoFVsVarBndr tv fvs++tyCoFVsVarBndrs :: [Var] -> FV -> FV+tyCoFVsVarBndrs vars fvs = foldr tyCoFVsVarBndr fvs vars++tyCoFVsVarBndr :: Var -> FV -> FV+tyCoFVsVarBndr var fvs+  = tyCoFVsOfType (varType var)   -- Free vars of its type/kind+    `unionFV` delFV var fvs       -- Delete it from the thing-inside++tyCoFVsOfTypes :: [Type] -> FV+-- See Note [Free variables of types]+tyCoFVsOfTypes (ty:tys) fv_cand in_scope acc = (tyCoFVsOfType ty `unionFV` tyCoFVsOfTypes tys) fv_cand in_scope acc+tyCoFVsOfTypes []       fv_cand in_scope acc = emptyFV fv_cand in_scope acc++-- | Get a deterministic set of the vars free in a coercion+tyCoVarsOfCoDSet :: Coercion -> DTyCoVarSet+-- See Note [Free variables of types]+tyCoVarsOfCoDSet co = fvDVarSet $ tyCoFVsOfCo co++tyCoVarsOfCoList :: Coercion -> [TyCoVar]+-- See Note [Free variables of types]+tyCoVarsOfCoList co = fvVarList $ tyCoFVsOfCo co++tyCoFVsOfMCo :: MCoercion -> FV+tyCoFVsOfMCo MRefl    = emptyFV+tyCoFVsOfMCo (MCo co) = tyCoFVsOfCo co++tyCoVarsOfCosSet :: CoVarEnv Coercion -> TyCoVarSet+tyCoVarsOfCosSet cos = tyCoVarsOfCos $ nonDetEltsUFM cos+  -- It's OK to use nonDetEltsUFM here because we immediately forget the+  -- ordering by returning a set++tyCoFVsOfCo :: Coercion -> FV+-- Extracts type and coercion variables from a coercion+-- See Note [Free variables of types]+tyCoFVsOfCo (Refl ty) fv_cand in_scope acc+  = tyCoFVsOfType ty fv_cand in_scope acc+tyCoFVsOfCo (GRefl _ ty mco) fv_cand in_scope acc+  = (tyCoFVsOfType ty `unionFV` tyCoFVsOfMCo mco) fv_cand in_scope acc+tyCoFVsOfCo (TyConAppCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc+tyCoFVsOfCo (AppCo co arg) fv_cand in_scope acc+  = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc+tyCoFVsOfCo (ForAllCo tv kind_co co) fv_cand in_scope acc+  = (tyCoFVsVarBndr tv (tyCoFVsOfCo co) `unionFV` tyCoFVsOfCo kind_co) fv_cand in_scope acc+tyCoFVsOfCo (FunCo _ co1 co2)    fv_cand in_scope acc+  = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2) fv_cand in_scope acc+tyCoFVsOfCo (CoVarCo v) fv_cand in_scope acc+  = tyCoFVsOfCoVar v fv_cand in_scope acc+tyCoFVsOfCo (HoleCo h) fv_cand in_scope acc+  = tyCoFVsOfCoVar (coHoleCoVar h) fv_cand in_scope acc+    -- See Note [CoercionHoles and coercion free variables]+tyCoFVsOfCo (AxiomInstCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc+tyCoFVsOfCo (UnivCo p _ t1 t2) fv_cand in_scope acc+  = (tyCoFVsOfProv p `unionFV` tyCoFVsOfType t1+                     `unionFV` tyCoFVsOfType t2) fv_cand in_scope acc+tyCoFVsOfCo (SymCo co)          fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc+tyCoFVsOfCo (TransCo co1 co2)   fv_cand in_scope acc = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2) fv_cand in_scope acc+tyCoFVsOfCo (NthCo _ _ co)      fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc+tyCoFVsOfCo (LRCo _ co)         fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc+tyCoFVsOfCo (InstCo co arg)     fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc+tyCoFVsOfCo (KindCo co)         fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc+tyCoFVsOfCo (SubCo co)          fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc+tyCoFVsOfCo (AxiomRuleCo _ cs)  fv_cand in_scope acc = tyCoFVsOfCos cs fv_cand in_scope acc++tyCoFVsOfCoVar :: CoVar -> FV+tyCoFVsOfCoVar v fv_cand in_scope acc+  = (unitFV v `unionFV` tyCoFVsOfType (varType v)) fv_cand in_scope acc++tyCoFVsOfProv :: UnivCoProvenance -> FV+tyCoFVsOfProv UnsafeCoerceProv    fv_cand in_scope acc = emptyFV fv_cand in_scope acc+tyCoFVsOfProv (PhantomProv co)    fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc+tyCoFVsOfProv (ProofIrrelProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc+tyCoFVsOfProv (PluginProv _)      fv_cand in_scope acc = emptyFV fv_cand in_scope acc++tyCoFVsOfCos :: [Coercion] -> FV+tyCoFVsOfCos []       fv_cand in_scope acc = emptyFV fv_cand in_scope acc+tyCoFVsOfCos (co:cos) fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCos cos) fv_cand in_scope acc+++------------- Extracting the CoVars of a type or coercion -----------++{-++Note [CoVarsOfX and the InterestingVarFun]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++The coVarsOfType, coVarsOfTypes, coVarsOfCo, and coVarsOfCos functions are+implemented in terms of the respective FV equivalents (tyCoFVsOf...), rather+than the VarSet-based flavors (tyCoVarsOf...), despite the performance+considerations outlined in Note [Free variables of types].++This is because FV includes the InterestingVarFun, which is useful here,+because we can cleverly use it to restrict our calculations to CoVars - this+is what getCoVarSet achieves.++See #14880.++-}++getCoVarSet :: FV -> CoVarSet+getCoVarSet fv = snd (fv isCoVar emptyVarSet ([], emptyVarSet))++coVarsOfType :: Type -> CoVarSet+coVarsOfType ty = getCoVarSet (tyCoFVsOfType ty)++coVarsOfTypes :: [Type] -> TyCoVarSet+coVarsOfTypes tys = getCoVarSet (tyCoFVsOfTypes tys)++coVarsOfCo :: Coercion -> CoVarSet+coVarsOfCo co = getCoVarSet (tyCoFVsOfCo co)++coVarsOfCos :: [Coercion] -> CoVarSet+coVarsOfCos cos = getCoVarSet (tyCoFVsOfCos cos)++----- Whether a covar is /Almost Devoid/ in a type or coercion ----++-- | Given a covar and a coercion, returns True if covar is almost devoid in+-- the coercion. That is, covar can only appear in Refl and GRefl.+-- See last wrinkle in Note [Unused coercion variable in ForAllCo] in Coercion+almostDevoidCoVarOfCo :: CoVar -> Coercion -> Bool+almostDevoidCoVarOfCo cv co =+  almost_devoid_co_var_of_co co cv++almost_devoid_co_var_of_co :: Coercion -> CoVar -> Bool+almost_devoid_co_var_of_co (Refl {}) _ = True   -- covar is allowed in Refl and+almost_devoid_co_var_of_co (GRefl {}) _ = True  -- GRefl, so we don't look into+                                                -- the coercions+almost_devoid_co_var_of_co (TyConAppCo _ _ cos) cv+  = almost_devoid_co_var_of_cos cos cv+almost_devoid_co_var_of_co (AppCo co arg) cv+  = almost_devoid_co_var_of_co co cv+  && almost_devoid_co_var_of_co arg cv+almost_devoid_co_var_of_co (ForAllCo v kind_co co) cv+  = almost_devoid_co_var_of_co kind_co cv+  && (v == cv || almost_devoid_co_var_of_co co cv)+almost_devoid_co_var_of_co (FunCo _ co1 co2) cv+  = almost_devoid_co_var_of_co co1 cv+  && almost_devoid_co_var_of_co co2 cv+almost_devoid_co_var_of_co (CoVarCo v) cv = v /= cv+almost_devoid_co_var_of_co (HoleCo h)  cv = (coHoleCoVar h) /= cv+almost_devoid_co_var_of_co (AxiomInstCo _ _ cos) cv+  = almost_devoid_co_var_of_cos cos cv+almost_devoid_co_var_of_co (UnivCo p _ t1 t2) cv+  = almost_devoid_co_var_of_prov p cv+  && almost_devoid_co_var_of_type t1 cv+  && almost_devoid_co_var_of_type t2 cv+almost_devoid_co_var_of_co (SymCo co) cv+  = almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_co (TransCo co1 co2) cv+  = almost_devoid_co_var_of_co co1 cv+  && almost_devoid_co_var_of_co co2 cv+almost_devoid_co_var_of_co (NthCo _ _ co) cv+  = almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_co (LRCo _ co) cv+  = almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_co (InstCo co arg) cv+  = almost_devoid_co_var_of_co co cv+  && almost_devoid_co_var_of_co arg cv+almost_devoid_co_var_of_co (KindCo co) cv+  = almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_co (SubCo co) cv+  = almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_co (AxiomRuleCo _ cs) cv+  = almost_devoid_co_var_of_cos cs cv++almost_devoid_co_var_of_cos :: [Coercion] -> CoVar -> Bool+almost_devoid_co_var_of_cos [] _ = True+almost_devoid_co_var_of_cos (co:cos) cv+  = almost_devoid_co_var_of_co co cv+  && almost_devoid_co_var_of_cos cos cv++almost_devoid_co_var_of_prov :: UnivCoProvenance -> CoVar -> Bool+almost_devoid_co_var_of_prov (PhantomProv co) cv+  = almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_prov (ProofIrrelProv co) cv+  = almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_prov UnsafeCoerceProv _ = True+almost_devoid_co_var_of_prov (PluginProv _) _ = True++almost_devoid_co_var_of_type :: Type -> CoVar -> Bool+almost_devoid_co_var_of_type (TyVarTy _) _ = True+almost_devoid_co_var_of_type (TyConApp _ tys) cv+  = almost_devoid_co_var_of_types tys cv+almost_devoid_co_var_of_type (LitTy {}) _ = True+almost_devoid_co_var_of_type (AppTy fun arg) cv+  = almost_devoid_co_var_of_type fun cv+  && almost_devoid_co_var_of_type arg cv+almost_devoid_co_var_of_type (FunTy _ arg res) cv+  = almost_devoid_co_var_of_type arg cv+  && almost_devoid_co_var_of_type res cv+almost_devoid_co_var_of_type (ForAllTy (Bndr v _) ty) cv+  = almost_devoid_co_var_of_type (varType v) cv+  && (v == cv || almost_devoid_co_var_of_type ty cv)+almost_devoid_co_var_of_type (CastTy ty co) cv+  = almost_devoid_co_var_of_type ty cv+  && almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_type (CoercionTy co) cv+  = almost_devoid_co_var_of_co co cv++almost_devoid_co_var_of_types :: [Type] -> CoVar -> Bool+almost_devoid_co_var_of_types [] _ = True+almost_devoid_co_var_of_types (ty:tys) cv+  = almost_devoid_co_var_of_type ty cv+  && almost_devoid_co_var_of_types tys cv++------------- Injective free vars -----------------++-- | Returns the free variables of a 'Type' that are in injective positions.+-- For example, if @F@ is a non-injective type family, then:+--+-- @+-- injectiveTyVarsOf( Either c (Maybe (a, F b c)) ) = {a,c}+-- @+--+-- If @'injectiveVarsOfType' ty = itvs@, then knowing @ty@ fixes @itvs@.+-- More formally, if+-- @a@ is in @'injectiveVarsOfType' ty@+-- and  @S1(ty) ~ S2(ty)@,+-- then @S1(a)  ~ S2(a)@,+-- where @S1@ and @S2@ are arbitrary substitutions.+--+-- See @Note [When does a tycon application need an explicit kind signature?]@.+injectiveVarsOfType :: Type -> FV+injectiveVarsOfType = go+  where+    go ty                 | Just ty' <- coreView ty+                          = go ty'+    go (TyVarTy v)        = unitFV v `unionFV` go (tyVarKind v)+    go (AppTy f a)        = go f `unionFV` go a+    go (FunTy _ ty1 ty2)  = go ty1 `unionFV` go ty2+    go (TyConApp tc tys)  =+      case tyConInjectivityInfo tc of+        NotInjective  -> emptyFV+        Injective inj -> mapUnionFV go $+                         filterByList (inj ++ repeat True) tys+                         -- Oversaturated arguments to a tycon are+                         -- always injective, hence the repeat True+    go (ForAllTy tvb ty) = tyCoFVsBndr tvb $ go ty+    go LitTy{}           = emptyFV+    go (CastTy ty _)     = go ty+    go CoercionTy{}      = emptyFV++-- | Does a 'TyCon' (that is applied to some number of arguments) need to be+-- ascribed with an explicit kind signature to resolve ambiguity if rendered as+-- a source-syntax type?+-- (See @Note [When does a tycon application need an explicit kind signature?]@+-- for a full explanation of what this function checks for.)++-- Morally, this function ought to belong in TyCon.hs, not TyCoRep.hs, but+-- accomplishing this requires a fair deal of futzing aruond with .hs-boot+-- files.+tyConAppNeedsKindSig+  :: Bool  -- ^ Should specified binders count towards injective positions in+           --   the kind of the TyCon? (If you're using visible kind+           --   applications, then you want True here.+  -> TyCon+  -> Int   -- ^ The number of args the 'TyCon' is applied to.+  -> Bool  -- ^ Does @T t_1 ... t_n@ need a kind signature? (Where @n@ is the+           --   number of arguments)+tyConAppNeedsKindSig spec_inj_pos tc n_args+  | LT <- listLengthCmp tc_binders n_args+  = False+  | otherwise+  = let (dropped_binders, remaining_binders)+          = splitAt n_args tc_binders+        result_kind  = mkTyConKind remaining_binders tc_res_kind+        result_vars  = tyCoVarsOfType result_kind+        dropped_vars = fvVarSet $+                       mapUnionFV injective_vars_of_binder dropped_binders++    in not (subVarSet result_vars dropped_vars)+  where+    tc_binders  = tyConBinders tc+    tc_res_kind = tyConResKind tc++    -- Returns the variables that would be fixed by knowing a TyConBinder. See+    -- Note [When does a tycon application need an explicit kind signature?]+    -- for a more detailed explanation of what this function does.+    injective_vars_of_binder :: TyConBinder -> FV+    injective_vars_of_binder (Bndr tv vis) =+      case vis of+        AnonTCB VisArg -> injectiveVarsOfType (varType tv)+        NamedTCB argf  | source_of_injectivity argf+                       -> unitFV tv `unionFV` injectiveVarsOfType (varType tv)+        _              -> emptyFV++    source_of_injectivity Required  = True+    source_of_injectivity Specified = spec_inj_pos+    source_of_injectivity Inferred  = False++{-+Note [When does a tycon application need an explicit kind signature?]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+There are a couple of places in GHC where we convert Core Types into forms that+more closely resemble user-written syntax. These include:++1. Template Haskell Type reification (see, for instance, TcSplice.reify_tc_app)+2. Converting Types to LHsTypes (in HsUtils.typeToLHsType, or in Haddock)++This conversion presents a challenge: how do we ensure that the resulting type+has enough kind information so as not to be ambiguous? To better motivate this+question, consider the following Core type:++  -- Foo :: Type -> Type+  type Foo = Proxy Type++There is nothing ambiguous about the RHS of Foo in Core. But if we were to,+say, reify it into a TH Type, then it's tempting to just drop the invisible+Type argument and simply return `Proxy`. But now we've lost crucial kind+information: we don't know if we're dealing with `Proxy Type` or `Proxy Bool`+or `Proxy Int` or something else! We've inadvertently introduced ambiguity.++Unlike in other situations in GHC, we can't just turn on+-fprint-explicit-kinds, as we need to produce something which has the same+structure as a source-syntax type. Moreover, we can't rely on visible kind+application, since the first kind argument to Proxy is inferred, not specified.+Our solution is to annotate certain tycons with their kinds whenever they+appear in applied form in order to resolve the ambiguity. For instance, we+would reify the RHS of Foo like so:++  type Foo = (Proxy :: Type -> Type)++We need to devise an algorithm that determines precisely which tycons need+these explicit kind signatures. We certainly don't want to annotate _every_+tycon with a kind signature, or else we might end up with horribly bloated+types like the following:++  (Either :: Type -> Type -> Type) (Int :: Type) (Char :: Type)++We only want to annotate tycons that absolutely require kind signatures in+order to resolve some sort of ambiguity, and nothing more.++Suppose we have a tycon application (T ty_1 ... ty_n). Why might this type+require a kind signature? It might require it when we need to fill in any of+T's omitted arguments. By "omitted argument", we mean one that is dropped when+reifying ty_1 ... ty_n. Sometimes, the omitted arguments are inferred and+specified arguments (e.g., TH reification in TcSplice), and sometimes the+omitted arguments are only the inferred ones (e.g., in HsUtils.typeToLHsType,+which reifies specified arguments through visible kind application).+Regardless, the key idea is that _some_ arguments are going to be omitted after+reification, and the only mechanism we have at our disposal for filling them in+is through explicit kind signatures.++What do we mean by "fill in"? Let's consider this small example:++  T :: forall {k}. Type -> (k -> Type) -> k++Moreover, we have this application of T:++  T @{j} Int aty++When we reify this type, we omit the inferred argument @{j}. Is it fixed by the+other (non-inferred) arguments? Yes! If we know the kind of (aty :: blah), then+we'll generate an equality constraint (kappa -> Type) and, assuming we can+solve it, that will fix `kappa`. (Here, `kappa` is the unification variable+that we instantiate `k` with.)++Therefore, for any application of a tycon T to some arguments, the Question We+Must Answer is:++* Given the first n arguments of T, do the kinds of the non-omitted arguments+  fill in the omitted arguments?++(This is still a bit hand-wavey, but we'll refine this question incrementally+as we explain more of the machinery underlying this process.)++Answering this question is precisely the role that the `injectiveVarsOfType`+and `injective_vars_of_binder` functions exist to serve. If an omitted argument+`a` appears in the set returned by `injectiveVarsOfType ty`, then knowing+`ty` determines (i.e., fills in) `a`. (More on `injective_vars_of_binder` in a+bit.)++More formally, if+`a` is in `injectiveVarsOfType ty`+and  S1(ty) ~ S2(ty),+then S1(a)  ~ S2(a),+where S1 and S2 are arbitrary substitutions.++For example, is `F` is a non-injective type family, then++  injectiveVarsOfType(Either c (Maybe (a, F b c))) = {a, c}++Now that we know what this function does, here is a second attempt at the+Question We Must Answer:++* Given the first n arguments of T (ty_1 ... ty_n), consider the binders+  of T that are instantiated by non-omitted arguments. Do the injective+  variables of these binders fill in the remainder of T's kind?++Alright, we're getting closer. Next, we need to clarify what the injective+variables of a tycon binder are. This the role that the+`injective_vars_of_binder` function serves. Here is what this function does for+each form of tycon binder:++* Anonymous binders are injective positions. For example, in the promoted data+  constructor '(:):++    '(:) :: forall a. a -> [a] -> [a]++  The second and third tyvar binders (of kinds `a` and `[a]`) are both+  anonymous, so if we had '(:) 'True '[], then the kinds of 'True and+  '[] would contribute to the kind of '(:) 'True '[]. Therefore,+  injective_vars_of_binder(_ :: a) = injectiveVarsOfType(a) = {a}.+  (Similarly, injective_vars_of_binder(_ :: [a]) = {a}.)+* Named binders:+  - Inferred binders are never injective positions. For example, in this data+    type:++      data Proxy a+      Proxy :: forall {k}. k -> Type++    If we had Proxy 'True, then the kind of 'True would not contribute to the+    kind of Proxy 'True. Therefore,+    injective_vars_of_binder(forall {k}. ...) = {}.+  - Required binders are injective positions. For example, in this data type:++      data Wurble k (a :: k) :: k+      Wurble :: forall k -> k -> k++  The first tyvar binder (of kind `forall k`) has required visibility, so if+  we had Wurble (Maybe a) Nothing, then the kind of Maybe a would+  contribute to the kind of Wurble (Maybe a) Nothing. Hence,+  injective_vars_of_binder(forall a -> ...) = {a}.+  - Specified binders /might/ be injective positions, depending on how you+    approach things. Continuing the '(:) example:++      '(:) :: forall a. a -> [a] -> [a]++    Normally, the (forall a. ...) tyvar binder wouldn't contribute to the kind+    of '(:) 'True '[], since it's not explicitly instantiated by the user. But+    if visible kind application is enabled, then this is possible, since the+    user can write '(:) @Bool 'True '[]. (In that case,+    injective_vars_of_binder(forall a. ...) = {a}.)++    There are some situations where using visible kind application is appropriate+    (e.g., HsUtils.typeToLHsType) and others where it is not (e.g., TH+    reification), so the `injective_vars_of_binder` function is parametrized by+    a Bool which decides if specified binders should be counted towards+    injective positions or not.++Now that we've defined injective_vars_of_binder, we can refine the Question We+Must Answer once more:++* Given the first n arguments of T (ty_1 ... ty_n), consider the binders+  of T that are instantiated by non-omitted arguments. For each such binder+  b_i, take the union of all injective_vars_of_binder(b_i). Is this set a+  superset of the free variables of the remainder of T's kind?++If the answer to this question is "no", then (T ty_1 ... ty_n) needs an+explicit kind signature, since T's kind has kind variables leftover that+aren't fixed by the non-omitted arguments.++One last sticking point: what does "the remainder of T's kind" mean? You might+be tempted to think that it corresponds to all of the arguments in the kind of+T that would normally be instantiated by omitted arguments. But this isn't+quite right, strictly speaking. Consider the following (silly) example:++  S :: forall {k}. Type -> Type++And suppose we have this application of S:++  S Int Bool++The Int argument would be omitted, and+injective_vars_of_binder(_ :: Type) = {}. This is not a superset of {k}, which+might suggest that (S Bool) needs an explicit kind signature. But+(S Bool :: Type) doesn't actually fix `k`! This is because the kind signature+only affects the /result/ of the application, not all of the individual+arguments. So adding a kind signature here won't make a difference. Therefore,+the fourth (and final) iteration of the Question We Must Answer is:++* Given the first n arguments of T (ty_1 ... ty_n), consider the binders+  of T that are instantiated by non-omitted arguments. For each such binder+  b_i, take the union of all injective_vars_of_binder(b_i). Is this set a+  superset of the free variables of the kind of (T ty_1 ... ty_n)?++Phew, that was a lot of work!++How can be sure that this is correct? That is, how can we be sure that in the+event that we leave off a kind annotation, that one could infer the kind of the+tycon application from its arguments? It's essentially a proof by induction: if+we can infer the kinds of every subtree of a type, then the whole tycon+application will have an inferrable kind--unless, of course, the remainder of+the tycon application's kind has uninstantiated kind variables.++What happens if T is oversaturated? That is, if T's kind has fewer than n+arguments, in the case that the concrete application instantiates a result+kind variable with an arrow kind? If we run out of arguments, we do not attach+a kind annotation. This should be a rare case, indeed. Here is an example:++   data T1 :: k1 -> k2 -> *+   data T2 :: k1 -> k2 -> *++   type family G (a :: k) :: k+   type instance G T1 = T2++   type instance F Char = (G T1 Bool :: (* -> *) -> *)   -- F from above++Here G's kind is (forall k. k -> k), and the desugared RHS of that last+instance of F is (G (* -> (* -> *) -> *) (T1 * (* -> *)) Bool). According to+the algorithm above, there are 3 arguments to G so we should peel off 3+arguments in G's kind. But G's kind has only two arguments. This is the+rare special case, and we choose not to annotate the application of G with+a kind signature. After all, we needn't do this, since that instance would+be reified as:++   type instance F Char = G (T1 :: * -> (* -> *) -> *) Bool++So the kind of G isn't ambiguous anymore due to the explicit kind annotation+on its argument. See #8953 and test th/T8953.+-}++------------- No free vars -----------------++-- | Returns True if this type has no free variables. Should be the same as+-- isEmptyVarSet . tyCoVarsOfType, but faster in the non-forall case.+noFreeVarsOfType :: Type -> Bool+noFreeVarsOfType (TyVarTy _)      = False+noFreeVarsOfType (AppTy t1 t2)    = noFreeVarsOfType t1 && noFreeVarsOfType t2+noFreeVarsOfType (TyConApp _ tys) = all noFreeVarsOfType tys+noFreeVarsOfType ty@(ForAllTy {}) = isEmptyVarSet (tyCoVarsOfType ty)+noFreeVarsOfType (FunTy _ t1 t2)  = noFreeVarsOfType t1 && noFreeVarsOfType t2+noFreeVarsOfType (LitTy _)        = True+noFreeVarsOfType (CastTy ty co)   = noFreeVarsOfType ty && noFreeVarsOfCo co+noFreeVarsOfType (CoercionTy co)  = noFreeVarsOfCo co++noFreeVarsOfMCo :: MCoercion -> Bool+noFreeVarsOfMCo MRefl    = True+noFreeVarsOfMCo (MCo co) = noFreeVarsOfCo co++noFreeVarsOfTypes :: [Type] -> Bool+noFreeVarsOfTypes = all noFreeVarsOfType++-- | Returns True if this coercion has no free variables. Should be the same as+-- isEmptyVarSet . tyCoVarsOfCo, but faster in the non-forall case.+noFreeVarsOfCo :: Coercion -> Bool+noFreeVarsOfCo (Refl ty)              = noFreeVarsOfType ty+noFreeVarsOfCo (GRefl _ ty co)        = noFreeVarsOfType ty && noFreeVarsOfMCo co+noFreeVarsOfCo (TyConAppCo _ _ args)  = all noFreeVarsOfCo args+noFreeVarsOfCo (AppCo c1 c2)          = noFreeVarsOfCo c1 && noFreeVarsOfCo c2+noFreeVarsOfCo co@(ForAllCo {})       = isEmptyVarSet (tyCoVarsOfCo co)+noFreeVarsOfCo (FunCo _ c1 c2)        = noFreeVarsOfCo c1 && noFreeVarsOfCo c2+noFreeVarsOfCo (CoVarCo _)            = False+noFreeVarsOfCo (HoleCo {})            = True    -- I'm unsure; probably never happens+noFreeVarsOfCo (AxiomInstCo _ _ args) = all noFreeVarsOfCo args+noFreeVarsOfCo (UnivCo p _ t1 t2)     = noFreeVarsOfProv p &&+                                        noFreeVarsOfType t1 &&+                                        noFreeVarsOfType t2+noFreeVarsOfCo (SymCo co)             = noFreeVarsOfCo co+noFreeVarsOfCo (TransCo co1 co2)      = noFreeVarsOfCo co1 && noFreeVarsOfCo co2+noFreeVarsOfCo (NthCo _ _ co)         = noFreeVarsOfCo co+noFreeVarsOfCo (LRCo _ co)            = noFreeVarsOfCo co+noFreeVarsOfCo (InstCo co1 co2)       = noFreeVarsOfCo co1 && noFreeVarsOfCo co2+noFreeVarsOfCo (KindCo co)            = noFreeVarsOfCo co+noFreeVarsOfCo (SubCo co)             = noFreeVarsOfCo co+noFreeVarsOfCo (AxiomRuleCo _ cs)     = all noFreeVarsOfCo cs++-- | Returns True if this UnivCoProv has no free variables. Should be the same as+-- isEmptyVarSet . tyCoVarsOfProv, but faster in the non-forall case.+noFreeVarsOfProv :: UnivCoProvenance -> Bool+noFreeVarsOfProv UnsafeCoerceProv    = True+noFreeVarsOfProv (PhantomProv co)    = noFreeVarsOfCo co+noFreeVarsOfProv (ProofIrrelProv co) = noFreeVarsOfCo co+noFreeVarsOfProv (PluginProv {})     = True++{-+%************************************************************************+%*                                                                      *+                        Substitutions+      Data type defined here to avoid unnecessary mutual recursion+%*                                                                      *+%************************************************************************+-}++-- | Type & coercion substitution+--+-- #tcvsubst_invariant#+-- The following invariants must hold of a 'TCvSubst':+--+-- 1. The in-scope set is needed /only/ to+-- guide the generation of fresh uniques+--+-- 2. In particular, the /kind/ of the type variables in+-- the in-scope set is not relevant+--+-- 3. The substitution is only applied ONCE! This is because+-- in general such application will not reach a fixed point.+data TCvSubst+  = TCvSubst InScopeSet -- The in-scope type and kind variables+             TvSubstEnv -- Substitutes both type and kind variables+             CvSubstEnv -- Substitutes coercion variables+        -- See Note [Substitutions apply only once]+        -- and Note [Extending the TvSubstEnv]+        -- and Note [Substituting types and coercions]+        -- and Note [The substitution invariant]++-- | A substitution of 'Type's for 'TyVar's+--                 and 'Kind's for 'KindVar's+type TvSubstEnv = TyVarEnv Type+  -- NB: A TvSubstEnv is used+  --   both inside a TCvSubst (with the apply-once invariant+  --        discussed in Note [Substitutions apply only once],+  --   and  also independently in the middle of matching,+  --        and unification (see Types.Unify).+  -- So you have to look at the context to know if it's idempotent or+  -- apply-once or whatever++-- | A substitution of 'Coercion's for 'CoVar's+type CvSubstEnv = CoVarEnv Coercion++{- Note [The substitution invariant]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When calling (substTy subst ty) it should be the case that+the in-scope set in the substitution is a superset of both:++  (SIa) The free vars of the range of the substitution+  (SIb) The free vars of ty minus the domain of the substitution++The same rules apply to other substitutions (notably CoreSubst.Subst)++* Reason for (SIa). Consider+      substTy [a :-> Maybe b] (forall b. b->a)+  we must rename the forall b, to get+      forall b2. b2 -> Maybe b+  Making 'b' part of the in-scope set forces this renaming to+  take place.++* Reason for (SIb). Consider+     substTy [a :-> Maybe b] (forall b. (a,b,x))+  Then if we use the in-scope set {b}, satisfying (SIa), there is+  a danger we will rename the forall'd variable to 'x' by mistake,+  getting this:+      forall x. (Maybe b, x, x)+  Breaking (SIb) caused the bug from #11371.++Note: if the free vars of the range of the substitution are freshly created,+then the problems of (SIa) can't happen, and so it would be sound to+ignore (SIa).++Note [Substitutions apply only once]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We use TCvSubsts to instantiate things, and we might instantiate+        forall a b. ty+with the types+        [a, b], or [b, a].+So the substitution might go [a->b, b->a].  A similar situation arises in Core+when we find a beta redex like+        (/\ a /\ b -> e) b a+Then we also end up with a substitution that permutes type variables. Other+variations happen to; for example [a -> (a, b)].++        ********************************************************+        *** So a substitution must be applied precisely once ***+        ********************************************************++A TCvSubst is not idempotent, but, unlike the non-idempotent substitution+we use during unifications, it must not be repeatedly applied.++Note [Extending the TvSubstEnv]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+See #tcvsubst_invariant# for the invariants that must hold.++This invariant allows a short-cut when the subst envs are empty:+if the TvSubstEnv and CvSubstEnv are empty --- i.e. (isEmptyTCvSubst subst)+holds --- then (substTy subst ty) does nothing.++For example, consider:+        (/\a. /\b:(a~Int). ...b..) Int+We substitute Int for 'a'.  The Unique of 'b' does not change, but+nevertheless we add 'b' to the TvSubstEnv, because b's kind does change++This invariant has several crucial consequences:++* In substVarBndr, we need extend the TvSubstEnv+        - if the unique has changed+        - or if the kind has changed++* In substTyVar, we do not need to consult the in-scope set;+  the TvSubstEnv is enough++* In substTy, substTheta, we can short-circuit when the TvSubstEnv is empty++Note [Substituting types and coercions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Types and coercions are mutually recursive, and either may have variables+"belonging" to the other. Thus, every time we wish to substitute in a+type, we may also need to substitute in a coercion, and vice versa.+However, the constructor used to create type variables is distinct from+that of coercion variables, so we carry two VarEnvs in a TCvSubst. Note+that it would be possible to use the CoercionTy constructor to combine+these environments, but that seems like a false economy.++Note that the TvSubstEnv should *never* map a CoVar (built with the Id+constructor) and the CvSubstEnv should *never* map a TyVar. Furthermore,+the range of the TvSubstEnv should *never* include a type headed with+CoercionTy.+-}++emptyTvSubstEnv :: TvSubstEnv+emptyTvSubstEnv = emptyVarEnv++emptyCvSubstEnv :: CvSubstEnv+emptyCvSubstEnv = emptyVarEnv++composeTCvSubstEnv :: InScopeSet+                   -> (TvSubstEnv, CvSubstEnv)+                   -> (TvSubstEnv, CvSubstEnv)+                   -> (TvSubstEnv, CvSubstEnv)+-- ^ @(compose env1 env2)(x)@ is @env1(env2(x))@; i.e. apply @env2@ then @env1@.+-- It assumes that both are idempotent.+-- Typically, @env1@ is the refinement to a base substitution @env2@+composeTCvSubstEnv in_scope (tenv1, cenv1) (tenv2, cenv2)+  = ( tenv1 `plusVarEnv` mapVarEnv (substTy subst1) tenv2+    , cenv1 `plusVarEnv` mapVarEnv (substCo subst1) cenv2 )+        -- First apply env1 to the range of env2+        -- Then combine the two, making sure that env1 loses if+        -- both bind the same variable; that's why env1 is the+        --  *left* argument to plusVarEnv, because the right arg wins+  where+    subst1 = TCvSubst in_scope tenv1 cenv1++-- | Composes two substitutions, applying the second one provided first,+-- like in function composition.+composeTCvSubst :: TCvSubst -> TCvSubst -> TCvSubst+composeTCvSubst (TCvSubst is1 tenv1 cenv1) (TCvSubst is2 tenv2 cenv2)+  = TCvSubst is3 tenv3 cenv3+  where+    is3 = is1 `unionInScope` is2+    (tenv3, cenv3) = composeTCvSubstEnv is3 (tenv1, cenv1) (tenv2, cenv2)++emptyTCvSubst :: TCvSubst+emptyTCvSubst = TCvSubst emptyInScopeSet emptyTvSubstEnv emptyCvSubstEnv++mkEmptyTCvSubst :: InScopeSet -> TCvSubst+mkEmptyTCvSubst is = TCvSubst is emptyTvSubstEnv emptyCvSubstEnv++isEmptyTCvSubst :: TCvSubst -> Bool+         -- See Note [Extending the TvSubstEnv]+isEmptyTCvSubst (TCvSubst _ tenv cenv) = isEmptyVarEnv tenv && isEmptyVarEnv cenv++mkTCvSubst :: InScopeSet -> (TvSubstEnv, CvSubstEnv) -> TCvSubst+mkTCvSubst in_scope (tenv, cenv) = TCvSubst in_scope tenv cenv++mkTvSubst :: InScopeSet -> TvSubstEnv -> TCvSubst+-- ^ Make a TCvSubst with specified tyvar subst and empty covar subst+mkTvSubst in_scope tenv = TCvSubst in_scope tenv emptyCvSubstEnv++mkCvSubst :: InScopeSet -> CvSubstEnv -> TCvSubst+-- ^ Make a TCvSubst with specified covar subst and empty tyvar subst+mkCvSubst in_scope cenv = TCvSubst in_scope emptyTvSubstEnv cenv++getTvSubstEnv :: TCvSubst -> TvSubstEnv+getTvSubstEnv (TCvSubst _ env _) = env++getCvSubstEnv :: TCvSubst -> CvSubstEnv+getCvSubstEnv (TCvSubst _ _ env) = env++getTCvInScope :: TCvSubst -> InScopeSet+getTCvInScope (TCvSubst in_scope _ _) = in_scope++-- | Returns the free variables of the types in the range of a substitution as+-- a non-deterministic set.+getTCvSubstRangeFVs :: TCvSubst -> VarSet+getTCvSubstRangeFVs (TCvSubst _ tenv cenv)+    = unionVarSet tenvFVs cenvFVs+  where+    tenvFVs = tyCoVarsOfTypesSet tenv+    cenvFVs = tyCoVarsOfCosSet cenv++isInScope :: Var -> TCvSubst -> Bool+isInScope v (TCvSubst in_scope _ _) = v `elemInScopeSet` in_scope++notElemTCvSubst :: Var -> TCvSubst -> Bool+notElemTCvSubst v (TCvSubst _ tenv cenv)+  | isTyVar v+  = not (v `elemVarEnv` tenv)+  | otherwise+  = not (v `elemVarEnv` cenv)++setTvSubstEnv :: TCvSubst -> TvSubstEnv -> TCvSubst+setTvSubstEnv (TCvSubst in_scope _ cenv) tenv = TCvSubst in_scope tenv cenv++setCvSubstEnv :: TCvSubst -> CvSubstEnv -> TCvSubst+setCvSubstEnv (TCvSubst in_scope tenv _) cenv = TCvSubst in_scope tenv cenv++zapTCvSubst :: TCvSubst -> TCvSubst+zapTCvSubst (TCvSubst in_scope _ _) = TCvSubst in_scope emptyVarEnv emptyVarEnv++extendTCvInScope :: TCvSubst -> Var -> TCvSubst+extendTCvInScope (TCvSubst in_scope tenv cenv) var+  = TCvSubst (extendInScopeSet in_scope var) tenv cenv++extendTCvInScopeList :: TCvSubst -> [Var] -> TCvSubst+extendTCvInScopeList (TCvSubst in_scope tenv cenv) vars+  = TCvSubst (extendInScopeSetList in_scope vars) tenv cenv++extendTCvInScopeSet :: TCvSubst -> VarSet -> TCvSubst+extendTCvInScopeSet (TCvSubst in_scope tenv cenv) vars+  = TCvSubst (extendInScopeSetSet in_scope vars) tenv cenv++extendTCvSubst :: TCvSubst -> TyCoVar -> Type -> TCvSubst+extendTCvSubst subst v ty+  | isTyVar v+  = extendTvSubst subst v ty+  | CoercionTy co <- ty+  = extendCvSubst subst v co+  | otherwise+  = pprPanic "extendTCvSubst" (ppr v <+> text "|->" <+> ppr ty)++extendTCvSubstWithClone :: TCvSubst -> TyCoVar -> TyCoVar -> TCvSubst+extendTCvSubstWithClone subst tcv+  | isTyVar tcv = extendTvSubstWithClone subst tcv+  | otherwise   = extendCvSubstWithClone subst tcv++extendTvSubst :: TCvSubst -> TyVar -> Type -> TCvSubst+extendTvSubst (TCvSubst in_scope tenv cenv) tv ty+  = TCvSubst in_scope (extendVarEnv tenv tv ty) cenv++extendTvSubstBinderAndInScope :: TCvSubst -> TyCoBinder -> Type -> TCvSubst+extendTvSubstBinderAndInScope subst (Named (Bndr v _)) ty+  = ASSERT( isTyVar v )+    extendTvSubstAndInScope subst v ty+extendTvSubstBinderAndInScope subst (Anon {}) _+  = subst++extendTvSubstWithClone :: TCvSubst -> TyVar -> TyVar -> TCvSubst+-- Adds a new tv -> tv mapping, /and/ extends the in-scope set+extendTvSubstWithClone (TCvSubst in_scope tenv cenv) tv tv'+  = TCvSubst (extendInScopeSetSet in_scope new_in_scope)+             (extendVarEnv tenv tv (mkTyVarTy tv'))+             cenv+  where+    new_in_scope = tyCoVarsOfType (tyVarKind tv') `extendVarSet` tv'++extendCvSubst :: TCvSubst -> CoVar -> Coercion -> TCvSubst+extendCvSubst (TCvSubst in_scope tenv cenv) v co+  = TCvSubst in_scope tenv (extendVarEnv cenv v co)++extendCvSubstWithClone :: TCvSubst -> CoVar -> CoVar -> TCvSubst+extendCvSubstWithClone (TCvSubst in_scope tenv cenv) cv cv'+  = TCvSubst (extendInScopeSetSet in_scope new_in_scope)+             tenv+             (extendVarEnv cenv cv (mkCoVarCo cv'))+  where+    new_in_scope = tyCoVarsOfType (varType cv') `extendVarSet` cv'++extendTvSubstAndInScope :: TCvSubst -> TyVar -> Type -> TCvSubst+-- Also extends the in-scope set+extendTvSubstAndInScope (TCvSubst in_scope tenv cenv) tv ty+  = TCvSubst (in_scope `extendInScopeSetSet` tyCoVarsOfType ty)+             (extendVarEnv tenv tv ty)+             cenv++extendTvSubstList :: TCvSubst -> [Var] -> [Type] -> TCvSubst+extendTvSubstList subst tvs tys+  = foldl2 extendTvSubst subst tvs tys++extendTCvSubstList :: TCvSubst -> [Var] -> [Type] -> TCvSubst+extendTCvSubstList subst tvs tys+  = foldl2 extendTCvSubst subst tvs tys++unionTCvSubst :: TCvSubst -> TCvSubst -> TCvSubst+-- Works when the ranges are disjoint+unionTCvSubst (TCvSubst in_scope1 tenv1 cenv1) (TCvSubst in_scope2 tenv2 cenv2)+  = ASSERT( not (tenv1 `intersectsVarEnv` tenv2)+         && not (cenv1 `intersectsVarEnv` cenv2) )+    TCvSubst (in_scope1 `unionInScope` in_scope2)+             (tenv1     `plusVarEnv`   tenv2)+             (cenv1     `plusVarEnv`   cenv2)++-- mkTvSubstPrs and zipTvSubst generate the in-scope set from+-- the types given; but it's just a thunk so with a bit of luck+-- it'll never be evaluated++-- | Generates the in-scope set for the 'TCvSubst' from the types in the incoming+-- environment. No CoVars, please!+zipTvSubst :: [TyVar] -> [Type] -> TCvSubst+zipTvSubst tvs tys+  | debugIsOn+  , not (all isTyVar tvs) || neLength tvs tys+  = pprTrace "zipTvSubst" (ppr tvs $$ ppr tys) emptyTCvSubst+  | otherwise+  = mkTvSubst (mkInScopeSet (tyCoVarsOfTypes tys)) tenv+  where+    tenv = zipTyEnv tvs tys++-- | Generates the in-scope set for the 'TCvSubst' from the types in the incoming+-- environment.  No TyVars, please!+zipCvSubst :: [CoVar] -> [Coercion] -> TCvSubst+zipCvSubst cvs cos+  | debugIsOn+  , not (all isCoVar cvs) || neLength cvs cos+  = pprTrace "zipCvSubst" (ppr cvs $$ ppr cos) emptyTCvSubst+  | otherwise+  = TCvSubst (mkInScopeSet (tyCoVarsOfCos cos)) emptyTvSubstEnv cenv+  where+    cenv = zipCoEnv cvs cos++zipTCvSubst :: [TyCoVar] -> [Type] -> TCvSubst+zipTCvSubst tcvs tys+  | debugIsOn+  , neLength tcvs tys+  = pprTrace "zipTCvSubst" (ppr tcvs $$ ppr tys) emptyTCvSubst+  | otherwise+  = zip_tcvsubst tcvs tys (mkEmptyTCvSubst $ mkInScopeSet (tyCoVarsOfTypes tys))+  where zip_tcvsubst :: [TyCoVar] -> [Type] -> TCvSubst -> TCvSubst+        zip_tcvsubst (tv:tvs) (ty:tys) subst+          = zip_tcvsubst tvs tys (extendTCvSubst subst tv ty)+        zip_tcvsubst _ _ subst = subst -- empty case++-- | Generates the in-scope set for the 'TCvSubst' from the types in the+-- incoming environment. No CoVars, please!+mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst+mkTvSubstPrs prs =+    ASSERT2( onlyTyVarsAndNoCoercionTy, text "prs" <+> ppr prs )+    mkTvSubst in_scope tenv+  where tenv = mkVarEnv prs+        in_scope = mkInScopeSet $ tyCoVarsOfTypes $ map snd prs+        onlyTyVarsAndNoCoercionTy =+          and [ isTyVar tv && not (isCoercionTy ty)+              | (tv, ty) <- prs ]++zipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv+zipTyEnv tyvars tys+  = ASSERT( all (not . isCoercionTy) tys )+    mkVarEnv (zipEqual "zipTyEnv" tyvars tys)+        -- There used to be a special case for when+        --      ty == TyVarTy tv+        -- (a not-uncommon case) in which case the substitution was dropped.+        -- But the type-tidier changes the print-name of a type variable without+        -- changing the unique, and that led to a bug.   Why?  Pre-tidying, we had+        -- a type {Foo t}, where Foo is a one-method class.  So Foo is really a newtype.+        -- And it happened that t was the type variable of the class.  Post-tiding,+        -- it got turned into {Foo t2}.  The ext-core printer expanded this using+        -- sourceTypeRep, but that said "Oh, t == t2" because they have the same unique,+        -- and so generated a rep type mentioning t not t2.+        --+        -- Simplest fix is to nuke the "optimisation"++zipCoEnv :: [CoVar] -> [Coercion] -> CvSubstEnv+zipCoEnv cvs cos = mkVarEnv (zipEqual "zipCoEnv" cvs cos)++instance Outputable TCvSubst where+  ppr (TCvSubst ins tenv cenv)+    = brackets $ sep[ text "TCvSubst",+                      nest 2 (text "In scope:" <+> ppr ins),+                      nest 2 (text "Type env:" <+> ppr tenv),+                      nest 2 (text "Co env:" <+> ppr cenv) ]++{-+%************************************************************************+%*                                                                      *+                Performing type or kind substitutions+%*                                                                      *+%************************************************************************++Note [Sym and ForAllCo]+~~~~~~~~~~~~~~~~~~~~~~~+In OptCoercion, we try to push "sym" out to the leaves of a coercion. But,+how do we push sym into a ForAllCo? It's a little ugly.++Here is the typing rule:++h : k1 ~# k2+(tv : k1) |- g : ty1 ~# ty2+----------------------------+ForAllCo tv h g : (ForAllTy (tv : k1) ty1) ~#+                  (ForAllTy (tv : k2) (ty2[tv |-> tv |> sym h]))++Here is what we want:++ForAllCo tv h' g' : (ForAllTy (tv : k2) (ty2[tv |-> tv |> sym h])) ~#+                    (ForAllTy (tv : k1) ty1)+++Because the kinds of the type variables to the right of the colon are the kinds+coerced by h', we know (h' : k2 ~# k1). Thus, (h' = sym h).++Now, we can rewrite ty1 to be (ty1[tv |-> tv |> sym h' |> h']). We thus want++ForAllCo tv h' g' :+  (ForAllTy (tv : k2) (ty2[tv |-> tv |> h'])) ~#+  (ForAllTy (tv : k1) (ty1[tv |-> tv |> h'][tv |-> tv |> sym h']))++We thus see that we want++g' : ty2[tv |-> tv |> h'] ~# ty1[tv |-> tv |> h']++and thus g' = sym (g[tv |-> tv |> h']).++Putting it all together, we get this:++sym (ForAllCo tv h g)+==>+ForAllCo tv (sym h) (sym g[tv |-> tv |> sym h])++Note [Substituting in a coercion hole]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+It seems highly suspicious to be substituting in a coercion that still+has coercion holes. Yet, this can happen in a situation like this:++  f :: forall k. k :~: Type -> ()+  f Refl = let x :: forall (a :: k). [a] -> ...+               x = ...++When we check x's type signature, we require that k ~ Type. We indeed+know this due to the Refl pattern match, but the eager unifier can't+make use of givens. So, when we're done looking at x's type, a coercion+hole will remain. Then, when we're checking x's definition, we skolemise+x's type (in order to, e.g., bring the scoped type variable `a` into scope).+This requires performing a substitution for the fresh skolem variables.++This subsitution needs to affect the kind of the coercion hole, too --+otherwise, the kind will have an out-of-scope variable in it. More problematically+in practice (we won't actually notice the out-of-scope variable ever), skolems+in the kind might have too high a level, triggering a failure to uphold the+invariant that no free variables in a type have a higher level than the+ambient level in the type checker. In the event of having free variables in the+hole's kind, I'm pretty sure we'll always have an erroneous program, so we+don't need to worry what will happen when the hole gets filled in. After all,+a hole relating a locally-bound type variable will be unable to be solved. This+is why it's OK not to look through the IORef of a coercion hole during+substitution.++-}++-- | Type substitution, see 'zipTvSubst'+substTyWith :: HasCallStack => [TyVar] -> [Type] -> Type -> Type+-- Works only if the domain of the substitution is a+-- superset of the type being substituted into+substTyWith tvs tys = {-#SCC "substTyWith" #-}+                      ASSERT( tvs `equalLength` tys )+                      substTy (zipTvSubst tvs tys)++-- | Type substitution, see 'zipTvSubst'. Disables sanity checks.+-- The problems that the sanity checks in substTy catch are described in+-- Note [The substitution invariant].+-- The goal of #11371 is to migrate all the calls of substTyUnchecked to+-- substTy and remove this function. Please don't use in new code.+substTyWithUnchecked :: [TyVar] -> [Type] -> Type -> Type+substTyWithUnchecked tvs tys+  = ASSERT( tvs `equalLength` tys )+    substTyUnchecked (zipTvSubst tvs tys)++-- | Substitute tyvars within a type using a known 'InScopeSet'.+-- Pre-condition: the 'in_scope' set should satisfy Note [The substitution+-- invariant]; specifically it should include the free vars of 'tys',+-- and of 'ty' minus the domain of the subst.+substTyWithInScope :: InScopeSet -> [TyVar] -> [Type] -> Type -> Type+substTyWithInScope in_scope tvs tys ty =+  ASSERT( tvs `equalLength` tys )+  substTy (mkTvSubst in_scope tenv) ty+  where tenv = zipTyEnv tvs tys++-- | Coercion substitution, see 'zipTvSubst'+substCoWith :: HasCallStack => [TyVar] -> [Type] -> Coercion -> Coercion+substCoWith tvs tys = ASSERT( tvs `equalLength` tys )+                      substCo (zipTvSubst tvs tys)++-- | Coercion substitution, see 'zipTvSubst'. Disables sanity checks.+-- The problems that the sanity checks in substCo catch are described in+-- Note [The substitution invariant].+-- The goal of #11371 is to migrate all the calls of substCoUnchecked to+-- substCo and remove this function. Please don't use in new code.+substCoWithUnchecked :: [TyVar] -> [Type] -> Coercion -> Coercion+substCoWithUnchecked tvs tys+  = ASSERT( tvs `equalLength` tys )+    substCoUnchecked (zipTvSubst tvs tys)++++-- | Substitute covars within a type+substTyWithCoVars :: [CoVar] -> [Coercion] -> Type -> Type+substTyWithCoVars cvs cos = substTy (zipCvSubst cvs cos)++-- | Type substitution, see 'zipTvSubst'+substTysWith :: [TyVar] -> [Type] -> [Type] -> [Type]+substTysWith tvs tys = ASSERT( tvs `equalLength` tys )+                       substTys (zipTvSubst tvs tys)++-- | Type substitution, see 'zipTvSubst'+substTysWithCoVars :: [CoVar] -> [Coercion] -> [Type] -> [Type]+substTysWithCoVars cvs cos = ASSERT( cvs `equalLength` cos )+                             substTys (zipCvSubst cvs cos)++-- | Substitute within a 'Type' after adding the free variables of the type+-- to the in-scope set. This is useful for the case when the free variables+-- aren't already in the in-scope set or easily available.+-- See also Note [The substitution invariant].+substTyAddInScope :: TCvSubst -> Type -> Type+substTyAddInScope subst ty =+  substTy (extendTCvInScopeSet subst $ tyCoVarsOfType ty) ty++-- | When calling `substTy` it should be the case that the in-scope set in+-- the substitution is a superset of the free vars of the range of the+-- substitution.+-- See also Note [The substitution invariant].+isValidTCvSubst :: TCvSubst -> Bool+isValidTCvSubst (TCvSubst in_scope tenv cenv) =+  (tenvFVs `varSetInScope` in_scope) &&+  (cenvFVs `varSetInScope` in_scope)+  where+  tenvFVs = tyCoVarsOfTypesSet tenv+  cenvFVs = tyCoVarsOfCosSet cenv++-- | This checks if the substitution satisfies the invariant from+-- Note [The substitution invariant].+checkValidSubst :: HasCallStack => TCvSubst -> [Type] -> [Coercion] -> a -> a+checkValidSubst subst@(TCvSubst in_scope tenv cenv) tys cos a+  = ASSERT2( isValidTCvSubst subst,+             text "in_scope" <+> ppr in_scope $$+             text "tenv" <+> ppr tenv $$+             text "tenvFVs" <+> ppr (tyCoVarsOfTypesSet tenv) $$+             text "cenv" <+> ppr cenv $$+             text "cenvFVs" <+> ppr (tyCoVarsOfCosSet cenv) $$+             text "tys" <+> ppr tys $$+             text "cos" <+> ppr cos )+    ASSERT2( tysCosFVsInScope,+             text "in_scope" <+> ppr in_scope $$+             text "tenv" <+> ppr tenv $$+             text "cenv" <+> ppr cenv $$+             text "tys" <+> ppr tys $$+             text "cos" <+> ppr cos $$+             text "needInScope" <+> ppr needInScope )+    a+  where+  substDomain = nonDetKeysUFM tenv ++ nonDetKeysUFM cenv+    -- It's OK to use nonDetKeysUFM here, because we only use this list to+    -- remove some elements from a set+  needInScope = (tyCoVarsOfTypes tys `unionVarSet` tyCoVarsOfCos cos)+                  `delListFromUniqSet_Directly` substDomain+  tysCosFVsInScope = needInScope `varSetInScope` in_scope+++-- | Substitute within a 'Type'+-- The substitution has to satisfy the invariants described in+-- Note [The substitution invariant].+substTy :: HasCallStack => TCvSubst -> Type  -> Type+substTy subst ty+  | isEmptyTCvSubst subst = ty+  | otherwise             = checkValidSubst subst [ty] [] $+                            subst_ty subst ty++-- | Substitute within a 'Type' disabling the sanity checks.+-- The problems that the sanity checks in substTy catch are described in+-- Note [The substitution invariant].+-- The goal of #11371 is to migrate all the calls of substTyUnchecked to+-- substTy and remove this function. Please don't use in new code.+substTyUnchecked :: TCvSubst -> Type -> Type+substTyUnchecked subst ty+                 | isEmptyTCvSubst subst = ty+                 | otherwise             = subst_ty subst ty++-- | Substitute within several 'Type's+-- The substitution has to satisfy the invariants described in+-- Note [The substitution invariant].+substTys :: HasCallStack => TCvSubst -> [Type] -> [Type]+substTys subst tys+  | isEmptyTCvSubst subst = tys+  | otherwise = checkValidSubst subst tys [] $ map (subst_ty subst) tys++-- | Substitute within several 'Type's disabling the sanity checks.+-- The problems that the sanity checks in substTys catch are described in+-- Note [The substitution invariant].+-- The goal of #11371 is to migrate all the calls of substTysUnchecked to+-- substTys and remove this function. Please don't use in new code.+substTysUnchecked :: TCvSubst -> [Type] -> [Type]+substTysUnchecked subst tys+                 | isEmptyTCvSubst subst = tys+                 | otherwise             = map (subst_ty subst) tys++-- | Substitute within a 'ThetaType'+-- The substitution has to satisfy the invariants described in+-- Note [The substitution invariant].+substTheta :: HasCallStack => TCvSubst -> ThetaType -> ThetaType+substTheta = substTys++-- | Substitute within a 'ThetaType' disabling the sanity checks.+-- The problems that the sanity checks in substTys catch are described in+-- Note [The substitution invariant].+-- The goal of #11371 is to migrate all the calls of substThetaUnchecked to+-- substTheta and remove this function. Please don't use in new code.+substThetaUnchecked :: TCvSubst -> ThetaType -> ThetaType+substThetaUnchecked = substTysUnchecked+++subst_ty :: TCvSubst -> Type -> Type+-- subst_ty is the main workhorse for type substitution+--+-- Note that the in_scope set is poked only if we hit a forall+-- so it may often never be fully computed+subst_ty subst ty+   = go ty+  where+    go (TyVarTy tv)      = substTyVar subst tv+    go (AppTy fun arg)   = mkAppTy (go fun) $! (go arg)+                -- The mkAppTy smart constructor is important+                -- we might be replacing (a Int), represented with App+                -- by [Int], represented with TyConApp+    go (TyConApp tc tys) = let args = map go tys+                           in  args `seqList` TyConApp tc args+    go ty@(FunTy { ft_arg = arg, ft_res = res })+      = let !arg' = go arg+            !res' = go res+        in ty { ft_arg = arg', ft_res = res' }+    go (ForAllTy (Bndr tv vis) ty)+                         = case substVarBndrUnchecked subst tv of+                             (subst', tv') ->+                               (ForAllTy $! ((Bndr $! tv') vis)) $!+                                            (subst_ty subst' ty)+    go (LitTy n)         = LitTy $! n+    go (CastTy ty co)    = (mkCastTy $! (go ty)) $! (subst_co subst co)+    go (CoercionTy co)   = CoercionTy $! (subst_co subst co)++substTyVar :: TCvSubst -> TyVar -> Type+substTyVar (TCvSubst _ tenv _) tv+  = ASSERT( isTyVar tv )+    case lookupVarEnv tenv tv of+      Just ty -> ty+      Nothing -> TyVarTy tv++substTyVars :: TCvSubst -> [TyVar] -> [Type]+substTyVars subst = map $ substTyVar subst++substTyCoVars :: TCvSubst -> [TyCoVar] -> [Type]+substTyCoVars subst = map $ substTyCoVar subst++substTyCoVar :: TCvSubst -> TyCoVar -> Type+substTyCoVar subst tv+  | isTyVar tv = substTyVar subst tv+  | otherwise = CoercionTy $ substCoVar subst tv++lookupTyVar :: TCvSubst -> TyVar  -> Maybe Type+        -- See Note [Extending the TCvSubst]+lookupTyVar (TCvSubst _ tenv _) tv+  = ASSERT( isTyVar tv )+    lookupVarEnv tenv tv++-- | Substitute within a 'Coercion'+-- The substitution has to satisfy the invariants described in+-- Note [The substitution invariant].+substCo :: HasCallStack => TCvSubst -> Coercion -> Coercion+substCo subst co+  | isEmptyTCvSubst subst = co+  | otherwise = checkValidSubst subst [] [co] $ subst_co subst co++-- | Substitute within a 'Coercion' disabling sanity checks.+-- The problems that the sanity checks in substCo catch are described in+-- Note [The substitution invariant].+-- The goal of #11371 is to migrate all the calls of substCoUnchecked to+-- substCo and remove this function. Please don't use in new code.+substCoUnchecked :: TCvSubst -> Coercion -> Coercion+substCoUnchecked subst co+  | isEmptyTCvSubst subst = co+  | otherwise = subst_co subst co++-- | Substitute within several 'Coercion's+-- The substitution has to satisfy the invariants described in+-- Note [The substitution invariant].+substCos :: HasCallStack => TCvSubst -> [Coercion] -> [Coercion]+substCos subst cos+  | isEmptyTCvSubst subst = cos+  | otherwise = checkValidSubst subst [] cos $ map (subst_co subst) cos++subst_co :: TCvSubst -> Coercion -> Coercion+subst_co subst co+  = go co+  where+    go_ty :: Type -> Type+    go_ty = subst_ty subst++    go_mco :: MCoercion -> MCoercion+    go_mco MRefl    = MRefl+    go_mco (MCo co) = MCo (go co)++    go :: Coercion -> Coercion+    go (Refl ty)             = mkNomReflCo $! (go_ty ty)+    go (GRefl r ty mco)      = (mkGReflCo r $! (go_ty ty)) $! (go_mco mco)+    go (TyConAppCo r tc args)= let args' = map go args+                               in  args' `seqList` mkTyConAppCo r tc args'+    go (AppCo co arg)        = (mkAppCo $! go co) $! go arg+    go (ForAllCo tv kind_co co)+      = case substForAllCoBndrUnchecked subst tv kind_co of+         (subst', tv', kind_co') ->+          ((mkForAllCo $! tv') $! kind_co') $! subst_co subst' co+    go (FunCo r co1 co2)     = (mkFunCo r $! go co1) $! go co2+    go (CoVarCo cv)          = substCoVar subst cv+    go (AxiomInstCo con ind cos) = mkAxiomInstCo con ind $! map go cos+    go (UnivCo p r t1 t2)    = (((mkUnivCo $! go_prov p) $! r) $!+                                (go_ty t1)) $! (go_ty t2)+    go (SymCo co)            = mkSymCo $! (go co)+    go (TransCo co1 co2)     = (mkTransCo $! (go co1)) $! (go co2)+    go (NthCo r d co)        = mkNthCo r d $! (go co)+    go (LRCo lr co)          = mkLRCo lr $! (go co)+    go (InstCo co arg)       = (mkInstCo $! (go co)) $! go arg+    go (KindCo co)           = mkKindCo $! (go co)+    go (SubCo co)            = mkSubCo $! (go co)+    go (AxiomRuleCo c cs)    = let cs1 = map go cs+                                in cs1 `seqList` AxiomRuleCo c cs1+    go (HoleCo h)            = HoleCo $! go_hole h++    go_prov UnsafeCoerceProv     = UnsafeCoerceProv+    go_prov (PhantomProv kco)    = PhantomProv (go kco)+    go_prov (ProofIrrelProv kco) = ProofIrrelProv (go kco)+    go_prov p@(PluginProv _)     = p++    -- See Note [Substituting in a coercion hole]+    go_hole h@(CoercionHole { ch_co_var = cv })+      = h { ch_co_var = updateVarType go_ty cv }++substForAllCoBndr :: TCvSubst -> TyCoVar -> KindCoercion+                  -> (TCvSubst, TyCoVar, Coercion)+substForAllCoBndr subst+  = substForAllCoBndrUsing False (substCo subst) subst++-- | Like 'substForAllCoBndr', but disables sanity checks.+-- The problems that the sanity checks in substCo catch are described in+-- Note [The substitution invariant].+-- The goal of #11371 is to migrate all the calls of substCoUnchecked to+-- substCo and remove this function. Please don't use in new code.+substForAllCoBndrUnchecked :: TCvSubst -> TyCoVar -> KindCoercion+                           -> (TCvSubst, TyCoVar, Coercion)+substForAllCoBndrUnchecked subst+  = substForAllCoBndrUsing False (substCoUnchecked subst) subst++-- See Note [Sym and ForAllCo]+substForAllCoBndrUsing :: Bool  -- apply sym to binder?+                       -> (Coercion -> Coercion)  -- transformation to kind co+                       -> TCvSubst -> TyCoVar -> KindCoercion+                       -> (TCvSubst, TyCoVar, KindCoercion)+substForAllCoBndrUsing sym sco subst old_var+  | isTyVar old_var = substForAllCoTyVarBndrUsing sym sco subst old_var+  | otherwise       = substForAllCoCoVarBndrUsing sym sco subst old_var++substForAllCoTyVarBndrUsing :: Bool  -- apply sym to binder?+                            -> (Coercion -> Coercion)  -- transformation to kind co+                            -> TCvSubst -> TyVar -> KindCoercion+                            -> (TCvSubst, TyVar, KindCoercion)+substForAllCoTyVarBndrUsing sym sco (TCvSubst in_scope tenv cenv) old_var old_kind_co+  = ASSERT( isTyVar old_var )+    ( TCvSubst (in_scope `extendInScopeSet` new_var) new_env cenv+    , new_var, new_kind_co )+  where+    new_env | no_change && not sym = delVarEnv tenv old_var+            | sym       = extendVarEnv tenv old_var $+                          TyVarTy new_var `CastTy` new_kind_co+            | otherwise = extendVarEnv tenv old_var (TyVarTy new_var)++    no_kind_change = noFreeVarsOfCo old_kind_co+    no_change = no_kind_change && (new_var == old_var)++    new_kind_co | no_kind_change = old_kind_co+                | otherwise      = sco old_kind_co++    Pair new_ki1 _ = coercionKind new_kind_co+    -- We could do substitution to (tyVarKind old_var). We don't do so because+    -- we already substituted new_kind_co, which contains the kind information+    -- we want. We don't want to do substitution once more. Also, in most cases,+    -- new_kind_co is a Refl, in which case coercionKind is really fast.++    new_var  = uniqAway in_scope (setTyVarKind old_var new_ki1)++substForAllCoCoVarBndrUsing :: Bool  -- apply sym to binder?+                            -> (Coercion -> Coercion)  -- transformation to kind co+                            -> TCvSubst -> CoVar -> KindCoercion+                            -> (TCvSubst, CoVar, KindCoercion)+substForAllCoCoVarBndrUsing sym sco (TCvSubst in_scope tenv cenv)+                            old_var old_kind_co+  = ASSERT( isCoVar old_var )+    ( TCvSubst (in_scope `extendInScopeSet` new_var) tenv new_cenv+    , new_var, new_kind_co )+  where+    new_cenv | no_change && not sym = delVarEnv cenv old_var+             | otherwise = extendVarEnv cenv old_var (mkCoVarCo new_var)++    no_kind_change = noFreeVarsOfCo old_kind_co+    no_change = no_kind_change && (new_var == old_var)++    new_kind_co | no_kind_change = old_kind_co+                | otherwise      = sco old_kind_co++    Pair h1 h2 = coercionKind new_kind_co++    new_var       = uniqAway in_scope $ mkCoVar (varName old_var) new_var_type+    new_var_type  | sym       = h2+                  | otherwise = h1++substCoVar :: TCvSubst -> CoVar -> Coercion+substCoVar (TCvSubst _ _ cenv) cv+  = case lookupVarEnv cenv cv of+      Just co -> co+      Nothing -> CoVarCo cv++substCoVars :: TCvSubst -> [CoVar] -> [Coercion]+substCoVars subst cvs = map (substCoVar subst) cvs++lookupCoVar :: TCvSubst -> Var -> Maybe Coercion+lookupCoVar (TCvSubst _ _ cenv) v = lookupVarEnv cenv v++substTyVarBndr :: HasCallStack => TCvSubst -> TyVar -> (TCvSubst, TyVar)+substTyVarBndr = substTyVarBndrUsing substTy++substTyVarBndrs :: HasCallStack => TCvSubst -> [TyVar] -> (TCvSubst, [TyVar])+substTyVarBndrs = mapAccumL substTyVarBndr++substVarBndr :: HasCallStack => TCvSubst -> TyCoVar -> (TCvSubst, TyCoVar)+substVarBndr = substVarBndrUsing substTy++substVarBndrs :: HasCallStack => TCvSubst -> [TyCoVar] -> (TCvSubst, [TyCoVar])+substVarBndrs = mapAccumL substVarBndr++substCoVarBndr :: HasCallStack => TCvSubst -> CoVar -> (TCvSubst, CoVar)+substCoVarBndr = substCoVarBndrUsing substTy++-- | Like 'substVarBndr', but disables sanity checks.+-- The problems that the sanity checks in substTy catch are described in+-- Note [The substitution invariant].+-- The goal of #11371 is to migrate all the calls of substTyUnchecked to+-- substTy and remove this function. Please don't use in new code.+substVarBndrUnchecked :: TCvSubst -> TyCoVar -> (TCvSubst, TyCoVar)+substVarBndrUnchecked = substVarBndrUsing substTyUnchecked++substVarBndrUsing :: (TCvSubst -> Type -> Type)+                  -> TCvSubst -> TyCoVar -> (TCvSubst, TyCoVar)+substVarBndrUsing subst_fn subst v+  | isTyVar v = substTyVarBndrUsing subst_fn subst v+  | otherwise = substCoVarBndrUsing subst_fn subst v++-- | Substitute a tyvar in a binding position, returning an+-- extended subst and a new tyvar.+-- Use the supplied function to substitute in the kind+substTyVarBndrUsing+  :: (TCvSubst -> Type -> Type)  -- ^ Use this to substitute in the kind+  -> TCvSubst -> TyVar -> (TCvSubst, TyVar)+substTyVarBndrUsing subst_fn subst@(TCvSubst in_scope tenv cenv) old_var+  = ASSERT2( _no_capture, pprTyVar old_var $$ pprTyVar new_var $$ ppr subst )+    ASSERT( isTyVar old_var )+    (TCvSubst (in_scope `extendInScopeSet` new_var) new_env cenv, new_var)+  where+    new_env | no_change = delVarEnv tenv old_var+            | otherwise = extendVarEnv tenv old_var (TyVarTy new_var)++    _no_capture = not (new_var `elemVarSet` tyCoVarsOfTypesSet tenv)+    -- Assertion check that we are not capturing something in the substitution++    old_ki = tyVarKind old_var+    no_kind_change = noFreeVarsOfType old_ki -- verify that kind is closed+    no_change = no_kind_change && (new_var == old_var)+        -- no_change means that the new_var is identical in+        -- all respects to the old_var (same unique, same kind)+        -- See Note [Extending the TCvSubst]+        --+        -- In that case we don't need to extend the substitution+        -- to map old to new.  But instead we must zap any+        -- current substitution for the variable. For example:+        --      (\x.e) with id_subst = [x |-> e']+        -- Here we must simply zap the substitution for x++    new_var | no_kind_change = uniqAway in_scope old_var+            | otherwise = uniqAway in_scope $+                          setTyVarKind old_var (subst_fn subst old_ki)+        -- The uniqAway part makes sure the new variable is not already in scope++-- | Substitute a covar in a binding position, returning an+-- extended subst and a new covar.+-- Use the supplied function to substitute in the kind+substCoVarBndrUsing+  :: (TCvSubst -> Type -> Type)+  -> TCvSubst -> CoVar -> (TCvSubst, CoVar)+substCoVarBndrUsing subst_fn subst@(TCvSubst in_scope tenv cenv) old_var+  = ASSERT( isCoVar old_var )+    (TCvSubst (in_scope `extendInScopeSet` new_var) tenv new_cenv, new_var)+  where+    new_co         = mkCoVarCo new_var+    no_kind_change = noFreeVarsOfTypes [t1, t2]+    no_change      = new_var == old_var && no_kind_change++    new_cenv | no_change = delVarEnv cenv old_var+             | otherwise = extendVarEnv cenv old_var new_co++    new_var = uniqAway in_scope subst_old_var+    subst_old_var = mkCoVar (varName old_var) new_var_type++    (_, _, t1, t2, role) = coVarKindsTypesRole old_var+    t1' = subst_fn subst t1+    t2' = subst_fn subst t2+    new_var_type = mkCoercionType role t1' t2'+                  -- It's important to do the substitution for coercions,+                  -- because they can have free type variables++cloneTyVarBndr :: TCvSubst -> TyVar -> Unique -> (TCvSubst, TyVar)+cloneTyVarBndr subst@(TCvSubst in_scope tv_env cv_env) tv uniq+  = ASSERT2( isTyVar tv, ppr tv )   -- I think it's only called on TyVars+    (TCvSubst (extendInScopeSet in_scope tv')+              (extendVarEnv tv_env tv (mkTyVarTy tv')) cv_env, tv')+  where+    old_ki = tyVarKind tv+    no_kind_change = noFreeVarsOfType old_ki -- verify that kind is closed++    tv1 | no_kind_change = tv+        | otherwise      = setTyVarKind tv (substTy subst old_ki)++    tv' = setVarUnique tv1 uniq++cloneTyVarBndrs :: TCvSubst -> [TyVar] -> UniqSupply -> (TCvSubst, [TyVar])+cloneTyVarBndrs subst []     _usupply = (subst, [])+cloneTyVarBndrs subst (t:ts)  usupply = (subst'', tv:tvs)+  where+    (uniq, usupply') = takeUniqFromSupply usupply+    (subst' , tv )   = cloneTyVarBndr subst t uniq+    (subst'', tvs)   = cloneTyVarBndrs subst' ts usupply'++{-+%************************************************************************+%*                                                                      *+                   Pretty-printing types++       Defined very early because of debug printing in assertions+%*                                                                      *+%************************************************************************++@pprType@ is the standard @Type@ printer; the overloaded @ppr@ function is+defined to use this.  @pprParendType@ is the same, except it puts+parens around the type, except for the atomic cases.  @pprParendType@+works just by setting the initial context precedence very high.++Note that any function which pretty-prints a @Type@ first converts the @Type@+to an @IfaceType@. See Note [IfaceType and pretty-printing] in IfaceType.++See Note [Precedence in types] in BasicTypes.+-}++--------------------------------------------------------+-- When pretty-printing types, we convert to IfaceType,+--   and pretty-print that.+-- See Note [Pretty printing via IfaceSyn] in PprTyThing+--------------------------------------------------------++pprType, pprParendType :: Type -> SDoc+pprType       = pprPrecType topPrec+pprParendType = pprPrecType appPrec++pprPrecType :: PprPrec -> Type -> SDoc+pprPrecType = pprPrecTypeX emptyTidyEnv++pprPrecTypeX :: TidyEnv -> PprPrec -> Type -> SDoc+pprPrecTypeX env prec ty+  = getPprStyle $ \sty ->+    if debugStyle sty           -- Use debugPprType when in+    then debug_ppr_ty prec ty   -- when in debug-style+    else pprPrecIfaceType prec (tidyToIfaceTypeStyX env ty sty)+    -- NB: debug-style is used for -dppr-debug+    --     dump-style  is used for -ddump-tc-trace etc++pprTyLit :: TyLit -> SDoc+pprTyLit = pprIfaceTyLit . toIfaceTyLit++pprKind, pprParendKind :: Kind -> SDoc+pprKind       = pprType+pprParendKind = pprParendType++tidyToIfaceTypeStyX :: TidyEnv -> Type -> PprStyle -> IfaceType+tidyToIfaceTypeStyX env ty sty+  | userStyle sty = tidyToIfaceTypeX env ty+  | otherwise     = toIfaceTypeX (tyCoVarsOfType ty) ty+     -- in latter case, don't tidy, as we'll be printing uniques.++tidyToIfaceType :: Type -> IfaceType+tidyToIfaceType = tidyToIfaceTypeX emptyTidyEnv++tidyToIfaceTypeX :: TidyEnv -> Type -> IfaceType+-- It's vital to tidy before converting to an IfaceType+-- or nested binders will become indistinguishable!+--+-- Also for the free type variables, tell toIfaceTypeX to+-- leave them as IfaceFreeTyVar.  This is super-important+-- for debug printing.+tidyToIfaceTypeX env ty = toIfaceTypeX (mkVarSet free_tcvs) (tidyType env' ty)+  where+    env'      = tidyFreeTyCoVars env free_tcvs+    free_tcvs = tyCoVarsOfTypeWellScoped ty++------------+pprCo, pprParendCo :: Coercion -> SDoc+pprCo       co = getPprStyle $ \ sty -> pprIfaceCoercion (tidyToIfaceCoSty co sty)+pprParendCo co = getPprStyle $ \ sty -> pprParendIfaceCoercion (tidyToIfaceCoSty co sty)++tidyToIfaceCoSty :: Coercion -> PprStyle -> IfaceCoercion+tidyToIfaceCoSty co sty+  | userStyle sty = tidyToIfaceCo co+  | otherwise     = toIfaceCoercionX (tyCoVarsOfCo co) co+     -- in latter case, don't tidy, as we'll be printing uniques.++tidyToIfaceCo :: Coercion -> IfaceCoercion+-- It's vital to tidy before converting to an IfaceType+-- or nested binders will become indistinguishable!+--+-- Also for the free type variables, tell toIfaceCoercionX to+-- leave them as IfaceFreeCoVar.  This is super-important+-- for debug printing.+tidyToIfaceCo co = toIfaceCoercionX (mkVarSet free_tcvs) (tidyCo env co)+  where+    env       = tidyFreeTyCoVars emptyTidyEnv free_tcvs+    free_tcvs = scopedSort $ tyCoVarsOfCoList co+------------+pprClassPred :: Class -> [Type] -> SDoc+pprClassPred clas tys = pprTypeApp (classTyCon clas) tys++------------+pprTheta :: ThetaType -> SDoc+pprTheta = pprIfaceContext topPrec . map tidyToIfaceType++pprParendTheta :: ThetaType -> SDoc+pprParendTheta = pprIfaceContext appPrec . map tidyToIfaceType++pprThetaArrowTy :: ThetaType -> SDoc+pprThetaArrowTy = pprIfaceContextArr . map tidyToIfaceType++------------------+instance Outputable Type where+    ppr ty = pprType ty++instance Outputable TyLit where+   ppr = pprTyLit++------------------+pprSigmaType :: Type -> SDoc+pprSigmaType = pprIfaceSigmaType ShowForAllWhen . tidyToIfaceType++pprForAll :: [TyCoVarBinder] -> SDoc+pprForAll tvs = pprIfaceForAll (map toIfaceForAllBndr tvs)++-- | Print a user-level forall; see Note [When to print foralls]+pprUserForAll :: [TyCoVarBinder] -> SDoc+pprUserForAll = pprUserIfaceForAll . map toIfaceForAllBndr++pprTCvBndrs :: [TyCoVarBinder] -> SDoc+pprTCvBndrs tvs = sep (map pprTCvBndr tvs)++pprTCvBndr :: TyCoVarBinder -> SDoc+pprTCvBndr = pprTyVar . binderVar++pprTyVars :: [TyVar] -> SDoc+pprTyVars tvs = sep (map pprTyVar tvs)++pprTyVar :: TyVar -> SDoc+-- Print a type variable binder with its kind (but not if *)+-- Here we do not go via IfaceType, because the duplication with+-- pprIfaceTvBndr is minimal, and the loss of uniques etc in+-- debug printing is disastrous+pprTyVar tv+  | isLiftedTypeKind kind = ppr tv+  | otherwise             = parens (ppr tv <+> dcolon <+> ppr kind)+  where+    kind = tyVarKind tv++instance Outputable TyCoBinder where+  ppr (Anon af ty) = ppr af <+> ppr ty+  ppr (Named (Bndr v Required))  = ppr v+  ppr (Named (Bndr v Specified)) = char '@' <> ppr v+  ppr (Named (Bndr v Inferred))  = braces (ppr v)++-----------------+instance Outputable Coercion where -- defined here to avoid orphans+  ppr = pprCo++debugPprType :: Type -> SDoc+-- ^ debugPprType is a simple pretty printer that prints a type+-- without going through IfaceType.  It does not format as prettily+-- as the normal route, but it's much more direct, and that can+-- be useful for debugging.  E.g. with -dppr-debug it prints the+-- kind on type-variable /occurrences/ which the normal route+-- fundamentally cannot do.+debugPprType ty = debug_ppr_ty topPrec ty++debug_ppr_ty :: PprPrec -> Type -> SDoc+debug_ppr_ty _ (LitTy l)+  = ppr l++debug_ppr_ty _ (TyVarTy tv)+  = ppr tv  -- With -dppr-debug we get (tv :: kind)++debug_ppr_ty prec (FunTy { ft_af = af, ft_arg = arg, ft_res = res })+  = maybeParen prec funPrec $+    sep [debug_ppr_ty funPrec arg, arrow <+> debug_ppr_ty prec res]+  where+    arrow = case af of+              VisArg   -> text "->"+              InvisArg -> text "=>"++debug_ppr_ty prec (TyConApp tc tys)+  | null tys  = ppr tc+  | otherwise = maybeParen prec appPrec $+                hang (ppr tc) 2 (sep (map (debug_ppr_ty appPrec) tys))++debug_ppr_ty _ (AppTy t1 t2)+  = hang (debug_ppr_ty appPrec t1)  -- Print parens so we see ((a b) c)+       2 (debug_ppr_ty appPrec t2)  -- so that we can distinguish+                                    -- TyConApp from AppTy++debug_ppr_ty prec (CastTy ty co)+  = maybeParen prec topPrec $+    hang (debug_ppr_ty topPrec ty)+       2 (text "|>" <+> ppr co)++debug_ppr_ty _ (CoercionTy co)+  = parens (text "CO" <+> ppr co)++debug_ppr_ty prec ty@(ForAllTy {})+  | (tvs, body) <- split ty+  = maybeParen prec funPrec $+    hang (text "forall" <+> fsep (map ppr tvs) <> dot)+         -- The (map ppr tvs) will print kind-annotated+         -- tvs, because we are (usually) in debug-style+       2 (ppr body)+  where+    split ty | ForAllTy tv ty' <- ty+             , (tvs, body) <- split ty'+             = (tv:tvs, body)+             | otherwise+             = ([], ty)++{-+Note [When to print foralls]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Mostly we want to print top-level foralls when (and only when) the user specifies+-fprint-explicit-foralls.  But when kind polymorphism is at work, that suppresses+too much information; see #9018.++So I'm trying out this rule: print explicit foralls if+  a) User specifies -fprint-explicit-foralls, or+  b) Any of the quantified type variables has a kind+     that mentions a kind variable++This catches common situations, such as a type siguature+     f :: m a+which means+      f :: forall k. forall (m :: k->*) (a :: k). m a+We really want to see both the "forall k" and the kind signatures+on m and a.  The latter comes from pprTCvBndr.++Note [Infix type variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+With TypeOperators you can say++   f :: (a ~> b) -> b++and the (~>) is considered a type variable.  However, the type+pretty-printer in this module will just see (a ~> b) as++   App (App (TyVarTy "~>") (TyVarTy "a")) (TyVarTy "b")++So it'll print the type in prefix form.  To avoid confusion we must+remember to parenthesise the operator, thus++   (~>) a b -> b++See #2766.+-}++pprDataCons :: TyCon -> SDoc+pprDataCons = sepWithVBars . fmap pprDataConWithArgs . tyConDataCons+  where+    sepWithVBars [] = empty+    sepWithVBars docs = sep (punctuate (space <> vbar) docs)++pprDataConWithArgs :: DataCon -> SDoc+pprDataConWithArgs dc = sep [forAllDoc, thetaDoc, ppr dc <+> argsDoc]+  where+    (_univ_tvs, _ex_tvs, _eq_spec, theta, arg_tys, _res_ty) = dataConFullSig dc+    user_bndrs = dataConUserTyVarBinders dc+    forAllDoc  = pprUserForAll user_bndrs+    thetaDoc   = pprThetaArrowTy theta+    argsDoc    = hsep (fmap pprParendType arg_tys)+++pprTypeApp :: TyCon -> [Type] -> SDoc+pprTypeApp tc tys+  = pprIfaceTypeApp topPrec (toIfaceTyCon tc)+                            (toIfaceTcArgs tc tys)+    -- TODO: toIfaceTcArgs seems rather wasteful here++------------------+-- | Display all kind information (with @-fprint-explicit-kinds@) when the+-- provided 'Bool' argument is 'True'.+-- See @Note [Kind arguments in error messages]@ in "TcErrors".+pprWithExplicitKindsWhen :: Bool -> SDoc -> SDoc+pprWithExplicitKindsWhen b+  = updSDocDynFlags $ \dflags ->+      if b then gopt_set dflags Opt_PrintExplicitKinds+           else dflags++{-+%************************************************************************+%*                                                                      *+\subsection{TidyType}+%*                                                                      *+%************************************************************************+-}++-- | This tidies up a type for printing in an error message, or in+-- an interface file.+--+-- It doesn't change the uniques at all, just the print names.+tidyVarBndrs :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])+tidyVarBndrs tidy_env tvs+  = mapAccumL tidyVarBndr (avoidNameClashes tvs tidy_env) tvs++tidyVarBndr :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)+tidyVarBndr tidy_env@(occ_env, subst) var+  = case tidyOccName occ_env (getHelpfulOccName var) of+      (occ_env', occ') -> ((occ_env', subst'), var')+        where+          subst' = extendVarEnv subst var var'+          var'   = setVarType (setVarName var name') type'+          type'  = tidyType tidy_env (varType var)+          name'  = tidyNameOcc name occ'+          name   = varName var++avoidNameClashes :: [TyCoVar] -> TidyEnv -> TidyEnv+-- Seed the occ_env with clashes among the names, see+-- Note [Tidying multiple names at once] in OccName+avoidNameClashes tvs (occ_env, subst)+  = (avoidClashesOccEnv occ_env occs, subst)+  where+    occs = map getHelpfulOccName tvs++getHelpfulOccName :: TyCoVar -> OccName+-- A TcTyVar with a System Name is probably a+-- unification variable; when we tidy them we give them a trailing+-- "0" (or 1 etc) so that they don't take precedence for the+-- un-modified name. Plus, indicating a unification variable in+-- this way is a helpful clue for users+getHelpfulOccName tv+  | isSystemName name, isTcTyVar tv+  = mkTyVarOcc (occNameString occ ++ "0")+  | otherwise+  = occ+  where+   name = varName tv+   occ  = getOccName name++tidyTyCoVarBinder :: TidyEnv -> VarBndr TyCoVar vis+                  -> (TidyEnv, VarBndr TyCoVar vis)+tidyTyCoVarBinder tidy_env (Bndr tv vis)+  = (tidy_env', Bndr tv' vis)+  where+    (tidy_env', tv') = tidyVarBndr tidy_env tv++tidyTyCoVarBinders :: TidyEnv -> [VarBndr TyCoVar vis]+                   -> (TidyEnv, [VarBndr TyCoVar vis])+tidyTyCoVarBinders tidy_env tvbs+  = mapAccumL tidyTyCoVarBinder+              (avoidNameClashes (binderVars tvbs) tidy_env) tvbs++---------------+tidyFreeTyCoVars :: TidyEnv -> [TyCoVar] -> TidyEnv+-- ^ Add the free 'TyVar's to the env in tidy form,+-- so that we can tidy the type they are free in+tidyFreeTyCoVars (full_occ_env, var_env) tyvars+  = fst (tidyOpenTyCoVars (full_occ_env, var_env) tyvars)++---------------+tidyOpenTyCoVars :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])+tidyOpenTyCoVars env tyvars = mapAccumL tidyOpenTyCoVar env tyvars++---------------+tidyOpenTyCoVar :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)+-- ^ Treat a new 'TyCoVar' as a binder, and give it a fresh tidy name+-- using the environment if one has not already been allocated. See+-- also 'tidyVarBndr'+tidyOpenTyCoVar env@(_, subst) tyvar+  = case lookupVarEnv subst tyvar of+        Just tyvar' -> (env, tyvar')              -- Already substituted+        Nothing     ->+          let env' = tidyFreeTyCoVars env (tyCoVarsOfTypeList (tyVarKind tyvar))+          in tidyVarBndr env' tyvar  -- Treat it as a binder++---------------+tidyTyCoVarOcc :: TidyEnv -> TyCoVar -> TyCoVar+tidyTyCoVarOcc env@(_, subst) tv+  = case lookupVarEnv subst tv of+        Nothing  -> updateVarType (tidyType env) tv+        Just tv' -> tv'++---------------+tidyTypes :: TidyEnv -> [Type] -> [Type]+tidyTypes env tys = map (tidyType env) tys++---------------+tidyType :: TidyEnv -> Type -> Type+tidyType _   (LitTy n)             = LitTy n+tidyType env (TyVarTy tv)          = TyVarTy (tidyTyCoVarOcc env tv)+tidyType env (TyConApp tycon tys)  = let args = tidyTypes env tys+                                     in args `seqList` TyConApp tycon args+tidyType env (AppTy fun arg)       = (AppTy $! (tidyType env fun)) $! (tidyType env arg)+tidyType env ty@(FunTy _ arg res)  = let { !arg' = tidyType env arg+                                         ; !res' = tidyType env res }+                                     in ty { ft_arg = arg', ft_res = res' }+tidyType env (ty@(ForAllTy{}))     = mkForAllTys' (zip tvs' vis) $! tidyType env' body_ty+  where+    (tvs, vis, body_ty) = splitForAllTys' ty+    (env', tvs') = tidyVarBndrs env tvs+tidyType env (CastTy ty co)       = (CastTy $! tidyType env ty) $! (tidyCo env co)+tidyType env (CoercionTy co)      = CoercionTy $! (tidyCo env co)+++-- The following two functions differ from mkForAllTys and splitForAllTys in that+-- they expect/preserve the ArgFlag argument. Thes belong to types/Type.hs, but+-- how should they be named?+mkForAllTys' :: [(TyCoVar, ArgFlag)] -> Type -> Type+mkForAllTys' tvvs ty = foldr strictMkForAllTy ty tvvs+  where+    strictMkForAllTy (tv,vis) ty = (ForAllTy $! ((Bndr $! tv) $! vis)) $! ty++splitForAllTys' :: Type -> ([TyCoVar], [ArgFlag], Type)+splitForAllTys' ty = go ty [] []+  where+    go (ForAllTy (Bndr tv vis) ty) tvs viss = go ty (tv:tvs) (vis:viss)+    go ty                          tvs viss = (reverse tvs, reverse viss, ty)+++---------------+-- | Grabs the free type variables, tidies them+-- and then uses 'tidyType' to work over the type itself+tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])+tidyOpenTypes env tys+  = (env', tidyTypes (trimmed_occ_env, var_env) tys)+  where+    (env'@(_, var_env), tvs') = tidyOpenTyCoVars env $+                                tyCoVarsOfTypesWellScoped tys+    trimmed_occ_env = initTidyOccEnv (map getOccName tvs')+      -- The idea here was that we restrict the new TidyEnv to the+      -- _free_ vars of the types, so that we don't gratuitously rename+      -- the _bound_ variables of the types.++---------------+tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)+tidyOpenType env ty = let (env', [ty']) = tidyOpenTypes env [ty] in+                      (env', ty')++---------------+-- | Calls 'tidyType' on a top-level type (i.e. with an empty tidying environment)+tidyTopType :: Type -> Type+tidyTopType ty = tidyType emptyTidyEnv ty++---------------+tidyOpenKind :: TidyEnv -> Kind -> (TidyEnv, Kind)+tidyOpenKind = tidyOpenType++tidyKind :: TidyEnv -> Kind -> Kind+tidyKind = tidyType++----------------+tidyCo :: TidyEnv -> Coercion -> Coercion+tidyCo env@(_, subst) co+  = go co+  where+    go_mco MRefl    = MRefl+    go_mco (MCo co) = MCo (go co)++    go (Refl ty)             = Refl (tidyType env ty)+    go (GRefl r ty mco)      = GRefl r (tidyType env ty) $! go_mco mco+    go (TyConAppCo r tc cos) = let args = map go cos+                               in args `seqList` TyConAppCo r tc args+    go (AppCo co1 co2)       = (AppCo $! go co1) $! go co2+    go (ForAllCo tv h co)    = ((ForAllCo $! tvp) $! (go h)) $! (tidyCo envp co)+                               where (envp, tvp) = tidyVarBndr env tv+            -- the case above duplicates a bit of work in tidying h and the kind+            -- of tv. But the alternative is to use coercionKind, which seems worse.+    go (FunCo r co1 co2)     = (FunCo r $! go co1) $! go co2+    go (CoVarCo cv)          = case lookupVarEnv subst cv of+                                 Nothing  -> CoVarCo cv+                                 Just cv' -> CoVarCo cv'+    go (HoleCo h)            = HoleCo h+    go (AxiomInstCo con ind cos) = let args = map go cos+                               in  args `seqList` AxiomInstCo con ind args+    go (UnivCo p r t1 t2)    = (((UnivCo $! (go_prov p)) $! r) $!+                                tidyType env t1) $! tidyType env t2+    go (SymCo co)            = SymCo $! go co+    go (TransCo co1 co2)     = (TransCo $! go co1) $! go co2+    go (NthCo r d co)        = NthCo r d $! go co+    go (LRCo lr co)          = LRCo lr $! go co+    go (InstCo co ty)        = (InstCo $! go co) $! go ty+    go (KindCo co)           = KindCo $! go co+    go (SubCo co)            = SubCo $! go co+    go (AxiomRuleCo ax cos)  = let cos1 = tidyCos env cos+                               in cos1 `seqList` AxiomRuleCo ax cos1++    go_prov UnsafeCoerceProv    = UnsafeCoerceProv+    go_prov (PhantomProv co)    = PhantomProv (go co)+    go_prov (ProofIrrelProv co) = ProofIrrelProv (go co)+    go_prov p@(PluginProv _)    = p++tidyCos :: TidyEnv -> [Coercion] -> [Coercion]+tidyCos env = map (tidyCo env)+++{- *********************************************************************+*                                                                      *+                   typeSize, coercionSize+*                                                                      *+********************************************************************* -}++-- NB: We put typeSize/coercionSize here because they are mutually+--     recursive, and have the CPR property.  If we have mutual+--     recursion across a hi-boot file, we don't get the CPR property+--     and these functions allocate a tremendous amount of rubbish.+--     It's not critical (because typeSize is really only used in+--     debug mode, but I tripped over an example (T5642) in which+--     typeSize was one of the biggest single allocators in all of GHC.+--     And it's easy to fix, so I did.++-- NB: typeSize does not respect `eqType`, in that two types that+--     are `eqType` may return different sizes. This is OK, because this+--     function is used only in reporting, not decision-making.++typeSize :: Type -> Int+typeSize (LitTy {})                 = 1+typeSize (TyVarTy {})               = 1+typeSize (AppTy t1 t2)              = typeSize t1 + typeSize t2+typeSize (FunTy _ t1 t2)            = typeSize t1 + typeSize t2+typeSize (ForAllTy (Bndr tv _) t)   = typeSize (varType tv) + typeSize t+typeSize (TyConApp _ ts)            = 1 + sum (map typeSize ts)+typeSize (CastTy ty co)             = typeSize ty + coercionSize co+typeSize (CoercionTy co)            = coercionSize co++coercionSize :: Coercion -> Int+coercionSize (Refl ty)             = typeSize ty+coercionSize (GRefl _ ty MRefl)    = typeSize ty+coercionSize (GRefl _ ty (MCo co)) = 1 + typeSize ty + coercionSize co+coercionSize (TyConAppCo _ _ args) = 1 + sum (map coercionSize args)+coercionSize (AppCo co arg)      = coercionSize co + coercionSize arg+coercionSize (ForAllCo _ h co)   = 1 + coercionSize co + coercionSize h+coercionSize (FunCo _ co1 co2)   = 1 + coercionSize co1 + coercionSize co2+coercionSize (CoVarCo _)         = 1+coercionSize (HoleCo _)          = 1+coercionSize (AxiomInstCo _ _ args) = 1 + sum (map coercionSize args)+coercionSize (UnivCo p _ t1 t2)  = 1 + provSize p + typeSize t1 + typeSize t2+coercionSize (SymCo co)          = 1 + coercionSize co+coercionSize (TransCo co1 co2)   = 1 + coercionSize co1 + coercionSize co2+coercionSize (NthCo _ _ co)      = 1 + coercionSize co+coercionSize (LRCo  _ co)        = 1 + coercionSize co+coercionSize (InstCo co arg)     = 1 + coercionSize co + coercionSize arg+coercionSize (KindCo co)         = 1 + coercionSize co+coercionSize (SubCo co)          = 1 + coercionSize co+coercionSize (AxiomRuleCo _ cs)  = 1 + sum (map coercionSize cs)++provSize :: UnivCoProvenance -> Int+provSize UnsafeCoerceProv    = 1+provSize (PhantomProv co)    = 1 + coercionSize co+provSize (ProofIrrelProv co) = 1 + coercionSize co+provSize (PluginProv _)      = 1
+ compiler/types/TyCoRep.hs-boot view
@@ -0,0 +1,31 @@+module TyCoRep where++import GhcPrelude++import Outputable ( SDoc )+import Data.Data  ( Data )+import {-# SOURCE #-} Var( Var, ArgFlag, AnonArgFlag )++data Type+data TyThing+data Coercion+data UnivCoProvenance+data TCvSubst+data TyLit+data TyCoBinder+data MCoercion++type PredType = Type+type Kind = Type+type ThetaType = [PredType]+type CoercionN = Coercion+type MCoercionN = MCoercion++pprKind :: Kind -> SDoc+pprType :: Type -> SDoc+mkFunTy   :: AnonArgFlag -> Type -> Type -> Type+mkForAllTy :: Var -> ArgFlag -> Type -> Type++isRuntimeRepTy :: Type -> Bool++instance Data Type  -- To support Data instances in CoAxiom
+ compiler/types/TyCon.hs view
@@ -0,0 +1,2732 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+++The @TyCon@ datatype+-}++{-# LANGUAGE CPP, FlexibleInstances #-}++module TyCon(+        -- * Main TyCon data types+        TyCon,+        AlgTyConRhs(..), visibleDataCons,+        AlgTyConFlav(..), isNoParent,+        FamTyConFlav(..), Role(..), Injectivity(..),+        RuntimeRepInfo(..), TyConFlavour(..),++        -- * TyConBinder+        TyConBinder, TyConBndrVis(..), TyConTyCoBinder,+        mkNamedTyConBinder, mkNamedTyConBinders,+        mkRequiredTyConBinder,+        mkAnonTyConBinder, mkAnonTyConBinders,+        tyConBinderArgFlag, tyConBndrVisArgFlag, isNamedTyConBinder,+        isVisibleTyConBinder, isInvisibleTyConBinder,++        -- ** Field labels+        tyConFieldLabels, lookupTyConFieldLabel,++        -- ** Constructing TyCons+        mkAlgTyCon,+        mkClassTyCon,+        mkFunTyCon,+        mkPrimTyCon,+        mkKindTyCon,+        mkLiftedPrimTyCon,+        mkTupleTyCon,+        mkSumTyCon,+        mkDataTyConRhs,+        mkSynonymTyCon,+        mkFamilyTyCon,+        mkPromotedDataCon,+        mkTcTyCon,++        -- ** Predicates on TyCons+        isAlgTyCon, isVanillaAlgTyCon,+        isClassTyCon, isFamInstTyCon,+        isFunTyCon,+        isPrimTyCon,+        isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon,+        isUnboxedSumTyCon, isPromotedTupleTyCon,+        isTypeSynonymTyCon,+        mustBeSaturated,+        isPromotedDataCon, isPromotedDataCon_maybe,+        isKindTyCon, isLiftedTypeKindTyConName,+        isTauTyCon, isFamFreeTyCon,++        isDataTyCon, isProductTyCon, isDataProductTyCon_maybe,+        isDataSumTyCon_maybe,+        isEnumerationTyCon,+        isNewTyCon, isAbstractTyCon,+        isFamilyTyCon, isOpenFamilyTyCon,+        isTypeFamilyTyCon, isDataFamilyTyCon,+        isOpenTypeFamilyTyCon, isClosedSynFamilyTyConWithAxiom_maybe,+        tyConInjectivityInfo,+        isBuiltInSynFamTyCon_maybe,+        isUnliftedTyCon,+        isGadtSyntaxTyCon, isInjectiveTyCon, isGenerativeTyCon, isGenInjAlgRhs,+        isTyConAssoc, tyConAssoc_maybe, tyConFlavourAssoc_maybe,+        isImplicitTyCon,+        isTyConWithSrcDataCons,+        isTcTyCon, setTcTyConKind,+        isTcLevPoly,++        -- ** Extracting information out of TyCons+        tyConName,+        tyConSkolem,+        tyConKind,+        tyConUnique,+        tyConTyVars, tyConVisibleTyVars,+        tyConCType, tyConCType_maybe,+        tyConDataCons, tyConDataCons_maybe,+        tyConSingleDataCon_maybe, tyConSingleDataCon,+        tyConSingleAlgDataCon_maybe,+        tyConFamilySize,+        tyConStupidTheta,+        tyConArity,+        tyConRoles,+        tyConFlavour,+        tyConTuple_maybe, tyConClass_maybe, tyConATs,+        tyConFamInst_maybe, tyConFamInstSig_maybe, tyConFamilyCoercion_maybe,+        tyConFamilyResVar_maybe,+        synTyConDefn_maybe, synTyConRhs_maybe,+        famTyConFlav_maybe, famTcResVar,+        algTyConRhs,+        newTyConRhs, newTyConEtadArity, newTyConEtadRhs,+        unwrapNewTyCon_maybe, unwrapNewTyConEtad_maybe,+        newTyConDataCon_maybe,+        algTcFields,+        tyConRuntimeRepInfo,+        tyConBinders, tyConResKind, tyConTyVarBinders,+        tcTyConScopedTyVars, tcTyConIsPoly,+        mkTyConTagMap,++        -- ** Manipulating TyCons+        expandSynTyCon_maybe,+        newTyConCo, newTyConCo_maybe,+        pprPromotionQuote, mkTyConKind,++        -- ** Predicated on TyConFlavours+        tcFlavourIsOpen,++        -- * Runtime type representation+        TyConRepName, tyConRepName_maybe,+        mkPrelTyConRepName,+        tyConRepModOcc,++        -- * Primitive representations of Types+        PrimRep(..), PrimElemRep(..),+        isVoidRep, isGcPtrRep,+        primRepSizeB,+        primElemRepSizeB,+        primRepIsFloat,++        -- * Recursion breaking+        RecTcChecker, initRecTc, defaultRecTcMaxBound,+        setRecTcMaxBound, checkRecTc++) where++#include "HsVersions.h"++import GhcPrelude++import {-# SOURCE #-} TyCoRep    ( Kind, Type, PredType, pprType, mkForAllTy, mkFunTy )+import {-# SOURCE #-} TysWiredIn ( runtimeRepTyCon, constraintKind+                                 , vecCountTyCon, vecElemTyCon, liftedTypeKind )+import {-# SOURCE #-} DataCon    ( DataCon, dataConExTyCoVars, dataConFieldLabels+                                 , dataConTyCon, dataConFullSig+                                 , isUnboxedSumCon )++import Binary+import Var+import VarSet+import Class+import BasicTypes+import DynFlags+import ForeignCall+import Name+import NameEnv+import CoAxiom+import PrelNames+import Maybes+import Outputable+import FastStringEnv+import FieldLabel+import Constants+import Util+import Unique( tyConRepNameUnique, dataConTyRepNameUnique )+import UniqSet+import Module++import qualified Data.Data as Data++{-+-----------------------------------------------+        Notes about type families+-----------------------------------------------++Note [Type synonym families]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+* Type synonym families, also known as "type functions", map directly+  onto the type functions in FC:++        type family F a :: *+        type instance F Int = Bool+        ..etc...++* Reply "yes" to isTypeFamilyTyCon, and isFamilyTyCon++* From the user's point of view (F Int) and Bool are simply+  equivalent types.++* A Haskell 98 type synonym is a degenerate form of a type synonym+  family.++* Type functions can't appear in the LHS of a type function:+        type instance F (F Int) = ...   -- BAD!++* Translation of type family decl:+        type family F a :: *+  translates to+    a FamilyTyCon 'F', whose FamTyConFlav is OpenSynFamilyTyCon++        type family G a :: * where+          G Int = Bool+          G Bool = Char+          G a = ()+  translates to+    a FamilyTyCon 'G', whose FamTyConFlav is ClosedSynFamilyTyCon, with the+    appropriate CoAxiom representing the equations++We also support injective type families -- see Note [Injective type families]++Note [Data type families]+~~~~~~~~~~~~~~~~~~~~~~~~~+See also Note [Wrappers for data instance tycons] in MkId.hs++* Data type families are declared thus+        data family T a :: *+        data instance T Int = T1 | T2 Bool++  Here T is the "family TyCon".++* Reply "yes" to isDataFamilyTyCon, and isFamilyTyCon++* The user does not see any "equivalent types" as he did with type+  synonym families.  He just sees constructors with types+        T1 :: T Int+        T2 :: Bool -> T Int++* Here's the FC version of the above declarations:++        data T a+        data R:TInt = T1 | T2 Bool+        axiom ax_ti : T Int ~R R:TInt++  Note that this is a *representational* coercion+  The R:TInt is the "representation TyCons".+  It has an AlgTyConFlav of+        DataFamInstTyCon T [Int] ax_ti++* The axiom ax_ti may be eta-reduced; see+  Note [Eta reduction for data families] in FamInstEnv++* Data family instances may have a different arity than the data family.+  See Note [Arity of data families] in FamInstEnv++* The data constructor T2 has a wrapper (which is what the+  source-level "T2" invokes):++        $WT2 :: Bool -> T Int+        $WT2 b = T2 b `cast` sym ax_ti++* A data instance can declare a fully-fledged GADT:++        data instance T (a,b) where+          X1 :: T (Int,Bool)+          X2 :: a -> b -> T (a,b)++  Here's the FC version of the above declaration:++        data R:TPair a b where+          X1 :: R:TPair Int Bool+          X2 :: a -> b -> R:TPair a b+        axiom ax_pr :: T (a,b)  ~R  R:TPair a b++        $WX1 :: forall a b. a -> b -> T (a,b)+        $WX1 a b (x::a) (y::b) = X2 a b x y `cast` sym (ax_pr a b)++  The R:TPair are the "representation TyCons".+  We have a bit of work to do, to unpick the result types of the+  data instance declaration for T (a,b), to get the result type in the+  representation; e.g.  T (a,b) --> R:TPair a b++  The representation TyCon R:TList, has an AlgTyConFlav of++        DataFamInstTyCon T [(a,b)] ax_pr++* Notice that T is NOT translated to a FC type function; it just+  becomes a "data type" with no constructors, which can be coerced+  into R:TInt, R:TPair by the axioms.  These axioms+  axioms come into play when (and *only* when) you+        - use a data constructor+        - do pattern matching+  Rather like newtype, in fact++  As a result++  - T behaves just like a data type so far as decomposition is concerned++  - (T Int) is not implicitly converted to R:TInt during type inference.+    Indeed the latter type is unknown to the programmer.++  - There *is* an instance for (T Int) in the type-family instance+    environment, but it is only used for overlap checking++  - It's fine to have T in the LHS of a type function:+    type instance F (T a) = [a]++  It was this last point that confused me!  The big thing is that you+  should not think of a data family T as a *type function* at all, not+  even an injective one!  We can't allow even injective type functions+  on the LHS of a type function:+        type family injective G a :: *+        type instance F (G Int) = Bool+  is no good, even if G is injective, because consider+        type instance G Int = Bool+        type instance F Bool = Char++  So a data type family is not an injective type function. It's just a+  data type with some axioms that connect it to other data types.++* The tyConTyVars of the representation tycon are the tyvars that the+  user wrote in the patterns. This is important in TcDeriv, where we+  bring these tyvars into scope before type-checking the deriving+  clause. This fact is arranged for in TcInstDecls.tcDataFamInstDecl.++Note [Associated families and their parent class]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+*Associated* families are just like *non-associated* families, except+that they have a famTcParent field of (Just cls_tc), which identifies the+parent class.++However there is an important sharing relationship between+  * the tyConTyVars of the parent Class+  * the tyConTyVars of the associated TyCon++   class C a b where+     data T p a+     type F a q b++Here the 'a' and 'b' are shared with the 'Class'; that is, they have+the same Unique.++This is important. In an instance declaration we expect+  * all the shared variables to be instantiated the same way+  * the non-shared variables of the associated type should not+    be instantiated at all++  instance C [x] (Tree y) where+     data T p [x] = T1 x | T2 p+     type F [x] q (Tree y) = (x,y,q)++Note [TyCon Role signatures]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Every tycon has a role signature, assigning a role to each of the tyConTyVars+(or of equal length to the tyConArity, if there are no tyConTyVars). An+example demonstrates these best: say we have a tycon T, with parameters a at+nominal, b at representational, and c at phantom. Then, to prove+representational equality between T a1 b1 c1 and T a2 b2 c2, we need to have+nominal equality between a1 and a2, representational equality between b1 and+b2, and nothing in particular (i.e., phantom equality) between c1 and c2. This+might happen, say, with the following declaration:++  data T a b c where+    MkT :: b -> T Int b c++Data and class tycons have their roles inferred (see inferRoles in TcTyDecls),+as do vanilla synonym tycons. Family tycons have all parameters at role N,+though it is conceivable that we could relax this restriction. (->)'s and+tuples' parameters are at role R. Each primitive tycon declares its roles;+it's worth noting that (~#)'s parameters are at role N. Promoted data+constructors' type arguments are at role R. All kind arguments are at role+N.++Note [Unboxed tuple RuntimeRep vars]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The contents of an unboxed tuple may have any representation. Accordingly,+the kind of the unboxed tuple constructor is runtime-representation+polymorphic. For example,++   (#,#) :: forall (q :: RuntimeRep) (r :: RuntimeRep). TYPE q -> TYPE r -> #++These extra tyvars (v and w) cause some delicate processing around tuples,+where we used to be able to assume that the tycon arity and the+datacon arity were the same.++Note [Injective type families]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We allow injectivity annotations for type families (both open and closed):++  type family F (a :: k) (b :: k) = r | r -> a+  type family G a b = res | res -> a b where ...++Injectivity information is stored in the `famTcInj` field of `FamilyTyCon`.+`famTcInj` maybe stores a list of Bools, where each entry corresponds to a+single element of `tyConTyVars` (both lists should have identical length). If no+injectivity annotation was provided `famTcInj` is Nothing. From this follows an+invariant that if `famTcInj` is a Just then at least one element in the list+must be True.++See also:+ * [Injectivity annotation] in HsDecls+ * [Renaming injectivity annotation] in RnSource+ * [Verifying injectivity annotation] in FamInstEnv+ * [Type inference for type families with injectivity] in TcInteract++************************************************************************+*                                                                      *+                    TyConBinder, TyConTyCoBinder+*                                                                      *+************************************************************************+-}++type TyConBinder = VarBndr TyVar TyConBndrVis++-- In the whole definition of @data TyCon@, only @PromotedDataCon@ will really+-- contain CoVar.+type TyConTyCoBinder = VarBndr TyCoVar TyConBndrVis++data TyConBndrVis+  = NamedTCB ArgFlag+  | AnonTCB  AnonArgFlag++instance Outputable TyConBndrVis where+  ppr (NamedTCB flag) = text "NamedTCB" <> ppr flag+  ppr (AnonTCB af)    = text "AnonTCB"  <> ppr af++mkAnonTyConBinder :: AnonArgFlag -> TyVar -> TyConBinder+mkAnonTyConBinder af tv = ASSERT( isTyVar tv)+                          Bndr tv (AnonTCB af)++mkAnonTyConBinders :: AnonArgFlag -> [TyVar] -> [TyConBinder]+mkAnonTyConBinders af tvs = map (mkAnonTyConBinder af) tvs++mkNamedTyConBinder :: ArgFlag -> TyVar -> TyConBinder+-- The odd argument order supports currying+mkNamedTyConBinder vis tv = ASSERT( isTyVar tv )+                            Bndr tv (NamedTCB vis)++mkNamedTyConBinders :: ArgFlag -> [TyVar] -> [TyConBinder]+-- The odd argument order supports currying+mkNamedTyConBinders vis tvs = map (mkNamedTyConBinder vis) tvs++-- | Make a Required TyConBinder. It chooses between NamedTCB and+-- AnonTCB based on whether the tv is mentioned in the dependent set+mkRequiredTyConBinder :: TyCoVarSet  -- these are used dependently+                      -> TyVar+                      -> TyConBinder+mkRequiredTyConBinder dep_set tv+  | tv `elemVarSet` dep_set = mkNamedTyConBinder Required tv+  | otherwise               = mkAnonTyConBinder  VisArg   tv++tyConBinderArgFlag :: TyConBinder -> ArgFlag+tyConBinderArgFlag (Bndr _ vis) = tyConBndrVisArgFlag vis++tyConBndrVisArgFlag :: TyConBndrVis -> ArgFlag+tyConBndrVisArgFlag (NamedTCB vis)     = vis+tyConBndrVisArgFlag (AnonTCB VisArg)   = Required+tyConBndrVisArgFlag (AnonTCB InvisArg) = Inferred    -- See Note [AnonTCB InvisArg]++isNamedTyConBinder :: TyConBinder -> Bool+-- Identifies kind variables+-- E.g. data T k (a:k) = blah+-- Here 'k' is a NamedTCB, a variable used in the kind of other binders+isNamedTyConBinder (Bndr _ (NamedTCB {})) = True+isNamedTyConBinder _                      = False++isVisibleTyConBinder :: VarBndr tv TyConBndrVis -> Bool+-- Works for IfaceTyConBinder too+isVisibleTyConBinder (Bndr _ tcb_vis) = isVisibleTcbVis tcb_vis++isVisibleTcbVis :: TyConBndrVis -> Bool+isVisibleTcbVis (NamedTCB vis)     = isVisibleArgFlag vis+isVisibleTcbVis (AnonTCB VisArg)   = True+isVisibleTcbVis (AnonTCB InvisArg) = False++isInvisibleTyConBinder :: VarBndr tv TyConBndrVis -> Bool+-- Works for IfaceTyConBinder too+isInvisibleTyConBinder tcb = not (isVisibleTyConBinder tcb)++mkTyConKind :: [TyConBinder] -> Kind -> Kind+mkTyConKind bndrs res_kind = foldr mk res_kind bndrs+  where+    mk :: TyConBinder -> Kind -> Kind+    mk (Bndr tv (AnonTCB af))   k = mkFunTy af (varType tv) k+    mk (Bndr tv (NamedTCB vis)) k = mkForAllTy tv vis k++tyConTyVarBinders :: [TyConBinder]   -- From the TyCon+                  -> [TyVarBinder]   -- Suitable for the foralls of a term function+-- See Note [Building TyVarBinders from TyConBinders]+tyConTyVarBinders tc_bndrs+ = map mk_binder tc_bndrs+ where+   mk_binder (Bndr tv tc_vis) = mkTyVarBinder vis tv+      where+        vis = case tc_vis of+                AnonTCB VisArg    -> Specified+                AnonTCB InvisArg  -> Inferred   -- See Note [AnonTCB InvisArg]+                NamedTCB Required -> Specified+                NamedTCB vis      -> vis++-- Returns only tyvars, as covars are always inferred+tyConVisibleTyVars :: TyCon -> [TyVar]+tyConVisibleTyVars tc+  = [ tv | Bndr tv vis <- tyConBinders tc+         , isVisibleTcbVis vis ]++{- Note [AnonTCB InivsArg]+~~~~~~~~~~~~~~~~~~~~~~~~~~+It's pretty rare to have an (AnonTCB InvisArg) binder.  The+only way it can occur is in a PromotedDataCon whose+kind has an equality constraint:+  'MkT :: forall a b. (a~b) => blah+See Note [Constraints in kinds] in TyCoRep, and+Note [Promoted data constructors] in this module.++When mapping an (AnonTCB InvisArg) to an ArgFlag, in+tyConBndrVisArgFlag, we use "Inferred" to mean "the user cannot+specify this arguments, even with visible type/kind application;+instead the type checker must fill it in.++We map (AnonTCB VisArg) to Required, of course: the user must+provide it. It would be utterly wrong to do this for constraint+arguments, which is why AnonTCB must have the AnonArgFlag in+the first place.++Note [Building TyVarBinders from TyConBinders]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We sometimes need to build the quantified type of a value from+the TyConBinders of a type or class.  For that we need not+TyConBinders but TyVarBinders (used in forall-type)  E.g:++ *  From   data T a = MkT (Maybe a)+    we are going to make a data constructor with type+           MkT :: forall a. Maybe a -> T a+    See the TyCoVarBinders passed to buildDataCon++ * From    class C a where { op :: a -> Maybe a }+   we are going to make a default method+           $dmop :: forall a. C a => a -> Maybe a+   See the TyCoVarBinders passed to mkSigmaTy in mkDefaultMethodType++Both of these are user-callable.  (NB: default methods are not callable+directly by the user but rather via the code generated by 'deriving',+which uses visible type application; see mkDefMethBind.)++Since they are user-callable we must get their type-argument visibility+information right; and that info is in the TyConBinders.+Here is an example:++  data App a b = MkApp (a b) -- App :: forall {k}. (k->*) -> k -> *++The TyCon has++  tyConTyBinders = [ Named (Bndr (k :: *) Inferred), Anon (k->*), Anon k ]++The TyConBinders for App line up with App's kind, given above.++But the DataCon MkApp has the type+  MkApp :: forall {k} (a:k->*) (b:k). a b -> App k a b++That is, its TyCoVarBinders should be++  dataConUnivTyVarBinders = [ Bndr (k:*)    Inferred+                            , Bndr (a:k->*) Specified+                            , Bndr (b:k)    Specified ]++So tyConTyVarBinders converts TyCon's TyConBinders into TyVarBinders:+  - variable names from the TyConBinders+  - but changing Anon/Required to Specified++The last part about Required->Specified comes from this:+  data T k (a:k) b = MkT (a b)+Here k is Required in T's kind, but we don't have Required binders in+the TyCoBinders for a term (see Note [No Required TyCoBinder in terms]+in TyCoRep), so we change it to Specified when making MkT's TyCoBinders+-}+++{- Note [The binders/kind/arity fields of a TyCon]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+All TyCons have this group of fields+  tyConBinders   :: [TyConBinder/TyConTyCoBinder]+  tyConResKind   :: Kind+  tyConTyVars    :: [TyVar]   -- Cached = binderVars tyConBinders+                              --   NB: Currently (Aug 2018), TyCons that own this+                              --   field really only contain TyVars. So it is+                              --   [TyVar] instead of [TyCoVar].+  tyConKind      :: Kind      -- Cached = mkTyConKind tyConBinders tyConResKind+  tyConArity     :: Arity     -- Cached = length tyConBinders++They fit together like so:++* tyConBinders gives the telescope of type/coercion variables on the LHS of the+  type declaration.  For example:++    type App a (b :: k) = a b++  tyConBinders = [ Bndr (k::*)   (NamedTCB Inferred)+                 , Bndr (a:k->*) AnonTCB+                 , Bndr (b:k)    AnonTCB ]++  Note that that are three binders here, including the+  kind variable k.++* See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep+  for what the visibility flag means.++* Each TyConBinder tyConBinders has a TyVar (sometimes it is TyCoVar), and+  that TyVar may scope over some other part of the TyCon's definition. Eg+      type T a = a -> a+  we have+      tyConBinders = [ Bndr (a:*) AnonTCB ]+      synTcRhs     = a -> a+  So the 'a' scopes over the synTcRhs++* From the tyConBinders and tyConResKind we can get the tyConKind+  E.g for our App example:+      App :: forall k. (k->*) -> k -> *++  We get a 'forall' in the kind for each NamedTCB, and an arrow+  for each AnonTCB++  tyConKind is the full kind of the TyCon, not just the result kind++* For type families, tyConArity is the arguments this TyCon must be+  applied to, to be considered saturated.  Here we mean "applied to in+  the actual Type", not surface syntax; i.e. including implicit kind+  variables.  So it's just (length tyConBinders)++* For an algebraic data type, or data instance, the tyConResKind is+  always (TYPE r); that is, the tyConBinders are enough to saturate+  the type constructor.  I'm not quite sure why we have this invariant,+  but it's enforced by etaExpandAlgTyCon+-}++instance Outputable tv => Outputable (VarBndr tv TyConBndrVis) where+  ppr (Bndr v bi) = ppr_bi bi <+> parens (ppr v)+    where+      ppr_bi (AnonTCB VisArg)     = text "anon-vis"+      ppr_bi (AnonTCB InvisArg)   = text "anon-invis"+      ppr_bi (NamedTCB Required)  = text "req"+      ppr_bi (NamedTCB Specified) = text "spec"+      ppr_bi (NamedTCB Inferred)  = text "inf"++instance Binary TyConBndrVis where+  put_ bh (AnonTCB af)   = do { putByte bh 0; put_ bh af }+  put_ bh (NamedTCB vis) = do { putByte bh 1; put_ bh vis }++  get bh = do { h <- getByte bh+              ; case h of+                  0 -> do { af  <- get bh; return (AnonTCB af) }+                  _ -> do { vis <- get bh; return (NamedTCB vis) } }+++{- *********************************************************************+*                                                                      *+               The TyCon type+*                                                                      *+************************************************************************+-}+++-- | TyCons represent type constructors. Type constructors are introduced by+-- things such as:+--+-- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of+--    kind @*@+--+-- 2) Type synonyms: @type Foo = ...@ creates the @Foo@ type constructor+--+-- 3) Newtypes: @newtype Foo a = MkFoo ...@ creates the @Foo@ type constructor+--    of kind @* -> *@+--+-- 4) Class declarations: @class Foo where@ creates the @Foo@ type constructor+--    of kind @*@+--+-- This data type also encodes a number of primitive, built in type constructors+-- such as those for function and tuple types.++-- If you edit this type, you may need to update the GHC formalism+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs+data TyCon+  = -- | The function type constructor, @(->)@+    FunTyCon {+        tyConUnique :: Unique,   -- ^ A Unique of this TyCon. Invariant:+                                 -- identical to Unique of Name stored in+                                 -- tyConName field.++        tyConName   :: Name,     -- ^ Name of the constructor++        -- See Note [The binders/kind/arity fields of a TyCon]+        tyConBinders :: [TyConBinder], -- ^ Full binders+        tyConResKind :: Kind,             -- ^ Result kind+        tyConKind    :: Kind,             -- ^ Kind of this TyCon+        tyConArity   :: Arity,            -- ^ Arity++        tcRepName :: TyConRepName+    }++  -- | Algebraic data types, from+  --     - @data@ declarations+  --     - @newtype@ declarations+  --     - data instance declarations+  --     - type instance declarations+  --     - the TyCon generated by a class declaration+  --     - boxed tuples+  --     - unboxed tuples+  --     - constraint tuples+  -- All these constructors are lifted and boxed except unboxed tuples+  -- which should have an 'UnboxedAlgTyCon' parent.+  -- Data/newtype/type /families/ are handled by 'FamilyTyCon'.+  -- See 'AlgTyConRhs' for more information.+  | AlgTyCon {+        tyConUnique  :: Unique,  -- ^ A Unique of this TyCon. Invariant:+                                 -- identical to Unique of Name stored in+                                 -- tyConName field.++        tyConName    :: Name,    -- ^ Name of the constructor++        -- See Note [The binders/kind/arity fields of a TyCon]+        tyConBinders :: [TyConBinder], -- ^ Full binders+        tyConTyVars  :: [TyVar],          -- ^ TyVar binders+        tyConResKind :: Kind,             -- ^ Result kind+        tyConKind    :: Kind,             -- ^ Kind of this TyCon+        tyConArity   :: Arity,            -- ^ Arity++              -- The tyConTyVars scope over:+              --+              -- 1. The 'algTcStupidTheta'+              -- 2. The cached types in algTyConRhs.NewTyCon+              -- 3. The family instance types if present+              --+              -- Note that it does /not/ scope over the data+              -- constructors.++        tcRoles      :: [Role],  -- ^ The role for each type variable+                                 -- This list has length = tyConArity+                                 -- See also Note [TyCon Role signatures]++        tyConCType   :: Maybe CType,-- ^ The C type that should be used+                                    -- for this type when using the FFI+                                    -- and CAPI++        algTcGadtSyntax  :: Bool,   -- ^ Was the data type declared with GADT+                                    -- syntax?  If so, that doesn't mean it's a+                                    -- true GADT; only that the "where" form+                                    -- was used.  This field is used only to+                                    -- guide pretty-printing++        algTcStupidTheta :: [PredType], -- ^ The \"stupid theta\" for the data+                                        -- type (always empty for GADTs).  A+                                        -- \"stupid theta\" is the context to+                                        -- the left of an algebraic type+                                        -- declaration, e.g. @Eq a@ in the+                                        -- declaration @data Eq a => T a ...@.++        algTcRhs    :: AlgTyConRhs, -- ^ Contains information about the+                                    -- data constructors of the algebraic type++        algTcFields :: FieldLabelEnv, -- ^ Maps a label to information+                                      -- about the field++        algTcParent :: AlgTyConFlav -- ^ Gives the class or family declaration+                                       -- 'TyCon' for derived 'TyCon's representing+                                       -- class or family instances, respectively.++    }++  -- | Represents type synonyms+  | SynonymTyCon {+        tyConUnique  :: Unique,  -- ^ A Unique of this TyCon. Invariant:+                                 -- identical to Unique of Name stored in+                                 -- tyConName field.++        tyConName    :: Name,    -- ^ Name of the constructor++        -- See Note [The binders/kind/arity fields of a TyCon]+        tyConBinders :: [TyConBinder], -- ^ Full binders+        tyConTyVars  :: [TyVar],          -- ^ TyVar binders+        tyConResKind :: Kind,             -- ^ Result kind+        tyConKind    :: Kind,             -- ^ Kind of this TyCon+        tyConArity   :: Arity,            -- ^ Arity+             -- tyConTyVars scope over: synTcRhs++        tcRoles      :: [Role],  -- ^ The role for each type variable+                                 -- This list has length = tyConArity+                                 -- See also Note [TyCon Role signatures]++        synTcRhs     :: Type,    -- ^ Contains information about the expansion+                                 -- of the synonym++        synIsTau     :: Bool,   -- True <=> the RHS of this synonym does not+                                 --          have any foralls, after expanding any+                                 --          nested synonyms+        synIsFamFree  :: Bool    -- True <=> the RHS of this synonym does not mention+                                 --          any type synonym families (data families+                                 --          are fine), again after expanding any+                                 --          nested synonyms+    }++  -- | Represents families (both type and data)+  -- Argument roles are all Nominal+  | FamilyTyCon {+        tyConUnique  :: Unique,  -- ^ A Unique of this TyCon. Invariant:+                                 -- identical to Unique of Name stored in+                                 -- tyConName field.++        tyConName    :: Name,    -- ^ Name of the constructor++        -- See Note [The binders/kind/arity fields of a TyCon]+        tyConBinders :: [TyConBinder], -- ^ Full binders+        tyConTyVars  :: [TyVar],          -- ^ TyVar binders+        tyConResKind :: Kind,             -- ^ Result kind+        tyConKind    :: Kind,             -- ^ Kind of this TyCon+        tyConArity   :: Arity,            -- ^ Arity+            -- tyConTyVars connect an associated family TyCon+            -- with its parent class; see TcValidity.checkConsistentFamInst++        famTcResVar  :: Maybe Name,   -- ^ Name of result type variable, used+                                      -- for pretty-printing with --show-iface+                                      -- and for reifying TyCon in Template+                                      -- Haskell++        famTcFlav    :: FamTyConFlav, -- ^ Type family flavour: open, closed,+                                      -- abstract, built-in. See comments for+                                      -- FamTyConFlav++        famTcParent  :: Maybe TyCon,  -- ^ For *associated* type/data families+                                      -- The class tycon in which the family is declared+                                      -- See Note [Associated families and their parent class]++        famTcInj     :: Injectivity   -- ^ is this a type family injective in+                                      -- its type variables? Nothing if no+                                      -- injectivity annotation was given+    }++  -- | Primitive types; cannot be defined in Haskell. This includes+  -- the usual suspects (such as @Int#@) as well as foreign-imported+  -- types and kinds (@*@, @#@, and @?@)+  | PrimTyCon {+        tyConUnique   :: Unique, -- ^ A Unique of this TyCon. Invariant:+                                 -- identical to Unique of Name stored in+                                 -- tyConName field.++        tyConName     :: Name,   -- ^ Name of the constructor++        -- See Note [The binders/kind/arity fields of a TyCon]+        tyConBinders :: [TyConBinder], -- ^ Full binders+        tyConResKind :: Kind,             -- ^ Result kind+        tyConKind    :: Kind,             -- ^ Kind of this TyCon+        tyConArity   :: Arity,            -- ^ Arity++        tcRoles       :: [Role], -- ^ The role for each type variable+                                 -- This list has length = tyConArity+                                 -- See also Note [TyCon Role signatures]++        isUnlifted   :: Bool,    -- ^ Most primitive tycons are unlifted (may+                                 -- not contain bottom) but other are lifted,+                                 -- e.g. @RealWorld@+                                 -- Only relevant if tyConKind = *++        primRepName :: Maybe TyConRepName   -- Only relevant for kind TyCons+                                            -- i.e, *, #, ?+    }++  -- | Represents promoted data constructor.+  | PromotedDataCon {          -- See Note [Promoted data constructors]+        tyConUnique  :: Unique,     -- ^ Same Unique as the data constructor+        tyConName    :: Name,       -- ^ Same Name as the data constructor++        -- See Note [The binders/kind/arity fields of a TyCon]+        tyConBinders :: [TyConTyCoBinder], -- ^ Full binders+        tyConResKind :: Kind,             -- ^ Result kind+        tyConKind    :: Kind,             -- ^ Kind of this TyCon+        tyConArity   :: Arity,            -- ^ Arity++        tcRoles       :: [Role],    -- ^ Roles: N for kind vars, R for type vars+        dataCon       :: DataCon,   -- ^ Corresponding data constructor+        tcRepName     :: TyConRepName,+        promDcRepInfo :: RuntimeRepInfo  -- ^ See comments with 'RuntimeRepInfo'+    }++  -- | These exist only during type-checking. See Note [How TcTyCons work]+  -- in TcTyClsDecls+  | TcTyCon {+        tyConUnique :: Unique,+        tyConName   :: Name,++        -- See Note [The binders/kind/arity fields of a TyCon]+        tyConBinders :: [TyConBinder], -- ^ Full binders+        tyConTyVars  :: [TyVar],       -- ^ TyVar binders+        tyConResKind :: Kind,          -- ^ Result kind+        tyConKind    :: Kind,          -- ^ Kind of this TyCon+        tyConArity   :: Arity,         -- ^ Arity++          -- NB: the TyConArity of a TcTyCon must match+          -- the number of Required (positional, user-specified)+          -- arguments to the type constructor; see the use+          -- of tyConArity in generaliseTcTyCon++        tcTyConScopedTyVars :: [(Name,TyVar)],+          -- ^ Scoped tyvars over the tycon's body+          -- See Note [Scoped tyvars in a TcTyCon]++        tcTyConIsPoly     :: Bool, -- ^ Is this TcTyCon already generalized?++        tcTyConFlavour :: TyConFlavour+                           -- ^ What sort of 'TyCon' this represents.+      }+{- Note [Scoped tyvars in a TcTyCon]++~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The tcTyConScopedTyVars field records the lexicial-binding connection+between the original, user-specified Name (i.e. thing in scope) and+the TcTyVar that the Name is bound to.++Order *does* matter; the tcTyConScopedTyvars list consists of+     specified_tvs ++ required_tvs++where+   * specified ones first+   * required_tvs the same as tyConTyVars+   * tyConArity = length required_tvs++See also Note [How TcTyCons work] in TcTyClsDecls+-}++-- | Represents right-hand-sides of 'TyCon's for algebraic types+data AlgTyConRhs++    -- | Says that we know nothing about this data type, except that+    -- it's represented by a pointer.  Used when we export a data type+    -- abstractly into an .hi file.+  = AbstractTyCon++    -- | Information about those 'TyCon's derived from a @data@+    -- declaration. This includes data types with no constructors at+    -- all.+  | DataTyCon {+        data_cons :: [DataCon],+                          -- ^ The data type constructors; can be empty if the+                          --   user declares the type to have no constructors+                          --+                          -- INVARIANT: Kept in order of increasing 'DataCon'+                          -- tag (see the tag assignment in mkTyConTagMap)+        data_cons_size :: Int,+                          -- ^ Cached value: length data_cons+        is_enum :: Bool   -- ^ Cached value: is this an enumeration type?+                          --   See Note [Enumeration types]+    }++  | TupleTyCon {                   -- A boxed, unboxed, or constraint tuple+        data_con :: DataCon,       -- NB: it can be an *unboxed* tuple+        tup_sort :: TupleSort      -- ^ Is this a boxed, unboxed or constraint+                                   -- tuple?+    }++  -- | An unboxed sum type.+  | SumTyCon {+        data_cons :: [DataCon],+        data_cons_size :: Int  -- ^ Cached value: length data_cons+    }++  -- | Information about those 'TyCon's derived from a @newtype@ declaration+  | NewTyCon {+        data_con :: DataCon,    -- ^ The unique constructor for the @newtype@.+                                --   It has no existentials++        nt_rhs :: Type,         -- ^ Cached value: the argument type of the+                                -- constructor, which is just the representation+                                -- type of the 'TyCon' (remember that @newtype@s+                                -- do not exist at runtime so need a different+                                -- representation type).+                                --+                                -- The free 'TyVar's of this type are the+                                -- 'tyConTyVars' from the corresponding 'TyCon'++        nt_etad_rhs :: ([TyVar], Type),+                        -- ^ Same as the 'nt_rhs', but this time eta-reduced.+                        -- Hence the list of 'TyVar's in this field may be+                        -- shorter than the declared arity of the 'TyCon'.++                        -- See Note [Newtype eta]+        nt_co :: CoAxiom Unbranched+                             -- The axiom coercion that creates the @newtype@+                             -- from the representation 'Type'.++                             -- See Note [Newtype coercions]+                             -- Invariant: arity = #tvs in nt_etad_rhs;+                             -- See Note [Newtype eta]+                             -- Watch out!  If any newtypes become transparent+                             -- again check #1072.+    }++mkSumTyConRhs :: [DataCon] -> AlgTyConRhs+mkSumTyConRhs data_cons = SumTyCon data_cons (length data_cons)++mkDataTyConRhs :: [DataCon] -> AlgTyConRhs+mkDataTyConRhs cons+  = DataTyCon {+        data_cons = cons,+        data_cons_size = length cons,+        is_enum = not (null cons) && all is_enum_con cons+                  -- See Note [Enumeration types] in TyCon+    }+  where+    is_enum_con con+       | (_univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res)+           <- dataConFullSig con+       = null ex_tvs && null eq_spec && null theta && null arg_tys++-- | Some promoted datacons signify extra info relevant to GHC. For example,+-- the @IntRep@ constructor of @RuntimeRep@ corresponds to the 'IntRep'+-- constructor of 'PrimRep'. This data structure allows us to store this+-- information right in the 'TyCon'. The other approach would be to look+-- up things like @RuntimeRep@'s @PrimRep@ by known-key every time.+data RuntimeRepInfo+  = NoRRI       -- ^ an ordinary promoted data con+  | RuntimeRep ([Type] -> [PrimRep])+      -- ^ A constructor of @RuntimeRep@. The argument to the function should+      -- be the list of arguments to the promoted datacon.+  | VecCount Int         -- ^ A constructor of @VecCount@+  | VecElem PrimElemRep  -- ^ A constructor of @VecElem@++-- | Extract those 'DataCon's that we are able to learn about.  Note+-- that visibility in this sense does not correspond to visibility in+-- the context of any particular user program!+visibleDataCons :: AlgTyConRhs -> [DataCon]+visibleDataCons (AbstractTyCon {})            = []+visibleDataCons (DataTyCon{ data_cons = cs }) = cs+visibleDataCons (NewTyCon{ data_con = c })    = [c]+visibleDataCons (TupleTyCon{ data_con = c })  = [c]+visibleDataCons (SumTyCon{ data_cons = cs })  = cs++-- ^ Both type classes as well as family instances imply implicit+-- type constructors.  These implicit type constructors refer to their parent+-- structure (ie, the class or family from which they derive) using a type of+-- the following form.+data AlgTyConFlav+  = -- | An ordinary type constructor has no parent.+    VanillaAlgTyCon+       TyConRepName++    -- | An unboxed type constructor. The TyConRepName is a Maybe since we+    -- currently don't allow unboxed sums to be Typeable since there are too+    -- many of them. See #13276.+  | UnboxedAlgTyCon+       (Maybe TyConRepName)++  -- | Type constructors representing a class dictionary.+  -- See Note [ATyCon for classes] in TyCoRep+  | ClassTyCon+        Class           -- INVARIANT: the classTyCon of this Class is the+                        -- current tycon+        TyConRepName++  -- | Type constructors representing an *instance* of a *data* family.+  -- Parameters:+  --+  --  1) The type family in question+  --+  --  2) Instance types; free variables are the 'tyConTyVars'+  --  of the current 'TyCon' (not the family one). INVARIANT:+  --  the number of types matches the arity of the family 'TyCon'+  --+  --  3) A 'CoTyCon' identifying the representation+  --  type with the type instance family+  | DataFamInstTyCon          -- See Note [Data type families]+        (CoAxiom Unbranched)  -- The coercion axiom.+               -- A *Representational* coercion,+               -- of kind   T ty1 ty2   ~R   R:T a b c+               -- where T is the family TyCon,+               -- and R:T is the representation TyCon (ie this one)+               -- and a,b,c are the tyConTyVars of this TyCon+               --+               -- BUT may be eta-reduced; see FamInstEnv+               --     Note [Eta reduction for data families]++          -- Cached fields of the CoAxiom, but adjusted to+          -- use the tyConTyVars of this TyCon+        TyCon   -- The family TyCon+        [Type]  -- Argument types (mentions the tyConTyVars of this TyCon)+                -- No shorter in length than the tyConTyVars of the family TyCon+                -- How could it be longer? See [Arity of data families] in FamInstEnv++        -- E.g.  data instance T [a] = ...+        -- gives a representation tycon:+        --      data R:TList a = ...+        --      axiom co a :: T [a] ~ R:TList a+        -- with R:TList's algTcParent = DataFamInstTyCon T [a] co++instance Outputable AlgTyConFlav where+    ppr (VanillaAlgTyCon {})        = text "Vanilla ADT"+    ppr (UnboxedAlgTyCon {})        = text "Unboxed ADT"+    ppr (ClassTyCon cls _)          = text "Class parent" <+> ppr cls+    ppr (DataFamInstTyCon _ tc tys) = text "Family parent (family instance)"+                                      <+> ppr tc <+> sep (map pprType tys)++-- | Checks the invariants of a 'AlgTyConFlav' given the appropriate type class+-- name, if any+okParent :: Name -> AlgTyConFlav -> Bool+okParent _       (VanillaAlgTyCon {})            = True+okParent _       (UnboxedAlgTyCon {})            = True+okParent tc_name (ClassTyCon cls _)              = tc_name == tyConName (classTyCon cls)+okParent _       (DataFamInstTyCon _ fam_tc tys) = tys `lengthAtLeast` tyConArity fam_tc++isNoParent :: AlgTyConFlav -> Bool+isNoParent (VanillaAlgTyCon {}) = True+isNoParent _                   = False++--------------------++data Injectivity+  = NotInjective+  | Injective [Bool]   -- 1-1 with tyConTyVars (incl kind vars)+  deriving( Eq )++-- | Information pertaining to the expansion of a type synonym (@type@)+data FamTyConFlav+  = -- | Represents an open type family without a fixed right hand+    -- side.  Additional instances can appear at any time.+    --+    -- These are introduced by either a top level declaration:+    --+    -- > data family T a :: *+    --+    -- Or an associated data type declaration, within a class declaration:+    --+    -- > class C a b where+    -- >   data T b :: *+     DataFamilyTyCon+       TyConRepName++     -- | An open type synonym family  e.g. @type family F x y :: * -> *@+   | OpenSynFamilyTyCon++   -- | A closed type synonym family  e.g.+   -- @type family F x where { F Int = Bool }@+   | ClosedSynFamilyTyCon (Maybe (CoAxiom Branched))+     -- See Note [Closed type families]++   -- | A closed type synonym family declared in an hs-boot file with+   -- type family F a where ..+   | AbstractClosedSynFamilyTyCon++   -- | Built-in type family used by the TypeNats solver+   | BuiltInSynFamTyCon BuiltInSynFamily++instance Outputable FamTyConFlav where+    ppr (DataFamilyTyCon n) = text "data family" <+> ppr n+    ppr OpenSynFamilyTyCon = text "open type family"+    ppr (ClosedSynFamilyTyCon Nothing) = text "closed type family"+    ppr (ClosedSynFamilyTyCon (Just coax)) = text "closed type family" <+> ppr coax+    ppr AbstractClosedSynFamilyTyCon = text "abstract closed type family"+    ppr (BuiltInSynFamTyCon _) = text "built-in type family"++{- Note [Closed type families]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+* In an open type family you can add new instances later.  This is the+  usual case.++* In a closed type family you can only put equations where the family+  is defined.++A non-empty closed type family has a single axiom with multiple+branches, stored in the 'ClosedSynFamilyTyCon' constructor.  A closed+type family with no equations does not have an axiom, because there is+nothing for the axiom to prove!+++Note [Promoted data constructors]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+All data constructors can be promoted to become a type constructor,+via the PromotedDataCon alternative in TyCon.++* The TyCon promoted from a DataCon has the *same* Name and Unique as+  the DataCon.  Eg. If the data constructor Data.Maybe.Just(unique 78,+  say) is promoted to a TyCon whose name is Data.Maybe.Just(unique 78)++* We promote the *user* type of the DataCon.  Eg+     data T = MkT {-# UNPACK #-} !(Bool, Bool)+  The promoted kind is+     'MkT :: (Bool,Bool) -> T+  *not*+     'MkT :: Bool -> Bool -> T++* Similarly for GADTs:+     data G a where+       MkG :: forall b. b -> G [b]+  The promoted data constructor has kind+       'MkG :: forall b. b -> G [b]+  *not*+       'MkG :: forall a b. (a ~# [b]) => b -> G a++Note [Enumeration types]+~~~~~~~~~~~~~~~~~~~~~~~~+We define datatypes with no constructors to *not* be+enumerations; this fixes trac #2578,  Otherwise we+end up generating an empty table for+  <mod>_<type>_closure_tbl+which is used by tagToEnum# to map Int# to constructors+in an enumeration. The empty table apparently upset+the linker.++Moreover, all the data constructor must be enumerations, meaning+they have type  (forall abc. T a b c).  GADTs are not enumerations.+For example consider+    data T a where+      T1 :: T Int+      T2 :: T Bool+      T3 :: T a+What would [T1 ..] be?  [T1,T3] :: T Int? Easiest thing is to exclude them.+See #4528.++Note [Newtype coercions]+~~~~~~~~~~~~~~~~~~~~~~~~+The NewTyCon field nt_co is a CoAxiom which is used for coercing from+the representation type of the newtype, to the newtype itself. For+example,++   newtype T a = MkT (a -> a)++the NewTyCon for T will contain nt_co = CoT where CoT t : T t ~ t -> t.++In the case that the right hand side is a type application+ending with the same type variables as the left hand side, we+"eta-contract" the coercion.  So if we had++   newtype S a = MkT [a]++then we would generate the arity 0 axiom CoS : S ~ [].  The+primary reason we do this is to make newtype deriving cleaner.++In the paper we'd write+        axiom CoT : (forall t. T t) ~ (forall t. [t])+and then when we used CoT at a particular type, s, we'd say+        CoT @ s+which encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s])++Note [Newtype eta]+~~~~~~~~~~~~~~~~~~+Consider+        newtype Parser a = MkParser (IO a) deriving Monad+Are these two types equal (to Core)?+        Monad Parser+        Monad IO+which we need to make the derived instance for Monad Parser.++Well, yes.  But to see that easily we eta-reduce the RHS type of+Parser, in this case to ([], Froogle), so that even unsaturated applications+of Parser will work right.  This eta reduction is done when the type+constructor is built, and cached in NewTyCon.++Here's an example that I think showed up in practice+Source code:+        newtype T a = MkT [a]+        newtype Foo m = MkFoo (forall a. m a -> Int)++        w1 :: Foo []+        w1 = ...++        w2 :: Foo T+        w2 = MkFoo (\(MkT x) -> case w1 of MkFoo f -> f x)++After desugaring, and discarding the data constructors for the newtypes,+we get:+        w2 = w1 `cast` Foo CoT+so the coercion tycon CoT must have+        kind:    T ~ []+ and    arity:   0++This eta-reduction is implemented in BuildTyCl.mkNewTyConRhs.+++************************************************************************+*                                                                      *+                 TyConRepName+*                                                                      *+********************************************************************* -}++type TyConRepName = Name -- The Name of the top-level declaration+                         --    $tcMaybe :: Data.Typeable.Internal.TyCon+                         --    $tcMaybe = TyCon { tyConName = "Maybe", ... }++tyConRepName_maybe :: TyCon -> Maybe TyConRepName+tyConRepName_maybe (FunTyCon   { tcRepName = rep_nm })+  = Just rep_nm+tyConRepName_maybe (PrimTyCon  { primRepName = mb_rep_nm })+  = mb_rep_nm+tyConRepName_maybe (AlgTyCon { algTcParent = parent })+  | VanillaAlgTyCon rep_nm <- parent = Just rep_nm+  | ClassTyCon _ rep_nm    <- parent = Just rep_nm+  | UnboxedAlgTyCon rep_nm <- parent = rep_nm+tyConRepName_maybe (FamilyTyCon { famTcFlav = DataFamilyTyCon rep_nm })+  = Just rep_nm+tyConRepName_maybe (PromotedDataCon { dataCon = dc, tcRepName = rep_nm })+  | isUnboxedSumCon dc   -- see #13276+  = Nothing+  | otherwise+  = Just rep_nm+tyConRepName_maybe _ = Nothing++-- | Make a 'Name' for the 'Typeable' representation of the given wired-in type+mkPrelTyConRepName :: Name -> TyConRepName+-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.+mkPrelTyConRepName tc_name  -- Prelude tc_name is always External,+                            -- so nameModule will work+  = mkExternalName rep_uniq rep_mod rep_occ (nameSrcSpan tc_name)+  where+    name_occ  = nameOccName tc_name+    name_mod  = nameModule  tc_name+    name_uniq = nameUnique  tc_name+    rep_uniq | isTcOcc name_occ = tyConRepNameUnique   name_uniq+             | otherwise        = dataConTyRepNameUnique name_uniq+    (rep_mod, rep_occ) = tyConRepModOcc name_mod name_occ++-- | The name (and defining module) for the Typeable representation (TyCon) of a+-- type constructor.+--+-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.+tyConRepModOcc :: Module -> OccName -> (Module, OccName)+tyConRepModOcc tc_module tc_occ = (rep_module, mkTyConRepOcc tc_occ)+  where+    rep_module+      | tc_module == gHC_PRIM = gHC_TYPES+      | otherwise             = tc_module+++{- *********************************************************************+*                                                                      *+                 PrimRep+*                                                                      *+************************************************************************++Note [rep swamp]++GHC has a rich selection of types that represent "primitive types" of+one kind or another.  Each of them makes a different set of+distinctions, and mostly the differences are for good reasons,+although it's probably true that we could merge some of these.++Roughly in order of "includes more information":++ - A Width (cmm/CmmType) is simply a binary value with the specified+   number of bits.  It may represent a signed or unsigned integer, a+   floating-point value, or an address.++    data Width = W8 | W16 | W32 | W64 | W80 | W128++ - Size, which is used in the native code generator, is Width ++   floating point information.++   data Size = II8 | II16 | II32 | II64 | FF32 | FF64 | FF80++   it is necessary because e.g. the instruction to move a 64-bit float+   on x86 (movsd) is different from the instruction to move a 64-bit+   integer (movq), so the mov instruction is parameterised by Size.++ - CmmType wraps Width with more information: GC ptr, float, or+   other value.++    data CmmType = CmmType CmmCat Width++    data CmmCat     -- "Category" (not exported)+       = GcPtrCat   -- GC pointer+       | BitsCat    -- Non-pointer+       | FloatCat   -- Float++   It is important to have GcPtr information in Cmm, since we generate+   info tables containing pointerhood for the GC from this.  As for+   why we have float (and not signed/unsigned) here, see Note [Signed+   vs unsigned].++ - ArgRep makes only the distinctions necessary for the call and+   return conventions of the STG machine.  It is essentially CmmType+   + void.++ - PrimRep makes a few more distinctions than ArgRep: it divides+   non-GC-pointers into signed/unsigned and addresses, information+   that is necessary for passing these values to foreign functions.++There's another tension here: whether the type encodes its size in+bytes, or whether its size depends on the machine word size.  Width+and CmmType have the size built-in, whereas ArgRep and PrimRep do not.++This means to turn an ArgRep/PrimRep into a CmmType requires DynFlags.++On the other hand, CmmType includes some "nonsense" values, such as+CmmType GcPtrCat W32 on a 64-bit machine.+-}++-- | A 'PrimRep' is an abstraction of a type.  It contains information that+-- the code generator needs in order to pass arguments, return results,+-- and store values of this type.+data PrimRep+  = VoidRep+  | LiftedRep+  | UnliftedRep   -- ^ Unlifted pointer+  | Int8Rep       -- ^ Signed, 8-bit value+  | Int16Rep      -- ^ Signed, 16-bit value+  | IntRep        -- ^ Signed, word-sized value+  | WordRep       -- ^ Unsigned, word-sized value+  | Int64Rep      -- ^ Signed, 64 bit value (with 32-bit words only)+  | Word8Rep      -- ^ Unsigned, 8 bit value+  | Word16Rep      -- ^ Unsigned, 16 bit value+  | Word64Rep     -- ^ Unsigned, 64 bit value (with 32-bit words only)+  | AddrRep       -- ^ A pointer, but /not/ to a Haskell value (use '(Un)liftedRep')+  | FloatRep+  | DoubleRep+  | VecRep Int PrimElemRep  -- ^ A vector+  deriving( Eq, Show )++data PrimElemRep+  = Int8ElemRep+  | Int16ElemRep+  | Int32ElemRep+  | Int64ElemRep+  | Word8ElemRep+  | Word16ElemRep+  | Word32ElemRep+  | Word64ElemRep+  | FloatElemRep+  | DoubleElemRep+   deriving( Eq, Show )++instance Outputable PrimRep where+  ppr r = text (show r)++instance Outputable PrimElemRep where+  ppr r = text (show r)++isVoidRep :: PrimRep -> Bool+isVoidRep VoidRep = True+isVoidRep _other  = False++isGcPtrRep :: PrimRep -> Bool+isGcPtrRep LiftedRep   = True+isGcPtrRep UnliftedRep = True+isGcPtrRep _           = False++-- | The size of a 'PrimRep' in bytes.+--+-- This applies also when used in a constructor, where we allow packing the+-- fields. For instance, in @data Foo = Foo Float# Float#@ the two fields will+-- take only 8 bytes, which for 64-bit arch will be equal to 1 word.+-- See also mkVirtHeapOffsetsWithPadding for details of how data fields are+-- layed out.+primRepSizeB :: DynFlags -> PrimRep -> Int+primRepSizeB dflags IntRep           = wORD_SIZE dflags+primRepSizeB dflags WordRep          = wORD_SIZE dflags+primRepSizeB _      Int8Rep          = 1+primRepSizeB _      Int16Rep         = 2+primRepSizeB _      Int64Rep         = wORD64_SIZE+primRepSizeB _      Word8Rep         = 1+primRepSizeB _      Word16Rep        = 2+primRepSizeB _      Word64Rep        = wORD64_SIZE+primRepSizeB _      FloatRep         = fLOAT_SIZE+primRepSizeB dflags DoubleRep        = dOUBLE_SIZE dflags+primRepSizeB dflags AddrRep          = wORD_SIZE dflags+primRepSizeB dflags LiftedRep        = wORD_SIZE dflags+primRepSizeB dflags UnliftedRep      = wORD_SIZE dflags+primRepSizeB _      VoidRep          = 0+primRepSizeB _      (VecRep len rep) = len * primElemRepSizeB rep++primElemRepSizeB :: PrimElemRep -> Int+primElemRepSizeB Int8ElemRep   = 1+primElemRepSizeB Int16ElemRep  = 2+primElemRepSizeB Int32ElemRep  = 4+primElemRepSizeB Int64ElemRep  = 8+primElemRepSizeB Word8ElemRep  = 1+primElemRepSizeB Word16ElemRep = 2+primElemRepSizeB Word32ElemRep = 4+primElemRepSizeB Word64ElemRep = 8+primElemRepSizeB FloatElemRep  = 4+primElemRepSizeB DoubleElemRep = 8++-- | Return if Rep stands for floating type,+-- returns Nothing for vector types.+primRepIsFloat :: PrimRep -> Maybe Bool+primRepIsFloat  FloatRep     = Just True+primRepIsFloat  DoubleRep    = Just True+primRepIsFloat  (VecRep _ _) = Nothing+primRepIsFloat  _            = Just False+++{-+************************************************************************+*                                                                      *+                             Field labels+*                                                                      *+************************************************************************+-}++-- | The labels for the fields of this particular 'TyCon'+tyConFieldLabels :: TyCon -> [FieldLabel]+tyConFieldLabels tc = dFsEnvElts $ tyConFieldLabelEnv tc++-- | The labels for the fields of this particular 'TyCon'+tyConFieldLabelEnv :: TyCon -> FieldLabelEnv+tyConFieldLabelEnv tc+  | isAlgTyCon tc = algTcFields tc+  | otherwise     = emptyDFsEnv++-- | Look up a field label belonging to this 'TyCon'+lookupTyConFieldLabel :: FieldLabelString -> TyCon -> Maybe FieldLabel+lookupTyConFieldLabel lbl tc = lookupDFsEnv (tyConFieldLabelEnv tc) lbl++-- | Make a map from strings to FieldLabels from all the data+-- constructors of this algebraic tycon+fieldsOfAlgTcRhs :: AlgTyConRhs -> FieldLabelEnv+fieldsOfAlgTcRhs rhs = mkDFsEnv [ (flLabel fl, fl)+                                | fl <- dataConsFields (visibleDataCons rhs) ]+  where+    -- Duplicates in this list will be removed by 'mkFsEnv'+    dataConsFields dcs = concatMap dataConFieldLabels dcs+++{-+************************************************************************+*                                                                      *+\subsection{TyCon Construction}+*                                                                      *+************************************************************************++Note: the TyCon constructors all take a Kind as one argument, even though+they could, in principle, work out their Kind from their other arguments.+But to do so they need functions from Types, and that makes a nasty+module mutual-recursion.  And they aren't called from many places.+So we compromise, and move their Kind calculation to the call site.+-}++-- | Given the name of the function type constructor and it's kind, create the+-- corresponding 'TyCon'. It is recommended to use 'TyCoRep.funTyCon' if you want+-- this functionality+mkFunTyCon :: Name -> [TyConBinder] -> Name -> TyCon+mkFunTyCon name binders rep_nm+  = FunTyCon {+        tyConUnique  = nameUnique name,+        tyConName    = name,+        tyConBinders = binders,+        tyConResKind = liftedTypeKind,+        tyConKind    = mkTyConKind binders liftedTypeKind,+        tyConArity   = length binders,+        tcRepName    = rep_nm+    }++-- | This is the making of an algebraic 'TyCon'. Notably, you have to+-- pass in the generic (in the -XGenerics sense) information about the+-- type constructor - you can get hold of it easily (see Generics+-- module)+mkAlgTyCon :: Name+           -> [TyConBinder]  -- ^ Binders of the 'TyCon'+           -> Kind              -- ^ Result kind+           -> [Role]            -- ^ The roles for each TyVar+           -> Maybe CType       -- ^ The C type this type corresponds to+                                --   when using the CAPI FFI+           -> [PredType]        -- ^ Stupid theta: see 'algTcStupidTheta'+           -> AlgTyConRhs       -- ^ Information about data constructors+           -> AlgTyConFlav      -- ^ What flavour is it?+                                -- (e.g. vanilla, type family)+           -> Bool              -- ^ Was the 'TyCon' declared with GADT syntax?+           -> TyCon+mkAlgTyCon name binders res_kind roles cType stupid rhs parent gadt_syn+  = AlgTyCon {+        tyConName        = name,+        tyConUnique      = nameUnique name,+        tyConBinders     = binders,+        tyConResKind     = res_kind,+        tyConKind        = mkTyConKind binders res_kind,+        tyConArity       = length binders,+        tyConTyVars      = binderVars binders,+        tcRoles          = roles,+        tyConCType       = cType,+        algTcStupidTheta = stupid,+        algTcRhs         = rhs,+        algTcFields      = fieldsOfAlgTcRhs rhs,+        algTcParent      = ASSERT2( okParent name parent, ppr name $$ ppr parent ) parent,+        algTcGadtSyntax  = gadt_syn+    }++-- | Simpler specialization of 'mkAlgTyCon' for classes+mkClassTyCon :: Name -> [TyConBinder]+             -> [Role] -> AlgTyConRhs -> Class+             -> Name -> TyCon+mkClassTyCon name binders roles rhs clas tc_rep_name+  = mkAlgTyCon name binders constraintKind roles Nothing [] rhs+               (ClassTyCon clas tc_rep_name)+               False++mkTupleTyCon :: Name+             -> [TyConBinder]+             -> Kind    -- ^ Result kind of the 'TyCon'+             -> Arity   -- ^ Arity of the tuple 'TyCon'+             -> DataCon+             -> TupleSort    -- ^ Whether the tuple is boxed or unboxed+             -> AlgTyConFlav+             -> TyCon+mkTupleTyCon name binders res_kind arity con sort parent+  = AlgTyCon {+        tyConUnique      = nameUnique name,+        tyConName        = name,+        tyConBinders     = binders,+        tyConTyVars      = binderVars binders,+        tyConResKind     = res_kind,+        tyConKind        = mkTyConKind binders res_kind,+        tyConArity       = arity,+        tcRoles          = replicate arity Representational,+        tyConCType       = Nothing,+        algTcGadtSyntax  = False,+        algTcStupidTheta = [],+        algTcRhs         = TupleTyCon { data_con = con,+                                        tup_sort = sort },+        algTcFields      = emptyDFsEnv,+        algTcParent      = parent+    }++mkSumTyCon :: Name+             -> [TyConBinder]+             -> Kind    -- ^ Kind of the resulting 'TyCon'+             -> Arity   -- ^ Arity of the sum+             -> [TyVar] -- ^ 'TyVar's scoped over: see 'tyConTyVars'+             -> [DataCon]+             -> AlgTyConFlav+             -> TyCon+mkSumTyCon name binders res_kind arity tyvars cons parent+  = AlgTyCon {+        tyConUnique      = nameUnique name,+        tyConName        = name,+        tyConBinders     = binders,+        tyConTyVars      = tyvars,+        tyConResKind     = res_kind,+        tyConKind        = mkTyConKind binders res_kind,+        tyConArity       = arity,+        tcRoles          = replicate arity Representational,+        tyConCType       = Nothing,+        algTcGadtSyntax  = False,+        algTcStupidTheta = [],+        algTcRhs         = mkSumTyConRhs cons,+        algTcFields      = emptyDFsEnv,+        algTcParent      = parent+    }++-- | Makes a tycon suitable for use during type-checking. It stores+-- a variety of details about the definition of the TyCon, but no+-- right-hand side. It lives only during the type-checking of a+-- mutually-recursive group of tycons; it is then zonked to a proper+-- TyCon in zonkTcTyCon.+-- See also Note [Kind checking recursive type and class declarations]+-- in TcTyClsDecls.+mkTcTyCon :: Name+          -> [TyConBinder]+          -> Kind                -- ^ /result/ kind only+          -> [(Name,TcTyVar)]    -- ^ Scoped type variables;+                                 -- see Note [How TcTyCons work] in TcTyClsDecls+          -> Bool                -- ^ Is this TcTyCon generalised already?+          -> TyConFlavour        -- ^ What sort of 'TyCon' this represents+          -> TyCon+mkTcTyCon name binders res_kind scoped_tvs poly flav+  = TcTyCon { tyConUnique  = getUnique name+            , tyConName    = name+            , tyConTyVars  = binderVars binders+            , tyConBinders = binders+            , tyConResKind = res_kind+            , tyConKind    = mkTyConKind binders res_kind+            , tyConArity   = length binders+            , tcTyConScopedTyVars = scoped_tvs+            , tcTyConIsPoly       = poly+            , tcTyConFlavour      = flav }++-- | Create an unlifted primitive 'TyCon', such as @Int#@.+mkPrimTyCon :: Name -> [TyConBinder]+            -> Kind   -- ^ /result/ kind, never levity-polymorphic+            -> [Role] -> TyCon+mkPrimTyCon name binders res_kind roles+  = mkPrimTyCon' name binders res_kind roles True (Just $ mkPrelTyConRepName name)++-- | Kind constructors+mkKindTyCon :: Name -> [TyConBinder]+            -> Kind  -- ^ /result/ kind+            -> [Role] -> Name -> TyCon+mkKindTyCon name binders res_kind roles rep_nm+  = tc+  where+    tc = mkPrimTyCon' name binders res_kind roles False (Just rep_nm)++-- | Create a lifted primitive 'TyCon' such as @RealWorld@+mkLiftedPrimTyCon :: Name -> [TyConBinder]+                  -> Kind   -- ^ /result/ kind+                  -> [Role] -> TyCon+mkLiftedPrimTyCon name binders res_kind roles+  = mkPrimTyCon' name binders res_kind roles False (Just rep_nm)+  where rep_nm = mkPrelTyConRepName name++mkPrimTyCon' :: Name -> [TyConBinder]+             -> Kind    -- ^ /result/ kind, never levity-polymorphic+                        -- (If you need a levity-polymorphic PrimTyCon, change+                        --  isTcLevPoly.)+             -> [Role]+             -> Bool -> Maybe TyConRepName -> TyCon+mkPrimTyCon' name binders res_kind roles is_unlifted rep_nm+  = PrimTyCon {+        tyConName    = name,+        tyConUnique  = nameUnique name,+        tyConBinders = binders,+        tyConResKind = res_kind,+        tyConKind    = mkTyConKind binders res_kind,+        tyConArity   = length roles,+        tcRoles      = roles,+        isUnlifted   = is_unlifted,+        primRepName  = rep_nm+    }++-- | Create a type synonym 'TyCon'+mkSynonymTyCon :: Name -> [TyConBinder] -> Kind   -- ^ /result/ kind+               -> [Role] -> Type -> Bool -> Bool -> TyCon+mkSynonymTyCon name binders res_kind roles rhs is_tau is_fam_free+  = SynonymTyCon {+        tyConName    = name,+        tyConUnique  = nameUnique name,+        tyConBinders = binders,+        tyConResKind = res_kind,+        tyConKind    = mkTyConKind binders res_kind,+        tyConArity   = length binders,+        tyConTyVars  = binderVars binders,+        tcRoles      = roles,+        synTcRhs     = rhs,+        synIsTau     = is_tau,+        synIsFamFree = is_fam_free+    }++-- | Create a type family 'TyCon'+mkFamilyTyCon :: Name -> [TyConBinder] -> Kind  -- ^ /result/ kind+              -> Maybe Name -> FamTyConFlav+              -> Maybe Class -> Injectivity -> TyCon+mkFamilyTyCon name binders res_kind resVar flav parent inj+  = FamilyTyCon+      { tyConUnique  = nameUnique name+      , tyConName    = name+      , tyConBinders = binders+      , tyConResKind = res_kind+      , tyConKind    = mkTyConKind binders res_kind+      , tyConArity   = length binders+      , tyConTyVars  = binderVars binders+      , famTcResVar  = resVar+      , famTcFlav    = flav+      , famTcParent  = classTyCon <$> parent+      , famTcInj     = inj+      }+++-- | Create a promoted data constructor 'TyCon'+-- Somewhat dodgily, we give it the same Name+-- as the data constructor itself; when we pretty-print+-- the TyCon we add a quote; see the Outputable TyCon instance+mkPromotedDataCon :: DataCon -> Name -> TyConRepName+                  -> [TyConTyCoBinder] -> Kind -> [Role]+                  -> RuntimeRepInfo -> TyCon+mkPromotedDataCon con name rep_name binders res_kind roles rep_info+  = PromotedDataCon {+        tyConUnique   = nameUnique name,+        tyConName     = name,+        tyConArity    = length roles,+        tcRoles       = roles,+        tyConBinders  = binders,+        tyConResKind  = res_kind,+        tyConKind     = mkTyConKind binders res_kind,+        dataCon       = con,+        tcRepName     = rep_name,+        promDcRepInfo = rep_info+  }++isFunTyCon :: TyCon -> Bool+isFunTyCon (FunTyCon {}) = True+isFunTyCon _             = False++-- | Test if the 'TyCon' is algebraic but abstract (invisible data constructors)+isAbstractTyCon :: TyCon -> Bool+isAbstractTyCon (AlgTyCon { algTcRhs = AbstractTyCon }) = True+isAbstractTyCon _ = False++-- | Does this 'TyCon' represent something that cannot be defined in Haskell?+isPrimTyCon :: TyCon -> Bool+isPrimTyCon (PrimTyCon {}) = True+isPrimTyCon _              = False++-- | Is this 'TyCon' unlifted (i.e. cannot contain bottom)? Note that this can+-- only be true for primitive and unboxed-tuple 'TyCon's+isUnliftedTyCon :: TyCon -> Bool+isUnliftedTyCon (PrimTyCon  {isUnlifted = is_unlifted})+  = is_unlifted+isUnliftedTyCon (AlgTyCon { algTcRhs = rhs } )+  | TupleTyCon { tup_sort = sort } <- rhs+  = not (isBoxed (tupleSortBoxity sort))+isUnliftedTyCon (AlgTyCon { algTcRhs = rhs } )+  | SumTyCon {} <- rhs+  = True+isUnliftedTyCon _ = False++-- | Returns @True@ if the supplied 'TyCon' resulted from either a+-- @data@ or @newtype@ declaration+isAlgTyCon :: TyCon -> Bool+isAlgTyCon (AlgTyCon {})   = True+isAlgTyCon _               = False++-- | Returns @True@ for vanilla AlgTyCons -- that is, those created+-- with a @data@ or @newtype@ declaration.+isVanillaAlgTyCon :: TyCon -> Bool+isVanillaAlgTyCon (AlgTyCon { algTcParent = VanillaAlgTyCon _ }) = True+isVanillaAlgTyCon _                                              = False++isDataTyCon :: TyCon -> Bool+-- ^ Returns @True@ for data types that are /definitely/ represented by+-- heap-allocated constructors.  These are scrutinised by Core-level+-- @case@ expressions, and they get info tables allocated for them.+--+-- Generally, the function will be true for all @data@ types and false+-- for @newtype@s, unboxed tuples, unboxed sums and type family+-- 'TyCon's. But it is not guaranteed to return @True@ in all cases+-- that it could.+--+-- NB: for a data type family, only the /instance/ 'TyCon's+--     get an info table.  The family declaration 'TyCon' does not+isDataTyCon (AlgTyCon {algTcRhs = rhs})+  = case rhs of+        TupleTyCon { tup_sort = sort }+                           -> isBoxed (tupleSortBoxity sort)+        SumTyCon {}        -> False+        DataTyCon {}       -> True+        NewTyCon {}        -> False+        AbstractTyCon {}   -> False      -- We don't know, so return False+isDataTyCon _ = False++-- | 'isInjectiveTyCon' is true of 'TyCon's for which this property holds+-- (where X is the role passed in):+--   If (T a1 b1 c1) ~X (T a2 b2 c2), then (a1 ~X1 a2), (b1 ~X2 b2), and (c1 ~X3 c2)+-- (where X1, X2, and X3, are the roles given by tyConRolesX tc X)+-- See also Note [Decomposing equality] in TcCanonical+isInjectiveTyCon :: TyCon -> Role -> Bool+isInjectiveTyCon _                             Phantom          = False+isInjectiveTyCon (FunTyCon {})                 _                = True+isInjectiveTyCon (AlgTyCon {})                 Nominal          = True+isInjectiveTyCon (AlgTyCon {algTcRhs = rhs})   Representational+  = isGenInjAlgRhs rhs+isInjectiveTyCon (SynonymTyCon {})             _                = False+isInjectiveTyCon (FamilyTyCon { famTcFlav = DataFamilyTyCon _ })+                                               Nominal          = True+isInjectiveTyCon (FamilyTyCon { famTcInj = Injective inj }) Nominal = and inj+isInjectiveTyCon (FamilyTyCon {})              _                = False+isInjectiveTyCon (PrimTyCon {})                _                = True+isInjectiveTyCon (PromotedDataCon {})          _                = True+isInjectiveTyCon (TcTyCon {})                  _                = True+  -- Reply True for TcTyCon to minimise knock on type errors+  -- See Note [How TcTyCons work] item (1) in TcTyClsDecls++-- | 'isGenerativeTyCon' is true of 'TyCon's for which this property holds+-- (where X is the role passed in):+--   If (T tys ~X t), then (t's head ~X T).+-- See also Note [Decomposing equality] in TcCanonical+isGenerativeTyCon :: TyCon -> Role -> Bool+isGenerativeTyCon (FamilyTyCon { famTcFlav = DataFamilyTyCon _ }) Nominal = True+isGenerativeTyCon (FamilyTyCon {}) _ = False+  -- in all other cases, injectivity implies generativity+isGenerativeTyCon tc               r = isInjectiveTyCon tc r++-- | Is this an 'AlgTyConRhs' of a 'TyCon' that is generative and injective+-- with respect to representational equality?+isGenInjAlgRhs :: AlgTyConRhs -> Bool+isGenInjAlgRhs (TupleTyCon {})          = True+isGenInjAlgRhs (SumTyCon {})            = True+isGenInjAlgRhs (DataTyCon {})           = True+isGenInjAlgRhs (AbstractTyCon {})       = False+isGenInjAlgRhs (NewTyCon {})            = False++-- | Is this 'TyCon' that for a @newtype@+isNewTyCon :: TyCon -> Bool+isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True+isNewTyCon _                                   = False++-- | Take a 'TyCon' apart into the 'TyVar's it scopes over, the 'Type' it+-- expands into, and (possibly) a coercion from the representation type to the+-- @newtype@.+-- Returns @Nothing@ if this is not possible.+unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Type, CoAxiom Unbranched)+unwrapNewTyCon_maybe (AlgTyCon { tyConTyVars = tvs,+                                 algTcRhs = NewTyCon { nt_co = co,+                                                       nt_rhs = rhs }})+                           = Just (tvs, rhs, co)+unwrapNewTyCon_maybe _     = Nothing++unwrapNewTyConEtad_maybe :: TyCon -> Maybe ([TyVar], Type, CoAxiom Unbranched)+unwrapNewTyConEtad_maybe (AlgTyCon { algTcRhs = NewTyCon { nt_co = co,+                                                           nt_etad_rhs = (tvs,rhs) }})+                           = Just (tvs, rhs, co)+unwrapNewTyConEtad_maybe _ = Nothing++isProductTyCon :: TyCon -> Bool+-- True of datatypes or newtypes that have+--   one, non-existential, data constructor+-- See Note [Product types]+isProductTyCon tc@(AlgTyCon {})+  = case algTcRhs tc of+      TupleTyCon {} -> True+      DataTyCon{ data_cons = [data_con] }+                    -> null (dataConExTyCoVars data_con)+      NewTyCon {}   -> True+      _             -> False+isProductTyCon _ = False++isDataProductTyCon_maybe :: TyCon -> Maybe DataCon+-- True of datatypes (not newtypes) with+--   one, vanilla, data constructor+-- See Note [Product types]+isDataProductTyCon_maybe (AlgTyCon { algTcRhs = rhs })+  = case rhs of+       DataTyCon { data_cons = [con] }+         | null (dataConExTyCoVars con)  -- non-existential+         -> Just con+       TupleTyCon { data_con = con }+         -> Just con+       _ -> Nothing+isDataProductTyCon_maybe _ = Nothing++isDataSumTyCon_maybe :: TyCon -> Maybe [DataCon]+isDataSumTyCon_maybe (AlgTyCon { algTcRhs = rhs })+  = case rhs of+      DataTyCon { data_cons = cons }+        | cons `lengthExceeds` 1+        , all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this?+        -> Just cons+      SumTyCon { data_cons = cons }+        | all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this?+        -> Just cons+      _ -> Nothing+isDataSumTyCon_maybe _ = Nothing++{- Note [Product types]+~~~~~~~~~~~~~~~~~~~~~~~+A product type is+ * A data type (not a newtype)+ * With one, boxed data constructor+ * That binds no existential type variables++The main point is that product types are amenable to unboxing for+  * Strict function calls; we can transform+        f (D a b) = e+    to+        fw a b = e+    via the worker/wrapper transformation.  (Question: couldn't this+    work for existentials too?)++  * CPR for function results; we can transform+        f x y = let ... in D a b+    to+        fw x y = let ... in (# a, b #)++Note that the data constructor /can/ have evidence arguments: equality+constraints, type classes etc.  So it can be GADT.  These evidence+arguments are simply value arguments, and should not get in the way.+-}+++-- | Is this a 'TyCon' representing a regular H98 type synonym (@type@)?+isTypeSynonymTyCon :: TyCon -> Bool+isTypeSynonymTyCon (SynonymTyCon {}) = True+isTypeSynonymTyCon _                 = False++isTauTyCon :: TyCon -> Bool+isTauTyCon (SynonymTyCon { synIsTau = is_tau }) = is_tau+isTauTyCon _                                    = True++isFamFreeTyCon :: TyCon -> Bool+isFamFreeTyCon (SynonymTyCon { synIsFamFree = fam_free }) = fam_free+isFamFreeTyCon (FamilyTyCon { famTcFlav = flav })         = isDataFamFlav flav+isFamFreeTyCon _                                          = True++-- As for newtypes, it is in some contexts important to distinguish between+-- closed synonyms and synonym families, as synonym families have no unique+-- right hand side to which a synonym family application can expand.+--++-- | True iff we can decompose (T a b c) into ((T a b) c)+--   I.e. is it injective and generative w.r.t nominal equality?+--   That is, if (T a b) ~N d e f, is it always the case that+--            (T ~N d), (a ~N e) and (b ~N f)?+-- Specifically NOT true of synonyms (open and otherwise)+--+-- It'd be unusual to call mustBeSaturated on a regular H98+-- type synonym, because you should probably have expanded it first+-- But regardless, it's not decomposable+mustBeSaturated :: TyCon -> Bool+mustBeSaturated = tcFlavourMustBeSaturated . tyConFlavour++-- | Is this an algebraic 'TyCon' declared with the GADT syntax?+isGadtSyntaxTyCon :: TyCon -> Bool+isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res+isGadtSyntaxTyCon _                                    = False++-- | Is this an algebraic 'TyCon' which is just an enumeration of values?+isEnumerationTyCon :: TyCon -> Bool+-- See Note [Enumeration types] in TyCon+isEnumerationTyCon (AlgTyCon { tyConArity = arity, algTcRhs = rhs })+  = case rhs of+       DataTyCon { is_enum = res } -> res+       TupleTyCon {}               -> arity == 0+       _                           -> False+isEnumerationTyCon _ = False++-- | Is this a 'TyCon', synonym or otherwise, that defines a family?+isFamilyTyCon :: TyCon -> Bool+isFamilyTyCon (FamilyTyCon {}) = True+isFamilyTyCon _                = False++-- | Is this a 'TyCon', synonym or otherwise, that defines a family with+-- instances?+isOpenFamilyTyCon :: TyCon -> Bool+isOpenFamilyTyCon (FamilyTyCon {famTcFlav = flav })+  | OpenSynFamilyTyCon <- flav = True+  | DataFamilyTyCon {} <- flav = True+isOpenFamilyTyCon _            = False++-- | Is this a synonym 'TyCon' that can have may have further instances appear?+isTypeFamilyTyCon :: TyCon -> Bool+isTypeFamilyTyCon (FamilyTyCon { famTcFlav = flav }) = not (isDataFamFlav flav)+isTypeFamilyTyCon _                                  = False++-- | Is this a synonym 'TyCon' that can have may have further instances appear?+isDataFamilyTyCon :: TyCon -> Bool+isDataFamilyTyCon (FamilyTyCon { famTcFlav = flav }) = isDataFamFlav flav+isDataFamilyTyCon _                                  = False++-- | Is this an open type family TyCon?+isOpenTypeFamilyTyCon :: TyCon -> Bool+isOpenTypeFamilyTyCon (FamilyTyCon {famTcFlav = OpenSynFamilyTyCon }) = True+isOpenTypeFamilyTyCon _                                               = False++-- | Is this a non-empty closed type family? Returns 'Nothing' for+-- abstract or empty closed families.+isClosedSynFamilyTyConWithAxiom_maybe :: TyCon -> Maybe (CoAxiom Branched)+isClosedSynFamilyTyConWithAxiom_maybe+  (FamilyTyCon {famTcFlav = ClosedSynFamilyTyCon mb}) = mb+isClosedSynFamilyTyConWithAxiom_maybe _               = Nothing++-- | @'tyConInjectivityInfo' tc@ returns @'Injective' is@ is @tc@ is an+-- injective tycon (where @is@ states for which 'tyConBinders' @tc@ is+-- injective), or 'NotInjective' otherwise.+tyConInjectivityInfo :: TyCon -> Injectivity+tyConInjectivityInfo tc+  | FamilyTyCon { famTcInj = inj } <- tc+  = inj+  | isInjectiveTyCon tc Nominal+  = Injective (replicate (tyConArity tc) True)+  | otherwise+  = NotInjective++isBuiltInSynFamTyCon_maybe :: TyCon -> Maybe BuiltInSynFamily+isBuiltInSynFamTyCon_maybe+  (FamilyTyCon {famTcFlav = BuiltInSynFamTyCon ops }) = Just ops+isBuiltInSynFamTyCon_maybe _                          = Nothing++isDataFamFlav :: FamTyConFlav -> Bool+isDataFamFlav (DataFamilyTyCon {}) = True   -- Data family+isDataFamFlav _                    = False  -- Type synonym family++-- | Is this TyCon for an associated type?+isTyConAssoc :: TyCon -> Bool+isTyConAssoc = isJust . tyConAssoc_maybe++-- | Get the enclosing class TyCon (if there is one) for the given TyCon.+tyConAssoc_maybe :: TyCon -> Maybe TyCon+tyConAssoc_maybe = tyConFlavourAssoc_maybe . tyConFlavour++-- | Get the enclosing class TyCon (if there is one) for the given TyConFlavour+tyConFlavourAssoc_maybe :: TyConFlavour -> Maybe TyCon+tyConFlavourAssoc_maybe (DataFamilyFlavour mb_parent)     = mb_parent+tyConFlavourAssoc_maybe (OpenTypeFamilyFlavour mb_parent) = mb_parent+tyConFlavourAssoc_maybe _                                 = Nothing++-- The unit tycon didn't used to be classed as a tuple tycon+-- but I thought that was silly so I've undone it+-- If it can't be for some reason, it should be a AlgTyCon+isTupleTyCon :: TyCon -> Bool+-- ^ Does this 'TyCon' represent a tuple?+--+-- NB: when compiling @Data.Tuple@, the tycons won't reply @True@ to+-- 'isTupleTyCon', because they are built as 'AlgTyCons'.  However they+-- get spat into the interface file as tuple tycons, so I don't think+-- it matters.+isTupleTyCon (AlgTyCon { algTcRhs = TupleTyCon {} }) = True+isTupleTyCon _ = False++tyConTuple_maybe :: TyCon -> Maybe TupleSort+tyConTuple_maybe (AlgTyCon { algTcRhs = rhs })+  | TupleTyCon { tup_sort = sort} <- rhs = Just sort+tyConTuple_maybe _                       = Nothing++-- | Is this the 'TyCon' for an unboxed tuple?+isUnboxedTupleTyCon :: TyCon -> Bool+isUnboxedTupleTyCon (AlgTyCon { algTcRhs = rhs })+  | TupleTyCon { tup_sort = sort } <- rhs+  = not (isBoxed (tupleSortBoxity sort))+isUnboxedTupleTyCon _ = False++-- | Is this the 'TyCon' for a boxed tuple?+isBoxedTupleTyCon :: TyCon -> Bool+isBoxedTupleTyCon (AlgTyCon { algTcRhs = rhs })+  | TupleTyCon { tup_sort = sort } <- rhs+  = isBoxed (tupleSortBoxity sort)+isBoxedTupleTyCon _ = False++-- | Is this the 'TyCon' for an unboxed sum?+isUnboxedSumTyCon :: TyCon -> Bool+isUnboxedSumTyCon (AlgTyCon { algTcRhs = rhs })+  | SumTyCon {} <- rhs+  = True+isUnboxedSumTyCon _ = False++-- | Is this the 'TyCon' for a /promoted/ tuple?+isPromotedTupleTyCon :: TyCon -> Bool+isPromotedTupleTyCon tyCon+  | Just dataCon <- isPromotedDataCon_maybe tyCon+  , isTupleTyCon (dataConTyCon dataCon) = True+  | otherwise                           = False++-- | Is this a PromotedDataCon?+isPromotedDataCon :: TyCon -> Bool+isPromotedDataCon (PromotedDataCon {}) = True+isPromotedDataCon _                    = False++-- | Retrieves the promoted DataCon if this is a PromotedDataCon;+isPromotedDataCon_maybe :: TyCon -> Maybe DataCon+isPromotedDataCon_maybe (PromotedDataCon { dataCon = dc }) = Just dc+isPromotedDataCon_maybe _ = Nothing++-- | Is this tycon really meant for use at the kind level? That is,+-- should it be permitted without -XDataKinds?+isKindTyCon :: TyCon -> Bool+isKindTyCon tc = getUnique tc `elementOfUniqSet` kindTyConKeys++-- | These TyCons should be allowed at the kind level, even without+-- -XDataKinds.+kindTyConKeys :: UniqSet Unique+kindTyConKeys = unionManyUniqSets+  ( mkUniqSet [ liftedTypeKindTyConKey, constraintKindTyConKey, tYPETyConKey ]+  : map (mkUniqSet . tycon_with_datacons) [ runtimeRepTyCon+                                          , vecCountTyCon, vecElemTyCon ] )+  where+    tycon_with_datacons tc = getUnique tc : map getUnique (tyConDataCons tc)++isLiftedTypeKindTyConName :: Name -> Bool+isLiftedTypeKindTyConName = (`hasKey` liftedTypeKindTyConKey)++-- | Identifies implicit tycons that, in particular, do not go into interface+-- files (because they are implicitly reconstructed when the interface is+-- read).+--+-- Note that:+--+-- * Associated families are implicit, as they are re-constructed from+--   the class declaration in which they reside, and+--+-- * Family instances are /not/ implicit as they represent the instance body+--   (similar to a @dfun@ does that for a class instance).+--+-- * Tuples are implicit iff they have a wired-in name+--   (namely: boxed and unboxed tupeles are wired-in and implicit,+--            but constraint tuples are not)+isImplicitTyCon :: TyCon -> Bool+isImplicitTyCon (FunTyCon {})        = True+isImplicitTyCon (PrimTyCon {})       = True+isImplicitTyCon (PromotedDataCon {}) = True+isImplicitTyCon (AlgTyCon { algTcRhs = rhs, tyConName = name })+  | TupleTyCon {} <- rhs             = isWiredInName name+  | SumTyCon {} <- rhs               = True+  | otherwise                        = False+isImplicitTyCon (FamilyTyCon { famTcParent = parent }) = isJust parent+isImplicitTyCon (SynonymTyCon {})    = False+isImplicitTyCon (TcTyCon {})         = False++tyConCType_maybe :: TyCon -> Maybe CType+tyConCType_maybe tc@(AlgTyCon {}) = tyConCType tc+tyConCType_maybe _ = Nothing++-- | Is this a TcTyCon? (That is, one only used during type-checking?)+isTcTyCon :: TyCon -> Bool+isTcTyCon (TcTyCon {}) = True+isTcTyCon _            = False++setTcTyConKind :: TyCon -> Kind -> TyCon+-- Update the Kind of a TcTyCon+-- The new kind is always a zonked version of its previous+-- kind, so we don't need to update any other fields.+-- See Note [The Purely Kinded Invariant] in TcHsType+setTcTyConKind tc@(TcTyCon {}) kind = tc { tyConKind = kind }+setTcTyConKind tc              _    = pprPanic "setTcTyConKind" (ppr tc)++-- | Could this TyCon ever be levity-polymorphic when fully applied?+-- True is safe. False means we're sure. Does only a quick check+-- based on the TyCon's category.+-- Precondition: The fully-applied TyCon has kind (TYPE blah)+isTcLevPoly :: TyCon -> Bool+isTcLevPoly FunTyCon{}           = False+isTcLevPoly (AlgTyCon { algTcParent = UnboxedAlgTyCon _ }) = True+isTcLevPoly AlgTyCon{}           = False+isTcLevPoly SynonymTyCon{}       = True+isTcLevPoly FamilyTyCon{}        = True+isTcLevPoly PrimTyCon{}          = False+isTcLevPoly TcTyCon{}            = False+isTcLevPoly tc@PromotedDataCon{} = pprPanic "isTcLevPoly datacon" (ppr tc)++{-+-----------------------------------------------+--      Expand type-constructor applications+-----------------------------------------------+-}++expandSynTyCon_maybe+        :: TyCon+        -> [tyco]                 -- ^ Arguments to 'TyCon'+        -> Maybe ([(TyVar,tyco)],+                  Type,+                  [tyco])         -- ^ Returns a 'TyVar' substitution, the body+                                  -- type of the synonym (not yet substituted)+                                  -- and any arguments remaining from the+                                  -- application++-- ^ Expand a type synonym application, if any+expandSynTyCon_maybe tc tys+  | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs, tyConArity = arity } <- tc+  = case tys `listLengthCmp` arity of+        GT -> Just (tvs `zip` tys, rhs, drop arity tys)+        EQ -> Just (tvs `zip` tys, rhs, [])+        LT -> Nothing+   | otherwise+   = Nothing++----------------++-- | Check if the tycon actually refers to a proper `data` or `newtype`+--  with user defined constructors rather than one from a class or other+--  construction.++-- NB: This is only used in TcRnExports.checkPatSynParent to determine if an+-- exported tycon can have a pattern synonym bundled with it, e.g.,+-- module Foo (TyCon(.., PatSyn)) where+isTyConWithSrcDataCons :: TyCon -> Bool+isTyConWithSrcDataCons (AlgTyCon { algTcRhs = rhs, algTcParent = parent }) =+  case rhs of+    DataTyCon {}  -> isSrcParent+    NewTyCon {}   -> isSrcParent+    TupleTyCon {} -> isSrcParent+    _ -> False+  where+    isSrcParent = isNoParent parent+isTyConWithSrcDataCons (FamilyTyCon { famTcFlav = DataFamilyTyCon {} })+                         = True -- #14058+isTyConWithSrcDataCons _ = False+++-- | As 'tyConDataCons_maybe', but returns the empty list of constructors if no+-- constructors could be found+tyConDataCons :: TyCon -> [DataCon]+-- It's convenient for tyConDataCons to return the+-- empty list for type synonyms etc+tyConDataCons tycon = tyConDataCons_maybe tycon `orElse` []++-- | Determine the 'DataCon's originating from the given 'TyCon', if the 'TyCon'+-- is the sort that can have any constructors (note: this does not include+-- abstract algebraic types)+tyConDataCons_maybe :: TyCon -> Maybe [DataCon]+tyConDataCons_maybe (AlgTyCon {algTcRhs = rhs})+  = case rhs of+       DataTyCon { data_cons = cons } -> Just cons+       NewTyCon { data_con = con }    -> Just [con]+       TupleTyCon { data_con = con }  -> Just [con]+       SumTyCon { data_cons = cons }  -> Just cons+       _                              -> Nothing+tyConDataCons_maybe _ = Nothing++-- | If the given 'TyCon' has a /single/ data constructor, i.e. it is a @data@+-- type with one alternative, a tuple type or a @newtype@ then that constructor+-- is returned. If the 'TyCon' has more than one constructor, or represents a+-- primitive or function type constructor then @Nothing@ is returned. In any+-- other case, the function panics+tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon+tyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs })+  = case rhs of+      DataTyCon { data_cons = [c] } -> Just c+      TupleTyCon { data_con = c }   -> Just c+      NewTyCon { data_con = c }     -> Just c+      _                             -> Nothing+tyConSingleDataCon_maybe _           = Nothing++tyConSingleDataCon :: TyCon -> DataCon+tyConSingleDataCon tc+  = case tyConSingleDataCon_maybe tc of+      Just c  -> c+      Nothing -> pprPanic "tyConDataCon" (ppr tc)++tyConSingleAlgDataCon_maybe :: TyCon -> Maybe DataCon+-- Returns (Just con) for single-constructor+-- *algebraic* data types *not* newtypes+tyConSingleAlgDataCon_maybe (AlgTyCon { algTcRhs = rhs })+  = case rhs of+      DataTyCon { data_cons = [c] } -> Just c+      TupleTyCon { data_con = c }   -> Just c+      _                             -> Nothing+tyConSingleAlgDataCon_maybe _        = Nothing++-- | Determine the number of value constructors a 'TyCon' has. Panics if the+-- 'TyCon' is not algebraic or a tuple+tyConFamilySize  :: TyCon -> Int+tyConFamilySize tc@(AlgTyCon { algTcRhs = rhs })+  = case rhs of+      DataTyCon { data_cons_size = size } -> size+      NewTyCon {}                    -> 1+      TupleTyCon {}                  -> 1+      SumTyCon { data_cons_size = size }  -> size+      _                              -> pprPanic "tyConFamilySize 1" (ppr tc)+tyConFamilySize tc = pprPanic "tyConFamilySize 2" (ppr tc)++-- | Extract an 'AlgTyConRhs' with information about data constructors from an+-- algebraic or tuple 'TyCon'. Panics for any other sort of 'TyCon'+algTyConRhs :: TyCon -> AlgTyConRhs+algTyConRhs (AlgTyCon {algTcRhs = rhs}) = rhs+algTyConRhs other = pprPanic "algTyConRhs" (ppr other)++-- | Extract type variable naming the result of injective type family+tyConFamilyResVar_maybe :: TyCon -> Maybe Name+tyConFamilyResVar_maybe (FamilyTyCon {famTcResVar = res}) = res+tyConFamilyResVar_maybe _                                 = Nothing++-- | Get the list of roles for the type parameters of a TyCon+tyConRoles :: TyCon -> [Role]+-- See also Note [TyCon Role signatures]+tyConRoles tc+  = case tc of+    { FunTyCon {}                         -> [Nominal, Nominal, Representational, Representational]+    ; AlgTyCon { tcRoles = roles }        -> roles+    ; SynonymTyCon { tcRoles = roles }    -> roles+    ; FamilyTyCon {}                      -> const_role Nominal+    ; PrimTyCon { tcRoles = roles }       -> roles+    ; PromotedDataCon { tcRoles = roles } -> roles+    ; TcTyCon {}                          -> const_role Nominal+    }+  where+    const_role r = replicate (tyConArity tc) r++-- | Extract the bound type variables and type expansion of a type synonym+-- 'TyCon'. Panics if the 'TyCon' is not a synonym+newTyConRhs :: TyCon -> ([TyVar], Type)+newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }})+    = (tvs, rhs)+newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon)++-- | The number of type parameters that need to be passed to a newtype to+-- resolve it. May be less than in the definition if it can be eta-contracted.+newTyConEtadArity :: TyCon -> Int+newTyConEtadArity (AlgTyCon {algTcRhs = NewTyCon { nt_etad_rhs = tvs_rhs }})+        = length (fst tvs_rhs)+newTyConEtadArity tycon = pprPanic "newTyConEtadArity" (ppr tycon)++-- | Extract the bound type variables and type expansion of an eta-contracted+-- type synonym 'TyCon'.  Panics if the 'TyCon' is not a synonym+newTyConEtadRhs :: TyCon -> ([TyVar], Type)+newTyConEtadRhs (AlgTyCon {algTcRhs = NewTyCon { nt_etad_rhs = tvs_rhs }}) = tvs_rhs+newTyConEtadRhs tycon = pprPanic "newTyConEtadRhs" (ppr tycon)++-- | Extracts the @newtype@ coercion from such a 'TyCon', which can be used to+-- construct something with the @newtype@s type from its representation type+-- (right hand side). If the supplied 'TyCon' is not a @newtype@, returns+-- @Nothing@+newTyConCo_maybe :: TyCon -> Maybe (CoAxiom Unbranched)+newTyConCo_maybe (AlgTyCon {algTcRhs = NewTyCon { nt_co = co }}) = Just co+newTyConCo_maybe _                                               = Nothing++newTyConCo :: TyCon -> CoAxiom Unbranched+newTyConCo tc = case newTyConCo_maybe tc of+                 Just co -> co+                 Nothing -> pprPanic "newTyConCo" (ppr tc)++newTyConDataCon_maybe :: TyCon -> Maybe DataCon+newTyConDataCon_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = con }}) = Just con+newTyConDataCon_maybe _ = Nothing++-- | Find the \"stupid theta\" of the 'TyCon'. A \"stupid theta\" is the context+-- to the left of an algebraic type declaration, e.g. @Eq a@ in the declaration+-- @data Eq a => T a ...@+tyConStupidTheta :: TyCon -> [PredType]+tyConStupidTheta (AlgTyCon {algTcStupidTheta = stupid}) = stupid+tyConStupidTheta (FunTyCon {}) = []+tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)++-- | Extract the 'TyVar's bound by a vanilla type synonym+-- and the corresponding (unsubstituted) right hand side.+synTyConDefn_maybe :: TyCon -> Maybe ([TyVar], Type)+synTyConDefn_maybe (SynonymTyCon {tyConTyVars = tyvars, synTcRhs = ty})+  = Just (tyvars, ty)+synTyConDefn_maybe _ = Nothing++-- | Extract the information pertaining to the right hand side of a type synonym+-- (@type@) declaration.+synTyConRhs_maybe :: TyCon -> Maybe Type+synTyConRhs_maybe (SynonymTyCon {synTcRhs = rhs}) = Just rhs+synTyConRhs_maybe _                               = Nothing++-- | Extract the flavour of a type family (with all the extra information that+-- it carries)+famTyConFlav_maybe :: TyCon -> Maybe FamTyConFlav+famTyConFlav_maybe (FamilyTyCon {famTcFlav = flav}) = Just flav+famTyConFlav_maybe _                                = Nothing++-- | Is this 'TyCon' that for a class instance?+isClassTyCon :: TyCon -> Bool+isClassTyCon (AlgTyCon {algTcParent = ClassTyCon {}}) = True+isClassTyCon _                                        = False++-- | If this 'TyCon' is that for a class instance, return the class it is for.+-- Otherwise returns @Nothing@+tyConClass_maybe :: TyCon -> Maybe Class+tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas _}) = Just clas+tyConClass_maybe _                                            = Nothing++-- | Return the associated types of the 'TyCon', if any+tyConATs :: TyCon -> [TyCon]+tyConATs (AlgTyCon {algTcParent = ClassTyCon clas _}) = classATs clas+tyConATs _                                            = []++----------------------------------------------------------------------------+-- | Is this 'TyCon' that for a data family instance?+isFamInstTyCon :: TyCon -> Bool+isFamInstTyCon (AlgTyCon {algTcParent = DataFamInstTyCon {} })+  = True+isFamInstTyCon _ = False++tyConFamInstSig_maybe :: TyCon -> Maybe (TyCon, [Type], CoAxiom Unbranched)+tyConFamInstSig_maybe (AlgTyCon {algTcParent = DataFamInstTyCon ax f ts })+  = Just (f, ts, ax)+tyConFamInstSig_maybe _ = Nothing++-- | If this 'TyCon' is that of a data family instance, return the family in question+-- and the instance types. Otherwise, return @Nothing@+tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])+tyConFamInst_maybe (AlgTyCon {algTcParent = DataFamInstTyCon _ f ts })+  = Just (f, ts)+tyConFamInst_maybe _ = Nothing++-- | If this 'TyCon' is that of a data family instance, return a 'TyCon' which+-- represents a coercion identifying the representation type with the type+-- instance family.  Otherwise, return @Nothing@+tyConFamilyCoercion_maybe :: TyCon -> Maybe (CoAxiom Unbranched)+tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = DataFamInstTyCon ax _ _ })+  = Just ax+tyConFamilyCoercion_maybe _ = Nothing++-- | Extract any 'RuntimeRepInfo' from this TyCon+tyConRuntimeRepInfo :: TyCon -> RuntimeRepInfo+tyConRuntimeRepInfo (PromotedDataCon { promDcRepInfo = rri }) = rri+tyConRuntimeRepInfo _                                         = NoRRI+  -- could panic in that second case. But Douglas Adams told me not to.++{-+Note [Constructor tag allocation]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When typechecking we need to allocate constructor tags to constructors.+They are allocated based on the position in the data_cons field of TyCon,+with the first constructor getting fIRST_TAG.++We used to pay linear cost per constructor, with each constructor looking up+its relative index in the constructor list. That was quadratic and prohibitive+for large data types with more than 10k constructors.++The current strategy is to build a NameEnv with a mapping from costructor's+Name to ConTag and pass it down to buildDataCon for efficient lookup.++Relevant ticket: #14657+-}++mkTyConTagMap :: TyCon -> NameEnv ConTag+mkTyConTagMap tycon =+  mkNameEnv $ map getName (tyConDataCons tycon) `zip` [fIRST_TAG..]+  -- See Note [Constructor tag allocation]++{-+************************************************************************+*                                                                      *+\subsection[TyCon-instances]{Instance declarations for @TyCon@}+*                                                                      *+************************************************************************++@TyCon@s are compared by comparing their @Unique@s.+-}++instance Eq TyCon where+    a == b = getUnique a == getUnique b+    a /= b = getUnique a /= getUnique b++instance Uniquable TyCon where+    getUnique tc = tyConUnique tc++instance Outputable TyCon where+  -- At the moment a promoted TyCon has the same Name as its+  -- corresponding TyCon, so we add the quote to distinguish it here+  ppr tc = pprPromotionQuote tc <> ppr (tyConName tc) <> pp_tc+    where+      pp_tc = getPprStyle $ \sty -> if ((debugStyle sty || dumpStyle sty) && isTcTyCon tc)+                                    then text "[tc]"+                                    else empty++-- | Paints a picture of what a 'TyCon' represents, in broad strokes.+-- This is used towards more informative error messages.+data TyConFlavour+  = ClassFlavour+  | TupleFlavour Boxity+  | SumFlavour+  | DataTypeFlavour+  | NewtypeFlavour+  | AbstractTypeFlavour+  | DataFamilyFlavour (Maybe TyCon)     -- Just tc <=> (tc == associated class)+  | OpenTypeFamilyFlavour (Maybe TyCon) -- Just tc <=> (tc == associated class)+  | ClosedTypeFamilyFlavour+  | TypeSynonymFlavour+  | BuiltInTypeFlavour -- ^ e.g., the @(->)@ 'TyCon'.+  | PromotedDataConFlavour+  deriving Eq++instance Outputable TyConFlavour where+  ppr = text . go+    where+      go ClassFlavour = "class"+      go (TupleFlavour boxed) | isBoxed boxed = "tuple"+                              | otherwise     = "unboxed tuple"+      go SumFlavour              = "unboxed sum"+      go DataTypeFlavour         = "data type"+      go NewtypeFlavour          = "newtype"+      go AbstractTypeFlavour     = "abstract type"+      go (DataFamilyFlavour (Just _))  = "associated data family"+      go (DataFamilyFlavour Nothing)   = "data family"+      go (OpenTypeFamilyFlavour (Just _)) = "associated type family"+      go (OpenTypeFamilyFlavour Nothing)  = "type family"+      go ClosedTypeFamilyFlavour = "type family"+      go TypeSynonymFlavour      = "type synonym"+      go BuiltInTypeFlavour      = "built-in type"+      go PromotedDataConFlavour  = "promoted data constructor"++tyConFlavour :: TyCon -> TyConFlavour+tyConFlavour (AlgTyCon { algTcParent = parent, algTcRhs = rhs })+  | ClassTyCon _ _ <- parent = ClassFlavour+  | otherwise = case rhs of+                  TupleTyCon { tup_sort = sort }+                                     -> TupleFlavour (tupleSortBoxity sort)+                  SumTyCon {}        -> SumFlavour+                  DataTyCon {}       -> DataTypeFlavour+                  NewTyCon {}        -> NewtypeFlavour+                  AbstractTyCon {}   -> AbstractTypeFlavour+tyConFlavour (FamilyTyCon { famTcFlav = flav, famTcParent = parent })+  = case flav of+      DataFamilyTyCon{}            -> DataFamilyFlavour parent+      OpenSynFamilyTyCon           -> OpenTypeFamilyFlavour parent+      ClosedSynFamilyTyCon{}       -> ClosedTypeFamilyFlavour+      AbstractClosedSynFamilyTyCon -> ClosedTypeFamilyFlavour+      BuiltInSynFamTyCon{}         -> ClosedTypeFamilyFlavour+tyConFlavour (SynonymTyCon {})    = TypeSynonymFlavour+tyConFlavour (FunTyCon {})        = BuiltInTypeFlavour+tyConFlavour (PrimTyCon {})       = BuiltInTypeFlavour+tyConFlavour (PromotedDataCon {}) = PromotedDataConFlavour+tyConFlavour (TcTyCon { tcTyConFlavour = flav }) = flav++-- | Can this flavour of 'TyCon' appear unsaturated?+tcFlavourMustBeSaturated :: TyConFlavour -> Bool+tcFlavourMustBeSaturated ClassFlavour            = False+tcFlavourMustBeSaturated DataTypeFlavour         = False+tcFlavourMustBeSaturated NewtypeFlavour          = False+tcFlavourMustBeSaturated DataFamilyFlavour{}     = False+tcFlavourMustBeSaturated TupleFlavour{}          = False+tcFlavourMustBeSaturated SumFlavour              = False+tcFlavourMustBeSaturated AbstractTypeFlavour     = False+tcFlavourMustBeSaturated BuiltInTypeFlavour      = False+tcFlavourMustBeSaturated PromotedDataConFlavour  = False+tcFlavourMustBeSaturated TypeSynonymFlavour      = True+tcFlavourMustBeSaturated OpenTypeFamilyFlavour{} = True+tcFlavourMustBeSaturated ClosedTypeFamilyFlavour = True++-- | Is this flavour of 'TyCon' an open type family or a data family?+tcFlavourIsOpen :: TyConFlavour -> Bool+tcFlavourIsOpen DataFamilyFlavour{}     = True+tcFlavourIsOpen OpenTypeFamilyFlavour{} = True+tcFlavourIsOpen ClosedTypeFamilyFlavour = False+tcFlavourIsOpen ClassFlavour            = False+tcFlavourIsOpen DataTypeFlavour         = False+tcFlavourIsOpen NewtypeFlavour          = False+tcFlavourIsOpen TupleFlavour{}          = False+tcFlavourIsOpen SumFlavour              = False+tcFlavourIsOpen AbstractTypeFlavour     = False+tcFlavourIsOpen BuiltInTypeFlavour      = False+tcFlavourIsOpen PromotedDataConFlavour  = False+tcFlavourIsOpen TypeSynonymFlavour      = False++pprPromotionQuote :: TyCon -> SDoc+-- Promoted data constructors already have a tick in their OccName+pprPromotionQuote tc+  = case tc of+      PromotedDataCon {} -> char '\'' -- Always quote promoted DataCons in types+      _                  -> empty++instance NamedThing TyCon where+    getName = tyConName++instance Data.Data TyCon where+    -- don't traverse?+    toConstr _   = abstractConstr "TyCon"+    gunfold _ _  = error "gunfold"+    dataTypeOf _ = mkNoRepType "TyCon"++instance Binary Injectivity where+    put_ bh NotInjective   = putByte bh 0+    put_ bh (Injective xs) = putByte bh 1 >> put_ bh xs++    get bh = do { h <- getByte bh+                ; case h of+                    0 -> return NotInjective+                    _ -> do { xs <- get bh+                            ; return (Injective xs) } }++{-+************************************************************************+*                                                                      *+           Walking over recursive TyCons+*                                                                      *+************************************************************************++Note [Expanding newtypes and products]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When expanding a type to expose a data-type constructor, we need to be+careful about newtypes, lest we fall into an infinite loop. Here are+the key examples:++  newtype Id  x = MkId x+  newtype Fix f = MkFix (f (Fix f))+  newtype T     = MkT (T -> T)++  Type           Expansion+ --------------------------+  T              T -> T+  Fix Maybe      Maybe (Fix Maybe)+  Id (Id Int)    Int+  Fix Id         NO NO NO++Notice that+ * We can expand T, even though it's recursive.+ * We can expand Id (Id Int), even though the Id shows up+   twice at the outer level, because Id is non-recursive++So, when expanding, we keep track of when we've seen a recursive+newtype at outermost level; and bail out if we see it again.++We sometimes want to do the same for product types, so that the+strictness analyser doesn't unbox infinitely deeply.++More precisely, we keep a *count* of how many times we've seen it.+This is to account for+   data instance T (a,b) = MkT (T a) (T b)+Then (#10482) if we have a type like+        T (Int,(Int,(Int,(Int,Int))))+we can still unbox deeply enough during strictness analysis.+We have to treat T as potentially recursive, but it's still+good to be able to unwrap multiple layers.++The function that manages all this is checkRecTc.+-}++data RecTcChecker = RC !Int (NameEnv Int)+  -- The upper bound, and the number of times+  -- we have encountered each TyCon++-- | Initialise a 'RecTcChecker' with 'defaultRecTcMaxBound'.+initRecTc :: RecTcChecker+initRecTc = RC defaultRecTcMaxBound emptyNameEnv++-- | The default upper bound (100) for the number of times a 'RecTcChecker' is+-- allowed to encounter each 'TyCon'.+defaultRecTcMaxBound :: Int+defaultRecTcMaxBound = 100+-- Should we have a flag for this?++-- | Change the upper bound for the number of times a 'RecTcChecker' is allowed+-- to encounter each 'TyCon'.+setRecTcMaxBound :: Int -> RecTcChecker -> RecTcChecker+setRecTcMaxBound new_bound (RC _old_bound rec_nts) = RC new_bound rec_nts++checkRecTc :: RecTcChecker -> TyCon -> Maybe RecTcChecker+-- Nothing      => Recursion detected+-- Just rec_tcs => Keep going+checkRecTc (RC bound rec_nts) tc+  = case lookupNameEnv rec_nts tc_name of+      Just n | n >= bound -> Nothing+             | otherwise  -> Just (RC bound (extendNameEnv rec_nts tc_name (n+1)))+      Nothing             -> Just (RC bound (extendNameEnv rec_nts tc_name 1))+  where+    tc_name = tyConName tc++-- | Returns whether or not this 'TyCon' is definite, or a hole+-- that may be filled in at some later point.  See Note [Skolem abstract data]+tyConSkolem :: TyCon -> Bool+tyConSkolem = isHoleName . tyConName++-- Note [Skolem abstract data]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- Skolem abstract data arises from data declarations in an hsig file.+--+-- The best analogy is to interpret the types declared in signature files as+-- elaborating to universally quantified type variables; e.g.,+--+--    unit p where+--        signature H where+--            data T+--            data S+--        module M where+--            import H+--            f :: (T ~ S) => a -> b+--            f x = x+--+-- elaborates as (with some fake structural types):+--+--    p :: forall t s. { f :: forall a b. t ~ s => a -> b }+--    p = { f = \x -> x } -- ill-typed+--+-- It is clear that inside p, t ~ s is not provable (and+-- if we tried to write a function to cast t to s, that+-- would not work), but if we call p @Int @Int, clearly Int ~ Int+-- is provable.  The skolem variables are all distinct from+-- one another, but we can't make assumptions like "f is+-- inaccessible", because the skolem variables will get+-- instantiated eventually!+--+-- Skolem abstractness can apply to "non-abstract" data as well):+--+--    unit p where+--        signature H1 where+--            data T = MkT+--        signature H2 where+--            data T = MkT+--        module M where+--            import qualified H1+--            import qualified H2+--            f :: (H1.T ~ H2.T) => a -> b+--            f x = x+--+-- This is why the test is on the original name of the TyCon,+-- not whether it is abstract or not.
+ compiler/types/TyCon.hs-boot view
@@ -0,0 +1,9 @@+module TyCon where++import GhcPrelude++data TyCon++isTupleTyCon        :: TyCon -> Bool+isUnboxedTupleTyCon :: TyCon -> Bool+isFunTyCon          :: TyCon -> Bool
+ compiler/types/Type.hs view
@@ -0,0 +1,3137 @@+-- (c) The University of Glasgow 2006+-- (c) The GRASP/AQUA Project, Glasgow University, 1998+--+-- Type - public interface++{-# LANGUAGE CPP, FlexibleContexts #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | Main functions for manipulating types and type-related things+module Type (+        -- Note some of this is just re-exports from TyCon..++        -- * Main data types representing Types+        -- $type_classification++        -- $representation_types+        TyThing(..), Type, ArgFlag(..), AnonArgFlag(..), ForallVisFlag(..),+        KindOrType, PredType, ThetaType,+        Var, TyVar, isTyVar, TyCoVar, TyCoBinder, TyCoVarBinder, TyVarBinder,+        KnotTied,++        -- ** Constructing and deconstructing types+        mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, repGetTyVar_maybe,+        getCastedTyVar_maybe, tyVarKind, varType,++        mkAppTy, mkAppTys, splitAppTy, splitAppTys, repSplitAppTys,+        splitAppTy_maybe, repSplitAppTy_maybe, tcRepSplitAppTy_maybe,++        mkVisFunTy, mkInvisFunTy, mkVisFunTys, mkInvisFunTys,+        splitFunTy, splitFunTy_maybe,+        splitFunTys, funResultTy, funArgTy,++        mkTyConApp, mkTyConTy,+        tyConAppTyCon_maybe, tyConAppTyConPicky_maybe,+        tyConAppArgs_maybe, tyConAppTyCon, tyConAppArgs,+        splitTyConApp_maybe, splitTyConApp, tyConAppArgN, nextRole,+        tcSplitTyConApp_maybe,+        splitListTyConApp_maybe,+        repSplitTyConApp_maybe,++        mkForAllTy, mkForAllTys, mkTyCoInvForAllTys,+        mkSpecForAllTy, mkSpecForAllTys,+        mkVisForAllTys, mkTyCoInvForAllTy,+        mkInvForAllTy, mkInvForAllTys,+        splitForAllTys, splitForAllTysSameVis, splitForAllVarBndrs,+        splitForAllTy_maybe, splitForAllTy,+        splitForAllTy_ty_maybe, splitForAllTy_co_maybe,+        splitPiTy_maybe, splitPiTy, splitPiTys,+        mkTyConBindersPreferAnon,+        mkPiTy, mkPiTys,+        mkLamType, mkLamTypes,+        piResultTy, piResultTys,+        applyTysX, dropForAlls,++        mkNumLitTy, isNumLitTy,+        mkStrLitTy, isStrLitTy,+        isLitTy,++        getRuntimeRep_maybe, kindRep_maybe, kindRep,++        mkCastTy, mkCoercionTy, splitCastTy_maybe,++        userTypeError_maybe, pprUserTypeErrorTy,++        coAxNthLHS,+        stripCoercionTy, splitCoercionType_maybe,++        splitPiTysInvisible, splitPiTysInvisibleN,+        invisibleTyBndrCount,+        filterOutInvisibleTypes, filterOutInferredTypes,+        partitionInvisibleTypes, partitionInvisibles,+        tyConArgFlags, appTyArgFlags,+        synTyConResKind,++        modifyJoinResTy, setJoinResTy,++        -- Analyzing types+        TyCoMapper(..), mapType, mapCoercion,++        -- (Newtypes)+        newTyConInstRhs,++        -- Pred types+        mkFamilyTyConApp,+        isDictLikeTy,+        mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole,+        equalityTyCon,+        mkHeteroPrimEqPred, mkHeteroReprPrimEqPred,+        mkClassPred,+        isClassPred, isEqPrimPred, isEqPred, isEqPredClass,+        isIPPred, isIPPred_maybe, isIPTyCon, isIPClass,+        isCTupleClass,++        -- Deconstructing predicate types+        PredTree(..), EqRel(..), eqRelRole, classifyPredType,+        getClassPredTys, getClassPredTys_maybe,+        getEqPredTys, getEqPredTys_maybe, getEqPredRole,+        predTypeEqRel,++        -- ** Binders+        sameVis,+        mkTyCoVarBinder, mkTyCoVarBinders,+        mkTyVarBinders,+        mkAnonBinder,+        isAnonTyCoBinder,+        binderVar, binderVars, binderType, binderArgFlag,+        tyCoBinderType, tyCoBinderVar_maybe,+        tyBinderType,+        binderRelevantType_maybe,+        isVisibleArgFlag, isInvisibleArgFlag, isVisibleBinder,+        isInvisibleBinder, isNamedBinder,+        tyConBindersTyCoBinders,++        -- ** Common type constructors+        funTyCon,++        -- ** Predicates on types+        isTyVarTy, isFunTy, isDictTy, isPredTy, isCoercionTy,+        isCoercionTy_maybe, isForAllTy,+        isForAllTy_ty, isForAllTy_co,+        isPiTy, isTauTy, isFamFreeTy,+        isCoVarType, isEvVarType,++        isValidJoinPointType,++        -- (Lifting and boxity)+        isLiftedType_maybe, isUnliftedType, isUnboxedTupleType, isUnboxedSumType,+        isAlgType, isDataFamilyAppType,+        isPrimitiveType, isStrictType,+        isRuntimeRepTy, isRuntimeRepVar, isRuntimeRepKindedTy,+        dropRuntimeRepArgs,+        getRuntimeRep,++        -- * Main data types representing Kinds+        Kind,++        -- ** Finding the kind of a type+        typeKind, tcTypeKind, isTypeLevPoly, resultIsLevPoly,+        tcIsLiftedTypeKind, tcIsConstraintKind, tcReturnsConstraintKind,++        -- ** Common Kind+        liftedTypeKind,++        -- * Type free variables+        tyCoFVsOfType, tyCoFVsBndr, tyCoFVsVarBndr, tyCoFVsVarBndrs,+        tyCoVarsOfType, tyCoVarsOfTypes,+        tyCoVarsOfTypeDSet,+        coVarsOfType,+        coVarsOfTypes,+        closeOverKindsDSet, closeOverKindsFV, closeOverKindsList,+        closeOverKinds,++        noFreeVarsOfType,+        splitVisVarsOfType, splitVisVarsOfTypes,+        expandTypeSynonyms,+        typeSize, occCheckExpand,++        -- * Well-scoped lists of variables+        dVarSetElemsWellScoped, scopedSort, tyCoVarsOfTypeWellScoped,+        tyCoVarsOfTypesWellScoped, tyCoVarsOfBindersWellScoped,++        -- * Type comparison+        eqType, eqTypeX, eqTypes, nonDetCmpType, nonDetCmpTypes, nonDetCmpTypeX,+        nonDetCmpTypesX, nonDetCmpTc,+        eqVarBndrs,++        -- * Forcing evaluation of types+        seqType, seqTypes,++        -- * Other views onto Types+        coreView, tcView,++        tyConsOfType,++        -- * Main type substitution data types+        TvSubstEnv,     -- Representation widely visible+        TCvSubst(..),    -- Representation visible to a few friends++        -- ** Manipulating type substitutions+        emptyTvSubstEnv, emptyTCvSubst, mkEmptyTCvSubst,++        mkTCvSubst, zipTvSubst, mkTvSubstPrs,+        zipTCvSubst,+        notElemTCvSubst,+        getTvSubstEnv, setTvSubstEnv,+        zapTCvSubst, getTCvInScope, getTCvSubstRangeFVs,+        extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,+        extendTCvSubst, extendCvSubst,+        extendTvSubst, extendTvSubstBinderAndInScope,+        extendTvSubstList, extendTvSubstAndInScope,+        extendTCvSubstList,+        extendTvSubstWithClone,+        extendTCvSubstWithClone,+        isInScope, composeTCvSubstEnv, composeTCvSubst, zipTyEnv, zipCoEnv,+        isEmptyTCvSubst, unionTCvSubst,++        -- ** Performing substitution on types and kinds+        substTy, substTys, substTyWith, substTysWith, substTheta,+        substTyAddInScope,+        substTyUnchecked, substTysUnchecked, substThetaUnchecked,+        substTyWithUnchecked,+        substCoUnchecked, substCoWithUnchecked,+        substTyVarBndr, substTyVarBndrs, substTyVar, substTyVars,+        substVarBndr, substVarBndrs,+        cloneTyVarBndr, cloneTyVarBndrs, lookupTyVar,++        -- * Pretty-printing+        pprType, pprParendType, pprPrecType,+        pprTypeApp, pprTyThingCategory, pprShortTyThing,+        pprTCvBndr, pprTCvBndrs, pprForAll, pprUserForAll,+        pprSigmaType, pprWithExplicitKindsWhen,+        pprTheta, pprThetaArrowTy, pprClassPred,+        pprKind, pprParendKind, pprSourceTyCon,+        PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen,+        pprTyVar, pprTyVars,+        pprWithTYPE,++        -- * Tidying type related things up for printing+        tidyType,      tidyTypes,+        tidyOpenType,  tidyOpenTypes,+        tidyOpenKind,+        tidyVarBndr, tidyVarBndrs, tidyFreeTyCoVars,+        tidyOpenTyCoVar, tidyOpenTyCoVars,+        tidyTyCoVarOcc,+        tidyTopType,+        tidyKind,+        tidyTyCoVarBinder, tidyTyCoVarBinders+    ) where++#include "HsVersions.h"++import GhcPrelude++import BasicTypes++-- We import the representation and primitive functions from TyCoRep.+-- Many things are reexported, but not the representation!++import Kind+import TyCoRep++-- friends:+import Var+import VarEnv+import VarSet+import UniqSet++import Class+import TyCon+import TysPrim+import {-# SOURCE #-} TysWiredIn ( listTyCon, typeNatKind, unitTy+                                 , typeSymbolKind, liftedTypeKind+                                 , constraintKind )+import PrelNames+import CoAxiom+import {-# SOURCE #-} Coercion( mkNomReflCo, mkGReflCo, mkReflCo+                              , mkTyConAppCo, mkAppCo, mkCoVarCo, mkAxiomRuleCo+                              , mkForAllCo, mkFunCo, mkAxiomInstCo, mkUnivCo+                              , mkSymCo, mkTransCo, mkNthCo, mkLRCo, mkInstCo+                              , mkKindCo, mkSubCo, mkFunCo, mkAxiomInstCo+                              , decomposePiCos, coercionKind, coercionType+                              , isReflexiveCo, seqCo )++-- others+import Util+import FV+import Outputable+import FastString+import Pair+import DynFlags  ( gopt_set, GeneralFlag(Opt_PrintExplicitRuntimeReps) )+import ListSetOps+import Unique ( nonDetCmpUnique )++import Maybes           ( orElse )+import Data.Maybe       ( isJust )+import Control.Monad    ( guard )++-- $type_classification+-- #type_classification#+--+-- Types are one of:+--+-- [Unboxed]            Iff its representation is other than a pointer+--                      Unboxed types are also unlifted.+--+-- [Lifted]             Iff it has bottom as an element.+--                      Closures always have lifted types: i.e. any+--                      let-bound identifier in Core must have a lifted+--                      type. Operationally, a lifted object is one that+--                      can be entered.+--                      Only lifted types may be unified with a type variable.+--+-- [Algebraic]          Iff it is a type with one or more constructors, whether+--                      declared with @data@ or @newtype@.+--                      An algebraic type is one that can be deconstructed+--                      with a case expression. This is /not/ the same as+--                      lifted types, because we also include unboxed+--                      tuples in this classification.+--+-- [Data]               Iff it is a type declared with @data@, or a boxed tuple.+--+-- [Primitive]          Iff it is a built-in type that can't be expressed in Haskell.+--+-- Currently, all primitive types are unlifted, but that's not necessarily+-- the case: for example, @Int@ could be primitive.+--+-- Some primitive types are unboxed, such as @Int#@, whereas some are boxed+-- but unlifted (such as @ByteArray#@).  The only primitive types that we+-- classify as algebraic are the unboxed tuples.+--+-- Some examples of type classifications that may make this a bit clearer are:+--+-- @+-- Type          primitive       boxed           lifted          algebraic+-- -----------------------------------------------------------------------------+-- Int#          Yes             No              No              No+-- ByteArray#    Yes             Yes             No              No+-- (\# a, b \#)  Yes             No              No              Yes+-- (\# a | b \#) Yes             No              No              Yes+-- (  a, b  )    No              Yes             Yes             Yes+-- [a]           No              Yes             Yes             Yes+-- @++-- $representation_types+-- A /source type/ is a type that is a separate type as far as the type checker is+-- concerned, but which has a more low-level representation as far as Core-to-Core+-- passes and the rest of the back end is concerned.+--+-- You don't normally have to worry about this, as the utility functions in+-- this module will automatically convert a source into a representation type+-- if they are spotted, to the best of its abilities. If you don't want this+-- to happen, use the equivalent functions from the "TcType" module.++{-+************************************************************************+*                                                                      *+                Type representation+*                                                                      *+************************************************************************++Note [coreView vs tcView]+~~~~~~~~~~~~~~~~~~~~~~~~~+So far as the typechecker is concerned, 'Constraint' and 'TYPE+LiftedRep' are distinct kinds.++But in Core these two are treated as identical.++We implement this by making 'coreView' convert 'Constraint' to 'TYPE+LiftedRep' on the fly.  The function tcView (used in the type checker)+does not do this.++See also #11715, which tracks removing this inconsistency.++-}++-- | Gives the typechecker view of a type. This unwraps synonyms but+-- leaves 'Constraint' alone. c.f. coreView, which turns Constraint into+-- TYPE LiftedRep. Returns Nothing if no unwrapping happens.+-- See also Note [coreView vs tcView]+{-# INLINE tcView #-}+tcView :: Type -> Maybe Type+tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys+  = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys')+               -- The free vars of 'rhs' should all be bound by 'tenv', so it's+               -- ok to use 'substTy' here.+               -- See also Note [The substitution invariant] in TyCoRep.+               -- Its important to use mkAppTys, rather than (foldl AppTy),+               -- because the function part might well return a+               -- partially-applied type constructor; indeed, usually will!+tcView _ = Nothing++{-# INLINE coreView #-}+coreView :: Type -> Maybe Type+-- ^ This function Strips off the /top layer only/ of a type synonym+-- application (if any) its underlying representation type.+-- Returns Nothing if there is nothing to look through.+-- This function considers 'Constraint' to be a synonym of @TYPE LiftedRep@.+--+-- By being non-recursive and inlined, this case analysis gets efficiently+-- joined onto the case analysis that the caller is already doing+coreView ty@(TyConApp tc tys)+  | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys+  = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys')+    -- This equation is exactly like tcView++  -- At the Core level, Constraint = Type+  -- See Note [coreView vs tcView]+  | isConstraintKindCon tc+  = ASSERT2( null tys, ppr ty )+    Just liftedTypeKind++coreView _ = Nothing++-----------------------------------------------+expandTypeSynonyms :: Type -> Type+-- ^ Expand out all type synonyms.  Actually, it'd suffice to expand out+-- just the ones that discard type variables (e.g.  type Funny a = Int)+-- But we don't know which those are currently, so we just expand all.+--+-- 'expandTypeSynonyms' only expands out type synonyms mentioned in the type,+-- not in the kinds of any TyCon or TyVar mentioned in the type.+--+-- Keep this synchronized with 'synonymTyConsOfType'+expandTypeSynonyms ty+  = go (mkEmptyTCvSubst in_scope) ty+  where+    in_scope = mkInScopeSet (tyCoVarsOfType ty)++    go subst (TyConApp tc tys)+      | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc expanded_tys+      = let subst' = mkTvSubst in_scope (mkVarEnv tenv)+            -- Make a fresh substitution; rhs has nothing to+            -- do with anything that has happened so far+            -- NB: if you make changes here, be sure to build an+            --     /idempotent/ substitution, even in the nested case+            --        type T a b = a -> b+            --        type S x y = T y x+            -- (#11665)+        in  mkAppTys (go subst' rhs) tys'+      | otherwise+      = TyConApp tc expanded_tys+      where+        expanded_tys = (map (go subst) tys)++    go _     (LitTy l)     = LitTy l+    go subst (TyVarTy tv)  = substTyVar subst tv+    go subst (AppTy t1 t2) = mkAppTy (go subst t1) (go subst t2)+    go subst ty@(FunTy _ arg res)+      = ty { ft_arg = go subst arg, ft_res = go subst res }+    go subst (ForAllTy (Bndr tv vis) t)+      = let (subst', tv') = substVarBndrUsing go subst tv in+        ForAllTy (Bndr tv' vis) (go subst' t)+    go subst (CastTy ty co)  = mkCastTy (go subst ty) (go_co subst co)+    go subst (CoercionTy co) = mkCoercionTy (go_co subst co)++    go_mco _     MRefl    = MRefl+    go_mco subst (MCo co) = MCo (go_co subst co)++    go_co subst (Refl ty)+      = mkNomReflCo (go subst ty)+    go_co subst (GRefl r ty mco)+      = mkGReflCo r (go subst ty) (go_mco subst mco)+       -- NB: coercions are always expanded upon creation+    go_co subst (TyConAppCo r tc args)+      = mkTyConAppCo r tc (map (go_co subst) args)+    go_co subst (AppCo co arg)+      = mkAppCo (go_co subst co) (go_co subst arg)+    go_co subst (ForAllCo tv kind_co co)+      = let (subst', tv', kind_co') = go_cobndr subst tv kind_co in+        mkForAllCo tv' kind_co' (go_co subst' co)+    go_co subst (FunCo r co1 co2)+      = mkFunCo r (go_co subst co1) (go_co subst co2)+    go_co subst (CoVarCo cv)+      = substCoVar subst cv+    go_co subst (AxiomInstCo ax ind args)+      = mkAxiomInstCo ax ind (map (go_co subst) args)+    go_co subst (UnivCo p r t1 t2)+      = mkUnivCo (go_prov subst p) r (go subst t1) (go subst t2)+    go_co subst (SymCo co)+      = mkSymCo (go_co subst co)+    go_co subst (TransCo co1 co2)+      = mkTransCo (go_co subst co1) (go_co subst co2)+    go_co subst (NthCo r n co)+      = mkNthCo r n (go_co subst co)+    go_co subst (LRCo lr co)+      = mkLRCo lr (go_co subst co)+    go_co subst (InstCo co arg)+      = mkInstCo (go_co subst co) (go_co subst arg)+    go_co subst (KindCo co)+      = mkKindCo (go_co subst co)+    go_co subst (SubCo co)+      = mkSubCo (go_co subst co)+    go_co subst (AxiomRuleCo ax cs)+      = AxiomRuleCo ax (map (go_co subst) cs)+    go_co _ (HoleCo h)+      = pprPanic "expandTypeSynonyms hit a hole" (ppr h)++    go_prov _     UnsafeCoerceProv    = UnsafeCoerceProv+    go_prov subst (PhantomProv co)    = PhantomProv (go_co subst co)+    go_prov subst (ProofIrrelProv co) = ProofIrrelProv (go_co subst co)+    go_prov _     p@(PluginProv _)    = p++      -- the "False" and "const" are to accommodate the type of+      -- substForAllCoBndrUsing, which is general enough to+      -- handle coercion optimization (which sometimes swaps the+      -- order of a coercion)+    go_cobndr subst = substForAllCoBndrUsing False (go_co subst) subst++{-+************************************************************************+*                                                                      *+   Analyzing types+*                                                                      *+************************************************************************++These functions do a map-like operation over types, performing some operation+on all variables and binding sites. Primarily used for zonking.++Note [Efficiency for mapCoercion ForAllCo case]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+As noted in Note [Forall coercions] in TyCoRep, a ForAllCo is a bit redundant.+It stores a TyCoVar and a Coercion, where the kind of the TyCoVar always matches+the left-hand kind of the coercion. This is convenient lots of the time, but+not when mapping a function over a coercion.++The problem is that tcm_tybinder will affect the TyCoVar's kind and+mapCoercion will affect the Coercion, and we hope that the results will be+the same. Even if they are the same (which should generally happen with+correct algorithms), then there is an efficiency issue. In particular,+this problem seems to make what should be a linear algorithm into a potentially+exponential one. But it's only going to be bad in the case where there's+lots of foralls in the kinds of other foralls. Like this:++  forall a : (forall b : (forall c : ...). ...). ...++This construction seems unlikely. So we'll do the inefficient, easy way+for now.++Note [Specialising mappers]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+These INLINABLE pragmas are indispensable. mapType/mapCoercion are used+to implement zonking, and it's vital that they get specialised to the TcM+monad. This specialisation happens automatically (that is, without a+SPECIALISE pragma) as long as the definitions are INLINABLE. For example,+this one change made a 20% allocation difference in perf/compiler/T5030.++-}++-- | This describes how a "map" operation over a type/coercion should behave+data TyCoMapper env m+  = TyCoMapper+      { tcm_tyvar :: env -> TyVar -> m Type+      , tcm_covar :: env -> CoVar -> m Coercion+      , tcm_hole  :: env -> CoercionHole -> m Coercion+          -- ^ What to do with coercion holes.+          -- See Note [Coercion holes] in TyCoRep.++      , tcm_tycobinder :: env -> TyCoVar -> ArgFlag -> m (env, TyCoVar)+          -- ^ The returned env is used in the extended scope++      , tcm_tycon :: TyCon -> m TyCon+          -- ^ This is used only for TcTyCons+          -- a) To zonk TcTyCons+          -- b) To turn TcTyCons into TyCons.+          --    See Note [Type checking recursive type and class declarations]+          --    in TcTyClsDecls+      }++{-# INLINABLE mapType #-}  -- See Note [Specialising mappers]+mapType :: Monad m => TyCoMapper env m -> env -> Type -> m Type+mapType mapper@(TyCoMapper { tcm_tyvar = tyvar+                           , tcm_tycobinder = tycobinder+                           , tcm_tycon = tycon })+        env ty+  = go ty+  where+    go (TyVarTy tv)    = tyvar env tv+    go (AppTy t1 t2)   = mkAppTy <$> go t1 <*> go t2+    go ty@(LitTy {})   = return ty+    go (CastTy ty co)  = mkCastTy <$> go ty <*> mapCoercion mapper env co+    go (CoercionTy co) = CoercionTy <$> mapCoercion mapper env co++    go ty@(FunTy _ arg res)+      = do { arg' <- go arg; res' <- go res+           ; return (ty { ft_arg = arg', ft_res = res' }) }++    go ty@(TyConApp tc tys)+      | isTcTyCon tc+      = do { tc' <- tycon tc+           ; mkTyConApp tc' <$> mapM go tys }++      -- Not a TcTyCon+      | null tys    -- Avoid allocation in this very+      = return ty   -- common case (E.g. Int, LiftedRep etc)++      | otherwise+      = mkTyConApp tc <$> mapM go tys++    go (ForAllTy (Bndr tv vis) inner)+      = do { (env', tv') <- tycobinder env tv vis+           ; inner' <- mapType mapper env' inner+           ; return $ ForAllTy (Bndr tv' vis) inner' }++{-# INLINABLE mapCoercion #-}  -- See Note [Specialising mappers]+mapCoercion :: Monad m+            => TyCoMapper env m -> env -> Coercion -> m Coercion+mapCoercion mapper@(TyCoMapper { tcm_covar = covar+                               , tcm_hole = cohole+                               , tcm_tycobinder = tycobinder+                               , tcm_tycon = tycon })+            env co+  = go co+  where+    go_mco MRefl    = return MRefl+    go_mco (MCo co) = MCo <$> (go co)++    go (Refl ty) = Refl <$> mapType mapper env ty+    go (GRefl r ty mco) = mkGReflCo r <$> mapType mapper env ty <*> (go_mco mco)+    go (TyConAppCo r tc args)+      = do { tc' <- if isTcTyCon tc+                    then tycon tc+                    else return tc+           ; mkTyConAppCo r tc' <$> mapM go args }+    go (AppCo c1 c2) = mkAppCo <$> go c1 <*> go c2+    go (ForAllCo tv kind_co co)+      = do { kind_co' <- go kind_co+           ; (env', tv') <- tycobinder env tv Inferred+           ; co' <- mapCoercion mapper env' co+           ; return $ mkForAllCo tv' kind_co' co' }+        -- See Note [Efficiency for mapCoercion ForAllCo case]+    go (FunCo r c1 c2) = mkFunCo r <$> go c1 <*> go c2+    go (CoVarCo cv) = covar env cv+    go (AxiomInstCo ax i args)+      = mkAxiomInstCo ax i <$> mapM go args+    go (HoleCo hole) = cohole env hole+    go (UnivCo p r t1 t2)+      = mkUnivCo <$> go_prov p <*> pure r+                 <*> mapType mapper env t1 <*> mapType mapper env t2+    go (SymCo co) = mkSymCo <$> go co+    go (TransCo c1 c2) = mkTransCo <$> go c1 <*> go c2+    go (AxiomRuleCo r cos) = AxiomRuleCo r <$> mapM go cos+    go (NthCo r i co)      = mkNthCo r i <$> go co+    go (LRCo lr co)        = mkLRCo lr <$> go co+    go (InstCo co arg)     = mkInstCo <$> go co <*> go arg+    go (KindCo co)         = mkKindCo <$> go co+    go (SubCo co)          = mkSubCo <$> go co++    go_prov UnsafeCoerceProv    = return UnsafeCoerceProv+    go_prov (PhantomProv co)    = PhantomProv <$> go co+    go_prov (ProofIrrelProv co) = ProofIrrelProv <$> go co+    go_prov p@(PluginProv _)    = return p++{-+************************************************************************+*                                                                      *+\subsection{Constructor-specific functions}+*                                                                      *+************************************************************************+++---------------------------------------------------------------------+                                TyVarTy+                                ~~~~~~~+-}++-- | Attempts to obtain the type variable underlying a 'Type', and panics with the+-- given message if this is not a type variable type. See also 'getTyVar_maybe'+getTyVar :: String -> Type -> TyVar+getTyVar msg ty = case getTyVar_maybe ty of+                    Just tv -> tv+                    Nothing -> panic ("getTyVar: " ++ msg)++isTyVarTy :: Type -> Bool+isTyVarTy ty = isJust (getTyVar_maybe ty)++-- | Attempts to obtain the type variable underlying a 'Type'+getTyVar_maybe :: Type -> Maybe TyVar+getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'+                  | otherwise               = repGetTyVar_maybe ty++-- | If the type is a tyvar, possibly under a cast, returns it, along+-- with the coercion. Thus, the co is :: kind tv ~N kind ty+getCastedTyVar_maybe :: Type -> Maybe (TyVar, CoercionN)+getCastedTyVar_maybe ty | Just ty' <- coreView ty = getCastedTyVar_maybe ty'+getCastedTyVar_maybe (CastTy (TyVarTy tv) co)     = Just (tv, co)+getCastedTyVar_maybe (TyVarTy tv)+  = Just (tv, mkReflCo Nominal (tyVarKind tv))+getCastedTyVar_maybe _                            = Nothing++-- | Attempts to obtain the type variable underlying a 'Type', without+-- any expansion+repGetTyVar_maybe :: Type -> Maybe TyVar+repGetTyVar_maybe (TyVarTy tv) = Just tv+repGetTyVar_maybe _            = Nothing++{-+---------------------------------------------------------------------+                                AppTy+                                ~~~~~+We need to be pretty careful with AppTy to make sure we obey the+invariant that a TyConApp is always visibly so.  mkAppTy maintains the+invariant: use it.++Note [Decomposing fat arrow c=>t]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Can we unify (a b) with (Eq a => ty)?   If we do so, we end up with+a partial application like ((=>) Eq a) which doesn't make sense in+source Haskell.  In contrast, we *can* unify (a b) with (t1 -> t2).+Here's an example (#9858) of how you might do it:+   i :: (Typeable a, Typeable b) => Proxy (a b) -> TypeRep+   i p = typeRep p++   j = i (Proxy :: Proxy (Eq Int => Int))+The type (Proxy (Eq Int => Int)) is only accepted with -XImpredicativeTypes,+but suppose we want that.  But then in the call to 'i', we end+up decomposing (Eq Int => Int), and we definitely don't want that.++This really only applies to the type checker; in Core, '=>' and '->'+are the same, as are 'Constraint' and '*'.  But for now I've put+the test in repSplitAppTy_maybe, which applies throughout, because+the other calls to splitAppTy are in Unify, which is also used by+the type checker (e.g. when matching type-function equations).++-}++-- | Applies a type to another, as in e.g. @k a@+mkAppTy :: Type -> Type -> Type+  -- See Note [Respecting definitional equality], invariant (EQ1).+mkAppTy (CastTy fun_ty co) arg_ty+  | ([arg_co], res_co) <- decomposePiCos co (coercionKind co) [arg_ty]+  = (fun_ty `mkAppTy` (arg_ty `mkCastTy` arg_co)) `mkCastTy` res_co++mkAppTy (TyConApp tc tys) ty2 = mkTyConApp tc (tys ++ [ty2])+mkAppTy ty1               ty2 = AppTy ty1 ty2+        -- Note that the TyConApp could be an+        -- under-saturated type synonym.  GHC allows that; e.g.+        --      type Foo k = k a -> k a+        --      type Id x = x+        --      foo :: Foo Id -> Foo Id+        --+        -- Here Id is partially applied in the type sig for Foo,+        -- but once the type synonyms are expanded all is well+        --+        -- Moreover in TcHsTypes.tcInferApps we build up a type+        --   (T t1 t2 t3) one argument at a type, thus forming+        --   (T t1), (T t1 t2), etc++mkAppTys :: Type -> [Type] -> Type+mkAppTys ty1                []   = ty1+mkAppTys (CastTy fun_ty co) arg_tys  -- much more efficient then nested mkAppTy+                                     -- Why do this? See (EQ1) of+                                     -- Note [Respecting definitional equality]+                                     -- in TyCoRep+  = foldl' AppTy ((mkAppTys fun_ty casted_arg_tys) `mkCastTy` res_co) leftovers+  where+    (arg_cos, res_co) = decomposePiCos co (coercionKind co) arg_tys+    (args_to_cast, leftovers) = splitAtList arg_cos arg_tys+    casted_arg_tys = zipWith mkCastTy args_to_cast arg_cos+mkAppTys (TyConApp tc tys1) tys2 = mkTyConApp tc (tys1 ++ tys2)+mkAppTys ty1                tys2 = foldl' AppTy ty1 tys2++-------------+splitAppTy_maybe :: Type -> Maybe (Type, Type)+-- ^ Attempt to take a type application apart, whether it is a+-- function, type constructor, or plain type application. Note+-- that type family applications are NEVER unsaturated by this!+splitAppTy_maybe ty | Just ty' <- coreView ty+                    = splitAppTy_maybe ty'+splitAppTy_maybe ty = repSplitAppTy_maybe ty++-------------+repSplitAppTy_maybe :: HasDebugCallStack => Type -> Maybe (Type,Type)+-- ^ Does the AppTy split as in 'splitAppTy_maybe', but assumes that+-- any Core view stuff is already done+repSplitAppTy_maybe (FunTy _ ty1 ty2)+  = Just (TyConApp funTyCon [rep1, rep2, ty1], ty2)+  where+    rep1 = getRuntimeRep ty1+    rep2 = getRuntimeRep ty2++repSplitAppTy_maybe (AppTy ty1 ty2)+  = Just (ty1, ty2)++repSplitAppTy_maybe (TyConApp tc tys)+  | not (mustBeSaturated tc) || tys `lengthExceeds` tyConArity tc+  , Just (tys', ty') <- snocView tys+  = Just (TyConApp tc tys', ty')    -- Never create unsaturated type family apps!++repSplitAppTy_maybe _other = Nothing++-- This one doesn't break apart (c => t).+-- See Note [Decomposing fat arrow c=>t]+-- Defined here to avoid module loops between Unify and TcType.+tcRepSplitAppTy_maybe :: Type -> Maybe (Type,Type)+-- ^ Does the AppTy split as in 'tcSplitAppTy_maybe', but assumes that+-- any coreView stuff is already done. Refuses to look through (c => t)+tcRepSplitAppTy_maybe (FunTy { ft_af = af, ft_arg = ty1, ft_res = ty2 })+  | InvisArg <- af+  = Nothing  -- See Note [Decomposing fat arrow c=>t]++  | otherwise+  = Just (TyConApp funTyCon [rep1, rep2, ty1], ty2)+  where+    rep1 = getRuntimeRep ty1+    rep2 = getRuntimeRep ty2++tcRepSplitAppTy_maybe (AppTy ty1 ty2)    = Just (ty1, ty2)+tcRepSplitAppTy_maybe (TyConApp tc tys)+  | not (mustBeSaturated tc) || tys `lengthExceeds` tyConArity tc+  , Just (tys', ty') <- snocView tys+  = Just (TyConApp tc tys', ty')    -- Never create unsaturated type family apps!+tcRepSplitAppTy_maybe _other = Nothing++-------------+splitAppTy :: Type -> (Type, Type)+-- ^ Attempts to take a type application apart, as in 'splitAppTy_maybe',+-- and panics if this is not possible+splitAppTy ty = case splitAppTy_maybe ty of+                Just pr -> pr+                Nothing -> panic "splitAppTy"++-------------+splitAppTys :: Type -> (Type, [Type])+-- ^ Recursively splits a type as far as is possible, leaving a residual+-- type being applied to and the type arguments applied to it. Never fails,+-- even if that means returning an empty list of type applications.+splitAppTys ty = split ty ty []+  where+    split orig_ty ty args | Just ty' <- coreView ty = split orig_ty ty' args+    split _       (AppTy ty arg)        args = split ty ty (arg:args)+    split _       (TyConApp tc tc_args) args+      = let -- keep type families saturated+            n | mustBeSaturated tc = tyConArity tc+              | otherwise          = 0+            (tc_args1, tc_args2) = splitAt n tc_args+        in+        (TyConApp tc tc_args1, tc_args2 ++ args)+    split _   (FunTy _ ty1 ty2) args+      = ASSERT( null args )+        (TyConApp funTyCon [], [rep1, rep2, ty1, ty2])+      where+        rep1 = getRuntimeRep ty1+        rep2 = getRuntimeRep ty2++    split orig_ty _                     args  = (orig_ty, args)++-- | Like 'splitAppTys', but doesn't look through type synonyms+repSplitAppTys :: HasDebugCallStack => Type -> (Type, [Type])+repSplitAppTys ty = split ty []+  where+    split (AppTy ty arg) args = split ty (arg:args)+    split (TyConApp tc tc_args) args+      = let n | mustBeSaturated tc = tyConArity tc+              | otherwise          = 0+            (tc_args1, tc_args2) = splitAt n tc_args+        in+        (TyConApp tc tc_args1, tc_args2 ++ args)+    split (FunTy _ ty1 ty2) args+      = ASSERT( null args )+        (TyConApp funTyCon [], [rep1, rep2, ty1, ty2])+      where+        rep1 = getRuntimeRep ty1+        rep2 = getRuntimeRep ty2++    split ty args = (ty, args)++{-+                      LitTy+                      ~~~~~+-}++mkNumLitTy :: Integer -> Type+mkNumLitTy n = LitTy (NumTyLit n)++-- | Is this a numeric literal. We also look through type synonyms.+isNumLitTy :: Type -> Maybe Integer+isNumLitTy ty | Just ty1 <- coreView ty = isNumLitTy ty1+isNumLitTy (LitTy (NumTyLit n)) = Just n+isNumLitTy _                    = Nothing++mkStrLitTy :: FastString -> Type+mkStrLitTy s = LitTy (StrTyLit s)++-- | Is this a symbol literal. We also look through type synonyms.+isStrLitTy :: Type -> Maybe FastString+isStrLitTy ty | Just ty1 <- coreView ty = isStrLitTy ty1+isStrLitTy (LitTy (StrTyLit s)) = Just s+isStrLitTy _                    = Nothing++-- | Is this a type literal (symbol or numeric).+isLitTy :: Type -> Maybe TyLit+isLitTy ty | Just ty1 <- coreView ty = isLitTy ty1+isLitTy (LitTy l)                    = Just l+isLitTy _                            = Nothing++-- | Is this type a custom user error?+-- If so, give us the kind and the error message.+userTypeError_maybe :: Type -> Maybe Type+userTypeError_maybe t+  = do { (tc, _kind : msg : _) <- splitTyConApp_maybe t+          -- There may be more than 2 arguments, if the type error is+          -- used as a type constructor (e.g. at kind `Type -> Type`).++       ; guard (tyConName tc == errorMessageTypeErrorFamName)+       ; return msg }++-- | Render a type corresponding to a user type error into a SDoc.+pprUserTypeErrorTy :: Type -> SDoc+pprUserTypeErrorTy ty =+  case splitTyConApp_maybe ty of++    -- Text "Something"+    Just (tc,[txt])+      | tyConName tc == typeErrorTextDataConName+      , Just str <- isStrLitTy txt -> ftext str++    -- ShowType t+    Just (tc,[_k,t])+      | tyConName tc == typeErrorShowTypeDataConName -> ppr t++    -- t1 :<>: t2+    Just (tc,[t1,t2])+      | tyConName tc == typeErrorAppendDataConName ->+        pprUserTypeErrorTy t1 <> pprUserTypeErrorTy t2++    -- t1 :$$: t2+    Just (tc,[t1,t2])+      | tyConName tc == typeErrorVAppendDataConName ->+        pprUserTypeErrorTy t1 $$ pprUserTypeErrorTy t2++    -- An unevaluated type function+    _ -> ppr ty+++++{-+---------------------------------------------------------------------+                                FunTy+                                ~~~~~++Note [Representation of function types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Functions (e.g. Int -> Char) can be thought of as being applications+of funTyCon (known in Haskell surface syntax as (->)),++    (->) :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)+                   (a :: TYPE r1) (b :: TYPE r2).+            a -> b -> Type++However, for efficiency's sake we represent saturated applications of (->)+with FunTy. For instance, the type,++    (->) r1 r2 a b++is equivalent to,++    FunTy (Anon a) b++Note how the RuntimeReps are implied in the FunTy representation. For this+reason we must be careful when recontructing the TyConApp representation (see,+for instance, splitTyConApp_maybe).++In the compiler we maintain the invariant that all saturated applications of+(->) are represented with FunTy.++See #11714.+-}++splitFunTy :: Type -> (Type, Type)+-- ^ Attempts to extract the argument and result types from a type, and+-- panics if that is not possible. See also 'splitFunTy_maybe'+splitFunTy ty | Just ty' <- coreView ty = splitFunTy ty'+splitFunTy (FunTy _ arg res) = (arg, res)+splitFunTy other             = pprPanic "splitFunTy" (ppr other)++splitFunTy_maybe :: Type -> Maybe (Type, Type)+-- ^ Attempts to extract the argument and result types from a type+splitFunTy_maybe ty | Just ty' <- coreView ty = splitFunTy_maybe ty'+splitFunTy_maybe (FunTy _ arg res) = Just (arg, res)+splitFunTy_maybe _                 = Nothing++splitFunTys :: Type -> ([Type], Type)+splitFunTys ty = split [] ty ty+  where+    split args orig_ty ty | Just ty' <- coreView ty = split args orig_ty ty'+    split args _       (FunTy _ arg res) = split (arg:args) res res+    split args orig_ty _                 = (reverse args, orig_ty)++funResultTy :: Type -> Type+-- ^ Extract the function result type and panic if that is not possible+funResultTy ty | Just ty' <- coreView ty = funResultTy ty'+funResultTy (FunTy { ft_res = res }) = res+funResultTy ty                       = pprPanic "funResultTy" (ppr ty)++funArgTy :: Type -> Type+-- ^ Extract the function argument type and panic if that is not possible+funArgTy ty | Just ty' <- coreView ty = funArgTy ty'+funArgTy (FunTy { ft_arg = arg })    = arg+funArgTy ty                           = pprPanic "funArgTy" (ppr ty)++-- ^ Just like 'piResultTys' but for a single argument+-- Try not to iterate 'piResultTy', because it's inefficient to substitute+-- one variable at a time; instead use 'piResultTys"+piResultTy :: HasDebugCallStack => Type -> Type ->  Type+piResultTy ty arg = case piResultTy_maybe ty arg of+                      Just res -> res+                      Nothing  -> pprPanic "piResultTy" (ppr ty $$ ppr arg)++piResultTy_maybe :: Type -> Type -> Maybe Type+-- We don't need a 'tc' version, because+-- this function behaves the same for Type and Constraint+piResultTy_maybe ty arg+  | Just ty' <- coreView ty = piResultTy_maybe ty' arg++  | FunTy { ft_res = res } <- ty+  = Just res++  | ForAllTy (Bndr tv _) res <- ty+  = let empty_subst = mkEmptyTCvSubst $ mkInScopeSet $+                      tyCoVarsOfTypes [arg,res]+    in Just (substTy (extendTCvSubst empty_subst tv arg) res)++  | otherwise+  = Nothing++-- | (piResultTys f_ty [ty1, .., tyn]) gives the type of (f ty1 .. tyn)+--   where f :: f_ty+-- 'piResultTys' is interesting because:+--      1. 'f_ty' may have more for-alls than there are args+--      2. Less obviously, it may have fewer for-alls+-- For case 2. think of:+--   piResultTys (forall a.a) [forall b.b, Int]+-- This really can happen, but only (I think) in situations involving+-- undefined.  For example:+--       undefined :: forall a. a+-- Term: undefined @(forall b. b->b) @Int+-- This term should have type (Int -> Int), but notice that+-- there are more type args than foralls in 'undefined's type.++-- If you edit this function, you may need to update the GHC formalism+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs++-- This is a heavily used function (e.g. from typeKind),+-- so we pay attention to efficiency, especially in the special case+-- where there are no for-alls so we are just dropping arrows from+-- a function type/kind.+piResultTys :: HasDebugCallStack => Type -> [Type] -> Type+piResultTys ty [] = ty+piResultTys ty orig_args@(arg:args)+  | Just ty' <- coreView ty+  = piResultTys ty' orig_args++  | FunTy { ft_res = res } <- ty+  = piResultTys res args++  | ForAllTy (Bndr tv _) res <- ty+  = go (extendTCvSubst init_subst tv arg) res args++  | otherwise+  = pprPanic "piResultTys1" (ppr ty $$ ppr orig_args)+  where+    init_subst = mkEmptyTCvSubst $ mkInScopeSet (tyCoVarsOfTypes (ty:orig_args))++    go :: TCvSubst -> Type -> [Type] -> Type+    go subst ty [] = substTy subst ty++    go subst ty all_args@(arg:args)+      | Just ty' <- coreView ty+      = go subst ty' all_args++      | FunTy { ft_res = res } <- ty+      = go subst res args++      | ForAllTy (Bndr tv _) res <- ty+      = go (extendTCvSubst subst tv arg) res args++      | not (isEmptyTCvSubst subst)  -- See Note [Care with kind instantiation]+      = go init_subst+          (substTy subst ty)+          all_args++      | otherwise+      = -- We have not run out of arguments, but the function doesn't+        -- have the right kind to apply to them; so panic.+        -- Without the explicit isEmptyVarEnv test, an ill-kinded type+        -- would give an infniite loop, which is very unhelpful+        -- c.f. #15473+        pprPanic "piResultTys2" (ppr ty $$ ppr orig_args $$ ppr all_args)++applyTysX :: [TyVar] -> Type -> [Type] -> Type+-- applyTyxX beta-reduces (/\tvs. body_ty) arg_tys+-- Assumes that (/\tvs. body_ty) is closed+applyTysX tvs body_ty arg_tys+  = ASSERT2( arg_tys `lengthAtLeast` n_tvs, pp_stuff )+    ASSERT2( tyCoVarsOfType body_ty `subVarSet` mkVarSet tvs, pp_stuff )+    mkAppTys (substTyWith tvs (take n_tvs arg_tys) body_ty)+             (drop n_tvs arg_tys)+  where+    pp_stuff = vcat [ppr tvs, ppr body_ty, ppr arg_tys]+    n_tvs = length tvs++++{- Note [Care with kind instantiation]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have+  T :: forall k. k+and we are finding the kind of+  T (forall b. b -> b) * Int+Then+  T (forall b. b->b) :: k[ k :-> forall b. b->b]+                     :: forall b. b -> b+So+  T (forall b. b->b) * :: (b -> b)[ b :-> *]+                       :: * -> *++In other words we must intantiate the forall!++Similarly (#15428)+   S :: forall k f. k -> f k+and we are finding the kind of+   S * (* ->) Int Bool+We have+   S * (* ->) :: (k -> f k)[ k :-> *, f :-> (* ->)]+              :: * -> * -> *+So again we must instantiate.++The same thing happens in ToIface.toIfaceAppArgsX.+++---------------------------------------------------------------------+                                TyConApp+                                ~~~~~~~~+-}++-- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to+-- its arguments.  Applies its arguments to the constructor from left to right.+mkTyConApp :: TyCon -> [Type] -> Type+mkTyConApp tycon tys+  | isFunTyCon tycon+  , [_rep1,_rep2,ty1,ty2] <- tys+  = FunTy { ft_af = VisArg, ft_arg = ty1, ft_res = ty2 }+    -- The FunTyCon (->) is always a visible one++  | otherwise+  = TyConApp tycon tys++-- splitTyConApp "looks through" synonyms, because they don't+-- mean a distinct type, but all other type-constructor applications+-- including functions are returned as Just ..++-- | Retrieve the tycon heading this type, if there is one. Does /not/+-- look through synonyms.+tyConAppTyConPicky_maybe :: Type -> Maybe TyCon+tyConAppTyConPicky_maybe (TyConApp tc _) = Just tc+tyConAppTyConPicky_maybe (FunTy {})      = Just funTyCon+tyConAppTyConPicky_maybe _               = Nothing+++-- | The same as @fst . splitTyConApp@+tyConAppTyCon_maybe :: Type -> Maybe TyCon+tyConAppTyCon_maybe ty | Just ty' <- coreView ty = tyConAppTyCon_maybe ty'+tyConAppTyCon_maybe (TyConApp tc _) = Just tc+tyConAppTyCon_maybe (FunTy {})      = Just funTyCon+tyConAppTyCon_maybe _               = Nothing++tyConAppTyCon :: Type -> TyCon+tyConAppTyCon ty = tyConAppTyCon_maybe ty `orElse` pprPanic "tyConAppTyCon" (ppr ty)++-- | The same as @snd . splitTyConApp@+tyConAppArgs_maybe :: Type -> Maybe [Type]+tyConAppArgs_maybe ty | Just ty' <- coreView ty = tyConAppArgs_maybe ty'+tyConAppArgs_maybe (TyConApp _ tys) = Just tys+tyConAppArgs_maybe (FunTy _ arg res)+  | Just rep1 <- getRuntimeRep_maybe arg+  , Just rep2 <- getRuntimeRep_maybe res+  = Just [rep1, rep2, arg, res]+tyConAppArgs_maybe _  = Nothing++tyConAppArgs :: Type -> [Type]+tyConAppArgs ty = tyConAppArgs_maybe ty `orElse` pprPanic "tyConAppArgs" (ppr ty)++tyConAppArgN :: Int -> Type -> Type+-- Executing Nth+tyConAppArgN n ty+  = case tyConAppArgs_maybe ty of+      Just tys -> ASSERT2( tys `lengthExceeds` n, ppr n <+> ppr tys ) tys `getNth` n+      Nothing  -> pprPanic "tyConAppArgN" (ppr n <+> ppr ty)++-- | Attempts to tease a type apart into a type constructor and the application+-- of a number of arguments to that constructor. Panics if that is not possible.+-- See also 'splitTyConApp_maybe'+splitTyConApp :: Type -> (TyCon, [Type])+splitTyConApp ty = case splitTyConApp_maybe ty of+                   Just stuff -> stuff+                   Nothing    -> pprPanic "splitTyConApp" (ppr ty)++-- | Attempts to tease a type apart into a type constructor and the application+-- of a number of arguments to that constructor+splitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])+splitTyConApp_maybe ty | Just ty' <- coreView ty = splitTyConApp_maybe ty'+splitTyConApp_maybe ty                           = repSplitTyConApp_maybe ty++-------------------+repSplitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])+-- ^ Like 'splitTyConApp_maybe', but doesn't look through synonyms. This+-- assumes the synonyms have already been dealt with.+--+-- Moreover, for a FunTy, it only succeeds if the argument types+-- have enough info to extract the runtime-rep arguments that+-- the funTyCon requires.  This will usually be true;+-- but may be temporarily false during canonicalization:+--     see Note [FunTy and decomposing tycon applications] in TcCanonical+--+repSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)+repSplitTyConApp_maybe (FunTy _ arg res)+  | Just arg_rep <- getRuntimeRep_maybe arg+  , Just res_rep <- getRuntimeRep_maybe res+  = Just (funTyCon, [arg_rep, res_rep, arg, res])+repSplitTyConApp_maybe _ = Nothing++-------------------+-- | Attempts to tease a list type apart and gives the type of the elements if+-- successful (looks through type synonyms)+splitListTyConApp_maybe :: Type -> Maybe Type+splitListTyConApp_maybe ty = case splitTyConApp_maybe ty of+  Just (tc,[e]) | tc == listTyCon -> Just e+  _other                          -> Nothing++nextRole :: Type -> Role+nextRole ty+  | Just (tc, tys) <- splitTyConApp_maybe ty+  , let num_tys = length tys+  , num_tys < tyConArity tc+  = tyConRoles tc `getNth` num_tys++  | otherwise+  = Nominal++newTyConInstRhs :: TyCon -> [Type] -> Type+-- ^ Unwrap one 'layer' of newtype on a type constructor and its+-- arguments, using an eta-reduced version of the @newtype@ if possible.+-- This requires tys to have at least @newTyConInstArity tycon@ elements.+newTyConInstRhs tycon tys+    = ASSERT2( tvs `leLength` tys, ppr tycon $$ ppr tys $$ ppr tvs )+      applyTysX tvs rhs tys+  where+    (tvs, rhs) = newTyConEtadRhs tycon++{-+---------------------------------------------------------------------+                           CastTy+                           ~~~~~~+A casted type has its *kind* casted into something new.+-}++splitCastTy_maybe :: Type -> Maybe (Type, Coercion)+splitCastTy_maybe ty | Just ty' <- coreView ty = splitCastTy_maybe ty'+splitCastTy_maybe (CastTy ty co)               = Just (ty, co)+splitCastTy_maybe _                            = Nothing++-- | Make a 'CastTy'. The Coercion must be nominal. Checks the+-- Coercion for reflexivity, dropping it if it's reflexive.+-- See Note [Respecting definitional equality] in TyCoRep+mkCastTy :: Type -> Coercion -> Type+mkCastTy ty co | isReflexiveCo co = ty  -- (EQ2) from the Note+-- NB: Do the slow check here. This is important to keep the splitXXX+-- functions working properly. Otherwise, we may end up with something+-- like (((->) |> something_reflexive_but_not_obviously_so) biz baz)+-- fails under splitFunTy_maybe. This happened with the cheaper check+-- in test dependent/should_compile/dynamic-paper.++mkCastTy (CastTy ty co1) co2+  -- (EQ3) from the Note+  = mkCastTy ty (co1 `mkTransCo` co2)+      -- call mkCastTy again for the reflexivity check++mkCastTy (ForAllTy (Bndr tv vis) inner_ty) co+  -- (EQ4) from the Note+  | isTyVar tv+  , let fvs = tyCoVarsOfCo co+  = -- have to make sure that pushing the co in doesn't capture the bound var!+    if tv `elemVarSet` fvs+    then let empty_subst = mkEmptyTCvSubst (mkInScopeSet fvs)+             (subst, tv') = substVarBndr empty_subst tv+         in ForAllTy (Bndr tv' vis) (substTy subst inner_ty `mkCastTy` co)+    else ForAllTy (Bndr tv vis) (inner_ty `mkCastTy` co)++mkCastTy ty co = CastTy ty co++tyConBindersTyCoBinders :: [TyConBinder] -> [TyCoBinder]+-- Return the tyConBinders in TyCoBinder form+tyConBindersTyCoBinders = map to_tyb+  where+    to_tyb (Bndr tv (NamedTCB vis)) = Named (Bndr tv vis)+    to_tyb (Bndr tv (AnonTCB af))   = Anon af (varType tv)++{-+--------------------------------------------------------------------+                            CoercionTy+                            ~~~~~~~~~~+CoercionTy allows us to inject coercions into types. A CoercionTy+should appear only in the right-hand side of an application.+-}++mkCoercionTy :: Coercion -> Type+mkCoercionTy = CoercionTy++isCoercionTy :: Type -> Bool+isCoercionTy (CoercionTy _) = True+isCoercionTy _              = False++isCoercionTy_maybe :: Type -> Maybe Coercion+isCoercionTy_maybe (CoercionTy co) = Just co+isCoercionTy_maybe _               = Nothing++stripCoercionTy :: Type -> Coercion+stripCoercionTy (CoercionTy co) = co+stripCoercionTy ty              = pprPanic "stripCoercionTy" (ppr ty)++{-+---------------------------------------------------------------------+                                SynTy+                                ~~~~~++Notes on type synonyms+~~~~~~~~~~~~~~~~~~~~~~+The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try+to return type synonyms wherever possible. Thus++        type Foo a = a -> a++we want+        splitFunTys (a -> Foo a) = ([a], Foo a)+not                                ([a], a -> a)++The reason is that we then get better (shorter) type signatures in+interfaces.  Notably this plays a role in tcTySigs in TcBinds.hs.+++---------------------------------------------------------------------+                                ForAllTy+                                ~~~~~~~~+-}++-- | Make a dependent forall over an 'Inferred' variable+mkTyCoInvForAllTy :: TyCoVar -> Type -> Type+mkTyCoInvForAllTy tv ty+  | isCoVar tv+  , not (tv `elemVarSet` tyCoVarsOfType ty)+  = mkVisFunTy (varType tv) ty+  | otherwise+  = ForAllTy (Bndr tv Inferred) ty++-- | Like 'mkTyCoInvForAllTy', but tv should be a tyvar+mkInvForAllTy :: TyVar -> Type -> Type+mkInvForAllTy tv ty = ASSERT( isTyVar tv )+                      ForAllTy (Bndr tv Inferred) ty++-- | Like 'mkForAllTys', but assumes all variables are dependent and+-- 'Inferred', a common case+mkTyCoInvForAllTys :: [TyCoVar] -> Type -> Type+mkTyCoInvForAllTys tvs ty = foldr mkTyCoInvForAllTy ty tvs++-- | Like 'mkTyCoInvForAllTys', but tvs should be a list of tyvar+mkInvForAllTys :: [TyVar] -> Type -> Type+mkInvForAllTys tvs ty = foldr mkInvForAllTy ty tvs++-- | Like 'mkForAllTy', but assumes the variable is dependent and 'Specified',+-- a common case+mkSpecForAllTy :: TyVar -> Type -> Type+mkSpecForAllTy tv ty = ASSERT( isTyVar tv )+                       -- covar is always Inferred, so input should be tyvar+                       ForAllTy (Bndr tv Specified) ty++-- | Like 'mkForAllTys', but assumes all variables are dependent and+-- 'Specified', a common case+mkSpecForAllTys :: [TyVar] -> Type -> Type+mkSpecForAllTys tvs ty = foldr mkSpecForAllTy ty tvs++-- | Like mkForAllTys, but assumes all variables are dependent and visible+mkVisForAllTys :: [TyVar] -> Type -> Type+mkVisForAllTys tvs = ASSERT( all isTyVar tvs )+                     -- covar is always Inferred, so all inputs should be tyvar+                     mkForAllTys [ Bndr tv Required | tv <- tvs ]++mkLamType  :: Var -> Type -> Type+-- ^ Makes a @(->)@ type or an implicit forall type, depending+-- on whether it is given a type variable or a term variable.+-- This is used, for example, when producing the type of a lambda.+-- Always uses Inferred binders.+mkLamTypes :: [Var] -> Type -> Type+-- ^ 'mkLamType' for multiple type or value arguments++mkLamType v body_ty+   | isTyVar v+   = ForAllTy (Bndr v Inferred) body_ty++   | isCoVar v+   , v `elemVarSet` tyCoVarsOfType body_ty+   = ForAllTy (Bndr v Required) body_ty++   | isPredTy arg_ty  -- See Note [mkLamType: dictionary arguments]+   = mkInvisFunTy arg_ty body_ty++   | otherwise+   = mkVisFunTy arg_ty body_ty+   where+     arg_ty = varType v++mkLamTypes vs ty = foldr mkLamType ty vs++{- Note [mkLamType: dictionary arguments]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If we have (\ (d :: Ord a). blah), we want to give it type+           (Ord a => blah_ty)+with a fat arrow; that is, using mkInvisFunTy, not mkVisFunTy.++Why? After all, we are in Core, where (=>) and (->) behave the same.+Yes, but the /specialiser/ does treat dictionary arguments specially.+Suppose we do w/w on 'foo' in module A, thus (#11272, #6056)+   foo :: Ord a => Int -> blah+   foo a d x = case x of I# x' -> $wfoo @a d x'++   $wfoo :: Ord a => Int# -> blah++Now in module B we see (foo @Int dOrdInt).  The specialiser will+specialise this to $sfoo, where+   $sfoo :: Int -> blah+   $sfoo x = case x of I# x' -> $wfoo @Int dOrdInt x'++Now we /must/ also specialise $wfoo!  But it wasn't user-written,+and has a type built with mkLamTypes.++Conclusion: the easiest thing is to make mkLamType build+            (c => ty)+when the argument is a predicate type.  See TyCoRep+Note [Types for coercions, predicates, and evidence]+-}++-- | Given a list of type-level vars and the free vars of a result kind,+-- makes TyCoBinders, preferring anonymous binders+-- if the variable is, in fact, not dependent.+-- e.g.    mkTyConBindersPreferAnon [(k:*),(b:k),(c:k)] (k->k)+-- We want (k:*) Named, (b:k) Anon, (c:k) Anon+--+-- All non-coercion binders are /visible/.+mkTyConBindersPreferAnon :: [TyVar]      -- ^ binders+                         -> TyCoVarSet   -- ^ free variables of result+                         -> [TyConBinder]+mkTyConBindersPreferAnon vars inner_tkvs = ASSERT( all isTyVar vars)+                                           fst (go vars)+  where+    go :: [TyVar] -> ([TyConBinder], VarSet) -- also returns the free vars+    go [] = ([], inner_tkvs)+    go (v:vs) | v `elemVarSet` fvs+              = ( Bndr v (NamedTCB Required) : binders+                , fvs `delVarSet` v `unionVarSet` kind_vars )+              | otherwise+              = ( Bndr v (AnonTCB VisArg) : binders+                , fvs `unionVarSet` kind_vars )+      where+        (binders, fvs) = go vs+        kind_vars      = tyCoVarsOfType $ tyVarKind v++-- | Take a ForAllTy apart, returning the list of tycovars and the result type.+-- This always succeeds, even if it returns only an empty list. Note that the+-- result type returned may have free variables that were bound by a forall.+splitForAllTys :: Type -> ([TyCoVar], Type)+splitForAllTys ty = split ty ty []+  where+    split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs+    split _       (ForAllTy (Bndr tv _) ty)    tvs = split ty ty (tv:tvs)+    split orig_ty _                            tvs = (reverse tvs, orig_ty)++-- | Like 'splitForAllTys', but only splits a 'ForAllTy' if+-- @'sameVis' argf supplied_argf@ is 'True', where @argf@ is the visibility+-- of the @ForAllTy@'s binder and @supplied_argf@ is the visibility provided+-- as an argument to this function.+splitForAllTysSameVis :: ArgFlag -> Type -> ([TyCoVar], Type)+splitForAllTysSameVis supplied_argf ty = split ty ty []+  where+    split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs+    split _       (ForAllTy (Bndr tv argf) ty) tvs+      | argf `sameVis` supplied_argf               = split ty ty (tv:tvs)+    split orig_ty _                            tvs = (reverse tvs, orig_ty)++-- | Like splitForAllTys, but split only for tyvars.+-- This always succeeds, even if it returns only an empty list. Note that the+-- result type returned may have free variables that were bound by a forall.+splitTyVarForAllTys :: Type -> ([TyVar], Type)+splitTyVarForAllTys ty = split ty ty []+  where+    split orig_ty ty tvs | Just ty' <- coreView ty     = split orig_ty ty' tvs+    split _ (ForAllTy (Bndr tv _) ty) tvs | isTyVar tv = split ty ty (tv:tvs)+    split orig_ty _                   tvs              = (reverse tvs, orig_ty)++-- | Checks whether this is a proper forall (with a named binder)+isForAllTy :: Type -> Bool+isForAllTy ty | Just ty' <- coreView ty = isForAllTy ty'+isForAllTy (ForAllTy {}) = True+isForAllTy _             = False++-- | Like `isForAllTy`, but returns True only if it is a tyvar binder+isForAllTy_ty :: Type -> Bool+isForAllTy_ty ty | Just ty' <- coreView ty = isForAllTy_ty ty'+isForAllTy_ty (ForAllTy (Bndr tv _) _) | isTyVar tv = True+isForAllTy_ty _             = False++-- | Like `isForAllTy`, but returns True only if it is a covar binder+isForAllTy_co :: Type -> Bool+isForAllTy_co ty | Just ty' <- coreView ty = isForAllTy_co ty'+isForAllTy_co (ForAllTy (Bndr tv _) _) | isCoVar tv = True+isForAllTy_co _             = False++-- | Is this a function or forall?+isPiTy :: Type -> Bool+isPiTy ty | Just ty' <- coreView ty = isPiTy ty'+isPiTy (ForAllTy {}) = True+isPiTy (FunTy {})    = True+isPiTy _             = False++-- | Is this a function?+isFunTy :: Type -> Bool+isFunTy ty | Just ty' <- coreView ty = isFunTy ty'+isFunTy (FunTy {}) = True+isFunTy _          = False++-- | Take a forall type apart, or panics if that is not possible.+splitForAllTy :: Type -> (TyCoVar, Type)+splitForAllTy ty+  | Just answer <- splitForAllTy_maybe ty = answer+  | otherwise                             = pprPanic "splitForAllTy" (ppr ty)++-- | Drops all ForAllTys+dropForAlls :: Type -> Type+dropForAlls ty = go ty+  where+    go ty | Just ty' <- coreView ty = go ty'+    go (ForAllTy _ res)            = go res+    go res                         = res++-- | Attempts to take a forall type apart, but only if it's a proper forall,+-- with a named binder+splitForAllTy_maybe :: Type -> Maybe (TyCoVar, Type)+splitForAllTy_maybe ty = go ty+  where+    go ty | Just ty' <- coreView ty = go ty'+    go (ForAllTy (Bndr tv _) ty)    = Just (tv, ty)+    go _                            = Nothing++-- | Like splitForAllTy_maybe, but only returns Just if it is a tyvar binder.+splitForAllTy_ty_maybe :: Type -> Maybe (TyCoVar, Type)+splitForAllTy_ty_maybe ty = go ty+  where+    go ty | Just ty' <- coreView ty = go ty'+    go (ForAllTy (Bndr tv _) ty) | isTyVar tv = Just (tv, ty)+    go _                            = Nothing++-- | Like splitForAllTy_maybe, but only returns Just if it is a covar binder.+splitForAllTy_co_maybe :: Type -> Maybe (TyCoVar, Type)+splitForAllTy_co_maybe ty = go ty+  where+    go ty | Just ty' <- coreView ty = go ty'+    go (ForAllTy (Bndr tv _) ty) | isCoVar tv = Just (tv, ty)+    go _                            = Nothing++-- | Attempts to take a forall type apart; works with proper foralls and+-- functions+splitPiTy_maybe :: Type -> Maybe (TyCoBinder, Type)+splitPiTy_maybe ty = go ty+  where+    go ty | Just ty' <- coreView ty = go ty'+    go (ForAllTy bndr ty) = Just (Named bndr, ty)+    go (FunTy { ft_af = af, ft_arg = arg, ft_res = res})+                          = Just (Anon af arg, res)+    go _                  = Nothing++-- | Takes a forall type apart, or panics+splitPiTy :: Type -> (TyCoBinder, Type)+splitPiTy ty+  | Just answer <- splitPiTy_maybe ty = answer+  | otherwise                         = pprPanic "splitPiTy" (ppr ty)++-- | Split off all TyCoBinders to a type, splitting both proper foralls+-- and functions+splitPiTys :: Type -> ([TyCoBinder], Type)+splitPiTys ty = split ty ty []+  where+    split orig_ty ty bs | Just ty' <- coreView ty = split orig_ty ty' bs+    split _       (ForAllTy b res) bs = split res res (Named b  : bs)+    split _       (FunTy { ft_af = af, ft_arg = arg, ft_res = res }) bs+                                      = split res res (Anon af arg : bs)+    split orig_ty _                bs = (reverse bs, orig_ty)++-- | Like 'splitPiTys' but split off only /named/ binders+--   and returns TyCoVarBinders rather than TyCoBinders+splitForAllVarBndrs :: Type -> ([TyCoVarBinder], Type)+splitForAllVarBndrs ty = split ty ty []+  where+    split orig_ty ty bs | Just ty' <- coreView ty = split orig_ty ty' bs+    split _       (ForAllTy b res) bs = split res res (b:bs)+    split orig_ty _                bs = (reverse bs, orig_ty)+{-# INLINE splitForAllVarBndrs #-}++invisibleTyBndrCount :: Type -> Int+-- Returns the number of leading invisible forall'd binders in the type+-- Includes invisible predicate arguments; e.g. for+--    e.g.  forall {k}. (k ~ *) => k -> k+-- returns 2 not 1+invisibleTyBndrCount ty = length (fst (splitPiTysInvisible ty))++-- Like splitPiTys, but returns only *invisible* binders, including constraints+-- Stops at the first visible binder+splitPiTysInvisible :: Type -> ([TyCoBinder], Type)+splitPiTysInvisible ty = split ty ty []+   where+    split orig_ty ty bs+      | Just ty' <- coreView ty  = split orig_ty ty' bs+    split _ (ForAllTy b res) bs+      | Bndr _ vis <- b+      , isInvisibleArgFlag vis   = split res res (Named b  : bs)+    split _ (FunTy { ft_af = InvisArg, ft_arg = arg, ft_res = res })  bs+                                 = split res res (Anon InvisArg arg : bs)+    split orig_ty _          bs  = (reverse bs, orig_ty)++splitPiTysInvisibleN :: Int -> Type -> ([TyCoBinder], Type)+-- Same as splitPiTysInvisible, but stop when+--   - you have found 'n' TyCoBinders,+--   - or you run out of invisible binders+splitPiTysInvisibleN n ty = split n ty ty []+   where+    split n orig_ty ty bs+      | n == 0                  = (reverse bs, orig_ty)+      | Just ty' <- coreView ty = split n orig_ty ty' bs+      | ForAllTy b res <- ty+      , Bndr _ vis <- b+      , isInvisibleArgFlag vis  = split (n-1) res res (Named b  : bs)+      | FunTy { ft_af = InvisArg, ft_arg = arg, ft_res = res } <- ty+                                = split (n-1) res res (Anon InvisArg arg : bs)+      | otherwise               = (reverse bs, orig_ty)++-- | Given a 'TyCon' and a list of argument types, filter out any invisible+-- (i.e., 'Inferred' or 'Specified') arguments.+filterOutInvisibleTypes :: TyCon -> [Type] -> [Type]+filterOutInvisibleTypes tc tys = snd $ partitionInvisibleTypes tc tys++-- | Given a 'TyCon' and a list of argument types, filter out any 'Inferred'+-- arguments.+filterOutInferredTypes :: TyCon -> [Type] -> [Type]+filterOutInferredTypes tc tys =+  filterByList (map (/= Inferred) $ tyConArgFlags tc tys) tys++-- | Given a 'TyCon' and a list of argument types, partition the arguments+-- into:+--+-- 1. 'Inferred' or 'Specified' (i.e., invisible) arguments and+--+-- 2. 'Required' (i.e., visible) arguments+partitionInvisibleTypes :: TyCon -> [Type] -> ([Type], [Type])+partitionInvisibleTypes tc tys =+  partitionByList (map isInvisibleArgFlag $ tyConArgFlags tc tys) tys++-- | Given a list of things paired with their visibilities, partition the+-- things into (invisible things, visible things).+partitionInvisibles :: [(a, ArgFlag)] -> ([a], [a])+partitionInvisibles = partitionWith pick_invis+  where+    pick_invis :: (a, ArgFlag) -> Either a a+    pick_invis (thing, vis) | isInvisibleArgFlag vis = Left thing+                            | otherwise              = Right thing++-- | Given a 'TyCon' and a list of argument types to which the 'TyCon' is+-- applied, determine each argument's visibility+-- ('Inferred', 'Specified', or 'Required').+--+-- Wrinkle: consider the following scenario:+--+-- > T :: forall k. k -> k+-- > tyConArgFlags T [forall m. m -> m -> m, S, R, Q]+--+-- After substituting, we get+--+-- > T (forall m. m -> m -> m) :: (forall m. m -> m -> m) -> forall n. n -> n -> n+--+-- Thus, the first argument is invisible, @S@ is visible, @R@ is invisible again,+-- and @Q@ is visible.+tyConArgFlags :: TyCon -> [Type] -> [ArgFlag]+tyConArgFlags tc = fun_kind_arg_flags (tyConKind tc)++-- | Given a 'Type' and a list of argument types to which the 'Type' is+-- applied, determine each argument's visibility+-- ('Inferred', 'Specified', or 'Required').+--+-- Most of the time, the arguments will be 'Required', but not always. Consider+-- @f :: forall a. a -> Type@. In @f Type Bool@, the first argument (@Type@) is+-- 'Specified' and the second argument (@Bool@) is 'Required'. It is precisely+-- this sort of higher-rank situation in which 'appTyArgFlags' comes in handy,+-- since @f Type Bool@ would be represented in Core using 'AppTy's.+-- (See also #15792).+appTyArgFlags :: Type -> [Type] -> [ArgFlag]+appTyArgFlags ty = fun_kind_arg_flags (typeKind ty)++-- | Given a function kind and a list of argument types (where each argument's+-- kind aligns with the corresponding position in the argument kind), determine+-- each argument's visibility ('Inferred', 'Specified', or 'Required').+fun_kind_arg_flags :: Kind -> [Type] -> [ArgFlag]+fun_kind_arg_flags = go emptyTCvSubst+  where+    go subst ki arg_tys+      | Just ki' <- coreView ki = go subst ki' arg_tys+    go _ _ [] = []+    go subst (ForAllTy (Bndr tv argf) res_ki) (arg_ty:arg_tys)+      = argf : go subst' res_ki arg_tys+      where+        subst' = extendTvSubst subst tv arg_ty+    go subst (TyVarTy tv) arg_tys+      | Just ki <- lookupTyVar subst tv = go subst ki arg_tys+    go _ _ arg_tys = map (const Required) arg_tys+                        -- something is ill-kinded. But this can happen+                        -- when printing errors. Assume everything is Required.++-- @isTauTy@ tests if a type has no foralls+isTauTy :: Type -> Bool+isTauTy ty | Just ty' <- coreView ty = isTauTy ty'+isTauTy (TyVarTy _)           = True+isTauTy (LitTy {})            = True+isTauTy (TyConApp tc tys)     = all isTauTy tys && isTauTyCon tc+isTauTy (AppTy a b)           = isTauTy a && isTauTy b+isTauTy (FunTy _ a b)         = isTauTy a && isTauTy b+isTauTy (ForAllTy {})         = False+isTauTy (CastTy ty _)         = isTauTy ty+isTauTy (CoercionTy _)        = False  -- Not sure about this++{-+%************************************************************************+%*                                                                      *+   TyCoBinders+%*                                                                      *+%************************************************************************+-}++-- | Make an anonymous binder+mkAnonBinder :: AnonArgFlag -> Type -> TyCoBinder+mkAnonBinder = Anon++-- | Does this binder bind a variable that is /not/ erased? Returns+-- 'True' for anonymous binders.+isAnonTyCoBinder :: TyCoBinder -> Bool+isAnonTyCoBinder (Named {}) = False+isAnonTyCoBinder (Anon {})  = True++tyCoBinderVar_maybe :: TyCoBinder -> Maybe TyCoVar+tyCoBinderVar_maybe (Named tv) = Just $ binderVar tv+tyCoBinderVar_maybe _          = Nothing++tyCoBinderType :: TyCoBinder -> Type+-- Barely used+tyCoBinderType (Named tvb) = binderType tvb+tyCoBinderType (Anon _ ty) = ty++tyBinderType :: TyBinder -> Type+tyBinderType (Named (Bndr tv _))+  = ASSERT( isTyVar tv )+    tyVarKind tv+tyBinderType (Anon _ ty)   = ty++-- | Extract a relevant type, if there is one.+binderRelevantType_maybe :: TyCoBinder -> Maybe Type+binderRelevantType_maybe (Named {})  = Nothing+binderRelevantType_maybe (Anon _ ty) = Just ty++{-+%************************************************************************+%*                                                                      *+                         Pred+*                                                                      *+************************************************************************++Predicates on PredType++Note [Evidence for quantified constraints]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The superclass mechanism in TcCanonical.makeSuperClasses risks+taking a quantified constraint like+   (forall a. C a => a ~ b)+and generate superclass evidence+   (forall a. C a => a ~# b)++This is a funny thing: neither isPredTy nor isCoVarType are true+of it.  So we are careful not to generate it in the first place:+see Note [Equality superclasses in quantified constraints]+in TcCanonical.+-}++-- | Split a type constructor application into its type constructor and+-- applied types. Note that this may fail in the case of a 'FunTy' with an+-- argument of unknown kind 'FunTy' (e.g. @FunTy (a :: k) Int@. since the kind+-- of @a@ isn't of the form @TYPE rep@). Consequently, you may need to zonk your+-- type before using this function.+--+-- If you only need the 'TyCon', consider using 'tcTyConAppTyCon_maybe'.+tcSplitTyConApp_maybe :: HasCallStack => Type -> Maybe (TyCon, [Type])+-- Defined here to avoid module loops between Unify and TcType.+tcSplitTyConApp_maybe ty | Just ty' <- tcView ty = tcSplitTyConApp_maybe ty'+tcSplitTyConApp_maybe ty                         = repSplitTyConApp_maybe ty++-- tcIsConstraintKind stuf only makes sense in the typechecker+-- After that Constraint = Type+-- See Note [coreView vs tcView]+-- Defined here because it is used in isPredTy and tcRepSplitAppTy_maybe (sigh)+tcIsConstraintKind :: Kind -> Bool+tcIsConstraintKind ty+  | Just (tc, args) <- tcSplitTyConApp_maybe ty    -- Note: tcSplit here+  , isConstraintKindCon tc+  = ASSERT2( null args, ppr ty ) True++  | otherwise+  = False++-- | Is this kind equivalent to @*@?+--+-- This considers 'Constraint' to be distinct from @*@. For a version that+-- treats them as the same type, see 'isLiftedTypeKind'.+tcIsLiftedTypeKind :: Kind -> Bool+tcIsLiftedTypeKind ty+  | Just (tc, [arg]) <- tcSplitTyConApp_maybe ty    -- Note: tcSplit here+  , tc `hasKey` tYPETyConKey+  = isLiftedRuntimeRep arg+  | otherwise+  = False++tcReturnsConstraintKind :: Kind -> Bool+-- True <=> the Kind ultimately returns a Constraint+--   E.g.  * -> Constraint+--         forall k. k -> Constraint+tcReturnsConstraintKind kind+  | Just kind' <- tcView kind = tcReturnsConstraintKind kind'+tcReturnsConstraintKind (ForAllTy _ ty)         = tcReturnsConstraintKind ty+tcReturnsConstraintKind (FunTy { ft_res = ty }) = tcReturnsConstraintKind ty+tcReturnsConstraintKind (TyConApp tc _)         = isConstraintKindCon tc+tcReturnsConstraintKind _                       = False++isEvVarType :: Type -> Bool+-- True of (a) predicates, of kind Constraint, such as (Eq a), and (a ~ b)+--         (b) coercion types, such as (t1 ~# t2) or (t1 ~R# t2)+-- See Note [Types for coercions, predicates, and evidence]+-- See Note [Evidence for quantified constraints]+isEvVarType ty = isCoVarType ty || isPredTy ty++-- | Does this type classify a core (unlifted) Coercion?+-- At either role nominal or representational+--    (t1 ~# t2) or (t1 ~R# t2)+-- See Note [Types for coercions, predicates, and evidence]+isCoVarType :: Type -> Bool+isCoVarType ty = isEqPrimPred ty++isEqPredClass :: Class -> Bool+-- True of (~) and (~~)+isEqPredClass cls =  cls `hasKey` eqTyConKey+                  || cls `hasKey` heqTyConKey++isClassPred, isEqPred, isEqPrimPred, isIPPred :: PredType -> Bool+isClassPred ty = case tyConAppTyCon_maybe ty of+    Just tyCon | isClassTyCon tyCon -> True+    _                               -> False++isEqPred ty  -- True of (a ~ b) and (a ~~ b)+             -- ToDo: should we check saturation?+  | Just tc <- tyConAppTyCon_maybe ty+  , Just cls <- tyConClass_maybe tc+  = isEqPredClass cls+  | otherwise+  = False++isEqPrimPred ty  -- True of (a ~# b) (a ~R# b)+             -- ToDo: should we check saturation?+  | Just tc <- tyConAppTyCon_maybe ty+  = tc `hasKey` eqPrimTyConKey || tc `hasKey` eqReprPrimTyConKey+  | otherwise+  = False++isIPPred ty = case tyConAppTyCon_maybe ty of+    Just tc -> isIPTyCon tc+    _       -> False++isIPTyCon :: TyCon -> Bool+isIPTyCon tc = tc `hasKey` ipClassKey+  -- Class and its corresponding TyCon have the same Unique++isIPClass :: Class -> Bool+isIPClass cls = cls `hasKey` ipClassKey++isCTupleClass :: Class -> Bool+isCTupleClass cls = isTupleTyCon (classTyCon cls)++isIPPred_maybe :: Type -> Maybe (FastString, Type)+isIPPred_maybe ty =+  do (tc,[t1,t2]) <- splitTyConApp_maybe ty+     guard (isIPTyCon tc)+     x <- isStrLitTy t1+     return (x,t2)++{-+Make PredTypes++--------------------- Equality types ---------------------------------+-}++-- | Makes a lifted equality predicate at the given role+mkPrimEqPredRole :: Role -> Type -> Type -> PredType+mkPrimEqPredRole Nominal          = mkPrimEqPred+mkPrimEqPredRole Representational = mkReprPrimEqPred+mkPrimEqPredRole Phantom          = panic "mkPrimEqPredRole phantom"++-- | Creates a primitive type equality predicate.+-- Invariant: the types are not Coercions+mkPrimEqPred :: Type -> Type -> Type+mkPrimEqPred ty1 ty2+  = TyConApp eqPrimTyCon [k1, k2, ty1, ty2]+  where+    k1 = typeKind ty1+    k2 = typeKind ty2++-- | Creates a primite type equality predicate with explicit kinds+mkHeteroPrimEqPred :: Kind -> Kind -> Type -> Type -> Type+mkHeteroPrimEqPred k1 k2 ty1 ty2 = TyConApp eqPrimTyCon [k1, k2, ty1, ty2]++-- | Creates a primitive representational type equality predicate+-- with explicit kinds+mkHeteroReprPrimEqPred :: Kind -> Kind -> Type -> Type -> Type+mkHeteroReprPrimEqPred k1 k2 ty1 ty2+  = TyConApp eqReprPrimTyCon [k1, k2, ty1, ty2]++-- | Try to split up a coercion type into the types that it coerces+splitCoercionType_maybe :: Type -> Maybe (Type, Type)+splitCoercionType_maybe ty+  = do { (tc, [_, _, ty1, ty2]) <- splitTyConApp_maybe ty+       ; guard $ tc `hasKey` eqPrimTyConKey || tc `hasKey` eqReprPrimTyConKey+       ; return (ty1, ty2) }++mkReprPrimEqPred :: Type -> Type -> Type+mkReprPrimEqPred ty1  ty2+  = TyConApp eqReprPrimTyCon [k1, k2, ty1, ty2]+  where+    k1 = typeKind ty1+    k2 = typeKind ty2++equalityTyCon :: Role -> TyCon+equalityTyCon Nominal          = eqPrimTyCon+equalityTyCon Representational = eqReprPrimTyCon+equalityTyCon Phantom          = eqPhantPrimTyCon++-- --------------------- Dictionary types ---------------------------------++mkClassPred :: Class -> [Type] -> PredType+mkClassPred clas tys = TyConApp (classTyCon clas) tys++isDictTy :: Type -> Bool+isDictTy = isClassPred++isDictLikeTy :: Type -> Bool+-- Note [Dictionary-like types]+isDictLikeTy ty | Just ty' <- coreView ty = isDictLikeTy ty'+isDictLikeTy ty = case splitTyConApp_maybe ty of+        Just (tc, tys) | isClassTyCon tc -> True+                       | isTupleTyCon tc -> all isDictLikeTy tys+        _other                           -> False++{- Note [Dictionary-like types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Being "dictionary-like" means either a dictionary type or a tuple thereof.+In GHC 6.10 we build implication constraints which construct such tuples,+and if we land up with a binding+    t :: (C [a], Eq [a])+    t = blah+then we want to treat t as cheap under "-fdicts-cheap" for example.+(Implication constraints are normally inlined, but sadly not if the+occurrence is itself inside an INLINE function!  Until we revise the+handling of implication constraints, that is.)  This turned out to+be important in getting good arities in DPH code.  Example:++    class C a+    class D a where { foo :: a -> a }+    instance C a => D (Maybe a) where { foo x = x }++    bar :: (C a, C b) => a -> b -> (Maybe a, Maybe b)+    {-# INLINE bar #-}+    bar x y = (foo (Just x), foo (Just y))++Then 'bar' should jolly well have arity 4 (two dicts, two args), but+we ended up with something like+   bar = __inline_me__ (\d1,d2. let t :: (D (Maybe a), D (Maybe b)) = ...+                                in \x,y. <blah>)++This is all a bit ad-hoc; eg it relies on knowing that implication+constraints build tuples.++ToDo: it would be far easier just to use isPredTy.+-}++-- | A choice of equality relation. This is separate from the type 'Role'+-- because 'Phantom' does not define a (non-trivial) equality relation.+data EqRel = NomEq | ReprEq+  deriving (Eq, Ord)++instance Outputable EqRel where+  ppr NomEq  = text "nominal equality"+  ppr ReprEq = text "representational equality"++eqRelRole :: EqRel -> Role+eqRelRole NomEq  = Nominal+eqRelRole ReprEq = Representational++data PredTree+  = ClassPred Class [Type]+  | EqPred EqRel Type Type+  | IrredPred PredType+  | ForAllPred [TyCoVarBinder] [PredType] PredType+     -- ForAllPred: see Note [Quantified constraints] in TcCanonical+  -- NB: There is no TuplePred case+  --     Tuple predicates like (Eq a, Ord b) are just treated+  --     as ClassPred, as if we had a tuple class with two superclasses+  --        class (c1, c2) => (%,%) c1 c2++classifyPredType :: PredType -> PredTree+classifyPredType ev_ty = case splitTyConApp_maybe ev_ty of+    Just (tc, [_, _, ty1, ty2])+      | tc `hasKey` eqReprPrimTyConKey -> EqPred ReprEq ty1 ty2+      | tc `hasKey` eqPrimTyConKey     -> EqPred NomEq ty1 ty2++    Just (tc, tys)+      | Just clas <- tyConClass_maybe tc+      -> ClassPred clas tys++    _ | (tvs, rho) <- splitForAllVarBndrs ev_ty+      , (theta, pred) <- splitFunTys rho+      , not (null tvs && null theta)+      -> ForAllPred tvs theta pred++      | otherwise+      -> IrredPred ev_ty++getClassPredTys :: HasDebugCallStack => PredType -> (Class, [Type])+getClassPredTys ty = case getClassPredTys_maybe ty of+        Just (clas, tys) -> (clas, tys)+        Nothing          -> pprPanic "getClassPredTys" (ppr ty)++getClassPredTys_maybe :: PredType -> Maybe (Class, [Type])+getClassPredTys_maybe ty = case splitTyConApp_maybe ty of+        Just (tc, tys) | Just clas <- tyConClass_maybe tc -> Just (clas, tys)+        _ -> Nothing++getEqPredTys :: PredType -> (Type, Type)+getEqPredTys ty+  = case splitTyConApp_maybe ty of+      Just (tc, [_, _, ty1, ty2])+        |  tc `hasKey` eqPrimTyConKey+        || tc `hasKey` eqReprPrimTyConKey+        -> (ty1, ty2)+      _ -> pprPanic "getEqPredTys" (ppr ty)++getEqPredTys_maybe :: PredType -> Maybe (Role, Type, Type)+getEqPredTys_maybe ty+  = case splitTyConApp_maybe ty of+      Just (tc, [_, _, ty1, ty2])+        | tc `hasKey` eqPrimTyConKey     -> Just (Nominal, ty1, ty2)+        | tc `hasKey` eqReprPrimTyConKey -> Just (Representational, ty1, ty2)+      _ -> Nothing++getEqPredRole :: PredType -> Role+getEqPredRole ty = eqRelRole (predTypeEqRel ty)++-- | Get the equality relation relevant for a pred type.+predTypeEqRel :: PredType -> EqRel+predTypeEqRel ty+  | Just (tc, _) <- splitTyConApp_maybe ty+  , tc `hasKey` eqReprPrimTyConKey+  = ReprEq+  | otherwise+  = NomEq++{-+%************************************************************************+%*                                                                      *+         Well-scoped tyvars+*                                                                      *+************************************************************************++Note [ScopedSort]+~~~~~~~~~~~~~~~~~+Consider++  foo :: Proxy a -> Proxy (b :: k) -> Proxy (a :: k2) -> ()++This function type is implicitly generalised over [a, b, k, k2]. These+variables will be Specified; that is, they will be available for visible+type application. This is because they are written in the type signature+by the user.++However, we must ask: what order will they appear in? In cases without+dependency, this is easy: we just use the lexical left-to-right ordering+of first occurrence. With dependency, we cannot get off the hook so+easily.++We thus state:++ * These variables appear in the order as given by ScopedSort, where+   the input to ScopedSort is the left-to-right order of first occurrence.++Note that this applies only to *implicit* quantification, without a+`forall`. If the user writes a `forall`, then we just use the order given.++ScopedSort is defined thusly (as proposed in #15743):+  * Work left-to-right through the input list, with a cursor.+  * If variable v at the cursor is depended on by any earlier variable w,+    move v immediately before the leftmost such w.++INVARIANT: The prefix of variables before the cursor form a valid telescope.++Note that ScopedSort makes sense only after type inference is done and all+types/kinds are fully settled and zonked.++-}++-- | Do a topological sort on a list of tyvars,+--   so that binders occur before occurrences+-- E.g. given  [ a::k, k::*, b::k ]+-- it'll return a well-scoped list [ k::*, a::k, b::k ]+--+-- This is a deterministic sorting operation+-- (that is, doesn't depend on Uniques).+--+-- It is also meant to be stable: that is, variables should not+-- be reordered unnecessarily. This is specified in Note [ScopedSort]+-- See also Note [Ordering of implicit variables] in RnTypes++scopedSort :: [TyCoVar] -> [TyCoVar]+scopedSort = go [] []+  where+    go :: [TyCoVar] -- already sorted, in reverse order+       -> [TyCoVarSet] -- each set contains all the variables which must be placed+                       -- before the tv corresponding to the set; they are accumulations+                       -- of the fvs in the sorted tvs' kinds++                       -- This list is in 1-to-1 correspondence with the sorted tyvars+                       -- INVARIANT:+                       --   all (\tl -> all (`subVarSet` head tl) (tail tl)) (tails fv_list)+                       -- That is, each set in the list is a superset of all later sets.++       -> [TyCoVar] -- yet to be sorted+       -> [TyCoVar]+    go acc _fv_list [] = reverse acc+    go acc  fv_list (tv:tvs)+      = go acc' fv_list' tvs+      where+        (acc', fv_list') = insert tv acc fv_list++    insert :: TyCoVar       -- var to insert+           -> [TyCoVar]     -- sorted list, in reverse order+           -> [TyCoVarSet]  -- list of fvs, as above+           -> ([TyCoVar], [TyCoVarSet])   -- augmented lists+    insert tv []     []         = ([tv], [tyCoVarsOfType (tyVarKind tv)])+    insert tv (a:as) (fvs:fvss)+      | tv `elemVarSet` fvs+      , (as', fvss') <- insert tv as fvss+      = (a:as', fvs `unionVarSet` fv_tv : fvss')++      | otherwise+      = (tv:a:as, fvs `unionVarSet` fv_tv : fvs : fvss)+      where+        fv_tv = tyCoVarsOfType (tyVarKind tv)++       -- lists not in correspondence+    insert _ _ _ = panic "scopedSort"++-- | Extract a well-scoped list of variables from a deterministic set of+-- variables. The result is deterministic.+-- NB: There used to exist varSetElemsWellScoped :: VarSet -> [Var] which+-- took a non-deterministic set and produced a non-deterministic+-- well-scoped list. If you care about the list being well-scoped you also+-- most likely care about it being in deterministic order.+dVarSetElemsWellScoped :: DVarSet -> [Var]+dVarSetElemsWellScoped = scopedSort . dVarSetElems++-- | Get the free vars of a type in scoped order+tyCoVarsOfTypeWellScoped :: Type -> [TyVar]+tyCoVarsOfTypeWellScoped = scopedSort . tyCoVarsOfTypeList++-- | Get the free vars of types in scoped order+tyCoVarsOfTypesWellScoped :: [Type] -> [TyVar]+tyCoVarsOfTypesWellScoped = scopedSort . tyCoVarsOfTypesList++-- | Given the suffix of a telescope, returns the prefix.+-- Ex: given [(k :: j), (a :: Proxy k)], returns [(j :: *)].+tyCoVarsOfBindersWellScoped :: [TyVar] -> [TyVar]+tyCoVarsOfBindersWellScoped tvs+  = tyCoVarsOfTypeWellScoped (mkInvForAllTys tvs unitTy)++------------- Closing over kinds -----------------++-- | Add the kind variables free in the kinds of the tyvars in the given set.+-- Returns a non-deterministic set.+closeOverKinds :: TyVarSet -> TyVarSet+closeOverKinds = fvVarSet . closeOverKindsFV . nonDetEltsUniqSet+  -- It's OK to use nonDetEltsUniqSet here because we immediately forget+  -- about the ordering by returning a set.++-- | Given a list of tyvars returns a deterministic FV computation that+-- returns the given tyvars with the kind variables free in the kinds of the+-- given tyvars.+closeOverKindsFV :: [TyVar] -> FV+closeOverKindsFV tvs =+  mapUnionFV (tyCoFVsOfType . tyVarKind) tvs `unionFV` mkFVs tvs++-- | Add the kind variables free in the kinds of the tyvars in the given set.+-- Returns a deterministically ordered list.+closeOverKindsList :: [TyVar] -> [TyVar]+closeOverKindsList tvs = fvVarList $ closeOverKindsFV tvs++-- | Add the kind variables free in the kinds of the tyvars in the given set.+-- Returns a deterministic set.+closeOverKindsDSet :: DTyVarSet -> DTyVarSet+closeOverKindsDSet = fvDVarSet . closeOverKindsFV . dVarSetElems++{-+************************************************************************+*                                                                      *+\subsection{Type families}+*                                                                      *+************************************************************************+-}++mkFamilyTyConApp :: TyCon -> [Type] -> Type+-- ^ Given a family instance TyCon and its arg types, return the+-- corresponding family type.  E.g:+--+-- > data family T a+-- > data instance T (Maybe b) = MkT b+--+-- Where the instance tycon is :RTL, so:+--+-- > mkFamilyTyConApp :RTL Int  =  T (Maybe Int)+mkFamilyTyConApp tc tys+  | Just (fam_tc, fam_tys) <- tyConFamInst_maybe tc+  , let tvs = tyConTyVars tc+        fam_subst = ASSERT2( tvs `equalLength` tys, ppr tc <+> ppr tys )+                    zipTvSubst tvs tys+  = mkTyConApp fam_tc (substTys fam_subst fam_tys)+  | otherwise+  = mkTyConApp tc tys++-- | Get the type on the LHS of a coercion induced by a type/data+-- family instance.+coAxNthLHS :: CoAxiom br -> Int -> Type+coAxNthLHS ax ind =+  mkTyConApp (coAxiomTyCon ax) (coAxBranchLHS (coAxiomNthBranch ax ind))++-- | Pretty prints a 'TyCon', using the family instance in case of a+-- representation tycon.  For example:+--+-- > data T [a] = ...+--+-- In that case we want to print @T [a]@, where @T@ is the family 'TyCon'+pprSourceTyCon :: TyCon -> SDoc+pprSourceTyCon tycon+  | Just (fam_tc, tys) <- tyConFamInst_maybe tycon+  = ppr $ fam_tc `TyConApp` tys        -- can't be FunTyCon+  | otherwise+  = ppr tycon++isFamFreeTy :: Type -> Bool+isFamFreeTy ty | Just ty' <- coreView ty = isFamFreeTy ty'+isFamFreeTy (TyVarTy _)       = True+isFamFreeTy (LitTy {})        = True+isFamFreeTy (TyConApp tc tys) = all isFamFreeTy tys && isFamFreeTyCon tc+isFamFreeTy (AppTy a b)       = isFamFreeTy a && isFamFreeTy b+isFamFreeTy (FunTy _ a b)     = isFamFreeTy a && isFamFreeTy b+isFamFreeTy (ForAllTy _ ty)   = isFamFreeTy ty+isFamFreeTy (CastTy ty _)     = isFamFreeTy ty+isFamFreeTy (CoercionTy _)    = False  -- Not sure about this++{-+************************************************************************+*                                                                      *+\subsection{Liftedness}+*                                                                      *+************************************************************************+-}++-- | Returns Just True if this type is surely lifted, Just False+-- if it is surely unlifted, Nothing if we can't be sure (i.e., it is+-- levity polymorphic), and panics if the kind does not have the shape+-- TYPE r.+isLiftedType_maybe :: HasDebugCallStack => Type -> Maybe Bool+isLiftedType_maybe ty = go (getRuntimeRep ty)+  where+    go rr | Just rr' <- coreView rr = go rr'+          | isLiftedRuntimeRep rr  = Just True+          | TyConApp {} <- rr      = Just False  -- Everything else is unlifted+          | otherwise              = Nothing     -- levity polymorphic++-- | See "Type#type_classification" for what an unlifted type is.+-- Panics on levity polymorphic types.+isUnliftedType :: HasDebugCallStack => Type -> Bool+        -- isUnliftedType returns True for forall'd unlifted types:+        --      x :: forall a. Int#+        -- I found bindings like these were getting floated to the top level.+        -- They are pretty bogus types, mind you.  It would be better never to+        -- construct them+isUnliftedType ty+  = not (isLiftedType_maybe ty `orElse`+         pprPanic "isUnliftedType" (ppr ty <+> dcolon <+> ppr (typeKind ty)))++-- | Is this a type of kind RuntimeRep? (e.g. LiftedRep)+isRuntimeRepKindedTy :: Type -> Bool+isRuntimeRepKindedTy = isRuntimeRepTy . typeKind++-- | Drops prefix of RuntimeRep constructors in 'TyConApp's. Useful for e.g.+-- dropping 'LiftedRep arguments of unboxed tuple TyCon applications:+--+--   dropRuntimeRepArgs [ 'LiftedRep, 'IntRep+--                      , String, Int# ] == [String, Int#]+--+dropRuntimeRepArgs :: [Type] -> [Type]+dropRuntimeRepArgs = dropWhile isRuntimeRepKindedTy++-- | Extract the RuntimeRep classifier of a type. For instance,+-- @getRuntimeRep_maybe Int = LiftedRep@. Returns 'Nothing' if this is not+-- possible.+getRuntimeRep_maybe :: HasDebugCallStack+                    => Type -> Maybe Type+getRuntimeRep_maybe = kindRep_maybe . typeKind++-- | Extract the RuntimeRep classifier of a type. For instance,+-- @getRuntimeRep_maybe Int = LiftedRep@. Panics if this is not possible.+getRuntimeRep :: HasDebugCallStack => Type -> Type+getRuntimeRep ty+  = case getRuntimeRep_maybe ty of+      Just r  -> r+      Nothing -> pprPanic "getRuntimeRep" (ppr ty <+> dcolon <+> ppr (typeKind ty))++isUnboxedTupleType :: Type -> Bool+isUnboxedTupleType ty+  = tyConAppTyCon (getRuntimeRep ty) `hasKey` tupleRepDataConKey+  -- NB: Do not use typePrimRep, as that can't tell the difference between+  -- unboxed tuples and unboxed sums+++isUnboxedSumType :: Type -> Bool+isUnboxedSumType ty+  = tyConAppTyCon (getRuntimeRep ty) `hasKey` sumRepDataConKey++-- | See "Type#type_classification" for what an algebraic type is.+-- Should only be applied to /types/, as opposed to e.g. partially+-- saturated type constructors+isAlgType :: Type -> Bool+isAlgType ty+  = case splitTyConApp_maybe ty of+      Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )+                            isAlgTyCon tc+      _other             -> False++-- | Check whether a type is a data family type+isDataFamilyAppType :: Type -> Bool+isDataFamilyAppType ty = case tyConAppTyCon_maybe ty of+                           Just tc -> isDataFamilyTyCon tc+                           _       -> False++-- | Computes whether an argument (or let right hand side) should+-- be computed strictly or lazily, based only on its type.+-- Currently, it's just 'isUnliftedType'. Panics on levity-polymorphic types.+isStrictType :: HasDebugCallStack => Type -> Bool+isStrictType = isUnliftedType++isPrimitiveType :: Type -> Bool+-- ^ Returns true of types that are opaque to Haskell.+isPrimitiveType ty = case splitTyConApp_maybe ty of+                        Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )+                                              isPrimTyCon tc+                        _                  -> False++{-+************************************************************************+*                                                                      *+\subsection{Join points}+*                                                                      *+************************************************************************+-}++-- | Determine whether a type could be the type of a join point of given total+-- arity, according to the polymorphism rule. A join point cannot be polymorphic+-- in its return type, since given+--   join j @a @b x y z = e1 in e2,+-- the types of e1 and e2 must be the same, and a and b are not in scope for e2.+-- (See Note [The polymorphism rule of join points] in CoreSyn.) Returns False+-- also if the type simply doesn't have enough arguments.+--+-- Note that we need to know how many arguments (type *and* value) the putative+-- join point takes; for instance, if+--   j :: forall a. a -> Int+-- then j could be a binary join point returning an Int, but it could *not* be a+-- unary join point returning a -> Int.+--+-- TODO: See Note [Excess polymorphism and join points]+isValidJoinPointType :: JoinArity -> Type -> Bool+isValidJoinPointType arity ty+  = valid_under emptyVarSet arity ty+  where+    valid_under tvs arity ty+      | arity == 0+      = isEmptyVarSet (tvs `intersectVarSet` tyCoVarsOfType ty)+      | Just (t, ty') <- splitForAllTy_maybe ty+      = valid_under (tvs `extendVarSet` t) (arity-1) ty'+      | Just (_, res_ty) <- splitFunTy_maybe ty+      = valid_under tvs (arity-1) res_ty+      | otherwise+      = False++{- Note [Excess polymorphism and join points]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In principle, if a function would be a join point except that it fails+the polymorphism rule (see Note [The polymorphism rule of join points] in+CoreSyn), it can still be made a join point with some effort. This is because+all tail calls must return the same type (they return to the same context!), and+thus if the return type depends on an argument, that argument must always be the+same.++For instance, consider:++  let f :: forall a. a -> Char -> [a]+      f @a x c = ... f @a y 'a' ...+  in ... f @Int 1 'b' ... f @Int 2 'c' ...++(where the calls are tail calls). `f` fails the polymorphism rule because its+return type is [a], where [a] is bound. But since the type argument is always+'Int', we can rewrite it as:++  let f' :: Int -> Char -> [Int]+      f' x c = ... f' y 'a' ...+  in ... f' 1 'b' ... f 2 'c' ...++and now we can make f' a join point:++  join f' :: Int -> Char -> [Int]+       f' x c = ... jump f' y 'a' ...+  in ... jump f' 1 'b' ... jump f' 2 'c' ...++It's not clear that this comes up often, however. TODO: Measure how often and+add this analysis if necessary.  See #14620.+++************************************************************************+*                                                                      *+\subsection{Sequencing on types}+*                                                                      *+************************************************************************+-}++seqType :: Type -> ()+seqType (LitTy n)                   = n `seq` ()+seqType (TyVarTy tv)                = tv `seq` ()+seqType (AppTy t1 t2)               = seqType t1 `seq` seqType t2+seqType (FunTy _ t1 t2)             = seqType t1 `seq` seqType t2+seqType (TyConApp tc tys)           = tc `seq` seqTypes tys+seqType (ForAllTy (Bndr tv _) ty)   = seqType (varType tv) `seq` seqType ty+seqType (CastTy ty co)              = seqType ty `seq` seqCo co+seqType (CoercionTy co)             = seqCo co++seqTypes :: [Type] -> ()+seqTypes []       = ()+seqTypes (ty:tys) = seqType ty `seq` seqTypes tys++{-+************************************************************************+*                                                                      *+                Comparison for types+        (We don't use instances so that we know where it happens)+*                                                                      *+************************************************************************++Note [Equality on AppTys]+~~~~~~~~~~~~~~~~~~~~~~~~~+In our cast-ignoring equality, we want to say that the following two+are equal:++  (Maybe |> co) (Int |> co')   ~?       Maybe Int++But the left is an AppTy while the right is a TyConApp. The solution is+to use repSplitAppTy_maybe to break up the TyConApp into its pieces and+then continue. Easy to do, but also easy to forget to do.++-}++eqType :: Type -> Type -> Bool+-- ^ Type equality on source types. Does not look through @newtypes@ or+-- 'PredType's, but it does look through type synonyms.+-- This first checks that the kinds of the types are equal and then+-- checks whether the types are equal, ignoring casts and coercions.+-- (The kind check is a recursive call, but since all kinds have type+-- @Type@, there is no need to check the types of kinds.)+-- See also Note [Non-trivial definitional equality] in TyCoRep.+eqType t1 t2 = isEqual $ nonDetCmpType t1 t2+  -- It's OK to use nonDetCmpType here and eqType is deterministic,+  -- nonDetCmpType does equality deterministically++-- | Compare types with respect to a (presumably) non-empty 'RnEnv2'.+eqTypeX :: RnEnv2 -> Type -> Type -> Bool+eqTypeX env t1 t2 = isEqual $ nonDetCmpTypeX env t1 t2+  -- It's OK to use nonDetCmpType here and eqTypeX is deterministic,+  -- nonDetCmpTypeX does equality deterministically++-- | Type equality on lists of types, looking through type synonyms+-- but not newtypes.+eqTypes :: [Type] -> [Type] -> Bool+eqTypes tys1 tys2 = isEqual $ nonDetCmpTypes tys1 tys2+  -- It's OK to use nonDetCmpType here and eqTypes is deterministic,+  -- nonDetCmpTypes does equality deterministically++eqVarBndrs :: RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2+-- Check that the var lists are the same length+-- and have matching kinds; if so, extend the RnEnv2+-- Returns Nothing if they don't match+eqVarBndrs env [] []+ = Just env+eqVarBndrs env (tv1:tvs1) (tv2:tvs2)+ | eqTypeX env (varType tv1) (varType tv2)+ = eqVarBndrs (rnBndr2 env tv1 tv2) tvs1 tvs2+eqVarBndrs _ _ _= Nothing++-- Now here comes the real worker++{-+Note [nonDetCmpType nondeterminism]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+nonDetCmpType is implemented in terms of nonDetCmpTypeX. nonDetCmpTypeX+uses nonDetCmpTc which compares TyCons by their Unique value. Using Uniques for+ordering leads to nondeterminism. We hit the same problem in the TyVarTy case,+comparing type variables is nondeterministic, note the call to nonDetCmpVar in+nonDetCmpTypeX.+See Note [Unique Determinism] for more details.+-}++nonDetCmpType :: Type -> Type -> Ordering+nonDetCmpType t1 t2+  -- we know k1 and k2 have the same kind, because they both have kind *.+  = nonDetCmpTypeX rn_env t1 t2+  where+    rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes [t1, t2]))++nonDetCmpTypes :: [Type] -> [Type] -> Ordering+nonDetCmpTypes ts1 ts2 = nonDetCmpTypesX rn_env ts1 ts2+  where+    rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes (ts1 ++ ts2)))++-- | An ordering relation between two 'Type's (known below as @t1 :: k1@+-- and @t2 :: k2@)+data TypeOrdering = TLT  -- ^ @t1 < t2@+                  | TEQ  -- ^ @t1 ~ t2@ and there are no casts in either,+                         -- therefore we can conclude @k1 ~ k2@+                  | TEQX -- ^ @t1 ~ t2@ yet one of the types contains a cast so+                         -- they may differ in kind.+                  | TGT  -- ^ @t1 > t2@+                  deriving (Eq, Ord, Enum, Bounded)++nonDetCmpTypeX :: RnEnv2 -> Type -> Type -> Ordering  -- Main workhorse+    -- See Note [Non-trivial definitional equality] in TyCoRep+nonDetCmpTypeX env orig_t1 orig_t2 =+    case go env orig_t1 orig_t2 of+      -- If there are casts then we also need to do a comparison of the kinds of+      -- the types being compared+      TEQX          -> toOrdering $ go env k1 k2+      ty_ordering   -> toOrdering ty_ordering+  where+    k1 = typeKind orig_t1+    k2 = typeKind orig_t2++    toOrdering :: TypeOrdering -> Ordering+    toOrdering TLT  = LT+    toOrdering TEQ  = EQ+    toOrdering TEQX = EQ+    toOrdering TGT  = GT++    liftOrdering :: Ordering -> TypeOrdering+    liftOrdering LT = TLT+    liftOrdering EQ = TEQ+    liftOrdering GT = TGT++    thenCmpTy :: TypeOrdering -> TypeOrdering -> TypeOrdering+    thenCmpTy TEQ  rel  = rel+    thenCmpTy TEQX rel  = hasCast rel+    thenCmpTy rel  _    = rel++    hasCast :: TypeOrdering -> TypeOrdering+    hasCast TEQ = TEQX+    hasCast rel = rel++    -- Returns both the resulting ordering relation between the two types+    -- and whether either contains a cast.+    go :: RnEnv2 -> Type -> Type -> TypeOrdering+    go env t1 t2+      | Just t1' <- coreView t1 = go env t1' t2+      | Just t2' <- coreView t2 = go env t1 t2'++    go env (TyVarTy tv1)       (TyVarTy tv2)+      = liftOrdering $ rnOccL env tv1 `nonDetCmpVar` rnOccR env tv2+    go env (ForAllTy (Bndr tv1 _) t1) (ForAllTy (Bndr tv2 _) t2)+      = go env (varType tv1) (varType tv2)+        `thenCmpTy` go (rnBndr2 env tv1 tv2) t1 t2+        -- See Note [Equality on AppTys]+    go env (AppTy s1 t1) ty2+      | Just (s2, t2) <- repSplitAppTy_maybe ty2+      = go env s1 s2 `thenCmpTy` go env t1 t2+    go env ty1 (AppTy s2 t2)+      | Just (s1, t1) <- repSplitAppTy_maybe ty1+      = go env s1 s2 `thenCmpTy` go env t1 t2+    go env (FunTy _ s1 t1) (FunTy _ s2 t2)+      = go env s1 s2 `thenCmpTy` go env t1 t2+    go env (TyConApp tc1 tys1) (TyConApp tc2 tys2)+      = liftOrdering (tc1 `nonDetCmpTc` tc2) `thenCmpTy` gos env tys1 tys2+    go _   (LitTy l1)          (LitTy l2)          = liftOrdering (compare l1 l2)+    go env (CastTy t1 _)       t2                  = hasCast $ go env t1 t2+    go env t1                  (CastTy t2 _)       = hasCast $ go env t1 t2++    go _   (CoercionTy {})     (CoercionTy {})     = TEQ++        -- Deal with the rest: TyVarTy < CoercionTy < AppTy < LitTy < TyConApp < ForAllTy+    go _ ty1 ty2+      = liftOrdering $ (get_rank ty1) `compare` (get_rank ty2)+      where get_rank :: Type -> Int+            get_rank (CastTy {})+              = pprPanic "nonDetCmpTypeX.get_rank" (ppr [ty1,ty2])+            get_rank (TyVarTy {})    = 0+            get_rank (CoercionTy {}) = 1+            get_rank (AppTy {})      = 3+            get_rank (LitTy {})      = 4+            get_rank (TyConApp {})   = 5+            get_rank (FunTy {})      = 6+            get_rank (ForAllTy {})   = 7++    gos :: RnEnv2 -> [Type] -> [Type] -> TypeOrdering+    gos _   []         []         = TEQ+    gos _   []         _          = TLT+    gos _   _          []         = TGT+    gos env (ty1:tys1) (ty2:tys2) = go env ty1 ty2 `thenCmpTy` gos env tys1 tys2++-------------+nonDetCmpTypesX :: RnEnv2 -> [Type] -> [Type] -> Ordering+nonDetCmpTypesX _   []        []        = EQ+nonDetCmpTypesX env (t1:tys1) (t2:tys2) = nonDetCmpTypeX env t1 t2+                                          `thenCmp`+                                          nonDetCmpTypesX env tys1 tys2+nonDetCmpTypesX _   []        _         = LT+nonDetCmpTypesX _   _         []        = GT++-------------+-- | Compare two 'TyCon's. NB: This should /never/ see 'Constraint' (as+-- recognized by Kind.isConstraintKindCon) which is considered a synonym for+-- 'Type' in Core.+-- See Note [Kind Constraint and kind Type] in Kind.+-- See Note [nonDetCmpType nondeterminism]+nonDetCmpTc :: TyCon -> TyCon -> Ordering+nonDetCmpTc tc1 tc2+  = ASSERT( not (isConstraintKindCon tc1) && not (isConstraintKindCon tc2) )+    u1 `nonDetCmpUnique` u2+  where+    u1  = tyConUnique tc1+    u2  = tyConUnique tc2++{-+************************************************************************+*                                                                      *+        The kind of a type+*                                                                      *+************************************************************************++Note [typeKind vs tcTypeKind]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We have two functions to get the kind of a type++  * typeKind   ignores  the distinction between Constraint and *+  * tcTypeKind respects the distinction between Constraint and *++tcTypeKind is used by the type inference engine, for which Constraint+and * are different; after that we use typeKind.++See also Note [coreView vs tcView]++Note [Kinding rules for types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In typeKind we consider Constraint and (TYPE LiftedRep) to be identical.+We then have++         t1 : TYPE rep1+         t2 : TYPE rep2+   (FUN) ----------------+         t1 -> t2 : Type++         ty : TYPE rep+         `a` is not free in rep+(FORALL) -----------------------+         forall a. ty : TYPE rep++In tcTypeKind we consider Constraint and (TYPE LiftedRep) to be distinct:++          t1 : TYPE rep1+          t2 : TYPE rep2+    (FUN) ----------------+          t1 -> t2 : Type++          t1 : Constraint+          t2 : TYPE rep+  (PRED1) ----------------+          t1 => t2 : Type++          t1 : Constraint+          t2 : Constraint+  (PRED2) ---------------------+          t1 => t2 : Constraint++          ty : TYPE rep+          `a` is not free in rep+(FORALL1) -----------------------+          forall a. ty : TYPE rep++          ty : Constraint+(FORALL2) -------------------------+          forall a. ty : Constraint++Note that:+* The only way we distinguish '->' from '=>' is by the fact+  that the argument is a PredTy.  Both are FunTys++Note [Phantom type variables in kinds]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider++  type K (r :: RuntimeRep) = Type   -- Note 'r' is unused+  data T r :: K r                   -- T :: forall r -> K r+  foo :: forall r. T r++The body of the forall in foo's type has kind (K r), and+normally it would make no sense to have+   forall r. (ty :: K r)+because the kind of the forall would escape the binding+of 'r'.  But in this case it's fine because (K r) exapands+to Type, so we expliclity /permit/ the type+   forall r. T r++To accommodate such a type, in typeKind (forall a.ty) we use+occCheckExpand to expand any type synonyms in the kind of 'ty'+to eliminate 'a'.  See kinding rule (FORALL) in+Note [Kinding rules for types]++And in TcValidity.checkEscapingKind, we use also use+occCheckExpand, for the same reason.+-}++-----------------------------+typeKind :: HasDebugCallStack => Type -> Kind+-- No need to expand synonyms+typeKind (TyConApp tc tys) = piResultTys (tyConKind tc) tys+typeKind (LitTy l)         = typeLiteralKind l+typeKind (FunTy {})        = liftedTypeKind+typeKind (TyVarTy tyvar)   = tyVarKind tyvar+typeKind (CastTy _ty co)   = pSnd $ coercionKind co+typeKind (CoercionTy co)   = coercionType co++typeKind (AppTy fun arg)+  = go fun [arg]+  where+    -- Accumulate the type arugments, so we can call piResultTys,+    -- rather than a succession of calls to piResultTy (which is+    -- asymptotically costly as the number of arguments increases)+    go (AppTy fun arg) args = go fun (arg:args)+    go fun             args = piResultTys (typeKind fun) args++typeKind ty@(ForAllTy {})+  = case occCheckExpand tvs body_kind of+      -- We must make sure tv does not occur in kind+      -- As it is already out of scope!+      -- See Note [Phantom type variables in kinds]+      Just k' -> k'+      Nothing -> pprPanic "typeKind"+                  (ppr ty $$ ppr tvs $$ ppr body <+> dcolon <+> ppr body_kind)+  where+    (tvs, body) = splitTyVarForAllTys ty+    body_kind   = typeKind body++-----------------------------+tcTypeKind :: HasDebugCallStack => Type -> Kind+-- No need to expand synonyms+tcTypeKind (TyConApp tc tys) = piResultTys (tyConKind tc) tys+tcTypeKind (LitTy l)         = typeLiteralKind l+tcTypeKind (TyVarTy tyvar)   = tyVarKind tyvar+tcTypeKind (CastTy _ty co)   = pSnd $ coercionKind co+tcTypeKind (CoercionTy co)   = coercionType co++tcTypeKind (FunTy { ft_af = af, ft_res = res })+  | InvisArg <- af+  , tcIsConstraintKind (tcTypeKind res)+  = constraintKind     -- Eq a => Ord a         :: Constraint+  | otherwise          -- Eq a => a -> a        :: TYPE LiftedRep+  = liftedTypeKind     -- Eq a => Array# Int    :: Type LiftedRep (not TYPE PtrRep)++tcTypeKind (AppTy fun arg)+  = go fun [arg]+  where+    -- Accumulate the type arugments, so we can call piResultTys,+    -- rather than a succession of calls to piResultTy (which is+    -- asymptotically costly as the number of arguments increases)+    go (AppTy fun arg) args = go fun (arg:args)+    go fun             args = piResultTys (tcTypeKind fun) args++tcTypeKind ty@(ForAllTy {})+  | tcIsConstraintKind body_kind+  = constraintKind++  | otherwise+  = case occCheckExpand tvs body_kind of+      -- We must make sure tv does not occur in kind+      -- As it is already out of scope!+      -- See Note [Phantom type variables in kinds]+      Just k' -> k'+      Nothing -> pprPanic "tcTypeKind"+                  (ppr ty $$ ppr tvs $$ ppr body <+> dcolon <+> ppr body_kind)+  where+    (tvs, body) = splitTyVarForAllTys ty+    body_kind = tcTypeKind body+++isPredTy :: HasDebugCallStack => Type -> Bool+-- See Note [Types for coercions, predicates, and evidence]+isPredTy ty = tcIsConstraintKind (tcTypeKind ty)++--------------------------+typeLiteralKind :: TyLit -> Kind+typeLiteralKind (NumTyLit {}) = typeNatKind+typeLiteralKind (StrTyLit {}) = typeSymbolKind++-- | Returns True if a type is levity polymorphic. Should be the same+-- as (isKindLevPoly . typeKind) but much faster.+-- Precondition: The type has kind (TYPE blah)+isTypeLevPoly :: Type -> Bool+isTypeLevPoly = go+  where+    go ty@(TyVarTy {})                           = check_kind ty+    go ty@(AppTy {})                             = check_kind ty+    go ty@(TyConApp tc _) | not (isTcLevPoly tc) = False+                          | otherwise            = check_kind ty+    go (ForAllTy _ ty)                           = go ty+    go (FunTy {})                                = False+    go (LitTy {})                                = False+    go ty@(CastTy {})                            = check_kind ty+    go ty@(CoercionTy {})                        = pprPanic "isTypeLevPoly co" (ppr ty)++    check_kind = isKindLevPoly . typeKind++-- | Looking past all pi-types, is the end result potentially levity polymorphic?+-- Example: True for (forall r (a :: TYPE r). String -> a)+-- Example: False for (forall r1 r2 (a :: TYPE r1) (b :: TYPE r2). a -> b -> Type)+resultIsLevPoly :: Type -> Bool+resultIsLevPoly = isTypeLevPoly . snd . splitPiTys+++{- **********************************************************************+*                                                                       *+           Occurs check expansion+%*                                                                      *+%********************************************************************* -}++{- Note [Occurs check expansion]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+(occurCheckExpand tv xi) expands synonyms in xi just enough to get rid+of occurrences of tv outside type function arguments, if that is+possible; otherwise, it returns Nothing.++For example, suppose we have+  type F a b = [a]+Then+  occCheckExpand b (F Int b) = Just [Int]+but+  occCheckExpand a (F a Int) = Nothing++We don't promise to do the absolute minimum amount of expanding+necessary, but we try not to do expansions we don't need to.  We+prefer doing inner expansions first.  For example,+  type F a b = (a, Int, a, [a])+  type G b   = Char+We have+  occCheckExpand b (F (G b)) = Just (F Char)+even though we could also expand F to get rid of b.+-}++occCheckExpand :: [Var] -> Type -> Maybe Type+-- See Note [Occurs check expansion]+-- We may have needed to do some type synonym unfolding in order to+-- get rid of the variable (or forall), so we also return the unfolded+-- version of the type, which is guaranteed to be syntactically free+-- of the given type variable.  If the type is already syntactically+-- free of the variable, then the same type is returned.+occCheckExpand vs_to_avoid ty+  = go (mkVarSet vs_to_avoid, emptyVarEnv) ty+  where+    go :: (VarSet, VarEnv TyCoVar) -> Type -> Maybe Type+          -- The VarSet is the set of variables we are trying to avoid+          -- The VarEnv carries mappings necessary+          -- because of kind expansion+    go cxt@(as, env) (TyVarTy tv')+      | tv' `elemVarSet` as               = Nothing+      | Just tv'' <- lookupVarEnv env tv' = return (mkTyVarTy tv'')+      | otherwise                         = do { tv'' <- go_var cxt tv'+                                               ; return (mkTyVarTy tv'') }++    go _   ty@(LitTy {}) = return ty+    go cxt (AppTy ty1 ty2) = do { ty1' <- go cxt ty1+                                ; ty2' <- go cxt ty2+                                ; return (mkAppTy ty1' ty2') }+    go cxt ty@(FunTy _ ty1 ty2)+       = do { ty1' <- go cxt ty1+            ; ty2' <- go cxt ty2+            ; return (ty { ft_arg = ty1', ft_res = ty2' }) }+    go cxt@(as, env) (ForAllTy (Bndr tv vis) body_ty)+       = do { ki' <- go cxt (varType tv)+            ; let tv' = setVarType tv ki'+                  env' = extendVarEnv env tv tv'+                  as'  = as `delVarSet` tv+            ; body' <- go (as', env') body_ty+            ; return (ForAllTy (Bndr tv' vis) body') }++    -- For a type constructor application, first try expanding away the+    -- offending variable from the arguments.  If that doesn't work, next+    -- see if the type constructor is a type synonym, and if so, expand+    -- it and try again.+    go cxt ty@(TyConApp tc tys)+      = case mapM (go cxt) tys of+          Just tys' -> return (mkTyConApp tc tys')+          Nothing | Just ty' <- tcView ty -> go cxt ty'+                  | otherwise             -> Nothing+                      -- Failing that, try to expand a synonym++    go cxt (CastTy ty co) =  do { ty' <- go cxt ty+                                ; co' <- go_co cxt co+                                ; return (mkCastTy ty' co') }+    go cxt (CoercionTy co) = do { co' <- go_co cxt co+                                ; return (mkCoercionTy co') }++    ------------------+    go_var cxt v = do { k' <- go cxt (varType v)+                      ; return (setVarType v k') }+           -- Works for TyVar and CoVar+           -- See Note [Occurrence checking: look inside kinds]++    ------------------+    go_mco _   MRefl = return MRefl+    go_mco ctx (MCo co) = MCo <$> go_co ctx co++    ------------------+    go_co cxt (Refl ty)                 = do { ty' <- go cxt ty+                                             ; return (mkNomReflCo ty') }+    go_co cxt (GRefl r ty mco)          = do { mco' <- go_mco cxt mco+                                             ; ty' <- go cxt ty+                                             ; return (mkGReflCo r ty' mco') }+      -- Note: Coercions do not contain type synonyms+    go_co cxt (TyConAppCo r tc args)    = do { args' <- mapM (go_co cxt) args+                                             ; return (mkTyConAppCo r tc args') }+    go_co cxt (AppCo co arg)            = do { co' <- go_co cxt co+                                             ; arg' <- go_co cxt arg+                                             ; return (mkAppCo co' arg') }+    go_co cxt@(as, env) (ForAllCo tv kind_co body_co)+      = do { kind_co' <- go_co cxt kind_co+           ; let tv' = setVarType tv $+                       pFst (coercionKind kind_co')+                 env' = extendVarEnv env tv tv'+                 as'  = as `delVarSet` tv+           ; body' <- go_co (as', env') body_co+           ; return (ForAllCo tv' kind_co' body') }+    go_co cxt (FunCo r co1 co2)         = do { co1' <- go_co cxt co1+                                             ; co2' <- go_co cxt co2+                                             ; return (mkFunCo r co1' co2') }+    go_co cxt@(as,env) (CoVarCo c)+      | c `elemVarSet` as               = Nothing+      | Just c' <- lookupVarEnv env c   = return (mkCoVarCo c')+      | otherwise                       = do { c' <- go_var cxt c+                                             ; return (mkCoVarCo c') }+    go_co cxt (HoleCo h)                = do { c' <- go_var cxt (ch_co_var h)+                                             ; return (HoleCo (h { ch_co_var = c' })) }+    go_co cxt (AxiomInstCo ax ind args) = do { args' <- mapM (go_co cxt) args+                                             ; return (mkAxiomInstCo ax ind args') }+    go_co cxt (UnivCo p r ty1 ty2)      = do { p' <- go_prov cxt p+                                             ; ty1' <- go cxt ty1+                                             ; ty2' <- go cxt ty2+                                             ; return (mkUnivCo p' r ty1' ty2') }+    go_co cxt (SymCo co)                = do { co' <- go_co cxt co+                                             ; return (mkSymCo co') }+    go_co cxt (TransCo co1 co2)         = do { co1' <- go_co cxt co1+                                             ; co2' <- go_co cxt co2+                                             ; return (mkTransCo co1' co2') }+    go_co cxt (NthCo r n co)            = do { co' <- go_co cxt co+                                             ; return (mkNthCo r n co') }+    go_co cxt (LRCo lr co)              = do { co' <- go_co cxt co+                                             ; return (mkLRCo lr co') }+    go_co cxt (InstCo co arg)           = do { co' <- go_co cxt co+                                             ; arg' <- go_co cxt arg+                                             ; return (mkInstCo co' arg') }+    go_co cxt (KindCo co)               = do { co' <- go_co cxt co+                                             ; return (mkKindCo co') }+    go_co cxt (SubCo co)                = do { co' <- go_co cxt co+                                             ; return (mkSubCo co') }+    go_co cxt (AxiomRuleCo ax cs)       = do { cs' <- mapM (go_co cxt) cs+                                             ; return (mkAxiomRuleCo ax cs') }++    ------------------+    go_prov _   UnsafeCoerceProv    = return UnsafeCoerceProv+    go_prov cxt (PhantomProv co)    = PhantomProv <$> go_co cxt co+    go_prov cxt (ProofIrrelProv co) = ProofIrrelProv <$> go_co cxt co+    go_prov _   p@(PluginProv _)    = return p+++{-+%************************************************************************+%*                                                                      *+        Miscellaneous functions+%*                                                                      *+%************************************************************************++-}+-- | All type constructors occurring in the type; looking through type+--   synonyms, but not newtypes.+--  When it finds a Class, it returns the class TyCon.+tyConsOfType :: Type -> UniqSet TyCon+tyConsOfType ty+  = go ty+  where+     go :: Type -> UniqSet TyCon  -- The UniqSet does duplicate elim+     go ty | Just ty' <- coreView ty = go ty'+     go (TyVarTy {})                = emptyUniqSet+     go (LitTy {})                  = emptyUniqSet+     go (TyConApp tc tys)           = go_tc tc `unionUniqSets` go_s tys+     go (AppTy a b)                 = go a `unionUniqSets` go b+     go (FunTy _ a b)               = go a `unionUniqSets` go b `unionUniqSets` go_tc funTyCon+     go (ForAllTy (Bndr tv _) ty)   = go ty `unionUniqSets` go (varType tv)+     go (CastTy ty co)              = go ty `unionUniqSets` go_co co+     go (CoercionTy co)             = go_co co++     go_co (Refl ty)               = go ty+     go_co (GRefl _ ty mco)        = go ty `unionUniqSets` go_mco mco+     go_co (TyConAppCo _ tc args)  = go_tc tc `unionUniqSets` go_cos args+     go_co (AppCo co arg)          = go_co co `unionUniqSets` go_co arg+     go_co (ForAllCo _ kind_co co) = go_co kind_co `unionUniqSets` go_co co+     go_co (FunCo _ co1 co2)       = go_co co1 `unionUniqSets` go_co co2+     go_co (AxiomInstCo ax _ args) = go_ax ax `unionUniqSets` go_cos args+     go_co (UnivCo p _ t1 t2)      = go_prov p `unionUniqSets` go t1 `unionUniqSets` go t2+     go_co (CoVarCo {})            = emptyUniqSet+     go_co (HoleCo {})             = emptyUniqSet+     go_co (SymCo co)              = go_co co+     go_co (TransCo co1 co2)       = go_co co1 `unionUniqSets` go_co co2+     go_co (NthCo _ _ co)          = go_co co+     go_co (LRCo _ co)             = go_co co+     go_co (InstCo co arg)         = go_co co `unionUniqSets` go_co arg+     go_co (KindCo co)             = go_co co+     go_co (SubCo co)              = go_co co+     go_co (AxiomRuleCo _ cs)      = go_cos cs++     go_mco MRefl    = emptyUniqSet+     go_mco (MCo co) = go_co co++     go_prov UnsafeCoerceProv    = emptyUniqSet+     go_prov (PhantomProv co)    = go_co co+     go_prov (ProofIrrelProv co) = go_co co+     go_prov (PluginProv _)      = emptyUniqSet+        -- this last case can happen from the tyConsOfType used from+        -- checkTauTvUpdate++     go_s tys     = foldr (unionUniqSets . go)     emptyUniqSet tys+     go_cos cos   = foldr (unionUniqSets . go_co)  emptyUniqSet cos++     go_tc tc = unitUniqSet tc+     go_ax ax = go_tc $ coAxiomTyCon ax++-- | Find the result 'Kind' of a type synonym,+-- after applying it to its 'arity' number of type variables+-- Actually this function works fine on data types too,+-- but they'd always return '*', so we never need to ask+synTyConResKind :: TyCon -> Kind+synTyConResKind tycon = piResultTys (tyConKind tycon) (mkTyVarTys (tyConTyVars tycon))++-- | Retrieve the free variables in this type, splitting them based+-- on whether they are used visibly or invisibly. Invisible ones come+-- first.+splitVisVarsOfType :: Type -> Pair TyCoVarSet+splitVisVarsOfType orig_ty = Pair invis_vars vis_vars+  where+    Pair invis_vars1 vis_vars = go orig_ty+    invis_vars = invis_vars1 `minusVarSet` vis_vars++    go (TyVarTy tv)      = Pair (tyCoVarsOfType $ tyVarKind tv) (unitVarSet tv)+    go (AppTy t1 t2)     = go t1 `mappend` go t2+    go (TyConApp tc tys) = go_tc tc tys+    go (FunTy _ t1 t2)   = go t1 `mappend` go t2+    go (ForAllTy (Bndr tv _) ty)+      = ((`delVarSet` tv) <$> go ty) `mappend`+        (invisible (tyCoVarsOfType $ varType tv))+    go (LitTy {}) = mempty+    go (CastTy ty co) = go ty `mappend` invisible (tyCoVarsOfCo co)+    go (CoercionTy co) = invisible $ tyCoVarsOfCo co++    invisible vs = Pair vs emptyVarSet++    go_tc tc tys = let (invis, vis) = partitionInvisibleTypes tc tys in+                   invisible (tyCoVarsOfTypes invis) `mappend` foldMap go vis++splitVisVarsOfTypes :: [Type] -> Pair TyCoVarSet+splitVisVarsOfTypes = foldMap splitVisVarsOfType++modifyJoinResTy :: Int            -- Number of binders to skip+                -> (Type -> Type) -- Function to apply to result type+                -> Type           -- Type of join point+                -> Type           -- New type+-- INVARIANT: If any of the first n binders are foralls, those tyvars cannot+-- appear in the original result type. See isValidJoinPointType.+modifyJoinResTy orig_ar f orig_ty+  = go orig_ar orig_ty+  where+    go 0 ty = f ty+    go n ty | Just (arg_bndr, res_ty) <- splitPiTy_maybe ty+            = mkPiTy arg_bndr (go (n-1) res_ty)+            | otherwise+            = pprPanic "modifyJoinResTy" (ppr orig_ar <+> ppr orig_ty)++setJoinResTy :: Int  -- Number of binders to skip+             -> Type -- New result type+             -> Type -- Type of join point+             -> Type -- New type+-- INVARIANT: Same as for modifyJoinResTy+setJoinResTy ar new_res_ty ty+  = modifyJoinResTy ar (const new_res_ty) ty+++{-+%************************************************************************+%*                                                                      *+         Pretty-printing+%*                                                                      *+%************************************************************************++Most pretty-printing is either in TyCoRep or IfaceType.++-}++-- | This variant preserves any use of TYPE in a type, effectively+-- locally setting -fprint-explicit-runtime-reps.+pprWithTYPE :: Type -> SDoc+pprWithTYPE ty = updSDocDynFlags (flip gopt_set Opt_PrintExplicitRuntimeReps) $+                 ppr ty
+ compiler/types/Type.hs-boot view
@@ -0,0 +1,26 @@+{-# LANGUAGE FlexibleContexts #-}++module Type where++import GhcPrelude+import TyCon+import Var ( TyCoVar )+import {-# SOURCE #-} TyCoRep( Type, Coercion )+import Util++isPredTy     :: HasDebugCallStack => Type -> Bool+isCoercionTy :: Type -> Bool++mkAppTy    :: Type -> Type -> Type+mkCastTy   :: Type -> Coercion -> Type+piResultTy :: HasDebugCallStack => Type -> Type -> Type++eqType :: Type -> Type -> Bool++coreView :: Type -> Maybe Type+tcView :: Type -> Maybe Type++tyCoVarsOfTypesWellScoped :: [Type] -> [TyCoVar]+tyCoVarsOfTypeWellScoped :: Type -> [TyCoVar]+scopedSort :: [TyCoVar] -> [TyCoVar]+splitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])
+ compiler/types/Unify.hs view
@@ -0,0 +1,1563 @@+-- (c) The University of Glasgow 2006++{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFunctor #-}++module Unify (+        tcMatchTy, tcMatchTyKi,+        tcMatchTys, tcMatchTyKis,+        tcMatchTyX, tcMatchTysX, tcMatchTyKisX,+        tcMatchTyX_BM, ruleMatchTyKiX,++        -- * Rough matching+        roughMatchTcs, instanceCantMatch,+        typesCantMatch,++        -- Side-effect free unification+        tcUnifyTy, tcUnifyTyKi, tcUnifyTys, tcUnifyTyKis,+        tcUnifyTysFG, tcUnifyTyWithTFs,+        BindFlag(..),+        UnifyResult, UnifyResultM(..),++        -- Matching a type against a lifted type (coercion)+        liftCoMatch+   ) where++#include "HsVersions.h"++import GhcPrelude++import Var+import VarEnv+import VarSet+import Name( Name )+import Type hiding ( getTvSubstEnv )+import Coercion hiding ( getCvSubstEnv )+import TyCon+import TyCoRep hiding ( getTvSubstEnv, getCvSubstEnv )+import FV( FV, fvVarSet, fvVarList )+import Util+import Pair+import Outputable+import UniqFM+import UniqSet++import Control.Monad+import qualified Control.Monad.Fail as MonadFail+import Control.Applicative hiding ( empty )+import qualified Control.Applicative++{-++Unification is much tricker than you might think.++1. The substitution we generate binds the *template type variables*+   which are given to us explicitly.++2. We want to match in the presence of foralls;+        e.g     (forall a. t1) ~ (forall b. t2)++   That is what the RnEnv2 is for; it does the alpha-renaming+   that makes it as if a and b were the same variable.+   Initialising the RnEnv2, so that it can generate a fresh+   binder when necessary, entails knowing the free variables of+   both types.++3. We must be careful not to bind a template type variable to a+   locally bound variable.  E.g.+        (forall a. x) ~ (forall b. b)+   where x is the template type variable.  Then we do not want to+   bind x to a/b!  This is a kind of occurs check.+   The necessary locals accumulate in the RnEnv2.++Note [tcMatchTy vs tcMatchTyKi]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+This module offers two variants of matching: with kinds and without.+The TyKi variant takes two types, of potentially different kinds,+and matches them. Along the way, it necessarily also matches their+kinds. The Ty variant instead assumes that the kinds are already+eqType and so skips matching up the kinds.++How do you choose between them?++1. If you know that the kinds of the two types are eqType, use+   the Ty variant. It is more efficient, as it does less work.++2. If the kinds of variables in the template type might mention type families,+   use the Ty variant (and do other work to make sure the kinds+   work out). These pure unification functions do a straightforward+   syntactic unification and do no complex reasoning about type+   families. Note that the types of the variables in instances can indeed+   mention type families, so instance lookup must use the Ty variant.++   (Nothing goes terribly wrong -- no panics -- if there might be type+   families in kinds in the TyKi variant. You just might get match+   failure even though a reducing a type family would lead to success.)++3. Otherwise, if you're sure that the variable kinds do not mention+   type families and you're not already sure that the kind of the template+   equals the kind of the target, then use the TyKi version.+-}++-- | @tcMatchTy t1 t2@ produces a substitution (over fvs(t1))+-- @s@ such that @s(t1)@ equals @t2@.+-- The returned substitution might bind coercion variables,+-- if the variable is an argument to a GADT constructor.+--+-- Precondition: typeKind ty1 `eqType` typeKind ty2+--+-- We don't pass in a set of "template variables" to be bound+-- by the match, because tcMatchTy (and similar functions) are+-- always used on top-level types, so we can bind any of the+-- free variables of the LHS.+-- See also Note [tcMatchTy vs tcMatchTyKi]+tcMatchTy :: Type -> Type -> Maybe TCvSubst+tcMatchTy ty1 ty2 = tcMatchTys [ty1] [ty2]++tcMatchTyX_BM :: (TyVar -> BindFlag) -> TCvSubst+              -> Type -> Type -> Maybe TCvSubst+tcMatchTyX_BM bind_me subst ty1 ty2+  = tc_match_tys_x bind_me False subst [ty1] [ty2]++-- | Like 'tcMatchTy', but allows the kinds of the types to differ,+-- and thus matches them as well.+-- See also Note [tcMatchTy vs tcMatchTyKi]+tcMatchTyKi :: Type -> Type -> Maybe TCvSubst+tcMatchTyKi ty1 ty2+  = tc_match_tys (const BindMe) True [ty1] [ty2]++-- | This is similar to 'tcMatchTy', but extends a substitution+-- See also Note [tcMatchTy vs tcMatchTyKi]+tcMatchTyX :: TCvSubst            -- ^ Substitution to extend+           -> Type                -- ^ Template+           -> Type                -- ^ Target+           -> Maybe TCvSubst+tcMatchTyX subst ty1 ty2+  = tc_match_tys_x (const BindMe) False subst [ty1] [ty2]++-- | Like 'tcMatchTy' but over a list of types.+-- See also Note [tcMatchTy vs tcMatchTyKi]+tcMatchTys :: [Type]         -- ^ Template+           -> [Type]         -- ^ Target+           -> Maybe TCvSubst -- ^ One-shot; in principle the template+                             -- variables could be free in the target+tcMatchTys tys1 tys2+  = tc_match_tys (const BindMe) False tys1 tys2++-- | Like 'tcMatchTyKi' but over a list of types.+-- See also Note [tcMatchTy vs tcMatchTyKi]+tcMatchTyKis :: [Type]         -- ^ Template+             -> [Type]         -- ^ Target+             -> Maybe TCvSubst -- ^ One-shot substitution+tcMatchTyKis tys1 tys2+  = tc_match_tys (const BindMe) True tys1 tys2++-- | Like 'tcMatchTys', but extending a substitution+-- See also Note [tcMatchTy vs tcMatchTyKi]+tcMatchTysX :: TCvSubst       -- ^ Substitution to extend+            -> [Type]         -- ^ Template+            -> [Type]         -- ^ Target+            -> Maybe TCvSubst -- ^ One-shot substitution+tcMatchTysX subst tys1 tys2+  = tc_match_tys_x (const BindMe) False subst tys1 tys2++-- | Like 'tcMatchTyKis', but extending a substitution+-- See also Note [tcMatchTy vs tcMatchTyKi]+tcMatchTyKisX :: TCvSubst        -- ^ Substitution to extend+              -> [Type]          -- ^ Template+              -> [Type]          -- ^ Target+              -> Maybe TCvSubst  -- ^ One-shot substitution+tcMatchTyKisX subst tys1 tys2+  = tc_match_tys_x (const BindMe) True subst tys1 tys2++-- | Same as tc_match_tys_x, but starts with an empty substitution+tc_match_tys :: (TyVar -> BindFlag)+               -> Bool          -- ^ match kinds?+               -> [Type]+               -> [Type]+               -> Maybe TCvSubst+tc_match_tys bind_me match_kis tys1 tys2+  = tc_match_tys_x bind_me match_kis (mkEmptyTCvSubst in_scope) tys1 tys2+  where+    in_scope = mkInScopeSet (tyCoVarsOfTypes tys1 `unionVarSet` tyCoVarsOfTypes tys2)++-- | Worker for 'tcMatchTysX' and 'tcMatchTyKisX'+tc_match_tys_x :: (TyVar -> BindFlag)+               -> Bool          -- ^ match kinds?+               -> TCvSubst+               -> [Type]+               -> [Type]+               -> Maybe TCvSubst+tc_match_tys_x bind_me match_kis (TCvSubst in_scope tv_env cv_env) tys1 tys2+  = case tc_unify_tys bind_me+                      False  -- Matching, not unifying+                      False  -- Not an injectivity check+                      match_kis+                      (mkRnEnv2 in_scope) tv_env cv_env tys1 tys2 of+      Unifiable (tv_env', cv_env')+        -> Just $ TCvSubst in_scope tv_env' cv_env'+      _ -> Nothing++-- | This one is called from the expression matcher,+-- which already has a MatchEnv in hand+ruleMatchTyKiX+  :: TyCoVarSet          -- ^ template variables+  -> RnEnv2+  -> TvSubstEnv          -- ^ type substitution to extend+  -> Type                -- ^ Template+  -> Type                -- ^ Target+  -> Maybe TvSubstEnv+ruleMatchTyKiX tmpl_tvs rn_env tenv tmpl target+-- See Note [Kind coercions in Unify]+  = case tc_unify_tys (matchBindFun tmpl_tvs) False False+                      True -- <-- this means to match the kinds+                      rn_env tenv emptyCvSubstEnv [tmpl] [target] of+      Unifiable (tenv', _) -> Just tenv'+      _                    -> Nothing++matchBindFun :: TyCoVarSet -> TyVar -> BindFlag+matchBindFun tvs tv = if tv `elemVarSet` tvs then BindMe else Skolem+++{- *********************************************************************+*                                                                      *+                Rough matching+*                                                                      *+********************************************************************* -}++-- See Note [Rough match] field in InstEnv++roughMatchTcs :: [Type] -> [Maybe Name]+roughMatchTcs tys = map rough tys+  where+    rough ty+      | Just (ty', _) <- splitCastTy_maybe ty   = rough ty'+      | Just (tc,_)   <- splitTyConApp_maybe ty = Just (tyConName tc)+      | otherwise                               = Nothing++instanceCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool+-- (instanceCantMatch tcs1 tcs2) returns True if tcs1 cannot+-- possibly be instantiated to actual, nor vice versa;+-- False is non-committal+instanceCantMatch (mt : ts) (ma : as) = itemCantMatch mt ma || instanceCantMatch ts as+instanceCantMatch _         _         =  False  -- Safe++itemCantMatch :: Maybe Name -> Maybe Name -> Bool+itemCantMatch (Just t) (Just a) = t /= a+itemCantMatch _        _        = False+++{-+************************************************************************+*                                                                      *+                GADTs+*                                                                      *+************************************************************************++Note [Pruning dead case alternatives]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider        data T a where+                   T1 :: T Int+                   T2 :: T a++                newtype X = MkX Int+                newtype Y = MkY Char++                type family F a+                type instance F Bool = Int++Now consider    case x of { T1 -> e1; T2 -> e2 }++The question before the house is this: if I know something about the type+of x, can I prune away the T1 alternative?++Suppose x::T Char.  It's impossible to construct a (T Char) using T1,+        Answer = YES we can prune the T1 branch (clearly)++Suppose x::T (F a), where 'a' is in scope.  Then 'a' might be instantiated+to 'Bool', in which case x::T Int, so+        ANSWER = NO (clearly)++We see here that we want precisely the apartness check implemented within+tcUnifyTysFG. So that's what we do! Two types cannot match if they are surely+apart. Note that since we are simply dropping dead code, a conservative test+suffices.+-}++-- | Given a list of pairs of types, are any two members of a pair surely+-- apart, even after arbitrary type function evaluation and substitution?+typesCantMatch :: [(Type,Type)] -> Bool+-- See Note [Pruning dead case alternatives]+typesCantMatch prs = any (uncurry cant_match) prs+  where+    cant_match :: Type -> Type -> Bool+    cant_match t1 t2 = case tcUnifyTysFG (const BindMe) [t1] [t2] of+      SurelyApart -> True+      _           -> False++{-+************************************************************************+*                                                                      *+             Unification+*                                                                      *+************************************************************************++Note [Fine-grained unification]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Do the types (x, x) and ([y], y) unify? The answer is seemingly "no" --+no substitution to finite types makes these match. But, a substitution to+*infinite* types can unify these two types: [x |-> [[[...]]], y |-> [[[...]]] ].+Why do we care? Consider these two type family instances:++type instance F x x   = Int+type instance F [y] y = Bool++If we also have++type instance Looper = [Looper]++then the instances potentially overlap. The solution is to use unification+over infinite terms. This is possible (see [1] for lots of gory details), but+a full algorithm is a little more power than we need. Instead, we make a+conservative approximation and just omit the occurs check.++[1]: http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/axioms-extended.pdf++tcUnifyTys considers an occurs-check problem as the same as general unification+failure.++tcUnifyTysFG ("fine-grained") returns one of three results: success, occurs-check+failure ("MaybeApart"), or general failure ("SurelyApart").++See also #8162.++It's worth noting that unification in the presence of infinite types is not+complete. This means that, sometimes, a closed type family does not reduce+when it should. See test case indexed-types/should_fail/Overlap15 for an+example.++Note [The substitution in MaybeApart]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The constructor MaybeApart carries data with it, typically a TvSubstEnv. Why?+Because consider unifying these:++(a, a, Int) ~ (b, [b], Bool)++If we go left-to-right, we start with [a |-> b]. Then, on the middle terms, we+apply the subst we have so far and discover that we need [b |-> [b]]. Because+this fails the occurs check, we say that the types are MaybeApart (see above+Note [Fine-grained unification]). But, we can't stop there! Because if we+continue, we discover that Int is SurelyApart from Bool, and therefore the+types are apart. This has practical consequences for the ability for closed+type family applications to reduce. See test case+indexed-types/should_compile/Overlap14.++Note [Unifying with skolems]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If we discover that two types unify if and only if a skolem variable is+substituted, we can't properly unify the types. But, that skolem variable+may later be instantiated with a unifyable type. So, we return maybeApart+in these cases.+-}++-- | Simple unification of two types; all type variables are bindable+-- Precondition: the kinds are already equal+tcUnifyTy :: Type -> Type       -- All tyvars are bindable+          -> Maybe TCvSubst+                       -- A regular one-shot (idempotent) substitution+tcUnifyTy t1 t2 = tcUnifyTys (const BindMe) [t1] [t2]++-- | Like 'tcUnifyTy', but also unifies the kinds+tcUnifyTyKi :: Type -> Type -> Maybe TCvSubst+tcUnifyTyKi t1 t2 = tcUnifyTyKis (const BindMe) [t1] [t2]++-- | Unify two types, treating type family applications as possibly unifying+-- with anything and looking through injective type family applications.+-- Precondition: kinds are the same+tcUnifyTyWithTFs :: Bool  -- ^ True <=> do two-way unification;+                          --   False <=> do one-way matching.+                          --   See end of sec 5.2 from the paper+                 -> Type -> Type -> Maybe TCvSubst+-- This algorithm is an implementation of the "Algorithm U" presented in+-- the paper "Injective type families for Haskell", Figures 2 and 3.+-- The code is incorporated with the standard unifier for convenience, but+-- its operation should match the specification in the paper.+tcUnifyTyWithTFs twoWay t1 t2+  = case tc_unify_tys (const BindMe) twoWay True False+                       rn_env emptyTvSubstEnv emptyCvSubstEnv+                       [t1] [t2] of+      Unifiable  (subst, _) -> Just $ niFixTCvSubst subst+      MaybeApart (subst, _) -> Just $ niFixTCvSubst subst+      -- we want to *succeed* in questionable cases. This is a+      -- pre-unification algorithm.+      SurelyApart      -> Nothing+  where+    rn_env = mkRnEnv2 $ mkInScopeSet $ tyCoVarsOfTypes [t1, t2]++-----------------+tcUnifyTys :: (TyCoVar -> BindFlag)+           -> [Type] -> [Type]+           -> Maybe TCvSubst+                                -- ^ A regular one-shot (idempotent) substitution+                                -- that unifies the erased types. See comments+                                -- for 'tcUnifyTysFG'++-- The two types may have common type variables, and indeed do so in the+-- second call to tcUnifyTys in FunDeps.checkClsFD+tcUnifyTys bind_fn tys1 tys2+  = case tcUnifyTysFG bind_fn tys1 tys2 of+      Unifiable result -> Just result+      _                -> Nothing++-- | Like 'tcUnifyTys' but also unifies the kinds+tcUnifyTyKis :: (TyCoVar -> BindFlag)+             -> [Type] -> [Type]+             -> Maybe TCvSubst+tcUnifyTyKis bind_fn tys1 tys2+  = case tcUnifyTyKisFG bind_fn tys1 tys2 of+      Unifiable result -> Just result+      _                -> Nothing++-- This type does double-duty. It is used in the UM (unifier monad) and to+-- return the final result. See Note [Fine-grained unification]+type UnifyResult = UnifyResultM TCvSubst+data UnifyResultM a = Unifiable a        -- the subst that unifies the types+                    | MaybeApart a       -- the subst has as much as we know+                                         -- it must be part of a most general unifier+                                         -- See Note [The substitution in MaybeApart]+                    | SurelyApart+                    deriving Functor++instance Applicative UnifyResultM where+  pure  = Unifiable+  (<*>) = ap++instance Monad UnifyResultM where++  SurelyApart  >>= _ = SurelyApart+  MaybeApart x >>= f = case f x of+                         Unifiable y -> MaybeApart y+                         other       -> other+  Unifiable x  >>= f = f x++instance Alternative UnifyResultM where+  empty = SurelyApart++  a@(Unifiable {})  <|> _                 = a+  _                 <|> b@(Unifiable {})  = b+  a@(MaybeApart {}) <|> _                 = a+  _                 <|> b@(MaybeApart {}) = b+  SurelyApart       <|> SurelyApart       = SurelyApart++instance MonadPlus UnifyResultM++-- | @tcUnifyTysFG bind_tv tys1 tys2@ attepts to find a substitution @s@ (whose+-- domain elements all respond 'BindMe' to @bind_tv@) such that+-- @s(tys1)@ and that of @s(tys2)@ are equal, as witnessed by the returned+-- Coercions. This version requires that the kinds of the types are the same,+-- if you unify left-to-right.+tcUnifyTysFG :: (TyVar -> BindFlag)+             -> [Type] -> [Type]+             -> UnifyResult+tcUnifyTysFG bind_fn tys1 tys2+  = tc_unify_tys_fg False bind_fn tys1 tys2++tcUnifyTyKisFG :: (TyVar -> BindFlag)+               -> [Type] -> [Type]+               -> UnifyResult+tcUnifyTyKisFG bind_fn tys1 tys2+  = tc_unify_tys_fg True bind_fn tys1 tys2++tc_unify_tys_fg :: Bool+                -> (TyVar -> BindFlag)+                -> [Type] -> [Type]+                -> UnifyResult+tc_unify_tys_fg match_kis bind_fn tys1 tys2+  = do { (env, _) <- tc_unify_tys bind_fn True False match_kis env+                                  emptyTvSubstEnv emptyCvSubstEnv+                                  tys1 tys2+       ; return $ niFixTCvSubst env }+  where+    vars = tyCoVarsOfTypes tys1 `unionVarSet` tyCoVarsOfTypes tys2+    env  = mkRnEnv2 $ mkInScopeSet vars++-- | This function is actually the one to call the unifier -- a little+-- too general for outside clients, though.+tc_unify_tys :: (TyVar -> BindFlag)+             -> AmIUnifying -- ^ True <=> unify; False <=> match+             -> Bool        -- ^ True <=> doing an injectivity check+             -> Bool        -- ^ True <=> treat the kinds as well+             -> RnEnv2+             -> TvSubstEnv  -- ^ substitution to extend+             -> CvSubstEnv+             -> [Type] -> [Type]+             -> UnifyResultM (TvSubstEnv, CvSubstEnv)+-- NB: It's tempting to ASSERT here that, if we're not matching kinds, then+-- the kinds of the types should be the same. However, this doesn't work,+-- as the types may be a dependent telescope, where later types have kinds+-- that mention variables occurring earlier in the list of types. Here's an+-- example (from typecheck/should_fail/T12709):+--   template: [rep :: RuntimeRep,       a :: TYPE rep]+--   target:   [LiftedRep :: RuntimeRep, Int :: TYPE LiftedRep]+-- We can see that matching the first pair will make the kinds of the second+-- pair equal. Yet, we still don't need a separate pass to unify the kinds+-- of these types, so it's appropriate to use the Ty variant of unification.+-- See also Note [tcMatchTy vs tcMatchTyKi].+tc_unify_tys bind_fn unif inj_check match_kis rn_env tv_env cv_env tys1 tys2+  = initUM tv_env cv_env $+    do { when match_kis $+         unify_tys env kis1 kis2+       ; unify_tys env tys1 tys2+       ; (,) <$> getTvSubstEnv <*> getCvSubstEnv }+  where+    env = UMEnv { um_bind_fun = bind_fn+                , um_skols    = emptyVarSet+                , um_unif     = unif+                , um_inj_tf   = inj_check+                , um_rn_env   = rn_env }++    kis1 = map typeKind tys1+    kis2 = map typeKind tys2++instance Outputable a => Outputable (UnifyResultM a) where+  ppr SurelyApart    = text "SurelyApart"+  ppr (Unifiable x)  = text "Unifiable" <+> ppr x+  ppr (MaybeApart x) = text "MaybeApart" <+> ppr x++{-+************************************************************************+*                                                                      *+                Non-idempotent substitution+*                                                                      *+************************************************************************++Note [Non-idempotent substitution]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+During unification we use a TvSubstEnv/CvSubstEnv pair that is+  (a) non-idempotent+  (b) loop-free; ie repeatedly applying it yields a fixed point++Note [Finding the substitution fixpoint]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Finding the fixpoint of a non-idempotent substitution arising from a+unification is much trickier than it looks, because of kinds.  Consider+   T k (H k (f:k)) ~ T * (g:*)+If we unify, we get the substitution+   [ k -> *+   , g -> H k (f:k) ]+To make it idempotent we don't want to get just+   [ k -> *+   , g -> H * (f:k) ]+We also want to substitute inside f's kind, to get+   [ k -> *+   , g -> H k (f:*) ]+If we don't do this, we may apply the substitution to something,+and get an ill-formed type, i.e. one where typeKind will fail.+This happened, for example, in #9106.++It gets worse.  In #14164 we wanted to take the fixpoint of+this substitution+   [ xs_asV :-> F a_aY6 (z_aY7 :: a_aY6)+                        (rest_aWF :: G a_aY6 (z_aY7 :: a_aY6))+   , a_aY6  :-> a_aXQ ]++We have to apply the substitution for a_aY6 two levels deep inside+the invocation of F!  We don't have a function that recursively+applies substitutions inside the kinds of variable occurrences (and+probably rightly so).++So, we work as follows:++ 1. Start with the current substitution (which we are+    trying to fixpoint+       [ xs :-> F a (z :: a) (rest :: G a (z :: a))+       , a  :-> b ]++ 2. Take all the free vars of the range of the substitution:+       {a, z, rest, b}+    NB: the free variable finder closes over+    the kinds of variable occurrences++ 3. If none are in the domain of the substitution, stop.+    We have found a fixpoint.++ 4. Remove the variables that are bound by the substitution, leaving+       {z, rest, b}++ 5. Do a topo-sort to put them in dependency order:+       [ b :: *, z :: a, rest :: G a z ]++ 6. Apply the substitution left-to-right to the kinds of these+    tyvars, extending it each time with a new binding, so we+    finish up with+       [ xs   :-> ..as before..+       , a    :-> b+       , b    :-> b    :: *+       , z    :-> z    :: b+       , rest :-> rest :: G b (z :: b) ]+    Note that rest now has the right kind++ 7. Apply this extended substitution (once) to the range of+    the /original/ substitution.  (Note that we do the+    extended substitution would go on forever if you tried+    to find its fixpoint, because it maps z to z.)++ 8. And go back to step 1++In Step 6 we use the free vars from Step 2 as the initial+in-scope set, because all of those variables appear in the+range of the substitution, so they must all be in the in-scope+set.  But NB that the type substitution engine does not look up+variables in the in-scope set; it is used only to ensure no+shadowing.+-}++niFixTCvSubst :: TvSubstEnv -> TCvSubst+-- Find the idempotent fixed point of the non-idempotent substitution+-- This is surprisingly tricky:+--   see Note [Finding the substitution fixpoint]+-- ToDo: use laziness instead of iteration?+niFixTCvSubst tenv+  | not_fixpoint = niFixTCvSubst (mapVarEnv (substTy subst) tenv)+  | otherwise    = subst+  where+    range_fvs :: FV+    range_fvs = tyCoFVsOfTypes (nonDetEltsUFM tenv)+          -- It's OK to use nonDetEltsUFM here because the+          -- order of range_fvs, range_tvs is immaterial++    range_tvs :: [TyVar]+    range_tvs = fvVarList range_fvs++    not_fixpoint  = any in_domain range_tvs+    in_domain tv  = tv `elemVarEnv` tenv++    free_tvs = scopedSort (filterOut in_domain range_tvs)++    -- See Note [Finding the substitution fixpoint], Step 6+    init_in_scope = mkInScopeSet (fvVarSet range_fvs)+    subst = foldl' add_free_tv+                  (mkTvSubst init_in_scope tenv)+                  free_tvs++    add_free_tv :: TCvSubst -> TyVar -> TCvSubst+    add_free_tv subst tv+      = extendTvSubst subst tv (mkTyVarTy tv')+     where+        tv' = updateTyVarKind (substTy subst) tv++niSubstTvSet :: TvSubstEnv -> TyCoVarSet -> TyCoVarSet+-- Apply the non-idempotent substitution to a set of type variables,+-- remembering that the substitution isn't necessarily idempotent+-- This is used in the occurs check, before extending the substitution+niSubstTvSet tsubst tvs+  = nonDetFoldUniqSet (unionVarSet . get) emptyVarSet tvs+  -- It's OK to nonDetFoldUFM here because we immediately forget the+  -- ordering by creating a set.+  where+    get tv+      | Just ty <- lookupVarEnv tsubst tv+      = niSubstTvSet tsubst (tyCoVarsOfType ty)++      | otherwise+      = unitVarSet tv++{-+************************************************************************+*                                                                      *+                unify_ty: the main workhorse+*                                                                      *+************************************************************************++Note [Specification of unification]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The pure unifier, unify_ty, defined in this module, tries to work out+a substitution to make two types say True to eqType. NB: eqType is+itself not purely syntactic; it accounts for CastTys;+see Note [Non-trivial definitional equality] in TyCoRep++Unlike the "impure unifiers" in the typechecker (the eager unifier in+TcUnify, and the constraint solver itself in TcCanonical), the pure+unifier It does /not/ work up to ~.++The algorithm implemented here is rather delicate, and we depend on it+to uphold certain properties. This is a summary of these required+properties. Any reference to "flattening" refers to the flattening+algorithm in FamInstEnv (See Note [Flattening] in FamInstEnv), not+the flattening algorithm in the solver.++Notation:+ θ,φ    substitutions+ ξ    type-function-free types+ τ,σ  other types+ τ♭   type τ, flattened++ ≡    eqType++(U1) Soundness.+     If (unify τ₁ τ₂) = Unifiable θ, then θ(τ₁) ≡ θ(τ₂).+     θ is a most general unifier for τ₁ and τ₂.++(U2) Completeness.+     If (unify ξ₁ ξ₂) = SurelyApart,+     then there exists no substitution θ such that θ(ξ₁) ≡ θ(ξ₂).++These two properties are stated as Property 11 in the "Closed Type Families"+paper (POPL'14). Below, this paper is called [CTF].++(U3) Apartness under substitution.+     If (unify ξ τ♭) = SurelyApart, then (unify ξ θ(τ)♭) = SurelyApart,+     for any θ. (Property 12 from [CTF])++(U4) Apart types do not unify.+     If (unify ξ τ♭) = SurelyApart, then there exists no θ+     such that θ(ξ) = θ(τ). (Property 13 from [CTF])++THEOREM. Completeness w.r.t ~+    If (unify τ₁♭ τ₂♭) = SurelyApart,+    then there exists no proof that (τ₁ ~ τ₂).++PROOF. See appendix of [CTF].+++The unification algorithm is used for type family injectivity, as described+in the "Injective Type Families" paper (Haskell'15), called [ITF]. When run+in this mode, it has the following properties.++(I1) If (unify σ τ) = SurelyApart, then σ and τ are not unifiable, even+     after arbitrary type family reductions. Note that σ and τ are+     not flattened here.++(I2) If (unify σ τ) = MaybeApart θ, and if some+     φ exists such that φ(σ) ~ φ(τ), then φ extends θ.+++Furthermore, the RULES matching algorithm requires this property,+but only when using this algorithm for matching:++(M1) If (match σ τ) succeeds with θ, then all matchable tyvars+     in σ are bound in θ.++     Property M1 means that we must extend the substitution with,+     say (a ↦ a) when appropriate during matching.+     See also Note [Self-substitution when matching].++(M2) Completeness of matching.+     If θ(σ) = τ, then (match σ τ) = Unifiable φ,+     where θ is an extension of φ.++Sadly, property M2 and I2 conflict. Consider++type family F1 a b where+  F1 Int    Bool   = Char+  F1 Double String = Char++Consider now two matching problems:++P1. match (F1 a Bool) (F1 Int Bool)+P2. match (F1 a Bool) (F1 Double String)++In case P1, we must find (a ↦ Int) to satisfy M2.+In case P2, we must /not/ find (a ↦ Double), in order to satisfy I2. (Note+that the correct mapping for I2 is (a ↦ Int). There is no way to discover+this, but we musn't map a to anything else!)++We thus must parameterize the algorithm over whether it's being used+for an injectivity check (refrain from looking at non-injective arguments+to type families) or not (do indeed look at those arguments).  This is+implemented  by the uf_inj_tf field of UmEnv.++(It's all a question of whether or not to include equation (7) from Fig. 2+of [ITF].)++This extra parameter is a bit fiddly, perhaps, but seemingly less so than+having two separate, almost-identical algorithms.++Note [Self-substitution when matching]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+What should happen when we're *matching* (not unifying) a1 with a1? We+should get a substitution [a1 |-> a1]. A successful match should map all+the template variables (except ones that disappear when expanding synonyms).+But when unifying, we don't want to do this, because we'll then fall into+a loop.++This arrangement affects the code in three places:+ - If we're matching a refined template variable, don't recur. Instead, just+   check for equality. That is, if we know [a |-> Maybe a] and are matching+   (a ~? Maybe Int), we want to just fail.++ - Skip the occurs check when matching. This comes up in two places, because+   matching against variables is handled separately from matching against+   full-on types.++Note that this arrangement was provoked by a real failure, where the same+unique ended up in the template as in the target. (It was a rule firing when+compiling Data.List.NonEmpty.)++Note [Matching coercion variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider this:++   type family F a++   data G a where+     MkG :: F a ~ Bool => G a++   type family Foo (x :: G a) :: F a+   type instance Foo MkG = False++We would like that to be accepted. For that to work, we need to introduce+a coercion variable on the left and then use it on the right. Accordingly,+at use sites of Foo, we need to be able to use matching to figure out the+value for the coercion. (See the desugared version:++   axFoo :: [a :: *, c :: F a ~ Bool]. Foo (MkG c) = False |> (sym c)++) We never want this action to happen during *unification* though, when+all bets are off.++Note [Kind coercions in Unify]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We wish to match/unify while ignoring casts. But, we can't just ignore+them completely, or we'll end up with ill-kinded substitutions. For example,+say we're matching `a` with `ty |> co`. If we just drop the cast, we'll+return [a |-> ty], but `a` and `ty` might have different kinds. We can't+just match/unify their kinds, either, because this might gratuitously+fail. After all, `co` is the witness that the kinds are the same -- they+may look nothing alike.++So, we pass a kind coercion to the match/unify worker. This coercion witnesses+the equality between the substed kind of the left-hand type and the substed+kind of the right-hand type. Note that we do not unify kinds at the leaves+(as we did previously). We thus have++INVARIANT: In the call+    unify_ty ty1 ty2 kco+it must be that subst(kco) :: subst(kind(ty1)) ~N subst(kind(ty2)), where+`subst` is the ambient substitution in the UM monad.++To get this coercion, we first have to match/unify+the kinds before looking at the types. Happily, we need look only one level+up, as all kinds are guaranteed to have kind *.++When we're working with type applications (either TyConApp or AppTy) we+need to worry about establishing INVARIANT, as the kinds of the function+& arguments aren't (necessarily) included in the kind of the result.+When unifying two TyConApps, this is easy, because the two TyCons are+the same. Their kinds are thus the same. As long as we unify left-to-right,+we'll be sure to unify types' kinds before the types themselves. (For example,+think about Proxy :: forall k. k -> *. Unifying the first args matches up+the kinds of the second args.)++For AppTy, we must unify the kinds of the functions, but once these are+unified, we can continue unifying arguments without worrying further about+kinds.++The interface to this module includes both "...Ty" functions and+"...TyKi" functions. The former assume that INVARIANT is already+established, either because the kinds are the same or because the+list of types being passed in are the well-typed arguments to some+type constructor (see two paragraphs above). The latter take a separate+pre-pass over the kinds to establish INVARIANT. Sometimes, it's important+not to take the second pass, as it caused #12442.++We thought, at one point, that this was all unnecessary: why should+casts be in types in the first place? But they are sometimes. In+dependent/should_compile/KindEqualities2, we see, for example the+constraint Num (Int |> (blah ; sym blah)).  We naturally want to find+a dictionary for that constraint, which requires dealing with+coercions in this manner.++Note [Matching in the presence of casts]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When matching, it is crucial that no variables from the template+end up in the range of the matching substitution (obviously!).+When unifying, that's not a constraint; instead we take the fixpoint+of the substitution at the end.++So what should we do with this, when matching?+   unify_ty (tmpl |> co) tgt kco++Previously, wrongly, we pushed 'co' in the (horrid) accumulating+'kco' argument like this:+   unify_ty (tmpl |> co) tgt kco+     = unify_ty tmpl tgt (kco ; co)++But that is obviously wrong because 'co' (from the template) ends+up in 'kco', which in turn ends up in the range of the substitution.++This all came up in #13910.  Because we match tycon arguments+left-to-right, the ambient substitution will already have a matching+substitution for any kinds; so there is an easy fix: just apply+the substitution-so-far to the coercion from the LHS.++Note that++* When matching, the first arg of unify_ty is always the template;+  we never swap round.++* The above argument is distressingly indirect. We seek a+  better way.++* One better way is to ensure that type patterns (the template+  in the matching process) have no casts.  See #14119.++Note [Polykinded tycon applications]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose  T :: forall k. Type -> K+and we are unifying+  ty1:  T @Type         Int       :: Type+  ty2:  T @(Type->Type) Int Int   :: Type++These two TyConApps have the same TyCon at the front but they+(legitimately) have different numbers of arguments.  They+are surelyApart, so we can report that without looking any+further (see #15704).+-}++-------------- unify_ty: the main workhorse -----------++type AmIUnifying = Bool   -- True  <=> Unifying+                          -- False <=> Matching++unify_ty :: UMEnv+         -> Type -> Type  -- Types to be unified and a co+         -> CoercionN     -- A coercion between their kinds+                          -- See Note [Kind coercions in Unify]+         -> UM ()+-- See Note [Specification of unification]+-- Respects newtypes, PredTypes++unify_ty env ty1 ty2 kco+    -- TODO: More commentary needed here+  | Just ty1' <- tcView ty1   = unify_ty env ty1' ty2 kco+  | Just ty2' <- tcView ty2   = unify_ty env ty1 ty2' kco+  | CastTy ty1' co <- ty1     = if um_unif env+                                then unify_ty env ty1' ty2 (co `mkTransCo` kco)+                                else -- See Note [Matching in the presence of casts]+                                     do { subst <- getSubst env+                                        ; let co' = substCo subst co+                                        ; unify_ty env ty1' ty2 (co' `mkTransCo` kco) }+  | CastTy ty2' co <- ty2     = unify_ty env ty1 ty2' (kco `mkTransCo` mkSymCo co)++unify_ty env (TyVarTy tv1) ty2 kco+  = uVar env tv1 ty2 kco+unify_ty env ty1 (TyVarTy tv2) kco+  | um_unif env  -- If unifying, can swap args+  = uVar (umSwapRn env) tv2 ty1 (mkSymCo kco)++unify_ty env ty1 ty2 _kco+  | Just (tc1, tys1) <- mb_tc_app1+  , Just (tc2, tys2) <- mb_tc_app2+  , tc1 == tc2 || (tcIsLiftedTypeKind ty1 && tcIsLiftedTypeKind ty2)+  = if isInjectiveTyCon tc1 Nominal+    then unify_tys env tys1 tys2+    else do { let inj | isTypeFamilyTyCon tc1+                      = case tyConInjectivityInfo tc1 of+                               NotInjective -> repeat False+                               Injective bs -> bs+                      | otherwise+                      = repeat False++                  (inj_tys1, noninj_tys1) = partitionByList inj tys1+                  (inj_tys2, noninj_tys2) = partitionByList inj tys2++            ; unify_tys env inj_tys1 inj_tys2+            ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification]+              don'tBeSoSure $ unify_tys env noninj_tys1 noninj_tys2 }++  | Just (tc1, _) <- mb_tc_app1+  , not (isGenerativeTyCon tc1 Nominal)+    -- E.g.   unify_ty (F ty1) b  =  MaybeApart+    --        because the (F ty1) behaves like a variable+    --        NB: if unifying, we have already dealt+    --            with the 'ty2 = variable' case+  = maybeApart++  | Just (tc2, _) <- mb_tc_app2+  , not (isGenerativeTyCon tc2 Nominal)+  , um_unif env+    -- E.g.   unify_ty [a] (F ty2) =  MaybeApart, when unifying (only)+    --        because the (F ty2) behaves like a variable+    --        NB: we have already dealt with the 'ty1 = variable' case+  = maybeApart++  where+    mb_tc_app1 = tcSplitTyConApp_maybe ty1+    mb_tc_app2 = tcSplitTyConApp_maybe ty2++        -- Applications need a bit of care!+        -- They can match FunTy and TyConApp, so use splitAppTy_maybe+        -- NB: we've already dealt with type variables,+        -- so if one type is an App the other one jolly well better be too+unify_ty env (AppTy ty1a ty1b) ty2 _kco+  | Just (ty2a, ty2b) <- tcRepSplitAppTy_maybe ty2+  = unify_ty_app env ty1a [ty1b] ty2a [ty2b]++unify_ty env ty1 (AppTy ty2a ty2b) _kco+  | Just (ty1a, ty1b) <- tcRepSplitAppTy_maybe ty1+  = unify_ty_app env ty1a [ty1b] ty2a [ty2b]++unify_ty _ (LitTy x) (LitTy y) _kco | x == y = return ()++unify_ty env (ForAllTy (Bndr tv1 _) ty1) (ForAllTy (Bndr tv2 _) ty2) kco+  = do { unify_ty env (varType tv1) (varType tv2) (mkNomReflCo liftedTypeKind)+       ; let env' = umRnBndr2 env tv1 tv2+       ; unify_ty env' ty1 ty2 kco }++-- See Note [Matching coercion variables]+unify_ty env (CoercionTy co1) (CoercionTy co2) kco+  = do { c_subst <- getCvSubstEnv+       ; case co1 of+           CoVarCo cv+             | not (um_unif env)+             , not (cv `elemVarEnv` c_subst)+             , BindMe <- tvBindFlag env cv+             -> do { checkRnEnv env (tyCoVarsOfCo co2)+                   ; let (co_l, co_r) = decomposeFunCo Nominal kco+                      -- cv :: t1 ~ t2+                      -- co2 :: s1 ~ s2+                      -- co_l :: t1 ~ s1+                      -- co_r :: t2 ~ s2+                   ; extendCvEnv cv (co_l `mkTransCo`+                                     co2 `mkTransCo`+                                     mkSymCo co_r) }+           _ -> return () }++unify_ty _ _ _ _ = surelyApart++unify_ty_app :: UMEnv -> Type -> [Type] -> Type -> [Type] -> UM ()+unify_ty_app env ty1 ty1args ty2 ty2args+  | Just (ty1', ty1a) <- repSplitAppTy_maybe ty1+  , Just (ty2', ty2a) <- repSplitAppTy_maybe ty2+  = unify_ty_app env ty1' (ty1a : ty1args) ty2' (ty2a : ty2args)++  | otherwise+  = do { let ki1 = typeKind ty1+             ki2 = typeKind ty2+           -- See Note [Kind coercions in Unify]+       ; unify_ty  env ki1 ki2 (mkNomReflCo liftedTypeKind)+       ; unify_ty  env ty1 ty2 (mkNomReflCo ki1)+       ; unify_tys env ty1args ty2args }++unify_tys :: UMEnv -> [Type] -> [Type] -> UM ()+unify_tys env orig_xs orig_ys+  = go orig_xs orig_ys+  where+    go []     []     = return ()+    go (x:xs) (y:ys)+      -- See Note [Kind coercions in Unify]+      = do { unify_ty env x y (mkNomReflCo $ typeKind x)+           ; go xs ys }+    go _ _ = surelyApart+      -- Possibly different saturations of a polykinded tycon+      -- See Note [Polykinded tycon applications]++---------------------------------+uVar :: UMEnv+     -> InTyVar         -- Variable to be unified+     -> Type            -- with this Type+     -> Coercion        -- :: kind tv ~N kind ty+     -> UM ()++uVar env tv1 ty kco+ = do { -- Apply the ambient renaming+        let tv1' = umRnOccL env tv1++        -- Check to see whether tv1 is refined by the substitution+      ; subst <- getTvSubstEnv+      ; case (lookupVarEnv subst tv1') of+          Just ty' | um_unif env                -- Unifying, so call+                   -> unify_ty env ty' ty kco   -- back into unify+                   | otherwise+                   -> -- Matching, we don't want to just recur here.+                      -- this is because the range of the subst is the target+                      -- type, not the template type. So, just check for+                      -- normal type equality.+                      guard ((ty' `mkCastTy` kco) `eqType` ty)+          Nothing  -> uUnrefined env tv1' ty ty kco } -- No, continue++uUnrefined :: UMEnv+           -> OutTyVar          -- variable to be unified+           -> Type              -- with this Type+           -> Type              -- (version w/ expanded synonyms)+           -> Coercion          -- :: kind tv ~N kind ty+           -> UM ()++-- We know that tv1 isn't refined++uUnrefined env tv1' ty2 ty2' kco+  | Just ty2'' <- coreView ty2'+  = uUnrefined env tv1' ty2 ty2'' kco    -- Unwrap synonyms+                -- This is essential, in case we have+                --      type Foo a = a+                -- and then unify a ~ Foo a++  | TyVarTy tv2 <- ty2'+  = do { let tv2' = umRnOccR env tv2+       ; unless (tv1' == tv2' && um_unif env) $ do+           -- If we are unifying a ~ a, just return immediately+           -- Do not extend the substitution+           -- See Note [Self-substitution when matching]++          -- Check to see whether tv2 is refined+       { subst <- getTvSubstEnv+       ; case lookupVarEnv subst tv2 of+         {  Just ty' | um_unif env -> uUnrefined env tv1' ty' ty' kco+         ;  _ ->++    do {   -- So both are unrefined+           -- Bind one or the other, depending on which is bindable+       ; let b1  = tvBindFlag env tv1'+             b2  = tvBindFlag env tv2'+             ty1 = mkTyVarTy tv1'+       ; case (b1, b2) of+           (BindMe, _) -> bindTv env tv1' (ty2 `mkCastTy` mkSymCo kco)+           (_, BindMe) | um_unif env+                       -> bindTv (umSwapRn env) tv2 (ty1 `mkCastTy` kco)++           _ | tv1' == tv2' -> return ()+             -- How could this happen? If we're only matching and if+             -- we're comparing forall-bound variables.++           _ -> maybeApart -- See Note [Unification with skolems]+  }}}}++uUnrefined env tv1' ty2 _ kco -- ty2 is not a type variable+  = case tvBindFlag env tv1' of+      Skolem -> maybeApart  -- See Note [Unification with skolems]+      BindMe -> bindTv env tv1' (ty2 `mkCastTy` mkSymCo kco)++bindTv :: UMEnv -> OutTyVar -> Type -> UM ()+-- OK, so we want to extend the substitution with tv := ty+-- But first, we must do a couple of checks+bindTv env tv1 ty2+  = do  { let free_tvs2 = tyCoVarsOfType ty2++        -- Make sure tys mentions no local variables+        -- E.g.  (forall a. b) ~ (forall a. [a])+        -- We should not unify b := [a]!+        ; checkRnEnv env free_tvs2++        -- Occurs check, see Note [Fine-grained unification]+        -- Make sure you include 'kco' (which ty2 does) #14846+        ; occurs <- occursCheck env tv1 free_tvs2++        ; if occurs then maybeApart+                    else extendTvEnv tv1 ty2 }++occursCheck :: UMEnv -> TyVar -> VarSet -> UM Bool+occursCheck env tv free_tvs+  | um_unif env+  = do { tsubst <- getTvSubstEnv+       ; return (tv `elemVarSet` niSubstTvSet tsubst free_tvs) }++  | otherwise      -- Matching; no occurs check+  = return False   -- See Note [Self-substitution when matching]++{-+%************************************************************************+%*                                                                      *+                Binding decisions+*                                                                      *+************************************************************************+-}++data BindFlag+  = BindMe      -- A regular type variable++  | Skolem      -- This type variable is a skolem constant+                -- Don't bind it; it only matches itself+  deriving Eq++{-+************************************************************************+*                                                                      *+                Unification monad+*                                                                      *+************************************************************************+-}++data UMEnv+  = UMEnv { um_unif :: AmIUnifying++          , um_inj_tf :: Bool+            -- Checking for injectivity?+            -- See (end of) Note [Specification of unification]++          , um_rn_env :: RnEnv2+            -- Renaming InTyVars to OutTyVars; this eliminates+            -- shadowing, and lines up matching foralls on the left+            -- and right++          , um_skols :: TyVarSet+            -- OutTyVars bound by a forall in this unification;+            -- Do not bind these in the substitution!+            -- See the function tvBindFlag++          , um_bind_fun :: TyVar -> BindFlag+            -- User-supplied BindFlag function,+            -- for variables not in um_skols+          }++data UMState = UMState+                   { um_tv_env   :: TvSubstEnv+                   , um_cv_env   :: CvSubstEnv }++newtype UM a = UM { unUM :: UMState -> UnifyResultM (UMState, a) }++instance Functor UM where+      fmap = liftM++instance Applicative UM where+      pure a = UM (\s -> pure (s, a))+      (<*>)  = ap++instance Monad UM where+#if !MIN_VERSION_base(4,13,0)+  fail     = MonadFail.fail+#endif+  m >>= k  = UM (\state ->+                  do { (state', v) <- unUM m state+                     ; unUM (k v) state' })++-- need this instance because of a use of 'guard' above+instance Alternative UM where+  empty     = UM (\_ -> Control.Applicative.empty)+  m1 <|> m2 = UM (\state ->+                  unUM m1 state <|>+                  unUM m2 state)++instance MonadPlus UM++instance MonadFail.MonadFail UM where+    fail _   = UM (\_ -> SurelyApart) -- failed pattern match++initUM :: TvSubstEnv  -- subst to extend+       -> CvSubstEnv+       -> UM a -> UnifyResultM a+initUM subst_env cv_subst_env um+  = case unUM um state of+      Unifiable (_, subst)  -> Unifiable subst+      MaybeApart (_, subst) -> MaybeApart subst+      SurelyApart           -> SurelyApart+  where+    state = UMState { um_tv_env = subst_env+                    , um_cv_env = cv_subst_env }++tvBindFlag :: UMEnv -> OutTyVar -> BindFlag+tvBindFlag env tv+  | tv `elemVarSet` um_skols env = Skolem+  | otherwise                    = um_bind_fun env tv++getTvSubstEnv :: UM TvSubstEnv+getTvSubstEnv = UM $ \state -> Unifiable (state, um_tv_env state)++getCvSubstEnv :: UM CvSubstEnv+getCvSubstEnv = UM $ \state -> Unifiable (state, um_cv_env state)++getSubst :: UMEnv -> UM TCvSubst+getSubst env = do { tv_env <- getTvSubstEnv+                  ; cv_env <- getCvSubstEnv+                  ; let in_scope = rnInScopeSet (um_rn_env env)+                  ; return (mkTCvSubst in_scope (tv_env, cv_env)) }++extendTvEnv :: TyVar -> Type -> UM ()+extendTvEnv tv ty = UM $ \state ->+  Unifiable (state { um_tv_env = extendVarEnv (um_tv_env state) tv ty }, ())++extendCvEnv :: CoVar -> Coercion -> UM ()+extendCvEnv cv co = UM $ \state ->+  Unifiable (state { um_cv_env = extendVarEnv (um_cv_env state) cv co }, ())++umRnBndr2 :: UMEnv -> TyCoVar -> TyCoVar -> UMEnv+umRnBndr2 env v1 v2+  = env { um_rn_env = rn_env', um_skols = um_skols env `extendVarSet` v' }+  where+    (rn_env', v') = rnBndr2_var (um_rn_env env) v1 v2++checkRnEnv :: UMEnv -> VarSet -> UM ()+checkRnEnv env varset+  | isEmptyVarSet skol_vars           = return ()+  | varset `disjointVarSet` skol_vars = return ()+  | otherwise                         = maybeApart+               -- ToDo: why MaybeApart?+               -- I think SurelyApart would be right+  where+    skol_vars = um_skols env+    -- NB: That isEmptyVarSet guard is a critical optimization;+    -- it means we don't have to calculate the free vars of+    -- the type, often saving quite a bit of allocation.++-- | Converts any SurelyApart to a MaybeApart+don'tBeSoSure :: UM () -> UM ()+don'tBeSoSure um = UM $ \ state ->+  case unUM um state of+    SurelyApart -> MaybeApart (state, ())+    other       -> other++umRnOccL :: UMEnv -> TyVar -> TyVar+umRnOccL env v = rnOccL (um_rn_env env) v++umRnOccR :: UMEnv -> TyVar -> TyVar+umRnOccR env v = rnOccR (um_rn_env env) v++umSwapRn :: UMEnv -> UMEnv+umSwapRn env = env { um_rn_env = rnSwap (um_rn_env env) }++maybeApart :: UM ()+maybeApart = UM (\state -> MaybeApart (state, ()))++surelyApart :: UM a+surelyApart = UM (\_ -> SurelyApart)++{-+%************************************************************************+%*                                                                      *+            Matching a (lifted) type against a coercion+%*                                                                      *+%************************************************************************++This section defines essentially an inverse to liftCoSubst. It is defined+here to avoid a dependency from Coercion on this module.++-}++data MatchEnv = ME { me_tmpls :: TyVarSet+                   , me_env   :: RnEnv2 }++-- | 'liftCoMatch' is sort of inverse to 'liftCoSubst'.  In particular, if+--   @liftCoMatch vars ty co == Just s@, then @liftCoSubst s ty == co@,+--   where @==@ there means that the result of 'liftCoSubst' has the same+--   type as the original co; but may be different under the hood.+--   That is, it matches a type against a coercion of the same+--   "shape", and returns a lifting substitution which could have been+--   used to produce the given coercion from the given type.+--   Note that this function is incomplete -- it might return Nothing+--   when there does indeed exist a possible lifting context.+--+-- This function is incomplete in that it doesn't respect the equality+-- in `eqType`. That is, it's possible that this will succeed for t1 and+-- fail for t2, even when t1 `eqType` t2. That's because it depends on+-- there being a very similar structure between the type and the coercion.+-- This incompleteness shouldn't be all that surprising, especially because+-- it depends on the structure of the coercion, which is a silly thing to do.+--+-- The lifting context produced doesn't have to be exacting in the roles+-- of the mappings. This is because any use of the lifting context will+-- also require a desired role. Thus, this algorithm prefers mapping to+-- nominal coercions where it can do so.+liftCoMatch :: TyCoVarSet -> Type -> Coercion -> Maybe LiftingContext+liftCoMatch tmpls ty co+  = do { cenv1 <- ty_co_match menv emptyVarEnv ki ki_co ki_ki_co ki_ki_co+       ; cenv2 <- ty_co_match menv cenv1       ty co+                              (mkNomReflCo co_lkind) (mkNomReflCo co_rkind)+       ; return (LC (mkEmptyTCvSubst in_scope) cenv2) }+  where+    menv     = ME { me_tmpls = tmpls, me_env = mkRnEnv2 in_scope }+    in_scope = mkInScopeSet (tmpls `unionVarSet` tyCoVarsOfCo co)+    -- Like tcMatchTy, assume all the interesting variables+    -- in ty are in tmpls++    ki       = typeKind ty+    ki_co    = promoteCoercion co+    ki_ki_co = mkNomReflCo liftedTypeKind++    Pair co_lkind co_rkind = coercionKind ki_co++-- | 'ty_co_match' does all the actual work for 'liftCoMatch'.+ty_co_match :: MatchEnv   -- ^ ambient helpful info+            -> LiftCoEnv  -- ^ incoming subst+            -> Type       -- ^ ty, type to match+            -> Coercion   -- ^ co, coercion to match against+            -> Coercion   -- ^ :: kind of L type of substed ty ~N L kind of co+            -> Coercion   -- ^ :: kind of R type of substed ty ~N R kind of co+            -> Maybe LiftCoEnv+ty_co_match menv subst ty co lkco rkco+  | Just ty' <- coreView ty = ty_co_match menv subst ty' co lkco rkco++  -- handle Refl case:+  | tyCoVarsOfType ty `isNotInDomainOf` subst+  , Just (ty', _) <- isReflCo_maybe co+  , ty `eqType` ty'+  = Just subst++  where+    isNotInDomainOf :: VarSet -> VarEnv a -> Bool+    isNotInDomainOf set env+      = noneSet (\v -> elemVarEnv v env) set++    noneSet :: (Var -> Bool) -> VarSet -> Bool+    noneSet f = allVarSet (not . f)++ty_co_match menv subst ty co lkco rkco+  | CastTy ty' co' <- ty+     -- See Note [Matching in the presence of casts]+  = let empty_subst  = mkEmptyTCvSubst (rnInScopeSet (me_env menv))+        substed_co_l = substCo (liftEnvSubstLeft empty_subst subst)  co'+        substed_co_r = substCo (liftEnvSubstRight empty_subst subst) co'+    in+    ty_co_match menv subst ty' co (substed_co_l `mkTransCo` lkco)+                                  (substed_co_r `mkTransCo` rkco)++  | SymCo co' <- co+  = swapLiftCoEnv <$> ty_co_match menv (swapLiftCoEnv subst) ty co' rkco lkco++  -- Match a type variable against a non-refl coercion+ty_co_match menv subst (TyVarTy tv1) co lkco rkco+  | Just co1' <- lookupVarEnv subst tv1' -- tv1' is already bound to co1+  = if eqCoercionX (nukeRnEnvL rn_env) co1' co+    then Just subst+    else Nothing       -- no match since tv1 matches two different coercions++  | tv1' `elemVarSet` me_tmpls menv           -- tv1' is a template var+  = if any (inRnEnvR rn_env) (tyCoVarsOfCoList co)+    then Nothing      -- occurs check failed+    else Just $ extendVarEnv subst tv1' $+                castCoercionKindI co (mkSymCo lkco) (mkSymCo rkco)++  | otherwise+  = Nothing++  where+    rn_env = me_env menv+    tv1' = rnOccL rn_env tv1++  -- just look through SubCo's. We don't really care about roles here.+ty_co_match menv subst ty (SubCo co) lkco rkco+  = ty_co_match menv subst ty co lkco rkco++ty_co_match menv subst (AppTy ty1a ty1b) co _lkco _rkco+  | Just (co2, arg2) <- splitAppCo_maybe co     -- c.f. Unify.match on AppTy+  = ty_co_match_app menv subst ty1a [ty1b] co2 [arg2]+ty_co_match menv subst ty1 (AppCo co2 arg2) _lkco _rkco+  | Just (ty1a, ty1b) <- repSplitAppTy_maybe ty1+       -- yes, the one from Type, not TcType; this is for coercion optimization+  = ty_co_match_app menv subst ty1a [ty1b] co2 [arg2]++ty_co_match menv subst (TyConApp tc1 tys) (TyConAppCo _ tc2 cos) _lkco _rkco+  = ty_co_match_tc menv subst tc1 tys tc2 cos+ty_co_match menv subst (FunTy _ ty1 ty2) co _lkco _rkco+    -- Despite the fact that (->) is polymorphic in four type variables (two+    -- runtime rep and two types), we shouldn't need to explicitly unify the+    -- runtime reps here; unifying the types themselves should be sufficient.+    -- See Note [Representation of function types].+  | Just (tc, [_,_,co1,co2]) <- splitTyConAppCo_maybe co+  , tc == funTyCon+  = let Pair lkcos rkcos = traverse (fmap mkNomReflCo . coercionKind) [co1,co2]+    in ty_co_match_args menv subst [ty1, ty2] [co1, co2] lkcos rkcos++ty_co_match menv subst (ForAllTy (Bndr tv1 _) ty1)+                       (ForAllCo tv2 kind_co2 co2)+                       lkco rkco+  | isTyVar tv1 && isTyVar tv2+  = do { subst1 <- ty_co_match menv subst (tyVarKind tv1) kind_co2+                               ki_ki_co ki_ki_co+       ; let rn_env0 = me_env menv+             rn_env1 = rnBndr2 rn_env0 tv1 tv2+             menv'   = menv { me_env = rn_env1 }+       ; ty_co_match menv' subst1 ty1 co2 lkco rkco }+  where+    ki_ki_co = mkNomReflCo liftedTypeKind++-- ty_co_match menv subst (ForAllTy (Bndr cv1 _) ty1)+--                        (ForAllCo cv2 kind_co2 co2)+--                        lkco rkco+--   | isCoVar cv1 && isCoVar cv2+--   We seems not to have enough information for this case+--   1. Given:+--        cv1      :: (s1 :: k1) ~r (s2 :: k2)+--        kind_co2 :: (s1' ~ s2') ~N (t1 ~ t2)+--        eta1      = mkNthCo role 2 (downgradeRole r Nominal kind_co2)+--                 :: s1' ~ t1+--        eta2      = mkNthCo role 3 (downgradeRole r Nominal kind_co2)+--                 :: s2' ~ t2+--      Wanted:+--        subst1 <- ty_co_match menv subst  s1 eta1 kco1 kco2+--        subst2 <- ty_co_match menv subst1 s2 eta2 kco3 kco4+--      Question: How do we get kcoi?+--   2. Given:+--        lkco :: <*>    -- See Note [Weird typing rule for ForAllTy] in Type+--        rkco :: <*>+--      Wanted:+--        ty_co_match menv' subst2 ty1 co2 lkco' rkco'+--      Question: How do we get lkco' and rkco'?++ty_co_match _ subst (CoercionTy {}) _ _ _+  = Just subst -- don't inspect coercions++ty_co_match menv subst ty (GRefl r t (MCo co)) lkco rkco+  =  ty_co_match menv subst ty (GRefl r t MRefl) lkco (rkco `mkTransCo` mkSymCo co)++ty_co_match menv subst ty co1 lkco rkco+  | Just (CastTy t co, r) <- isReflCo_maybe co1+  -- In @pushRefl@, pushing reflexive coercion inside CastTy will give us+  -- t |> co ~ t ; <t> ; t ~ t |> co+  -- But transitive coercions are not helpful. Therefore we deal+  -- with it here: we do recursion on the smaller reflexive coercion,+  -- while propagating the correct kind coercions.+  = let kco' = mkSymCo co+    in ty_co_match menv subst ty (mkReflCo r t) (lkco `mkTransCo` kco')+                                                (rkco `mkTransCo` kco')+++ty_co_match menv subst ty co lkco rkco+  | Just co' <- pushRefl co = ty_co_match menv subst ty co' lkco rkco+  | otherwise               = Nothing++ty_co_match_tc :: MatchEnv -> LiftCoEnv+               -> TyCon -> [Type]+               -> TyCon -> [Coercion]+               -> Maybe LiftCoEnv+ty_co_match_tc menv subst tc1 tys1 tc2 cos2+  = do { guard (tc1 == tc2)+       ; ty_co_match_args menv subst tys1 cos2 lkcos rkcos }+  where+    Pair lkcos rkcos+      = traverse (fmap mkNomReflCo . coercionKind) cos2++ty_co_match_app :: MatchEnv -> LiftCoEnv+                -> Type -> [Type] -> Coercion -> [Coercion]+                -> Maybe LiftCoEnv+ty_co_match_app menv subst ty1 ty1args co2 co2args+  | Just (ty1', ty1a) <- repSplitAppTy_maybe ty1+  , Just (co2', co2a) <- splitAppCo_maybe co2+  = ty_co_match_app menv subst ty1' (ty1a : ty1args) co2' (co2a : co2args)++  | otherwise+  = do { subst1 <- ty_co_match menv subst ki1 ki2 ki_ki_co ki_ki_co+       ; let Pair lkco rkco = mkNomReflCo <$> coercionKind ki2+       ; subst2 <- ty_co_match menv subst1 ty1 co2 lkco rkco+       ; let Pair lkcos rkcos = traverse (fmap mkNomReflCo . coercionKind) co2args+       ; ty_co_match_args menv subst2 ty1args co2args lkcos rkcos }+  where+    ki1 = typeKind ty1+    ki2 = promoteCoercion co2+    ki_ki_co = mkNomReflCo liftedTypeKind++ty_co_match_args :: MatchEnv -> LiftCoEnv -> [Type]+                 -> [Coercion] -> [Coercion] -> [Coercion]+                 -> Maybe LiftCoEnv+ty_co_match_args _    subst []       []         _ _ = Just subst+ty_co_match_args menv subst (ty:tys) (arg:args) (lkco:lkcos) (rkco:rkcos)+  = do { subst' <- ty_co_match menv subst ty arg lkco rkco+       ; ty_co_match_args menv subst' tys args lkcos rkcos }+ty_co_match_args _    _     _        _          _ _ = Nothing++pushRefl :: Coercion -> Maybe Coercion+pushRefl co =+  case (isReflCo_maybe co) of+    Just (AppTy ty1 ty2, Nominal)+      -> Just (AppCo (mkReflCo Nominal ty1) (mkNomReflCo ty2))+    Just (FunTy _ ty1 ty2, r)+      | Just rep1 <- getRuntimeRep_maybe ty1+      , Just rep2 <- getRuntimeRep_maybe ty2+      ->  Just (TyConAppCo r funTyCon [ mkReflCo r rep1, mkReflCo r rep2+                                       , mkReflCo r ty1,  mkReflCo r ty2 ])+    Just (TyConApp tc tys, r)+      -> Just (TyConAppCo r tc (zipWith mkReflCo (tyConRolesX r tc) tys))+    Just (ForAllTy (Bndr tv _) ty, r)+      -> Just (ForAllCo tv (mkNomReflCo (varType tv)) (mkReflCo r ty))+    -- NB: NoRefl variant. Otherwise, we get a loop!+    _ -> Nothing
+ compiler/utils/Bag.hs view
@@ -0,0 +1,351 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+++Bag: an unordered collection with duplicates+-}++{-# LANGUAGE ScopedTypeVariables, CPP #-}++module Bag (+        Bag, -- abstract type++        emptyBag, unitBag, unionBags, unionManyBags,+        mapBag,+        elemBag, lengthBag,+        filterBag, partitionBag, partitionBagWith,+        concatBag, catBagMaybes, foldBag, foldrBag, foldlBag,+        isEmptyBag, isSingletonBag, consBag, snocBag, anyBag, allBag,+        listToBag, bagToList, mapAccumBagL,+        concatMapBag, concatMapBagPair, mapMaybeBag,+        foldrBagM, foldlBagM, mapBagM, mapBagM_,+        flatMapBagM, flatMapBagPairM,+        mapAndUnzipBagM, mapAccumBagLM,+        anyBagM, filterBagM+    ) where++import GhcPrelude++import Outputable+import Util++import MonadUtils+import Control.Monad+import Data.Data+import Data.Maybe( mapMaybe )+import Data.List ( partition, mapAccumL )+import qualified Data.Foldable as Foldable++infixr 3 `consBag`+infixl 3 `snocBag`++data Bag a+  = EmptyBag+  | UnitBag a+  | TwoBags (Bag a) (Bag a) -- INVARIANT: neither branch is empty+  | ListBag [a]             -- INVARIANT: the list is non-empty++emptyBag :: Bag a+emptyBag = EmptyBag++unitBag :: a -> Bag a+unitBag  = UnitBag++lengthBag :: Bag a -> Int+lengthBag EmptyBag        = 0+lengthBag (UnitBag {})    = 1+lengthBag (TwoBags b1 b2) = lengthBag b1 + lengthBag b2+lengthBag (ListBag xs)    = length xs++elemBag :: Eq a => a -> Bag a -> Bool+elemBag _ EmptyBag        = False+elemBag x (UnitBag y)     = x == y+elemBag x (TwoBags b1 b2) = x `elemBag` b1 || x `elemBag` b2+elemBag x (ListBag ys)    = any (x ==) ys++unionManyBags :: [Bag a] -> Bag a+unionManyBags xs = foldr unionBags EmptyBag xs++-- This one is a bit stricter! The bag will get completely evaluated.++unionBags :: Bag a -> Bag a -> Bag a+unionBags EmptyBag b = b+unionBags b EmptyBag = b+unionBags b1 b2      = TwoBags b1 b2++consBag :: a -> Bag a -> Bag a+snocBag :: Bag a -> a -> Bag a++consBag elt bag = (unitBag elt) `unionBags` bag+snocBag bag elt = bag `unionBags` (unitBag elt)++isEmptyBag :: Bag a -> Bool+isEmptyBag EmptyBag = True+isEmptyBag _        = False -- NB invariants++isSingletonBag :: Bag a -> Bool+isSingletonBag EmptyBag      = False+isSingletonBag (UnitBag _)   = True+isSingletonBag (TwoBags _ _) = False          -- Neither is empty+isSingletonBag (ListBag xs)  = isSingleton xs++filterBag :: (a -> Bool) -> Bag a -> Bag a+filterBag _    EmptyBag = EmptyBag+filterBag pred b@(UnitBag val) = if pred val then b else EmptyBag+filterBag pred (TwoBags b1 b2) = sat1 `unionBags` sat2+    where sat1 = filterBag pred b1+          sat2 = filterBag pred b2+filterBag pred (ListBag vs)    = listToBag (filter pred vs)++filterBagM :: Monad m => (a -> m Bool) -> Bag a -> m (Bag a)+filterBagM _    EmptyBag = return EmptyBag+filterBagM pred b@(UnitBag val) = do+  flag <- pred val+  if flag then return b+          else return EmptyBag+filterBagM pred (TwoBags b1 b2) = do+  sat1 <- filterBagM pred b1+  sat2 <- filterBagM pred b2+  return (sat1 `unionBags` sat2)+filterBagM pred (ListBag vs) = do+  sat <- filterM pred vs+  return (listToBag sat)++allBag :: (a -> Bool) -> Bag a -> Bool+allBag _ EmptyBag        = True+allBag p (UnitBag v)     = p v+allBag p (TwoBags b1 b2) = allBag p b1 && allBag p b2+allBag p (ListBag xs)    = all p xs++anyBag :: (a -> Bool) -> Bag a -> Bool+anyBag _ EmptyBag        = False+anyBag p (UnitBag v)     = p v+anyBag p (TwoBags b1 b2) = anyBag p b1 || anyBag p b2+anyBag p (ListBag xs)    = any p xs++anyBagM :: Monad m => (a -> m Bool) -> Bag a -> m Bool+anyBagM _ EmptyBag        = return False+anyBagM p (UnitBag v)     = p v+anyBagM p (TwoBags b1 b2) = do flag <- anyBagM p b1+                               if flag then return True+                                       else anyBagM p b2+anyBagM p (ListBag xs)    = anyM p xs++concatBag :: Bag (Bag a) -> Bag a+concatBag bss = foldrBag add emptyBag bss+  where+    add bs rs = bs `unionBags` rs++catBagMaybes :: Bag (Maybe a) -> Bag a+catBagMaybes bs = foldrBag add emptyBag bs+  where+    add Nothing rs = rs+    add (Just x) rs = x `consBag` rs++partitionBag :: (a -> Bool) -> Bag a -> (Bag a {- Satisfy predictate -},+                                         Bag a {- Don't -})+partitionBag _    EmptyBag = (EmptyBag, EmptyBag)+partitionBag pred b@(UnitBag val)+    = if pred val then (b, EmptyBag) else (EmptyBag, b)+partitionBag pred (TwoBags b1 b2)+    = (sat1 `unionBags` sat2, fail1 `unionBags` fail2)+  where (sat1, fail1) = partitionBag pred b1+        (sat2, fail2) = partitionBag pred b2+partitionBag pred (ListBag vs) = (listToBag sats, listToBag fails)+  where (sats, fails) = partition pred vs+++partitionBagWith :: (a -> Either b c) -> Bag a+                    -> (Bag b {- Left  -},+                        Bag c {- Right -})+partitionBagWith _    EmptyBag = (EmptyBag, EmptyBag)+partitionBagWith pred (UnitBag val)+    = case pred val of+         Left a  -> (UnitBag a, EmptyBag)+         Right b -> (EmptyBag, UnitBag b)+partitionBagWith pred (TwoBags b1 b2)+    = (sat1 `unionBags` sat2, fail1 `unionBags` fail2)+  where (sat1, fail1) = partitionBagWith pred b1+        (sat2, fail2) = partitionBagWith pred b2+partitionBagWith pred (ListBag vs) = (listToBag sats, listToBag fails)+  where (sats, fails) = partitionWith pred vs++foldBag :: (r -> r -> r) -- Replace TwoBags with this; should be associative+        -> (a -> r)      -- Replace UnitBag with this+        -> r             -- Replace EmptyBag with this+        -> Bag a+        -> r++{- Standard definition+foldBag t u e EmptyBag        = e+foldBag t u e (UnitBag x)     = u x+foldBag t u e (TwoBags b1 b2) = (foldBag t u e b1) `t` (foldBag t u e b2)+foldBag t u e (ListBag xs)    = foldr (t.u) e xs+-}++-- More tail-recursive definition, exploiting associativity of "t"+foldBag _ _ e EmptyBag        = e+foldBag t u e (UnitBag x)     = u x `t` e+foldBag t u e (TwoBags b1 b2) = foldBag t u (foldBag t u e b2) b1+foldBag t u e (ListBag xs)    = foldr (t.u) e xs++foldrBag :: (a -> r -> r) -> r+         -> Bag a+         -> r++foldrBag _ z EmptyBag        = z+foldrBag k z (UnitBag x)     = k x z+foldrBag k z (TwoBags b1 b2) = foldrBag k (foldrBag k z b2) b1+foldrBag k z (ListBag xs)    = foldr k z xs++foldlBag :: (r -> a -> r) -> r+         -> Bag a+         -> r++foldlBag _ z EmptyBag        = z+foldlBag k z (UnitBag x)     = k z x+foldlBag k z (TwoBags b1 b2) = foldlBag k (foldlBag k z b1) b2+foldlBag k z (ListBag xs)    = foldl k z xs++foldrBagM :: (Monad m) => (a -> b -> m b) -> b -> Bag a -> m b+foldrBagM _ z EmptyBag        = return z+foldrBagM k z (UnitBag x)     = k x z+foldrBagM k z (TwoBags b1 b2) = do { z' <- foldrBagM k z b2; foldrBagM k z' b1 }+foldrBagM k z (ListBag xs)    = foldrM k z xs++foldlBagM :: (Monad m) => (b -> a -> m b) -> b -> Bag a -> m b+foldlBagM _ z EmptyBag        = return z+foldlBagM k z (UnitBag x)     = k z x+foldlBagM k z (TwoBags b1 b2) = do { z' <- foldlBagM k z b1; foldlBagM k z' b2 }+foldlBagM k z (ListBag xs)    = foldlM k z xs++mapBag :: (a -> b) -> Bag a -> Bag b+mapBag _ EmptyBag        = EmptyBag+mapBag f (UnitBag x)     = UnitBag (f x)+mapBag f (TwoBags b1 b2) = TwoBags (mapBag f b1) (mapBag f b2)+mapBag f (ListBag xs)    = ListBag (map f xs)++concatMapBag :: (a -> Bag b) -> Bag a -> Bag b+concatMapBag _ EmptyBag        = EmptyBag+concatMapBag f (UnitBag x)     = f x+concatMapBag f (TwoBags b1 b2) = unionBags (concatMapBag f b1) (concatMapBag f b2)+concatMapBag f (ListBag xs)    = foldr (unionBags . f) emptyBag xs++concatMapBagPair :: (a -> (Bag b, Bag c)) -> Bag a -> (Bag b, Bag c)+concatMapBagPair _ EmptyBag        = (EmptyBag, EmptyBag)+concatMapBagPair f (UnitBag x)     = f x+concatMapBagPair f (TwoBags b1 b2) = (unionBags r1 r2, unionBags s1 s2)+  where+    (r1, s1) = concatMapBagPair f b1+    (r2, s2) = concatMapBagPair f b2+concatMapBagPair f (ListBag xs)    = foldr go (emptyBag, emptyBag) xs+  where+    go a (s1, s2) = (unionBags r1 s1, unionBags r2 s2)+      where+        (r1, r2) = f a++mapMaybeBag :: (a -> Maybe b) -> Bag a -> Bag b+mapMaybeBag _ EmptyBag        = EmptyBag+mapMaybeBag f (UnitBag x)     = case f x of+                                  Nothing -> EmptyBag+                                  Just y  -> UnitBag y+mapMaybeBag f (TwoBags b1 b2) = unionBags (mapMaybeBag f b1) (mapMaybeBag f b2)+mapMaybeBag f (ListBag xs)    = ListBag (mapMaybe f xs)++mapBagM :: Monad m => (a -> m b) -> Bag a -> m (Bag b)+mapBagM _ EmptyBag        = return EmptyBag+mapBagM f (UnitBag x)     = do r <- f x+                               return (UnitBag r)+mapBagM f (TwoBags b1 b2) = do r1 <- mapBagM f b1+                               r2 <- mapBagM f b2+                               return (TwoBags r1 r2)+mapBagM f (ListBag    xs) = do rs <- mapM f xs+                               return (ListBag rs)++mapBagM_ :: Monad m => (a -> m b) -> Bag a -> m ()+mapBagM_ _ EmptyBag        = return ()+mapBagM_ f (UnitBag x)     = f x >> return ()+mapBagM_ f (TwoBags b1 b2) = mapBagM_ f b1 >> mapBagM_ f b2+mapBagM_ f (ListBag    xs) = mapM_ f xs++flatMapBagM :: Monad m => (a -> m (Bag b)) -> Bag a -> m (Bag b)+flatMapBagM _ EmptyBag        = return EmptyBag+flatMapBagM f (UnitBag x)     = f x+flatMapBagM f (TwoBags b1 b2) = do r1 <- flatMapBagM f b1+                                   r2 <- flatMapBagM f b2+                                   return (r1 `unionBags` r2)+flatMapBagM f (ListBag    xs) = foldrM k EmptyBag xs+  where+    k x b2 = do { b1 <- f x; return (b1 `unionBags` b2) }++flatMapBagPairM :: Monad m => (a -> m (Bag b, Bag c)) -> Bag a -> m (Bag b, Bag c)+flatMapBagPairM _ EmptyBag        = return (EmptyBag, EmptyBag)+flatMapBagPairM f (UnitBag x)     = f x+flatMapBagPairM f (TwoBags b1 b2) = do (r1,s1) <- flatMapBagPairM f b1+                                       (r2,s2) <- flatMapBagPairM f b2+                                       return (r1 `unionBags` r2, s1 `unionBags` s2)+flatMapBagPairM f (ListBag    xs) = foldrM k (EmptyBag, EmptyBag) xs+  where+    k x (r2,s2) = do { (r1,s1) <- f x+                     ; return (r1 `unionBags` r2, s1 `unionBags` s2) }++mapAndUnzipBagM :: Monad m => (a -> m (b,c)) -> Bag a -> m (Bag b, Bag c)+mapAndUnzipBagM _ EmptyBag        = return (EmptyBag, EmptyBag)+mapAndUnzipBagM f (UnitBag x)     = do (r,s) <- f x+                                       return (UnitBag r, UnitBag s)+mapAndUnzipBagM f (TwoBags b1 b2) = do (r1,s1) <- mapAndUnzipBagM f b1+                                       (r2,s2) <- mapAndUnzipBagM f b2+                                       return (TwoBags r1 r2, TwoBags s1 s2)+mapAndUnzipBagM f (ListBag xs)    = do ts <- mapM f xs+                                       let (rs,ss) = unzip ts+                                       return (ListBag rs, ListBag ss)++mapAccumBagL ::(acc -> x -> (acc, y)) -- ^ combining function+            -> acc                    -- ^ initial state+            -> Bag x                  -- ^ inputs+            -> (acc, Bag y)           -- ^ final state, outputs+mapAccumBagL _ s EmptyBag        = (s, EmptyBag)+mapAccumBagL f s (UnitBag x)     = let (s1, x1) = f s x in (s1, UnitBag x1)+mapAccumBagL f s (TwoBags b1 b2) = let (s1, b1') = mapAccumBagL f s  b1+                                       (s2, b2') = mapAccumBagL f s1 b2+                                   in (s2, TwoBags b1' b2')+mapAccumBagL f s (ListBag xs)    = let (s', xs') = mapAccumL f s xs+                                   in (s', ListBag xs')++mapAccumBagLM :: Monad m+            => (acc -> x -> m (acc, y)) -- ^ combining function+            -> acc                      -- ^ initial state+            -> Bag x                    -- ^ inputs+            -> m (acc, Bag y)           -- ^ final state, outputs+mapAccumBagLM _ s EmptyBag        = return (s, EmptyBag)+mapAccumBagLM f s (UnitBag x)     = do { (s1, x1) <- f s x; return (s1, UnitBag x1) }+mapAccumBagLM f s (TwoBags b1 b2) = do { (s1, b1') <- mapAccumBagLM f s  b1+                                       ; (s2, b2') <- mapAccumBagLM f s1 b2+                                       ; return (s2, TwoBags b1' b2') }+mapAccumBagLM f s (ListBag xs)    = do { (s', xs') <- mapAccumLM f s xs+                                       ; return (s', ListBag xs') }++listToBag :: [a] -> Bag a+listToBag [] = EmptyBag+listToBag [x] = UnitBag x+listToBag vs = ListBag vs++bagToList :: Bag a -> [a]+bagToList b = foldrBag (:) [] b++instance (Outputable a) => Outputable (Bag a) where+    ppr bag = braces (pprWithCommas ppr (bagToList bag))++instance Data a => Data (Bag a) where+  gfoldl k z b = z listToBag `k` bagToList b -- traverse abstract type abstractly+  toConstr _   = abstractConstr $ "Bag("++show (typeOf (undefined::a))++")"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "Bag"+  dataCast1 x  = gcast1 x++instance Functor Bag where+    fmap = mapBag++instance Foldable.Foldable Bag where+    foldr = foldrBag
+ compiler/utils/Binary.hs view
@@ -0,0 +1,1215 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiWayIf #-}++{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}+-- We always optimise this, otherwise performance of a non-optimised+-- compiler is severely affected++--+-- (c) The University of Glasgow 2002-2006+--+-- Binary I/O library, with special tweaks for GHC+--+-- Based on the nhc98 Binary library, which is copyright+-- (c) Malcolm Wallace and Colin Runciman, University of York, 1998.+-- Under the terms of the license for that software, we must tell you+-- where you can obtain the original version of the Binary library, namely+--     http://www.cs.york.ac.uk/fp/nhc98/++module Binary+  ( {-type-}  Bin,+    {-class-} Binary(..),+    {-type-}  BinHandle,+    SymbolTable, Dictionary,++   openBinMem,+--   closeBin,++   seekBin,+   seekBy,+   tellBin,+   castBin,+   isEOFBin,+   withBinBuffer,++   writeBinMem,+   readBinMem,++   putAt, getAt,++   -- * For writing instances+   putByte,+   getByte,++   -- * Lazy Binary I/O+   lazyGet,+   lazyPut,++   -- * User data+   UserData(..), getUserData, setUserData,+   newReadState, newWriteState,+   putDictionary, getDictionary, putFS,+  ) where++#include "HsVersions.h"++-- The *host* architecture version:+#include "../includes/MachDeps.h"++import GhcPrelude++import {-# SOURCE #-} Name (Name)+import FastString+import Panic+import UniqFM+import FastMutInt+import Fingerprint+import BasicTypes+import SrcLoc++import Foreign+import Data.Array+import Data.ByteString (ByteString)+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Unsafe   as BS+import Data.IORef+import Data.Char                ( ord, chr )+import Data.Time+import Type.Reflection+import Type.Reflection.Unsafe+import Data.Kind (Type)+import GHC.Exts (TYPE, RuntimeRep(..), VecCount(..), VecElem(..))+import Control.Monad            ( when )+import System.IO as IO+import System.IO.Unsafe         ( unsafeInterleaveIO )+import System.IO.Error          ( mkIOError, eofErrorType )+import GHC.Real                 ( Ratio(..) )+import GHC.Serialized++type BinArray = ForeignPtr Word8++---------------------------------------------------------------+-- BinHandle+---------------------------------------------------------------++data BinHandle+  = BinMem {                     -- binary data stored in an unboxed array+     bh_usr :: UserData,         -- sigh, need parameterized modules :-)+     _off_r :: !FastMutInt,      -- the current offset+     _sz_r  :: !FastMutInt,      -- size of the array (cached)+     _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1))+    }+        -- XXX: should really store a "high water mark" for dumping out+        -- the binary data to a file.++getUserData :: BinHandle -> UserData+getUserData bh = bh_usr bh++setUserData :: BinHandle -> UserData -> BinHandle+setUserData bh us = bh { bh_usr = us }++-- | Get access to the underlying buffer.+--+-- It is quite important that no references to the 'ByteString' leak out of the+-- continuation lest terrible things happen.+withBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a+withBinBuffer (BinMem _ ix_r _ arr_r) action = do+  arr <- readIORef arr_r+  ix <- readFastMutInt ix_r+  withForeignPtr arr $ \ptr ->+    BS.unsafePackCStringLen (castPtr ptr, ix) >>= action+++---------------------------------------------------------------+-- Bin+---------------------------------------------------------------++newtype Bin a = BinPtr Int+  deriving (Eq, Ord, Show, Bounded)++castBin :: Bin a -> Bin b+castBin (BinPtr i) = BinPtr i++---------------------------------------------------------------+-- class Binary+---------------------------------------------------------------++class Binary a where+    put_   :: BinHandle -> a -> IO ()+    put    :: BinHandle -> a -> IO (Bin a)+    get    :: BinHandle -> IO a++    -- define one of put_, put.  Use of put_ is recommended because it+    -- is more likely that tail-calls can kick in, and we rarely need the+    -- position return value.+    put_ bh a = do _ <- put bh a; return ()+    put bh a  = do p <- tellBin bh; put_ bh a; return p++putAt  :: Binary a => BinHandle -> Bin a -> a -> IO ()+putAt bh p x = do seekBin bh p; put_ bh x; return ()++getAt  :: Binary a => BinHandle -> Bin a -> IO a+getAt bh p = do seekBin bh p; get bh++openBinMem :: Int -> IO BinHandle+openBinMem size+ | size <= 0 = error "Data.Binary.openBinMem: size must be >= 0"+ | otherwise = do+   arr <- mallocForeignPtrBytes size+   arr_r <- newIORef arr+   ix_r <- newFastMutInt+   writeFastMutInt ix_r 0+   sz_r <- newFastMutInt+   writeFastMutInt sz_r size+   return (BinMem noUserData ix_r sz_r arr_r)++tellBin :: BinHandle -> IO (Bin a)+tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix)++seekBin :: BinHandle -> Bin a -> IO ()+seekBin h@(BinMem _ ix_r sz_r _) (BinPtr p) = do+  sz <- readFastMutInt sz_r+  if (p >= sz)+        then do expandBin h p; writeFastMutInt ix_r p+        else writeFastMutInt ix_r p++seekBy :: BinHandle -> Int -> IO ()+seekBy h@(BinMem _ ix_r sz_r _) off = do+  sz <- readFastMutInt sz_r+  ix <- readFastMutInt ix_r+  let ix' = ix + off+  if (ix' >= sz)+        then do expandBin h ix'; writeFastMutInt ix_r ix'+        else writeFastMutInt ix_r ix'++isEOFBin :: BinHandle -> IO Bool+isEOFBin (BinMem _ ix_r sz_r _) = do+  ix <- readFastMutInt ix_r+  sz <- readFastMutInt sz_r+  return (ix >= sz)++writeBinMem :: BinHandle -> FilePath -> IO ()+writeBinMem (BinMem _ ix_r _ arr_r) fn = do+  h <- openBinaryFile fn WriteMode+  arr <- readIORef arr_r+  ix  <- readFastMutInt ix_r+  withForeignPtr arr $ \p -> hPutBuf h p ix+  hClose h++readBinMem :: FilePath -> IO BinHandle+-- Return a BinHandle with a totally undefined State+readBinMem filename = do+  h <- openBinaryFile filename ReadMode+  filesize' <- hFileSize h+  let filesize = fromIntegral filesize'+  arr <- mallocForeignPtrBytes filesize+  count <- withForeignPtr arr $ \p -> hGetBuf h p filesize+  when (count /= filesize) $+       error ("Binary.readBinMem: only read " ++ show count ++ " bytes")+  hClose h+  arr_r <- newIORef arr+  ix_r <- newFastMutInt+  writeFastMutInt ix_r 0+  sz_r <- newFastMutInt+  writeFastMutInt sz_r filesize+  return (BinMem noUserData ix_r sz_r arr_r)++-- expand the size of the array to include a specified offset+expandBin :: BinHandle -> Int -> IO ()+expandBin (BinMem _ _ sz_r arr_r) off = do+   sz <- readFastMutInt sz_r+   let sz' = head (dropWhile (<= off) (iterate (* 2) sz))+   arr <- readIORef arr_r+   arr' <- mallocForeignPtrBytes sz'+   withForeignPtr arr $ \old ->+     withForeignPtr arr' $ \new ->+       copyBytes new old sz+   writeFastMutInt sz_r sz'+   writeIORef arr_r arr'++-- -----------------------------------------------------------------------------+-- Low-level reading/writing of bytes++putPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()+putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do+  ix <- readFastMutInt ix_r+  sz <- readFastMutInt sz_r+  when (ix + size > sz) $+    expandBin h (ix + size)+  arr <- readIORef arr_r+  withForeignPtr arr $ \op -> f (op `plusPtr` ix)+  writeFastMutInt ix_r (ix + size)++getPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a+getPrim (BinMem _ ix_r sz_r arr_r) size f = do+  ix <- readFastMutInt ix_r+  sz <- readFastMutInt sz_r+  when (ix + size > sz) $+      ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing)+  arr <- readIORef arr_r+  w <- withForeignPtr arr $ \op -> f (op `plusPtr` ix)+  writeFastMutInt ix_r (ix + size)+  return w++putWord8 :: BinHandle -> Word8 -> IO ()+putWord8 h w = putPrim h 1 (\op -> poke op w)++getWord8 :: BinHandle -> IO Word8+getWord8 h = getPrim h 1 peek++putWord16 :: BinHandle -> Word16 -> IO ()+putWord16 h w = putPrim h 2 (\op -> do+  pokeElemOff op 0 (fromIntegral (w `shiftR` 8))+  pokeElemOff op 1 (fromIntegral (w .&. 0xFF))+  )++getWord16 :: BinHandle -> IO Word16+getWord16 h = getPrim h 2 (\op -> do+  w0 <- fromIntegral <$> peekElemOff op 0+  w1 <- fromIntegral <$> peekElemOff op 1+  return $! w0 `shiftL` 8 .|. w1+  )++putWord32 :: BinHandle -> Word32 -> IO ()+putWord32 h w = putPrim h 4 (\op -> do+  pokeElemOff op 0 (fromIntegral (w `shiftR` 24))+  pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF))+  pokeElemOff op 2 (fromIntegral ((w `shiftR` 8) .&. 0xFF))+  pokeElemOff op 3 (fromIntegral (w .&. 0xFF))+  )++getWord32 :: BinHandle -> IO Word32+getWord32 h = getPrim h 4 (\op -> do+  w0 <- fromIntegral <$> peekElemOff op 0+  w1 <- fromIntegral <$> peekElemOff op 1+  w2 <- fromIntegral <$> peekElemOff op 2+  w3 <- fromIntegral <$> peekElemOff op 3++  return $! (w0 `shiftL` 24) .|.+            (w1 `shiftL` 16) .|.+            (w2 `shiftL` 8)  .|.+            w3+  )++putWord64 :: BinHandle -> Word64 -> IO ()+putWord64 h w = putPrim h 8 (\op -> do+  pokeElemOff op 0 (fromIntegral (w `shiftR` 56))+  pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF))+  pokeElemOff op 2 (fromIntegral ((w `shiftR` 40) .&. 0xFF))+  pokeElemOff op 3 (fromIntegral ((w `shiftR` 32) .&. 0xFF))+  pokeElemOff op 4 (fromIntegral ((w `shiftR` 24) .&. 0xFF))+  pokeElemOff op 5 (fromIntegral ((w `shiftR` 16) .&. 0xFF))+  pokeElemOff op 6 (fromIntegral ((w `shiftR` 8) .&. 0xFF))+  pokeElemOff op 7 (fromIntegral (w .&. 0xFF))+  )++getWord64 :: BinHandle -> IO Word64+getWord64 h = getPrim h 8 (\op -> do+  w0 <- fromIntegral <$> peekElemOff op 0+  w1 <- fromIntegral <$> peekElemOff op 1+  w2 <- fromIntegral <$> peekElemOff op 2+  w3 <- fromIntegral <$> peekElemOff op 3+  w4 <- fromIntegral <$> peekElemOff op 4+  w5 <- fromIntegral <$> peekElemOff op 5+  w6 <- fromIntegral <$> peekElemOff op 6+  w7 <- fromIntegral <$> peekElemOff op 7++  return $! (w0 `shiftL` 56) .|.+            (w1 `shiftL` 48) .|.+            (w2 `shiftL` 40) .|.+            (w3 `shiftL` 32) .|.+            (w4 `shiftL` 24) .|.+            (w5 `shiftL` 16) .|.+            (w6 `shiftL` 8)  .|.+            w7+  )++putByte :: BinHandle -> Word8 -> IO ()+putByte bh w = putWord8 bh w++getByte :: BinHandle -> IO Word8+getByte h = getWord8 h++-- -----------------------------------------------------------------------------+-- Primitive Word writes++instance Binary Word8 where+  put_ = putWord8+  get  = getWord8++instance Binary Word16 where+  put_ h w = putWord16 h w+  get h = getWord16 h++instance Binary Word32 where+  put_ h w = putWord32 h w+  get h = getWord32 h++instance Binary Word64 where+  put_ h w = putWord64 h w+  get h = getWord64 h++-- -----------------------------------------------------------------------------+-- Primitive Int writes++instance Binary Int8 where+  put_ h w = put_ h (fromIntegral w :: Word8)+  get h    = do w <- get h; return $! (fromIntegral (w::Word8))++instance Binary Int16 where+  put_ h w = put_ h (fromIntegral w :: Word16)+  get h    = do w <- get h; return $! (fromIntegral (w::Word16))++instance Binary Int32 where+  put_ h w = put_ h (fromIntegral w :: Word32)+  get h    = do w <- get h; return $! (fromIntegral (w::Word32))++instance Binary Int64 where+  put_ h w = put_ h (fromIntegral w :: Word64)+  get h    = do w <- get h; return $! (fromIntegral (w::Word64))++-- -----------------------------------------------------------------------------+-- Instances for standard types++instance Binary () where+    put_ _ () = return ()+    get  _    = return ()++instance Binary Bool where+    put_ bh b = putByte bh (fromIntegral (fromEnum b))+    get  bh   = do x <- getWord8 bh; return $! (toEnum (fromIntegral x))++instance Binary Char where+    put_  bh c = put_ bh (fromIntegral (ord c) :: Word32)+    get  bh   = do x <- get bh; return $! (chr (fromIntegral (x :: Word32)))++instance Binary Int where+    put_ bh i = put_ bh (fromIntegral i :: Int64)+    get  bh = do+        x <- get bh+        return $! (fromIntegral (x :: Int64))++instance Binary a => Binary [a] where+    put_ bh l = do+        let len = length l+        if (len < 0xff)+          then putByte bh (fromIntegral len :: Word8)+          else do putByte bh 0xff; put_ bh (fromIntegral len :: Word32)+        mapM_ (put_ bh) l+    get bh = do+        b <- getByte bh+        len <- if b == 0xff+                  then get bh+                  else return (fromIntegral b :: Word32)+        let loop 0 = return []+            loop n = do a <- get bh; as <- loop (n-1); return (a:as)+        loop len++instance (Ix a, Binary a, Binary b) => Binary (Array a b) where+    put_ bh arr = do+        put_ bh $ bounds arr+        put_ bh $ elems arr+    get bh = do+        bounds <- get bh+        xs <- get bh+        return $ listArray bounds xs++instance (Binary a, Binary b) => Binary (a,b) where+    put_ bh (a,b) = do put_ bh a; put_ bh b+    get bh        = do a <- get bh+                       b <- get bh+                       return (a,b)++instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where+    put_ bh (a,b,c) = do put_ bh a; put_ bh b; put_ bh c+    get bh          = do a <- get bh+                         b <- get bh+                         c <- get bh+                         return (a,b,c)++instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where+    put_ bh (a,b,c,d) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d+    get bh            = do a <- get bh+                           b <- get bh+                           c <- get bh+                           d <- get bh+                           return (a,b,c,d)++instance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a,b,c,d, e) where+    put_ bh (a,b,c,d, e) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e;+    get bh               = do a <- get bh+                              b <- get bh+                              c <- get bh+                              d <- get bh+                              e <- get bh+                              return (a,b,c,d,e)++instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f) => Binary (a,b,c,d, e, f) where+    put_ bh (a,b,c,d, e, f) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e; put_ bh f;+    get bh                  = do a <- get bh+                                 b <- get bh+                                 c <- get bh+                                 d <- get bh+                                 e <- get bh+                                 f <- get bh+                                 return (a,b,c,d,e,f)++instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g) => Binary (a,b,c,d,e,f,g) where+    put_ bh (a,b,c,d,e,f,g) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e; put_ bh f; put_ bh g+    get bh                  = do a <- get bh+                                 b <- get bh+                                 c <- get bh+                                 d <- get bh+                                 e <- get bh+                                 f <- get bh+                                 g <- get bh+                                 return (a,b,c,d,e,f,g)++instance Binary a => Binary (Maybe a) where+    put_ bh Nothing  = putByte bh 0+    put_ bh (Just a) = do putByte bh 1; put_ bh a+    get bh           = do h <- getWord8 bh+                          case h of+                            0 -> return Nothing+                            _ -> do x <- get bh; return (Just x)++instance (Binary a, Binary b) => Binary (Either a b) where+    put_ bh (Left  a) = do putByte bh 0; put_ bh a+    put_ bh (Right b) = do putByte bh 1; put_ bh b+    get bh            = do h <- getWord8 bh+                           case h of+                             0 -> do a <- get bh ; return (Left a)+                             _ -> do b <- get bh ; return (Right b)++instance Binary UTCTime where+    put_ bh u = do put_ bh (utctDay u)+                   put_ bh (utctDayTime u)+    get bh = do day <- get bh+                dayTime <- get bh+                return $ UTCTime { utctDay = day, utctDayTime = dayTime }++instance Binary Day where+    put_ bh d = put_ bh (toModifiedJulianDay d)+    get bh = do i <- get bh+                return $ ModifiedJulianDay { toModifiedJulianDay = i }++instance Binary DiffTime where+    put_ bh dt = put_ bh (toRational dt)+    get bh = do r <- get bh+                return $ fromRational r++--to quote binary-0.3 on this code idea,+--+-- TODO  This instance is not architecture portable.  GMP stores numbers as+-- arrays of machine sized words, so the byte format is not portable across+-- architectures with different endianness and word size.+--+-- This makes it hard (impossible) to make an equivalent instance+-- with code that is compilable with non-GHC.  Do we need any instance+-- Binary Integer, and if so, does it have to be blazing fast?  Or can+-- we just change this instance to be portable like the rest of the+-- instances? (binary package has code to steal for that)+--+-- yes, we need Binary Integer and Binary Rational in basicTypes/Literal.hs++instance Binary Integer where+    put_ bh i+      | i >= lo32 && i <= hi32 = do+          putWord8 bh 0+          put_ bh (fromIntegral i :: Int32)+      | otherwise = do+          putWord8 bh 1+          put_ bh (show i)+      where+        lo32 = fromIntegral (minBound :: Int32)+        hi32 = fromIntegral (maxBound :: Int32)++    get bh = do+      int_kind <- getWord8 bh+      case int_kind of+        0 -> fromIntegral <$> (get bh :: IO Int32)+        _ -> do str <- get bh+                case reads str of+                  [(i, "")] -> return i+                  _ -> fail ("Binary integer: got " ++ show str)++    {-+    -- This code is currently commented out.+    -- See https://gitlab.haskell.org/ghc/ghc/issues/3379#note_104346 for+    -- discussion.++    put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#)+    put_ bh (J# s# a#) = do+        putByte bh 1+        put_ bh (I# s#)+        let sz# = sizeofByteArray# a#  -- in *bytes*+        put_ bh (I# sz#)  -- in *bytes*+        putByteArray bh a# sz#++    get bh = do+        b <- getByte bh+        case b of+          0 -> do (I# i#) <- get bh+                  return (S# i#)+          _ -> do (I# s#) <- get bh+                  sz <- get bh+                  (BA a#) <- getByteArray bh sz+                  return (J# s# a#)++putByteArray :: BinHandle -> ByteArray# -> Int# -> IO ()+putByteArray bh a s# = loop 0#+  where loop n#+           | n# ==# s# = return ()+           | otherwise = do+                putByte bh (indexByteArray a n#)+                loop (n# +# 1#)++getByteArray :: BinHandle -> Int -> IO ByteArray+getByteArray bh (I# sz) = do+  (MBA arr) <- newByteArray sz+  let loop n+           | n ==# sz = return ()+           | otherwise = do+                w <- getByte bh+                writeByteArray arr n w+                loop (n +# 1#)+  loop 0#+  freezeByteArray arr+    -}++{-+data ByteArray = BA ByteArray#+data MBA = MBA (MutableByteArray# RealWorld)++newByteArray :: Int# -> IO MBA+newByteArray sz = IO $ \s ->+  case newByteArray# sz s of { (# s, arr #) ->+  (# s, MBA arr #) }++freezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray+freezeByteArray arr = IO $ \s ->+  case unsafeFreezeByteArray# arr s of { (# s, arr #) ->+  (# s, BA arr #) }++writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO ()+writeByteArray arr i (W8# w) = IO $ \s ->+  case writeWord8Array# arr i w s of { s ->+  (# s, () #) }++indexByteArray :: ByteArray# -> Int# -> Word8+indexByteArray a# n# = W8# (indexWord8Array# a# n#)++-}+instance (Binary a) => Binary (Ratio a) where+    put_ bh (a :% b) = do put_ bh a; put_ bh b+    get bh = do a <- get bh; b <- get bh; return (a :% b)++instance Binary (Bin a) where+  put_ bh (BinPtr i) = put_ bh (fromIntegral i :: Int32)+  get bh = do i <- get bh; return (BinPtr (fromIntegral (i :: Int32)))++-- -----------------------------------------------------------------------------+-- Instances for Data.Typeable stuff++instance Binary TyCon where+    put_ bh tc = do+        put_ bh (tyConPackage tc)+        put_ bh (tyConModule tc)+        put_ bh (tyConName tc)+        put_ bh (tyConKindArgs tc)+        put_ bh (tyConKindRep tc)+    get bh =+        mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh++instance Binary VecCount where+    put_ bh = putByte bh . fromIntegral . fromEnum+    get bh = toEnum . fromIntegral <$> getByte bh++instance Binary VecElem where+    put_ bh = putByte bh . fromIntegral . fromEnum+    get bh = toEnum . fromIntegral <$> getByte bh++instance Binary RuntimeRep where+    put_ bh (VecRep a b)    = putByte bh 0 >> put_ bh a >> put_ bh b+    put_ bh (TupleRep reps) = putByte bh 1 >> put_ bh reps+    put_ bh (SumRep reps)   = putByte bh 2 >> put_ bh reps+    put_ bh LiftedRep       = putByte bh 3+    put_ bh UnliftedRep     = putByte bh 4+    put_ bh IntRep          = putByte bh 5+    put_ bh WordRep         = putByte bh 6+    put_ bh Int64Rep        = putByte bh 7+    put_ bh Word64Rep       = putByte bh 8+    put_ bh AddrRep         = putByte bh 9+    put_ bh FloatRep        = putByte bh 10+    put_ bh DoubleRep       = putByte bh 11+#if __GLASGOW_HASKELL__ >= 807+    put_ bh Int8Rep         = putByte bh 12+    put_ bh Word8Rep        = putByte bh 13+    put_ bh Int16Rep        = putByte bh 14+    put_ bh Word16Rep       = putByte bh 15+#endif++    get bh = do+        tag <- getByte bh+        case tag of+          0  -> VecRep <$> get bh <*> get bh+          1  -> TupleRep <$> get bh+          2  -> SumRep <$> get bh+          3  -> pure LiftedRep+          4  -> pure UnliftedRep+          5  -> pure IntRep+          6  -> pure WordRep+          7  -> pure Int64Rep+          8  -> pure Word64Rep+          9  -> pure AddrRep+          10 -> pure FloatRep+          11 -> pure DoubleRep+#if __GLASGOW_HASKELL__ >= 807+          12 -> pure Int8Rep+          13 -> pure Word8Rep+          14 -> pure Int16Rep+          15 -> pure Word16Rep+#endif+          _  -> fail "Binary.putRuntimeRep: invalid tag"++instance Binary KindRep where+    put_ bh (KindRepTyConApp tc k) = putByte bh 0 >> put_ bh tc >> put_ bh k+    put_ bh (KindRepVar bndr) = putByte bh 1 >> put_ bh bndr+    put_ bh (KindRepApp a b) = putByte bh 2 >> put_ bh a >> put_ bh b+    put_ bh (KindRepFun a b) = putByte bh 3 >> put_ bh a >> put_ bh b+    put_ bh (KindRepTYPE r) = putByte bh 4 >> put_ bh r+    put_ bh (KindRepTypeLit sort r) = putByte bh 5 >> put_ bh sort >> put_ bh r++    get bh = do+        tag <- getByte bh+        case tag of+          0 -> KindRepTyConApp <$> get bh <*> get bh+          1 -> KindRepVar <$> get bh+          2 -> KindRepApp <$> get bh <*> get bh+          3 -> KindRepFun <$> get bh <*> get bh+          4 -> KindRepTYPE <$> get bh+          5 -> KindRepTypeLit <$> get bh <*> get bh+          _ -> fail "Binary.putKindRep: invalid tag"++instance Binary TypeLitSort where+    put_ bh TypeLitSymbol = putByte bh 0+    put_ bh TypeLitNat = putByte bh 1+    get bh = do+        tag <- getByte bh+        case tag of+          0 -> pure TypeLitSymbol+          1 -> pure TypeLitNat+          _ -> fail "Binary.putTypeLitSort: invalid tag"++putTypeRep :: BinHandle -> TypeRep a -> IO ()+-- Special handling for TYPE, (->), and RuntimeRep due to recursive kind+-- relations.+-- See Note [Mutually recursive representations of primitive types]+putTypeRep bh rep+  | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type)+  = put_ bh (0 :: Word8)+putTypeRep bh (Con' con ks) = do+    put_ bh (1 :: Word8)+    put_ bh con+    put_ bh ks+putTypeRep bh (App f x) = do+    put_ bh (2 :: Word8)+    putTypeRep bh f+    putTypeRep bh x+putTypeRep bh (Fun arg res) = do+    put_ bh (3 :: Word8)+    putTypeRep bh arg+    putTypeRep bh res+putTypeRep _ _ = fail "Binary.putTypeRep: Impossible"++getSomeTypeRep :: BinHandle -> IO SomeTypeRep+getSomeTypeRep bh = do+    tag <- get bh :: IO Word8+    case tag of+        0 -> return $ SomeTypeRep (typeRep :: TypeRep Type)+        1 -> do con <- get bh :: IO TyCon+                ks <- get bh :: IO [SomeTypeRep]+                return $ SomeTypeRep $ mkTrCon con ks++        2 -> do SomeTypeRep f <- getSomeTypeRep bh+                SomeTypeRep x <- getSomeTypeRep bh+                case typeRepKind f of+                  Fun arg res ->+                      case arg `eqTypeRep` typeRepKind x of+                        Just HRefl ->+                            case typeRepKind res `eqTypeRep` (typeRep :: TypeRep Type) of+                              Just HRefl -> return $ SomeTypeRep $ mkTrApp f x+                              _ -> failure "Kind mismatch in type application" []+                        _ -> failure "Kind mismatch in type application"+                             [ "    Found argument of kind: " ++ show (typeRepKind x)+                             , "    Where the constructor:  " ++ show f+                             , "    Expects kind:           " ++ show arg+                             ]+                  _ -> failure "Applied non-arrow"+                       [ "    Applied type: " ++ show f+                       , "    To argument:  " ++ show x+                       ]+        3 -> do SomeTypeRep arg <- getSomeTypeRep bh+                SomeTypeRep res <- getSomeTypeRep bh+                if+                  | App argkcon _ <- typeRepKind arg+                  , App reskcon _ <- typeRepKind res+                  , Just HRefl <- argkcon `eqTypeRep` tYPErep+                  , Just HRefl <- reskcon `eqTypeRep` tYPErep+                  -> return $ SomeTypeRep $ Fun arg res+                  | otherwise -> failure "Kind mismatch" []+        _ -> failure "Invalid SomeTypeRep" []+  where+    tYPErep :: TypeRep TYPE+    tYPErep = typeRep++    failure description info =+        fail $ unlines $ [ "Binary.getSomeTypeRep: "++description ]+                      ++ map ("    "++) info++instance Typeable a => Binary (TypeRep (a :: k)) where+    put_ = putTypeRep+    get bh = do+        SomeTypeRep rep <- getSomeTypeRep bh+        case rep `eqTypeRep` expected of+            Just HRefl -> pure rep+            Nothing    -> fail $ unlines+                               [ "Binary: Type mismatch"+                               , "    Deserialized type: " ++ show rep+                               , "    Expected type:     " ++ show expected+                               ]+     where expected = typeRep :: TypeRep a++instance Binary SomeTypeRep where+    put_ bh (SomeTypeRep rep) = putTypeRep bh rep+    get = getSomeTypeRep++-- -----------------------------------------------------------------------------+-- Lazy reading/writing++lazyPut :: Binary a => BinHandle -> a -> IO ()+lazyPut bh a = do+    -- output the obj with a ptr to skip over it:+    pre_a <- tellBin bh+    put_ bh pre_a       -- save a slot for the ptr+    put_ bh a           -- dump the object+    q <- tellBin bh     -- q = ptr to after object+    putAt bh pre_a q    -- fill in slot before a with ptr to q+    seekBin bh q        -- finally carry on writing at q++lazyGet :: Binary a => BinHandle -> IO a+lazyGet bh = do+    p <- get bh -- a BinPtr+    p_a <- tellBin bh+    a <- unsafeInterleaveIO $ do+        -- NB: Use a fresh off_r variable in the child thread, for thread+        -- safety.+        off_r <- newFastMutInt+        getAt bh { _off_r = off_r } p_a+    seekBin bh p -- skip over the object for now+    return a++-- -----------------------------------------------------------------------------+-- UserData+-- -----------------------------------------------------------------------------++-- | Information we keep around during interface file+-- serialization/deserialization. Namely we keep the functions for serializing+-- and deserializing 'Name's and 'FastString's. We do this because we actually+-- use serialization in two distinct settings,+--+-- * When serializing interface files themselves+--+-- * When computing the fingerprint of an IfaceDecl (which we computing by+--   hashing its Binary serialization)+--+-- These two settings have different needs while serializing Names:+--+-- * Names in interface files are serialized via a symbol table (see Note+--   [Symbol table representation of names] in BinIface).+--+-- * During fingerprinting a binding Name is serialized as the OccName and a+--   non-binding Name is serialized as the fingerprint of the thing they+--   represent. See Note [Fingerprinting IfaceDecls] for further discussion.+--+data UserData =+   UserData {+        -- for *deserialising* only:+        ud_get_name :: BinHandle -> IO Name,+        ud_get_fs   :: BinHandle -> IO FastString,++        -- for *serialising* only:+        ud_put_nonbinding_name :: BinHandle -> Name -> IO (),+        -- ^ serialize a non-binding 'Name' (e.g. a reference to another+        -- binding).+        ud_put_binding_name :: BinHandle -> Name -> IO (),+        -- ^ serialize a binding 'Name' (e.g. the name of an IfaceDecl)+        ud_put_fs   :: BinHandle -> FastString -> IO ()+   }++newReadState :: (BinHandle -> IO Name)   -- ^ how to deserialize 'Name's+             -> (BinHandle -> IO FastString)+             -> UserData+newReadState get_name get_fs+  = UserData { ud_get_name = get_name,+               ud_get_fs   = get_fs,+               ud_put_nonbinding_name = undef "put_nonbinding_name",+               ud_put_binding_name    = undef "put_binding_name",+               ud_put_fs   = undef "put_fs"+             }++newWriteState :: (BinHandle -> Name -> IO ())+                 -- ^ how to serialize non-binding 'Name's+              -> (BinHandle -> Name -> IO ())+                 -- ^ how to serialize binding 'Name's+              -> (BinHandle -> FastString -> IO ())+              -> UserData+newWriteState put_nonbinding_name put_binding_name put_fs+  = UserData { ud_get_name = undef "get_name",+               ud_get_fs   = undef "get_fs",+               ud_put_nonbinding_name = put_nonbinding_name,+               ud_put_binding_name    = put_binding_name,+               ud_put_fs   = put_fs+             }++noUserData :: a+noUserData = undef "UserData"++undef :: String -> a+undef s = panic ("Binary.UserData: no " ++ s)++---------------------------------------------------------+-- The Dictionary+---------------------------------------------------------++type Dictionary = Array Int FastString -- The dictionary+                                       -- Should be 0-indexed++putDictionary :: BinHandle -> Int -> UniqFM (Int,FastString) -> IO ()+putDictionary bh sz dict = do+  put_ bh sz+  mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict)))+    -- It's OK to use nonDetEltsUFM here because the elements have indices+    -- that array uses to create order++getDictionary :: BinHandle -> IO Dictionary+getDictionary bh = do+  sz <- get bh+  elems <- sequence (take sz (repeat (getFS bh)))+  return (listArray (0,sz-1) elems)++---------------------------------------------------------+-- The Symbol Table+---------------------------------------------------------++-- On disk, the symbol table is an array of IfExtName, when+-- reading it in we turn it into a SymbolTable.++type SymbolTable = Array Int Name++---------------------------------------------------------+-- Reading and writing FastStrings+---------------------------------------------------------++putFS :: BinHandle -> FastString -> IO ()+putFS bh fs = putBS bh $ bytesFS fs++getFS :: BinHandle -> IO FastString+getFS bh = do+  l  <- get bh :: IO Int+  getPrim bh l (\src -> pure $! mkFastStringBytes src l )++putBS :: BinHandle -> ByteString -> IO ()+putBS bh bs =+  BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do+    put_ bh l+    putPrim bh l (\op -> BS.memcpy op (castPtr ptr) l)++getBS :: BinHandle -> IO ByteString+getBS bh = do+  l <- get bh :: IO Int+  BS.create l $ \dest -> do+    getPrim bh l (\src -> BS.memcpy dest src l)++instance Binary ByteString where+  put_ bh f = putBS bh f+  get bh = getBS bh++instance Binary FastString where+  put_ bh f =+    case getUserData bh of+        UserData { ud_put_fs = put_fs } -> put_fs bh f++  get bh =+    case getUserData bh of+        UserData { ud_get_fs = get_fs } -> get_fs bh++-- Here to avoid loop+instance Binary LeftOrRight where+   put_ bh CLeft  = putByte bh 0+   put_ bh CRight = putByte bh 1++   get bh = do { h <- getByte bh+               ; case h of+                   0 -> return CLeft+                   _ -> return CRight }++instance Binary PromotionFlag where+   put_ bh NotPromoted = putByte bh 0+   put_ bh IsPromoted  = putByte bh 1++   get bh = do+       n <- getByte bh+       case n of+         0 -> return NotPromoted+         1 -> return IsPromoted+         _ -> fail "Binary(IsPromoted): fail)"++instance Binary Fingerprint where+  put_ h (Fingerprint w1 w2) = do put_ h w1; put_ h w2+  get  h = do w1 <- get h; w2 <- get h; return (Fingerprint w1 w2)++instance Binary FunctionOrData where+    put_ bh IsFunction = putByte bh 0+    put_ bh IsData     = putByte bh 1+    get bh = do+        h <- getByte bh+        case h of+          0 -> return IsFunction+          1 -> return IsData+          _ -> panic "Binary FunctionOrData"++instance Binary TupleSort where+    put_ bh BoxedTuple      = putByte bh 0+    put_ bh UnboxedTuple    = putByte bh 1+    put_ bh ConstraintTuple = putByte bh 2+    get bh = do+      h <- getByte bh+      case h of+        0 -> do return BoxedTuple+        1 -> do return UnboxedTuple+        _ -> do return ConstraintTuple++instance Binary Activation where+    put_ bh NeverActive = do+            putByte bh 0+    put_ bh AlwaysActive = do+            putByte bh 1+    put_ bh (ActiveBefore src aa) = do+            putByte bh 2+            put_ bh src+            put_ bh aa+    put_ bh (ActiveAfter src ab) = do+            putByte bh 3+            put_ bh src+            put_ bh ab+    get bh = do+            h <- getByte bh+            case h of+              0 -> do return NeverActive+              1 -> do return AlwaysActive+              2 -> do src <- get bh+                      aa <- get bh+                      return (ActiveBefore src aa)+              _ -> do src <- get bh+                      ab <- get bh+                      return (ActiveAfter src ab)++instance Binary InlinePragma where+    put_ bh (InlinePragma s a b c d) = do+            put_ bh s+            put_ bh a+            put_ bh b+            put_ bh c+            put_ bh d++    get bh = do+           s <- get bh+           a <- get bh+           b <- get bh+           c <- get bh+           d <- get bh+           return (InlinePragma s a b c d)++instance Binary RuleMatchInfo where+    put_ bh FunLike = putByte bh 0+    put_ bh ConLike = putByte bh 1+    get bh = do+            h <- getByte bh+            if h == 1 then return ConLike+                      else return FunLike++instance Binary InlineSpec where+    put_ bh NoUserInline    = putByte bh 0+    put_ bh Inline          = putByte bh 1+    put_ bh Inlinable       = putByte bh 2+    put_ bh NoInline        = putByte bh 3++    get bh = do h <- getByte bh+                case h of+                  0 -> return NoUserInline+                  1 -> return Inline+                  2 -> return Inlinable+                  _ -> return NoInline++instance Binary RecFlag where+    put_ bh Recursive = do+            putByte bh 0+    put_ bh NonRecursive = do+            putByte bh 1+    get bh = do+            h <- getByte bh+            case h of+              0 -> do return Recursive+              _ -> do return NonRecursive++instance Binary OverlapMode where+    put_ bh (NoOverlap    s) = putByte bh 0 >> put_ bh s+    put_ bh (Overlaps     s) = putByte bh 1 >> put_ bh s+    put_ bh (Incoherent   s) = putByte bh 2 >> put_ bh s+    put_ bh (Overlapping  s) = putByte bh 3 >> put_ bh s+    put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s+    get bh = do+        h <- getByte bh+        case h of+            0 -> (get bh) >>= \s -> return $ NoOverlap s+            1 -> (get bh) >>= \s -> return $ Overlaps s+            2 -> (get bh) >>= \s -> return $ Incoherent s+            3 -> (get bh) >>= \s -> return $ Overlapping s+            4 -> (get bh) >>= \s -> return $ Overlappable s+            _ -> panic ("get OverlapMode" ++ show h)+++instance Binary OverlapFlag where+    put_ bh flag = do put_ bh (overlapMode flag)+                      put_ bh (isSafeOverlap flag)+    get bh = do+        h <- get bh+        b <- get bh+        return OverlapFlag { overlapMode = h, isSafeOverlap = b }++instance Binary FixityDirection where+    put_ bh InfixL = do+            putByte bh 0+    put_ bh InfixR = do+            putByte bh 1+    put_ bh InfixN = do+            putByte bh 2+    get bh = do+            h <- getByte bh+            case h of+              0 -> do return InfixL+              1 -> do return InfixR+              _ -> do return InfixN++instance Binary Fixity where+    put_ bh (Fixity src aa ab) = do+            put_ bh src+            put_ bh aa+            put_ bh ab+    get bh = do+          src <- get bh+          aa <- get bh+          ab <- get bh+          return (Fixity src aa ab)++instance Binary WarningTxt where+    put_ bh (WarningTxt s w) = do+            putByte bh 0+            put_ bh s+            put_ bh w+    put_ bh (DeprecatedTxt s d) = do+            putByte bh 1+            put_ bh s+            put_ bh d++    get bh = do+            h <- getByte bh+            case h of+              0 -> do s <- get bh+                      w <- get bh+                      return (WarningTxt s w)+              _ -> do s <- get bh+                      d <- get bh+                      return (DeprecatedTxt s d)++instance Binary StringLiteral where+  put_ bh (StringLiteral st fs) = do+            put_ bh st+            put_ bh fs+  get bh = do+            st <- get bh+            fs <- get bh+            return (StringLiteral st fs)++instance Binary a => Binary (Located a) where+    put_ bh (L l x) = do+            put_ bh l+            put_ bh x++    get bh = do+            l <- get bh+            x <- get bh+            return (L l x)++instance Binary RealSrcSpan where+  put_ bh ss = do+            put_ bh (srcSpanFile ss)+            put_ bh (srcSpanStartLine ss)+            put_ bh (srcSpanStartCol ss)+            put_ bh (srcSpanEndLine ss)+            put_ bh (srcSpanEndCol ss)++  get bh = do+            f <- get bh+            sl <- get bh+            sc <- get bh+            el <- get bh+            ec <- get bh+            return (mkRealSrcSpan (mkRealSrcLoc f sl sc)+                                  (mkRealSrcLoc f el ec))++instance Binary SrcSpan where+  put_ bh (RealSrcSpan ss) = do+          putByte bh 0+          put_ bh ss++  put_ bh (UnhelpfulSpan s) = do+          putByte bh 1+          put_ bh s++  get bh = do+          h <- getByte bh+          case h of+            0 -> do ss <- get bh+                    return (RealSrcSpan ss)+            _ -> do s <- get bh+                    return (UnhelpfulSpan s)++instance Binary Serialized where+    put_ bh (Serialized the_type bytes) = do+        put_ bh the_type+        put_ bh bytes+    get bh = do+        the_type <- get bh+        bytes <- get bh+        return (Serialized the_type bytes)++instance Binary SourceText where+  put_ bh NoSourceText = putByte bh 0+  put_ bh (SourceText s) = do+        putByte bh 1+        put_ bh s++  get bh = do+    h <- getByte bh+    case h of+      0 -> return NoSourceText+      1 -> do+        s <- get bh+        return (SourceText s)+      _ -> panic $ "Binary SourceText:" ++ show h
+ compiler/utils/BooleanFormula.hs view
@@ -0,0 +1,262 @@+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable,+             DeriveTraversable #-}++--------------------------------------------------------------------------------+-- | Boolean formulas without quantifiers and without negation.+-- Such a formula consists of variables, conjunctions (and), and disjunctions (or).+--+-- This module is used to represent minimal complete definitions for classes.+--+module BooleanFormula (+        BooleanFormula(..), LBooleanFormula,+        mkFalse, mkTrue, mkAnd, mkOr, mkVar,+        isFalse, isTrue,+        eval, simplify, isUnsatisfied,+        implies, impliesAtom,+        pprBooleanFormula, pprBooleanFormulaNice+  ) where++import GhcPrelude++import Data.List ( nub, intersperse )+import Data.Data++import MonadUtils+import Outputable+import Binary+import SrcLoc+import Unique+import UniqSet++----------------------------------------------------------------------+-- Boolean formula type and smart constructors+----------------------------------------------------------------------++type LBooleanFormula a = Located (BooleanFormula a)++data BooleanFormula a = Var a | And [LBooleanFormula a] | Or [LBooleanFormula a]+                      | Parens (LBooleanFormula a)+  deriving (Eq, Data, Functor, Foldable, Traversable)++mkVar :: a -> BooleanFormula a+mkVar = Var++mkFalse, mkTrue :: BooleanFormula a+mkFalse = Or []+mkTrue = And []++-- Convert a Bool to a BooleanFormula+mkBool :: Bool -> BooleanFormula a+mkBool False = mkFalse+mkBool True  = mkTrue++-- Make a conjunction, and try to simplify+mkAnd :: Eq a => [LBooleanFormula a] -> BooleanFormula a+mkAnd = maybe mkFalse (mkAnd' . nub) . concatMapM fromAnd+  where+  -- See Note [Simplification of BooleanFormulas]+  fromAnd :: LBooleanFormula a -> Maybe [LBooleanFormula a]+  fromAnd (L _ (And xs)) = Just xs+     -- assume that xs are already simplified+     -- otherwise we would need: fromAnd (And xs) = concat <$> traverse fromAnd xs+  fromAnd (L _ (Or [])) = Nothing+     -- in case of False we bail out, And [..,mkFalse,..] == mkFalse+  fromAnd x = Just [x]+  mkAnd' [x] = unLoc x+  mkAnd' xs = And xs++mkOr :: Eq a => [LBooleanFormula a] -> BooleanFormula a+mkOr = maybe mkTrue (mkOr' . nub) . concatMapM fromOr+  where+  -- See Note [Simplification of BooleanFormulas]+  fromOr (L _ (Or xs)) = Just xs+  fromOr (L _ (And [])) = Nothing+  fromOr x = Just [x]+  mkOr' [x] = unLoc x+  mkOr' xs = Or xs+++{-+Note [Simplification of BooleanFormulas]+~~~~~~~~~~~~~~~~~~~~~~+The smart constructors (`mkAnd` and `mkOr`) do some attempt to simplify expressions. In particular,+ 1. Collapsing nested ands and ors, so+     `(mkAnd [x, And [y,z]]`+    is represented as+     `And [x,y,z]`+    Implemented by `fromAnd`/`fromOr`+ 2. Collapsing trivial ands and ors, so+     `mkAnd [x]` becomes just `x`.+    Implemented by mkAnd' / mkOr'+ 3. Conjunction with false, disjunction with true is simplified, i.e.+     `mkAnd [mkFalse,x]` becomes `mkFalse`.+ 4. Common subexpression elimination:+     `mkAnd [x,x,y]` is reduced to just `mkAnd [x,y]`.++This simplification is not exhaustive, in the sense that it will not produce+the smallest possible equivalent expression. For example,+`Or [And [x,y], And [x]]` could be simplified to `And [x]`, but it currently+is not. A general simplifier would need to use something like BDDs.++The reason behind the (crude) simplifier is to make for more user friendly+error messages. E.g. for the code+  > class Foo a where+  >     {-# MINIMAL bar, (foo, baq | foo, quux) #-}+  > instance Foo Int where+  >     bar = ...+  >     baz = ...+  >     quux = ...+We don't show a ridiculous error message like+    Implement () and (either (`foo' and ()) or (`foo' and ()))+-}++----------------------------------------------------------------------+-- Evaluation and simplification+----------------------------------------------------------------------++isFalse :: BooleanFormula a -> Bool+isFalse (Or []) = True+isFalse _ = False++isTrue :: BooleanFormula a -> Bool+isTrue (And []) = True+isTrue _ = False++eval :: (a -> Bool) -> BooleanFormula a -> Bool+eval f (Var x)  = f x+eval f (And xs) = all (eval f . unLoc) xs+eval f (Or xs)  = any (eval f . unLoc) xs+eval f (Parens x) = eval f (unLoc x)++-- Simplify a boolean formula.+-- The argument function should give the truth of the atoms, or Nothing if undecided.+simplify :: Eq a => (a -> Maybe Bool) -> BooleanFormula a -> BooleanFormula a+simplify f (Var a) = case f a of+  Nothing -> Var a+  Just b  -> mkBool b+simplify f (And xs) = mkAnd (map (\(L l x) -> L l (simplify f x)) xs)+simplify f (Or xs) = mkOr (map (\(L l x) -> L l (simplify f x)) xs)+simplify f (Parens x) = simplify f (unLoc x)++-- Test if a boolean formula is satisfied when the given values are assigned to the atoms+-- if it is, returns Nothing+-- if it is not, return (Just remainder)+isUnsatisfied :: Eq a => (a -> Bool) -> BooleanFormula a -> Maybe (BooleanFormula a)+isUnsatisfied f bf+    | isTrue bf' = Nothing+    | otherwise  = Just bf'+  where+  f' x = if f x then Just True else Nothing+  bf' = simplify f' bf++-- prop_simplify:+--   eval f x == True   <==>  isTrue  (simplify (Just . f) x)+--   eval f x == False  <==>  isFalse (simplify (Just . f) x)++-- If the boolean formula holds, does that mean that the given atom is always true?+impliesAtom :: Eq a => BooleanFormula a -> a -> Bool+Var x  `impliesAtom` y = x == y+And xs `impliesAtom` y = any (\x -> (unLoc x) `impliesAtom` y) xs+           -- we have all of xs, so one of them implying y is enough+Or  xs `impliesAtom` y = all (\x -> (unLoc x) `impliesAtom` y) xs+Parens x `impliesAtom` y = (unLoc x) `impliesAtom` y++implies :: Uniquable a => BooleanFormula a -> BooleanFormula a -> Bool+implies e1 e2 = go (Clause emptyUniqSet [e1]) (Clause emptyUniqSet [e2])+  where+    go :: Uniquable a => Clause a -> Clause a -> Bool+    go l@Clause{ clauseExprs = hyp:hyps } r =+        case hyp of+            Var x | memberClauseAtoms x r -> True+                  | otherwise -> go (extendClauseAtoms l x) { clauseExprs = hyps } r+            Parens hyp' -> go l { clauseExprs = unLoc hyp':hyps }     r+            And hyps'  -> go l { clauseExprs = map unLoc hyps' ++ hyps } r+            Or hyps'   -> all (\hyp' -> go l { clauseExprs = unLoc hyp':hyps } r) hyps'+    go l r@Clause{ clauseExprs = con:cons } =+        case con of+            Var x | memberClauseAtoms x l -> True+                  | otherwise -> go l (extendClauseAtoms r x) { clauseExprs = cons }+            Parens con' -> go l r { clauseExprs = unLoc con':cons }+            And cons'   -> all (\con' -> go l r { clauseExprs = unLoc con':cons }) cons'+            Or cons'    -> go l r { clauseExprs = map unLoc cons' ++ cons }+    go _ _ = False++-- A small sequent calculus proof engine.+data Clause a = Clause {+        clauseAtoms :: UniqSet a,+        clauseExprs :: [BooleanFormula a]+    }+extendClauseAtoms :: Uniquable a => Clause a -> a -> Clause a+extendClauseAtoms c x = c { clauseAtoms = addOneToUniqSet (clauseAtoms c) x }++memberClauseAtoms :: Uniquable a => a -> Clause a -> Bool+memberClauseAtoms x c = x `elementOfUniqSet` clauseAtoms c++----------------------------------------------------------------------+-- Pretty printing+----------------------------------------------------------------------++-- Pretty print a BooleanFormula,+-- using the arguments as pretty printers for Var, And and Or respectively+pprBooleanFormula' :: (Rational -> a -> SDoc)+                   -> (Rational -> [SDoc] -> SDoc)+                   -> (Rational -> [SDoc] -> SDoc)+                   -> Rational -> BooleanFormula a -> SDoc+pprBooleanFormula' pprVar pprAnd pprOr = go+  where+  go p (Var x)  = pprVar p x+  go p (And []) = cparen (p > 0) $ empty+  go p (And xs) = pprAnd p (map (go 3 . unLoc) xs)+  go _ (Or  []) = keyword $ text "FALSE"+  go p (Or  xs) = pprOr p (map (go 2 . unLoc) xs)+  go p (Parens x) = go p (unLoc x)++-- Pretty print in source syntax, "a | b | c,d,e"+pprBooleanFormula :: (Rational -> a -> SDoc) -> Rational -> BooleanFormula a -> SDoc+pprBooleanFormula pprVar = pprBooleanFormula' pprVar pprAnd pprOr+  where+  pprAnd p = cparen (p > 3) . fsep . punctuate comma+  pprOr  p = cparen (p > 2) . fsep . intersperse vbar++-- Pretty print human in readable format, "either `a' or `b' or (`c', `d' and `e')"?+pprBooleanFormulaNice :: Outputable a => BooleanFormula a -> SDoc+pprBooleanFormulaNice = pprBooleanFormula' pprVar pprAnd pprOr 0+  where+  pprVar _ = quotes . ppr+  pprAnd p = cparen (p > 1) . pprAnd'+  pprAnd' [] = empty+  pprAnd' [x,y] = x <+> text "and" <+> y+  pprAnd' xs@(_:_) = fsep (punctuate comma (init xs)) <> text ", and" <+> last xs+  pprOr p xs = cparen (p > 1) $ text "either" <+> sep (intersperse (text "or") xs)++instance (OutputableBndr a) => Outputable (BooleanFormula a) where+  ppr = pprBooleanFormulaNormal++pprBooleanFormulaNormal :: (OutputableBndr a)+                        => BooleanFormula a -> SDoc+pprBooleanFormulaNormal = go+  where+    go (Var x)    = pprPrefixOcc x+    go (And xs)   = fsep $ punctuate comma (map (go . unLoc) xs)+    go (Or [])    = keyword $ text "FALSE"+    go (Or xs)    = fsep $ intersperse vbar (map (go . unLoc) xs)+    go (Parens x) = parens (go $ unLoc x)+++----------------------------------------------------------------------+-- Binary+----------------------------------------------------------------------++instance Binary a => Binary (BooleanFormula a) where+  put_ bh (Var x)    = putByte bh 0 >> put_ bh x+  put_ bh (And xs)   = putByte bh 1 >> put_ bh xs+  put_ bh (Or  xs)   = putByte bh 2 >> put_ bh xs+  put_ bh (Parens x) = putByte bh 3 >> put_ bh x++  get bh = do+    h <- getByte bh+    case h of+      0 -> Var    <$> get bh+      1 -> And    <$> get bh+      2 -> Or     <$> get bh+      _ -> Parens <$> get bh
+ compiler/utils/BufWrite.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE BangPatterns #-}++-----------------------------------------------------------------------------+--+-- Fast write-buffered Handles+--+-- (c) The University of Glasgow 2005-2006+--+-- This is a simple abstraction over Handles that offers very fast write+-- buffering, but without the thread safety that Handles provide.  It's used+-- to save time in Pretty.printDoc.+--+-----------------------------------------------------------------------------++module BufWrite (+        BufHandle(..),+        newBufHandle,+        bPutChar,+        bPutStr,+        bPutFS,+        bPutFZS,+        bPutPtrString,+        bPutReplicate,+        bFlush,+  ) where++import GhcPrelude++import FastString+import FastMutInt++import Control.Monad    ( when )+import Data.ByteString (ByteString)+import qualified Data.ByteString.Unsafe as BS+import Data.Char        ( ord )+import Foreign+import Foreign.C.String+import System.IO++-- -----------------------------------------------------------------------------++data BufHandle = BufHandle {-#UNPACK#-}!(Ptr Word8)+                           {-#UNPACK#-}!FastMutInt+                           Handle++newBufHandle :: Handle -> IO BufHandle+newBufHandle hdl = do+  ptr <- mallocBytes buf_size+  r <- newFastMutInt+  writeFastMutInt r 0+  return (BufHandle ptr r hdl)++buf_size :: Int+buf_size = 8192++bPutChar :: BufHandle -> Char -> IO ()+bPutChar b@(BufHandle buf r hdl) !c = do+  i <- readFastMutInt r+  if (i >= buf_size)+        then do hPutBuf hdl buf buf_size+                writeFastMutInt r 0+                bPutChar b c+        else do pokeElemOff buf i (fromIntegral (ord c) :: Word8)+                writeFastMutInt r (i+1)++bPutStr :: BufHandle -> String -> IO ()+bPutStr (BufHandle buf r hdl) !str = do+  i <- readFastMutInt r+  loop str i+  where loop "" !i = do writeFastMutInt r i; return ()+        loop (c:cs) !i+           | i >= buf_size = do+                hPutBuf hdl buf buf_size+                loop (c:cs) 0+           | otherwise = do+                pokeElemOff buf i (fromIntegral (ord c))+                loop cs (i+1)++bPutFS :: BufHandle -> FastString -> IO ()+bPutFS b fs = bPutBS b $ bytesFS fs++bPutFZS :: BufHandle -> FastZString -> IO ()+bPutFZS b fs = bPutBS b $ fastZStringToByteString fs++bPutBS :: BufHandle -> ByteString -> IO ()+bPutBS b bs = BS.unsafeUseAsCStringLen bs $ bPutCStringLen b++bPutCStringLen :: BufHandle -> CStringLen -> IO ()+bPutCStringLen b@(BufHandle buf r hdl) cstr@(ptr, len) = do+  i <- readFastMutInt r+  if (i + len) >= buf_size+        then do hPutBuf hdl buf i+                writeFastMutInt r 0+                if (len >= buf_size)+                    then hPutBuf hdl ptr len+                    else bPutCStringLen b cstr+        else do+                copyBytes (buf `plusPtr` i) ptr len+                writeFastMutInt r (i + len)++bPutPtrString :: BufHandle -> PtrString -> IO ()+bPutPtrString b@(BufHandle buf r hdl) l@(PtrString a len) = l `seq` do+  i <- readFastMutInt r+  if (i+len) >= buf_size+        then do hPutBuf hdl buf i+                writeFastMutInt r 0+                if (len >= buf_size)+                    then hPutBuf hdl a len+                    else bPutPtrString b l+        else do+                copyBytes (buf `plusPtr` i) a len+                writeFastMutInt r (i+len)++-- | Replicate an 8-bit character+bPutReplicate :: BufHandle -> Int -> Char -> IO ()+bPutReplicate (BufHandle buf r hdl) len c = do+  i <- readFastMutInt r+  let oc = fromIntegral (ord c)+  if (i+len) < buf_size+    then do+      fillBytes (buf `plusPtr` i) oc len+      writeFastMutInt r (i+len)+    else do+      -- flush the current buffer+      when (i /= 0) $ hPutBuf hdl buf i+      if (len < buf_size)+        then do+          fillBytes buf oc len+          writeFastMutInt r len+        else do+          -- fill a full buffer+          fillBytes buf oc buf_size+          -- flush it as many times as necessary+          let go n | n >= buf_size = do+                                       hPutBuf hdl buf buf_size+                                       go (n-buf_size)+                   | otherwise     = writeFastMutInt r n+          go len++bFlush :: BufHandle -> IO ()+bFlush (BufHandle buf r hdl) = do+  i <- readFastMutInt r+  when (i > 0) $ hPutBuf hdl buf i+  free buf+  return ()
+ compiler/utils/Digraph.hs view
@@ -0,0 +1,524 @@+-- (c) The University of Glasgow 2006++{-# LANGUAGE CPP, ScopedTypeVariables, ViewPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Digraph(+        Graph, graphFromEdgedVerticesOrd, graphFromEdgedVerticesUniq,++        SCC(..), Node(..), flattenSCC, flattenSCCs,+        stronglyConnCompG,+        topologicalSortG,+        verticesG, edgesG, hasVertexG,+        reachableG, reachablesG, transposeG,+        emptyG,++        findCycle,++        -- For backwards compatibility with the simpler version of Digraph+        stronglyConnCompFromEdgedVerticesOrd,+        stronglyConnCompFromEdgedVerticesOrdR,+        stronglyConnCompFromEdgedVerticesUniq,+        stronglyConnCompFromEdgedVerticesUniqR,++        -- Simple way to classify edges+        EdgeType(..), classifyEdges+    ) where++#include "HsVersions.h"++------------------------------------------------------------------------------+-- A version of the graph algorithms described in:+--+-- ``Lazy Depth-First Search and Linear IntGraph Algorithms in Haskell''+--   by David King and John Launchbury+--+-- Also included is some additional code for printing tree structures ...+--+-- If you ever find yourself in need of algorithms for classifying edges,+-- or finding connected/biconnected components, consult the history; Sigbjorn+-- Finne contributed some implementations in 1997, although we've since+-- removed them since they were not used anywhere in GHC.+------------------------------------------------------------------------------+++import GhcPrelude++import Util        ( minWith, count )+import Outputable+import Maybes      ( expectJust )++-- std interfaces+import Data.Maybe+import Data.Array+import Data.List hiding (transpose)+import qualified Data.Map as Map+import qualified Data.Set as Set++import qualified Data.Graph as G+import Data.Graph hiding (Graph, Edge, transposeG, reachable)+import Data.Tree+import Unique+import UniqFM++{-+************************************************************************+*                                                                      *+*      Graphs and Graph Construction+*                                                                      *+************************************************************************++Note [Nodes, keys, vertices]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+ * A 'node' is a big blob of client-stuff++ * Each 'node' has a unique (client) 'key', but the latter+        is in Ord and has fast comparison++ * Digraph then maps each 'key' to a Vertex (Int) which is+        arranged densely in 0.n+-}++data Graph node = Graph {+    gr_int_graph      :: IntGraph,+    gr_vertex_to_node :: Vertex -> node,+    gr_node_to_vertex :: node -> Maybe Vertex+  }++data Edge node = Edge node node++{-| Representation for nodes of the Graph.++ * The @payload@ is user data, just carried around in this module++ * The @key@ is the node identifier.+   Key has an Ord instance for performance reasons.++ * The @[key]@ are the dependencies of the node;+   it's ok to have extra keys in the dependencies that+   are not the key of any Node in the graph+-}+data Node key payload = DigraphNode {+      node_payload :: payload, -- ^ User data+      node_key :: key, -- ^ User defined node id+      node_dependencies :: [key] -- ^ Dependencies/successors of the node+  }+++instance (Outputable a, Outputable b) => Outputable (Node  a b) where+  ppr (DigraphNode a b c) = ppr (a, b, c)++emptyGraph :: Graph a+emptyGraph = Graph (array (1, 0) []) (error "emptyGraph") (const Nothing)++-- See Note [Deterministic SCC]+graphFromEdgedVertices+        :: ReduceFn key payload+        -> [Node key payload]           -- The graph; its ok for the+                                        -- out-list to contain keys which aren't+                                        -- a vertex key, they are ignored+        -> Graph (Node key payload)+graphFromEdgedVertices _reduceFn []            = emptyGraph+graphFromEdgedVertices reduceFn edged_vertices =+  Graph graph vertex_fn (key_vertex . key_extractor)+  where key_extractor = node_key+        (bounds, vertex_fn, key_vertex, numbered_nodes) =+          reduceFn edged_vertices key_extractor+        graph = array bounds [ (v, sort $ mapMaybe key_vertex ks)+                             | (v, (node_dependencies -> ks)) <- numbered_nodes]+                -- We normalize outgoing edges by sorting on node order, so+                -- that the result doesn't depend on the order of the edges++-- See Note [Deterministic SCC]+-- See Note [reduceNodesIntoVertices implementations]+graphFromEdgedVerticesOrd+        :: Ord key+        => [Node key payload]           -- The graph; its ok for the+                                        -- out-list to contain keys which aren't+                                        -- a vertex key, they are ignored+        -> Graph (Node key payload)+graphFromEdgedVerticesOrd = graphFromEdgedVertices reduceNodesIntoVerticesOrd++-- See Note [Deterministic SCC]+-- See Note [reduceNodesIntoVertices implementations]+graphFromEdgedVerticesUniq+        :: Uniquable key+        => [Node key payload]           -- The graph; its ok for the+                                        -- out-list to contain keys which aren't+                                        -- a vertex key, they are ignored+        -> Graph (Node key payload)+graphFromEdgedVerticesUniq = graphFromEdgedVertices reduceNodesIntoVerticesUniq++type ReduceFn key payload =+  [Node key payload] -> (Node key payload -> key) ->+    (Bounds, Vertex -> Node key payload+    , key -> Maybe Vertex, [(Vertex, Node key payload)])++{-+Note [reduceNodesIntoVertices implementations]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+reduceNodesIntoVertices is parameterized by the container type.+This is to accomodate key types that don't have an Ord instance+and hence preclude the use of Data.Map. An example of such type+would be Unique, there's no way to implement Ord Unique+deterministically.++For such types, there's a version with a Uniquable constraint.+This leaves us with two versions of every function that depends on+reduceNodesIntoVertices, one with Ord constraint and the other with+Uniquable constraint.+For example: graphFromEdgedVerticesOrd and graphFromEdgedVerticesUniq.++The Uniq version should be a tiny bit more efficient since it uses+Data.IntMap internally.+-}+reduceNodesIntoVertices+  :: ([(key, Vertex)] -> m)+  -> (key -> m -> Maybe Vertex)+  -> ReduceFn key payload+reduceNodesIntoVertices fromList lookup nodes key_extractor =+  (bounds, (!) vertex_map, key_vertex, numbered_nodes)+  where+    max_v           = length nodes - 1+    bounds          = (0, max_v) :: (Vertex, Vertex)++    -- Keep the order intact to make the result depend on input order+    -- instead of key order+    numbered_nodes  = zip [0..] nodes+    vertex_map      = array bounds numbered_nodes++    key_map = fromList+      [ (key_extractor node, v) | (v, node) <- numbered_nodes ]+    key_vertex k = lookup k key_map++-- See Note [reduceNodesIntoVertices implementations]+reduceNodesIntoVerticesOrd :: Ord key => ReduceFn key payload+reduceNodesIntoVerticesOrd = reduceNodesIntoVertices Map.fromList Map.lookup++-- See Note [reduceNodesIntoVertices implementations]+reduceNodesIntoVerticesUniq :: Uniquable key => ReduceFn key payload+reduceNodesIntoVerticesUniq = reduceNodesIntoVertices listToUFM (flip lookupUFM)++{-+************************************************************************+*                                                                      *+*      SCC+*                                                                      *+************************************************************************+-}++type WorkItem key payload+  = (Node key payload,  -- Tip of the path+     [payload])         -- Rest of the path;+                        --  [a,b,c] means c depends on b, b depends on a++-- | Find a reasonably short cycle a->b->c->a, in a strongly+-- connected component.  The input nodes are presumed to be+-- a SCC, so you can start anywhere.+findCycle :: forall payload key. Ord key+          => [Node key payload]     -- The nodes.  The dependencies can+                                    -- contain extra keys, which are ignored+          -> Maybe [payload]        -- A cycle, starting with node+                                    -- so each depends on the next+findCycle graph+  = go Set.empty (new_work root_deps []) []+  where+    env :: Map.Map key (Node key payload)+    env = Map.fromList [ (node_key node, node) | node <- graph ]++    -- Find the node with fewest dependencies among the SCC modules+    -- This is just a heuristic to find some plausible root module+    root :: Node key payload+    root = fst (minWith snd [ (node, count (`Map.member` env)+                                           (node_dependencies node))+                            | node <- graph ])+    DigraphNode root_payload root_key root_deps = root+++    -- 'go' implements Dijkstra's algorithm, more or less+    go :: Set.Set key   -- Visited+       -> [WorkItem key payload]        -- Work list, items length n+       -> [WorkItem key payload]        -- Work list, items length n+1+       -> Maybe [payload]               -- Returned cycle+       -- Invariant: in a call (go visited ps qs),+       --            visited = union (map tail (ps ++ qs))++    go _       [] [] = Nothing  -- No cycles+    go visited [] qs = go visited qs []+    go visited (((DigraphNode payload key deps), path) : ps) qs+       | key == root_key           = Just (root_payload : reverse path)+       | key `Set.member` visited  = go visited ps qs+       | key `Map.notMember` env   = go visited ps qs+       | otherwise                 = go (Set.insert key visited)+                                        ps (new_qs ++ qs)+       where+         new_qs = new_work deps (payload : path)++    new_work :: [key] -> [payload] -> [WorkItem key payload]+    new_work deps path = [ (n, path) | Just n <- map (`Map.lookup` env) deps ]++{-+************************************************************************+*                                                                      *+*      Strongly Connected Component wrappers for Graph+*                                                                      *+************************************************************************++Note: the components are returned topologically sorted: later components+depend on earlier ones, but not vice versa i.e. later components only have+edges going from them to earlier ones.+-}++{-+Note [Deterministic SCC]+~~~~~~~~~~~~~~~~~~~~~~~~+stronglyConnCompFromEdgedVerticesUniq,+stronglyConnCompFromEdgedVerticesUniqR,+stronglyConnCompFromEdgedVerticesOrd and+stronglyConnCompFromEdgedVerticesOrdR+provide a following guarantee:+Given a deterministically ordered list of nodes it returns a deterministically+ordered list of strongly connected components, where the list of vertices+in an SCC is also deterministically ordered.+Note that the order of edges doesn't need to be deterministic for this to work.+We use the order of nodes to normalize the order of edges.+-}++stronglyConnCompG :: Graph node -> [SCC node]+stronglyConnCompG graph = decodeSccs graph forest+  where forest = {-# SCC "Digraph.scc" #-} scc (gr_int_graph graph)++decodeSccs :: Graph node -> Forest Vertex -> [SCC node]+decodeSccs Graph { gr_int_graph = graph, gr_vertex_to_node = vertex_fn } forest+  = map decode forest+  where+    decode (Node v []) | mentions_itself v = CyclicSCC [vertex_fn v]+                       | otherwise         = AcyclicSCC (vertex_fn v)+    decode other = CyclicSCC (dec other [])+      where dec (Node v ts) vs = vertex_fn v : foldr dec vs ts+    mentions_itself v = v `elem` (graph ! v)+++-- The following two versions are provided for backwards compatibility:+-- See Note [Deterministic SCC]+-- See Note [reduceNodesIntoVertices implementations]+stronglyConnCompFromEdgedVerticesOrd+        :: Ord key+        => [Node key payload]+        -> [SCC payload]+stronglyConnCompFromEdgedVerticesOrd+  = map (fmap node_payload) . stronglyConnCompFromEdgedVerticesOrdR++-- The following two versions are provided for backwards compatibility:+-- See Note [Deterministic SCC]+-- See Note [reduceNodesIntoVertices implementations]+stronglyConnCompFromEdgedVerticesUniq+        :: Uniquable key+        => [Node key payload]+        -> [SCC payload]+stronglyConnCompFromEdgedVerticesUniq+  = map (fmap node_payload) . stronglyConnCompFromEdgedVerticesUniqR++-- The "R" interface is used when you expect to apply SCC to+-- (some of) the result of SCC, so you don't want to lose the dependency info+-- See Note [Deterministic SCC]+-- See Note [reduceNodesIntoVertices implementations]+stronglyConnCompFromEdgedVerticesOrdR+        :: Ord key+        => [Node key payload]+        -> [SCC (Node key payload)]+stronglyConnCompFromEdgedVerticesOrdR =+  stronglyConnCompG . graphFromEdgedVertices reduceNodesIntoVerticesOrd++-- The "R" interface is used when you expect to apply SCC to+-- (some of) the result of SCC, so you don't want to lose the dependency info+-- See Note [Deterministic SCC]+-- See Note [reduceNodesIntoVertices implementations]+stronglyConnCompFromEdgedVerticesUniqR+        :: Uniquable key+        => [Node key payload]+        -> [SCC (Node key payload)]+stronglyConnCompFromEdgedVerticesUniqR =+  stronglyConnCompG . graphFromEdgedVertices reduceNodesIntoVerticesUniq++{-+************************************************************************+*                                                                      *+*      Misc wrappers for Graph+*                                                                      *+************************************************************************+-}++topologicalSortG :: Graph node -> [node]+topologicalSortG graph = map (gr_vertex_to_node graph) result+  where result = {-# SCC "Digraph.topSort" #-} topSort (gr_int_graph graph)++reachableG :: Graph node -> node -> [node]+reachableG graph from = map (gr_vertex_to_node graph) result+  where from_vertex = expectJust "reachableG" (gr_node_to_vertex graph from)+        result = {-# SCC "Digraph.reachable" #-} reachable (gr_int_graph graph) [from_vertex]++-- | Given a list of roots return all reachable nodes.+reachablesG :: Graph node -> [node] -> [node]+reachablesG graph froms = map (gr_vertex_to_node graph) result+  where result = {-# SCC "Digraph.reachable" #-}+                 reachable (gr_int_graph graph) vs+        vs = [ v | Just v <- map (gr_node_to_vertex graph) froms ]++hasVertexG :: Graph node -> node -> Bool+hasVertexG graph node = isJust $ gr_node_to_vertex graph node++verticesG :: Graph node -> [node]+verticesG graph = map (gr_vertex_to_node graph) $ vertices (gr_int_graph graph)++edgesG :: Graph node -> [Edge node]+edgesG graph = map (\(v1, v2) -> Edge (v2n v1) (v2n v2)) $ edges (gr_int_graph graph)+  where v2n = gr_vertex_to_node graph++transposeG :: Graph node -> Graph node+transposeG graph = Graph (G.transposeG (gr_int_graph graph))+                         (gr_vertex_to_node graph)+                         (gr_node_to_vertex graph)++emptyG :: Graph node -> Bool+emptyG g = graphEmpty (gr_int_graph g)++{-+************************************************************************+*                                                                      *+*      Showing Graphs+*                                                                      *+************************************************************************+-}++instance Outputable node => Outputable (Graph node) where+    ppr graph = vcat [+                  hang (text "Vertices:") 2 (vcat (map ppr $ verticesG graph)),+                  hang (text "Edges:") 2 (vcat (map ppr $ edgesG graph))+                ]++instance Outputable node => Outputable (Edge node) where+    ppr (Edge from to) = ppr from <+> text "->" <+> ppr to++graphEmpty :: G.Graph -> Bool+graphEmpty g = lo > hi+  where (lo, hi) = bounds g++{-+************************************************************************+*                                                                      *+*      IntGraphs+*                                                                      *+************************************************************************+-}++type IntGraph = G.Graph++{-+------------------------------------------------------------+-- Depth first search numbering+------------------------------------------------------------+-}++-- Data.Tree has flatten for Tree, but nothing for Forest+preorderF           :: Forest a -> [a]+preorderF ts         = concat (map flatten ts)++{-+------------------------------------------------------------+-- Finding reachable vertices+------------------------------------------------------------+-}++-- This generalizes reachable which was found in Data.Graph+reachable    :: IntGraph -> [Vertex] -> [Vertex]+reachable g vs = preorderF (dfs g vs)++{-+************************************************************************+*                                                                      *+*                         Classify Edge Types+*                                                                      *+************************************************************************+-}++-- Remark: While we could generalize this algorithm this comes at a runtime+-- cost and with no advantages. If you find yourself using this with graphs+-- not easily represented using Int nodes please consider rewriting this+-- using the more general Graph type.++-- | Edge direction based on DFS Classification+data EdgeType+  = Forward+  | Cross+  | Backward -- ^ Loop back towards the root node.+             -- Eg backjumps in loops+  | SelfLoop -- ^ v -> v+   deriving (Eq,Ord)++instance Outputable EdgeType where+  ppr Forward = text "Forward"+  ppr Cross = text "Cross"+  ppr Backward = text "Backward"+  ppr SelfLoop = text "SelfLoop"++newtype Time = Time Int deriving (Eq,Ord,Num,Outputable)++--Allow for specialzation+{-# INLINEABLE classifyEdges #-}++-- | Given a start vertex, a way to get successors from a node+-- and a list of (directed) edges classify the types of edges.+classifyEdges :: forall key. Uniquable key => key -> (key -> [key])+              -> [(key,key)] -> [((key, key), EdgeType)]+classifyEdges root getSucc edges =+    --let uqe (from,to) = (getUnique from, getUnique to)+    --in pprTrace "Edges:" (ppr $ map uqe edges) $+    zip edges $ map classify edges+  where+    (_time, starts, ends) = addTimes (0,emptyUFM,emptyUFM) root+    classify :: (key,key) -> EdgeType+    classify (from,to)+      | startFrom < startTo+      , endFrom   > endTo+      = Forward+      | startFrom > startTo+      , endFrom   < endTo+      = Backward+      | startFrom > startTo+      , endFrom   > endTo+      = Cross+      | getUnique from == getUnique to+      = SelfLoop+      | otherwise+      = pprPanic "Failed to classify edge of Graph"+                 (ppr (getUnique from, getUnique to))++      where+        getTime event node+          | Just time <- lookupUFM event node+          = time+          | otherwise+          = pprPanic "Failed to classify edge of CFG - not not timed"+            (text "edges" <> ppr (getUnique from, getUnique to)+                          <+> ppr starts <+> ppr ends )+        startFrom = getTime starts from+        startTo   = getTime starts to+        endFrom   = getTime ends   from+        endTo     = getTime ends   to++    addTimes :: (Time, UniqFM Time, UniqFM Time) -> key+             -> (Time, UniqFM Time, UniqFM Time)+    addTimes (time,starts,ends) n+      --Dont reenter nodes+      | elemUFM n starts+      = (time,starts,ends)+      | otherwise =+        let+          starts' = addToUFM starts n time+          time' = time + 1+          succs = getSucc n :: [key]+          (time'',starts'',ends') = foldl' addTimes (time',starts',ends) succs+          ends'' = addToUFM ends' n time''+        in+        (time'' + 1, starts'', ends'')
+ compiler/utils/Encoding.hs view
@@ -0,0 +1,450 @@+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}+{-# OPTIONS_GHC -O2 #-}+-- We always optimise this, otherwise performance of a non-optimised+-- compiler is severely affected++-- -----------------------------------------------------------------------------+--+-- (c) The University of Glasgow, 1997-2006+--+-- Character encodings+--+-- -----------------------------------------------------------------------------++module Encoding (+        -- * UTF-8+        utf8DecodeChar#,+        utf8PrevChar,+        utf8CharStart,+        utf8DecodeChar,+        utf8DecodeByteString,+        utf8DecodeStringLazy,+        utf8EncodeChar,+        utf8EncodeString,+        utf8EncodedLength,+        countUTF8Chars,++        -- * Z-encoding+        zEncodeString,+        zDecodeString,++        -- * Base62-encoding+        toBase62,+        toBase62Padded+  ) where++import GhcPrelude++import Foreign+import Foreign.ForeignPtr.Unsafe+import Data.Char+import qualified Data.Char as Char+import Numeric+import GHC.IO++import Data.ByteString (ByteString)+import qualified Data.ByteString.Internal as BS++import GHC.Exts++-- -----------------------------------------------------------------------------+-- UTF-8++-- We can't write the decoder as efficiently as we'd like without+-- resorting to unboxed extensions, unfortunately.  I tried to write+-- an IO version of this function, but GHC can't eliminate boxed+-- results from an IO-returning function.+--+-- We assume we can ignore overflow when parsing a multibyte character here.+-- To make this safe, we add extra sentinel bytes to unparsed UTF-8 sequences+-- before decoding them (see StringBuffer.hs).++{-# INLINE utf8DecodeChar# #-}+utf8DecodeChar# :: Addr# -> (# Char#, Int# #)+utf8DecodeChar# a# =+  let !ch0 = word2Int# (indexWord8OffAddr# a# 0#) in+  case () of+    _ | isTrue# (ch0 <=# 0x7F#) -> (# chr# ch0, 1# #)++      | isTrue# ((ch0 >=# 0xC0#) `andI#` (ch0 <=# 0xDF#)) ->+        let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in+        if isTrue# ((ch1 <# 0x80#) `orI#` (ch1 >=# 0xC0#)) then fail 1# else+        (# chr# (((ch0 -# 0xC0#) `uncheckedIShiftL#` 6#) +#+                  (ch1 -# 0x80#)),+           2# #)++      | isTrue# ((ch0 >=# 0xE0#) `andI#` (ch0 <=# 0xEF#)) ->+        let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in+        if isTrue# ((ch1 <# 0x80#) `orI#` (ch1 >=# 0xC0#)) then fail 1# else+        let !ch2 = word2Int# (indexWord8OffAddr# a# 2#) in+        if isTrue# ((ch2 <# 0x80#) `orI#` (ch2 >=# 0xC0#)) then fail 2# else+        (# chr# (((ch0 -# 0xE0#) `uncheckedIShiftL#` 12#) +#+                 ((ch1 -# 0x80#) `uncheckedIShiftL#` 6#)  +#+                  (ch2 -# 0x80#)),+           3# #)++     | isTrue# ((ch0 >=# 0xF0#) `andI#` (ch0 <=# 0xF8#)) ->+        let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in+        if isTrue# ((ch1 <# 0x80#) `orI#` (ch1 >=# 0xC0#)) then fail 1# else+        let !ch2 = word2Int# (indexWord8OffAddr# a# 2#) in+        if isTrue# ((ch2 <# 0x80#) `orI#` (ch2 >=# 0xC0#)) then fail 2# else+        let !ch3 = word2Int# (indexWord8OffAddr# a# 3#) in+        if isTrue# ((ch3 <# 0x80#) `orI#` (ch3 >=# 0xC0#)) then fail 3# else+        (# chr# (((ch0 -# 0xF0#) `uncheckedIShiftL#` 18#) +#+                 ((ch1 -# 0x80#) `uncheckedIShiftL#` 12#) +#+                 ((ch2 -# 0x80#) `uncheckedIShiftL#` 6#)  +#+                  (ch3 -# 0x80#)),+           4# #)++      | otherwise -> fail 1#+  where+        -- all invalid sequences end up here:+        fail :: Int# -> (# Char#, Int# #)+        fail nBytes# = (# '\0'#, nBytes# #)+        -- '\xFFFD' would be the usual replacement character, but+        -- that's a valid symbol in Haskell, so will result in a+        -- confusing parse error later on.  Instead we use '\0' which+        -- will signal a lexer error immediately.++utf8DecodeChar :: Ptr Word8 -> (Char, Int)+utf8DecodeChar (Ptr a#) =+  case utf8DecodeChar# a# of (# c#, nBytes# #) -> ( C# c#, I# nBytes# )++-- UTF-8 is cleverly designed so that we can always figure out where+-- the start of the current character is, given any position in a+-- stream.  This function finds the start of the previous character,+-- assuming there *is* a previous character.+utf8PrevChar :: Ptr Word8 -> IO (Ptr Word8)+utf8PrevChar p = utf8CharStart (p `plusPtr` (-1))++utf8CharStart :: Ptr Word8 -> IO (Ptr Word8)+utf8CharStart p = go p+ where go p = do w <- peek p+                 if w >= 0x80 && w < 0xC0+                        then go (p `plusPtr` (-1))+                        else return p++utf8DecodeByteString :: ByteString -> [Char]+utf8DecodeByteString (BS.PS ptr offset len)+  = utf8DecodeStringLazy ptr offset len++utf8DecodeStringLazy :: ForeignPtr Word8 -> Int -> Int -> [Char]+utf8DecodeStringLazy fptr offset len+  = unsafeDupablePerformIO $ unpack start+  where+    !start = unsafeForeignPtrToPtr fptr `plusPtr` offset+    !end = start `plusPtr` len++    unpack p+        | p >= end  = touchForeignPtr fptr >> return []+        | otherwise =+            case utf8DecodeChar# (unPtr p) of+                (# c#, nBytes# #) -> do+                  rest <- unsafeDupableInterleaveIO $ unpack (p `plusPtr#` nBytes#)+                  return (C# c# : rest)++countUTF8Chars :: Ptr Word8 -> Int -> IO Int+countUTF8Chars ptr len = go ptr 0+  where+        !end = ptr `plusPtr` len++        go p !n+           | p >= end = return n+           | otherwise  = do+                case utf8DecodeChar# (unPtr p) of+                  (# _, nBytes# #) -> go (p `plusPtr#` nBytes#) (n+1)++unPtr :: Ptr a -> Addr#+unPtr (Ptr a) = a++plusPtr# :: Ptr a -> Int# -> Ptr a+plusPtr# ptr nBytes# = ptr `plusPtr` (I# nBytes#)++utf8EncodeChar :: Char -> Ptr Word8 -> IO (Ptr Word8)+utf8EncodeChar c ptr =+  let x = ord c in+  case () of+    _ | x > 0 && x <= 0x007f -> do+          poke ptr (fromIntegral x)+          return (ptr `plusPtr` 1)+        -- NB. '\0' is encoded as '\xC0\x80', not '\0'.  This is so that we+        -- can have 0-terminated UTF-8 strings (see GHC.Base.unpackCStringUtf8).+      | x <= 0x07ff -> do+          poke ptr (fromIntegral (0xC0 .|. ((x `shiftR` 6) .&. 0x1F)))+          pokeElemOff ptr 1 (fromIntegral (0x80 .|. (x .&. 0x3F)))+          return (ptr `plusPtr` 2)+      | x <= 0xffff -> do+          poke ptr (fromIntegral (0xE0 .|. (x `shiftR` 12) .&. 0x0F))+          pokeElemOff ptr 1 (fromIntegral (0x80 .|. (x `shiftR` 6) .&. 0x3F))+          pokeElemOff ptr 2 (fromIntegral (0x80 .|. (x .&. 0x3F)))+          return (ptr `plusPtr` 3)+      | otherwise -> do+          poke ptr (fromIntegral (0xF0 .|. (x `shiftR` 18)))+          pokeElemOff ptr 1 (fromIntegral (0x80 .|. ((x `shiftR` 12) .&. 0x3F)))+          pokeElemOff ptr 2 (fromIntegral (0x80 .|. ((x `shiftR` 6) .&. 0x3F)))+          pokeElemOff ptr 3 (fromIntegral (0x80 .|. (x .&. 0x3F)))+          return (ptr `plusPtr` 4)++utf8EncodeString :: Ptr Word8 -> String -> IO ()+utf8EncodeString ptr str = go ptr str+  where go !_   []     = return ()+        go ptr (c:cs) = do+          ptr' <- utf8EncodeChar c ptr+          go ptr' cs++utf8EncodedLength :: String -> Int+utf8EncodedLength str = go 0 str+  where go !n [] = n+        go n (c:cs)+          | ord c > 0 && ord c <= 0x007f = go (n+1) cs+          | ord c <= 0x07ff = go (n+2) cs+          | ord c <= 0xffff = go (n+3) cs+          | otherwise       = go (n+4) cs++-- -----------------------------------------------------------------------------+-- The Z-encoding++{-+This is the main name-encoding and decoding function.  It encodes any+string into a string that is acceptable as a C name.  This is done+right before we emit a symbol name into the compiled C or asm code.+Z-encoding of strings is cached in the FastString interface, so we+never encode the same string more than once.++The basic encoding scheme is this.++* Tuples (,,,) are coded as Z3T++* Alphabetic characters (upper and lower) and digits+        all translate to themselves;+        except 'Z', which translates to 'ZZ'+        and    'z', which translates to 'zz'+  We need both so that we can preserve the variable/tycon distinction++* Most other printable characters translate to 'zx' or 'Zx' for some+        alphabetic character x++* The others translate as 'znnnU' where 'nnn' is the decimal number+        of the character++        Before          After+        --------------------------+        Trak            Trak+        foo_wib         foozuwib+        >               zg+        >1              zg1+        foo#            foozh+        foo##           foozhzh+        foo##1          foozhzh1+        fooZ            fooZZ+        :+              ZCzp+        ()              Z0T     0-tuple+        (,,,,)          Z5T     5-tuple+        (# #)           Z1H     unboxed 1-tuple (note the space)+        (#,,,,#)        Z5H     unboxed 5-tuple+                (NB: There is no Z1T nor Z0H.)+-}++type UserString = String        -- As the user typed it+type EncodedString = String     -- Encoded form+++zEncodeString :: UserString -> EncodedString+zEncodeString cs = case maybe_tuple cs of+                Just n  -> n            -- Tuples go to Z2T etc+                Nothing -> go cs+          where+                go []     = []+                go (c:cs) = encode_digit_ch c ++ go' cs+                go' []     = []+                go' (c:cs) = encode_ch c ++ go' cs++unencodedChar :: Char -> Bool   -- True for chars that don't need encoding+unencodedChar 'Z' = False+unencodedChar 'z' = False+unencodedChar c   =  c >= 'a' && c <= 'z'+                  || c >= 'A' && c <= 'Z'+                  || c >= '0' && c <= '9'++-- If a digit is at the start of a symbol then we need to encode it.+-- Otherwise package names like 9pH-0.1 give linker errors.+encode_digit_ch :: Char -> EncodedString+encode_digit_ch c | c >= '0' && c <= '9' = encode_as_unicode_char c+encode_digit_ch c | otherwise            = encode_ch c++encode_ch :: Char -> EncodedString+encode_ch c | unencodedChar c = [c]     -- Common case first++-- Constructors+encode_ch '('  = "ZL"   -- Needed for things like (,), and (->)+encode_ch ')'  = "ZR"   -- For symmetry with (+encode_ch '['  = "ZM"+encode_ch ']'  = "ZN"+encode_ch ':'  = "ZC"+encode_ch 'Z'  = "ZZ"++-- Variables+encode_ch 'z'  = "zz"+encode_ch '&'  = "za"+encode_ch '|'  = "zb"+encode_ch '^'  = "zc"+encode_ch '$'  = "zd"+encode_ch '='  = "ze"+encode_ch '>'  = "zg"+encode_ch '#'  = "zh"+encode_ch '.'  = "zi"+encode_ch '<'  = "zl"+encode_ch '-'  = "zm"+encode_ch '!'  = "zn"+encode_ch '+'  = "zp"+encode_ch '\'' = "zq"+encode_ch '\\' = "zr"+encode_ch '/'  = "zs"+encode_ch '*'  = "zt"+encode_ch '_'  = "zu"+encode_ch '%'  = "zv"+encode_ch c    = encode_as_unicode_char c++encode_as_unicode_char :: Char -> EncodedString+encode_as_unicode_char c = 'z' : if isDigit (head hex_str) then hex_str+                                                           else '0':hex_str+  where hex_str = showHex (ord c) "U"+  -- ToDo: we could improve the encoding here in various ways.+  -- eg. strings of unicode characters come out as 'z1234Uz5678U', we+  -- could remove the 'U' in the middle (the 'z' works as a separator).++zDecodeString :: EncodedString -> UserString+zDecodeString [] = []+zDecodeString ('Z' : d : rest)+  | isDigit d = decode_tuple   d rest+  | otherwise = decode_upper   d : zDecodeString rest+zDecodeString ('z' : d : rest)+  | isDigit d = decode_num_esc d rest+  | otherwise = decode_lower   d : zDecodeString rest+zDecodeString (c   : rest) = c : zDecodeString rest++decode_upper, decode_lower :: Char -> Char++decode_upper 'L' = '('+decode_upper 'R' = ')'+decode_upper 'M' = '['+decode_upper 'N' = ']'+decode_upper 'C' = ':'+decode_upper 'Z' = 'Z'+decode_upper ch  = {-pprTrace "decode_upper" (char ch)-} ch++decode_lower 'z' = 'z'+decode_lower 'a' = '&'+decode_lower 'b' = '|'+decode_lower 'c' = '^'+decode_lower 'd' = '$'+decode_lower 'e' = '='+decode_lower 'g' = '>'+decode_lower 'h' = '#'+decode_lower 'i' = '.'+decode_lower 'l' = '<'+decode_lower 'm' = '-'+decode_lower 'n' = '!'+decode_lower 'p' = '+'+decode_lower 'q' = '\''+decode_lower 'r' = '\\'+decode_lower 's' = '/'+decode_lower 't' = '*'+decode_lower 'u' = '_'+decode_lower 'v' = '%'+decode_lower ch  = {-pprTrace "decode_lower" (char ch)-} ch++-- Characters not having a specific code are coded as z224U (in hex)+decode_num_esc :: Char -> EncodedString -> UserString+decode_num_esc d rest+  = go (digitToInt d) rest+  where+    go n (c : rest) | isHexDigit c = go (16*n + digitToInt c) rest+    go n ('U' : rest)           = chr n : zDecodeString rest+    go n other = error ("decode_num_esc: " ++ show n ++  ' ':other)++decode_tuple :: Char -> EncodedString -> UserString+decode_tuple d rest+  = go (digitToInt d) rest+  where+        -- NB. recurse back to zDecodeString after decoding the tuple, because+        -- the tuple might be embedded in a longer name.+    go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest+    go 0 ('T':rest)     = "()" ++ zDecodeString rest+    go n ('T':rest)     = '(' : replicate (n-1) ',' ++ ")" ++ zDecodeString rest+    go 1 ('H':rest)     = "(# #)" ++ zDecodeString rest+    go n ('H':rest)     = '(' : '#' : replicate (n-1) ',' ++ "#)" ++ zDecodeString rest+    go n other = error ("decode_tuple: " ++ show n ++ ' ':other)++{-+Tuples are encoded as+        Z3T or Z3H+for 3-tuples or unboxed 3-tuples respectively.  No other encoding starts+        Z<digit>++* "(# #)" is the tycon for an unboxed 1-tuple (not 0-tuple)+  There are no unboxed 0-tuples.++* "()" is the tycon for a boxed 0-tuple.+  There are no boxed 1-tuples.+-}++maybe_tuple :: UserString -> Maybe EncodedString++maybe_tuple "(# #)" = Just("Z1H")+maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of+                                 (n, '#' : ')' : _) -> Just ('Z' : shows (n+1) "H")+                                 _                  -> Nothing+maybe_tuple "()" = Just("Z0T")+maybe_tuple ('(' : cs)       = case count_commas (0::Int) cs of+                                 (n, ')' : _) -> Just ('Z' : shows (n+1) "T")+                                 _            -> Nothing+maybe_tuple _                = Nothing++count_commas :: Int -> String -> (Int, String)+count_commas n (',' : cs) = count_commas (n+1) cs+count_commas n cs         = (n,cs)+++{-+************************************************************************+*                                                                      *+                        Base 62+*                                                                      *+************************************************************************++Note [Base 62 encoding 128-bit integers]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Instead of base-62 encoding a single 128-bit integer+(ceil(21.49) characters), we'll base-62 a pair of 64-bit integers+(2 * ceil(10.75) characters).  Luckily for us, it's the same number of+characters!+-}++--------------------------------------------------------------------------+-- Base 62++-- The base-62 code is based off of 'locators'+-- ((c) Operational Dynamics Consulting, BSD3 licensed)++-- | Size of a 64-bit word when written as a base-62 string+word64Base62Len :: Int+word64Base62Len = 11++-- | Converts a 64-bit word into a base-62 string+toBase62Padded :: Word64 -> String+toBase62Padded w = pad ++ str+  where+    pad = replicate len '0'+    len = word64Base62Len - length str -- 11 == ceil(64 / lg 62)+    str = toBase62 w++toBase62 :: Word64 -> String+toBase62 w = showIntAtBase 62 represent w ""+  where+    represent :: Int -> Char+    represent x+        | x < 10 = Char.chr (48 + x)+        | x < 36 = Char.chr (65 + x - 10)+        | x < 62 = Char.chr (97 + x - 36)+        | otherwise = error "represent (base 62): impossible!"
+ compiler/utils/EnumSet.hs view
@@ -0,0 +1,35 @@+-- | A tiny wrapper around 'IntSet.IntSet' for representing sets of 'Enum'+-- things.+module EnumSet+    ( EnumSet+    , member+    , insert+    , delete+    , toList+    , fromList+    , empty+    ) where++import GhcPrelude++import qualified Data.IntSet as IntSet++newtype EnumSet a = EnumSet IntSet.IntSet++member :: Enum a => a -> EnumSet a -> Bool+member x (EnumSet s) = IntSet.member (fromEnum x) s++insert :: Enum a => a -> EnumSet a -> EnumSet a+insert x (EnumSet s) = EnumSet $ IntSet.insert (fromEnum x) s++delete :: Enum a => a -> EnumSet a -> EnumSet a+delete x (EnumSet s) = EnumSet $ IntSet.delete (fromEnum x) s++toList :: Enum a => EnumSet a -> [a]+toList (EnumSet s) = map toEnum $ IntSet.toList s++fromList :: Enum a => [a] -> EnumSet a+fromList = EnumSet . IntSet.fromList . map fromEnum++empty :: EnumSet a+empty = EnumSet IntSet.empty
+ compiler/utils/Exception.hs view
@@ -0,0 +1,83 @@+{-# OPTIONS_GHC -fno-warn-deprecations #-}+module Exception+    (+    module Control.Exception,+    module Exception+    )+    where++import GhcPrelude++import Control.Exception+import Control.Monad.IO.Class++catchIO :: IO a -> (IOException -> IO a) -> IO a+catchIO = Control.Exception.catch++handleIO :: (IOException -> IO a) -> IO a -> IO a+handleIO = flip catchIO++tryIO :: IO a -> IO (Either IOException a)+tryIO = try++-- | A monad that can catch exceptions.  A minimal definition+-- requires a definition of 'gcatch'.+--+-- Implementations on top of 'IO' should implement 'gmask' to+-- eventually call the primitive 'Control.Exception.mask'.+-- These are used for+-- implementations that support asynchronous exceptions.  The default+-- implementations of 'gbracket' and 'gfinally' use 'gmask'+-- thus rarely require overriding.+--+class MonadIO m => ExceptionMonad m where++  -- | Generalised version of 'Control.Exception.catch', allowing an arbitrary+  -- exception handling monad instead of just 'IO'.+  gcatch :: Exception e => m a -> (e -> m a) -> m a++  -- | Generalised version of 'Control.Exception.mask_', allowing an arbitrary+  -- exception handling monad instead of just 'IO'.+  gmask :: ((m a -> m a) -> m b) -> m b++  -- | Generalised version of 'Control.Exception.bracket', allowing an arbitrary+  -- exception handling monad instead of just 'IO'.+  gbracket :: m a -> (a -> m b) -> (a -> m c) -> m c++  -- | Generalised version of 'Control.Exception.finally', allowing an arbitrary+  -- exception handling monad instead of just 'IO'.+  gfinally :: m a -> m b -> m a++  gbracket before after thing =+    gmask $ \restore -> do+      a <- before+      r <- restore (thing a) `gonException` after a+      _ <- after a+      return r++  a `gfinally` sequel =+    gmask $ \restore -> do+      r <- restore a `gonException` sequel+      _ <- sequel+      return r++instance ExceptionMonad IO where+  gcatch    = Control.Exception.catch+  gmask f   = mask (\x -> f x)++gtry :: (ExceptionMonad m, Exception e) => m a -> m (Either e a)+gtry act = gcatch (act >>= \a -> return (Right a))+                  (\e -> return (Left e))++-- | Generalised version of 'Control.Exception.handle', allowing an arbitrary+-- exception handling monad instead of just 'IO'.+ghandle :: (ExceptionMonad m, Exception e) => (e -> m a) -> m a -> m a+ghandle = flip gcatch++-- | Always executes the first argument.  If this throws an exception the+-- second argument is executed and the exception is raised again.+gonException :: (ExceptionMonad m) => m a -> m b -> m a+gonException ioA cleanup = ioA `gcatch` \e ->+                             do _ <- cleanup+                                liftIO $ throwIO (e :: SomeException)+
+ compiler/utils/FV.hs view
@@ -0,0 +1,201 @@+{-+(c) Bartosz Nitka, Facebook 2015++Utilities for efficiently and deterministically computing free variables.++-}++{-# LANGUAGE BangPatterns #-}++module FV (+        -- * Deterministic free vars computations+        FV, InterestingVarFun,++        -- * Running the computations+        fvVarListVarSet, fvVarList, fvVarSet, fvDVarSet,++        -- ** Manipulating those computations+        unitFV,+        emptyFV,+        mkFVs,+        unionFV,+        unionsFV,+        delFV,+        delFVs,+        filterFV,+        mapUnionFV,+    ) where++import GhcPrelude++import Var+import VarSet++-- | Predicate on possible free variables: returns @True@ iff the variable is+-- interesting+type InterestingVarFun = Var -> Bool++-- Note [Deterministic FV]+-- ~~~~~~~~~~~~~~~~~~~~~~~+-- When computing free variables, the order in which you get them affects+-- the results of floating and specialization. If you use UniqFM to collect+-- them and then turn that into a list, you get them in nondeterministic+-- order as described in Note [Deterministic UniqFM] in UniqDFM.++-- A naive algorithm for free variables relies on merging sets of variables.+-- Merging costs O(n+m) for UniqFM and for UniqDFM there's an additional log+-- factor. It's cheaper to incrementally add to a list and use a set to check+-- for duplicates.+type FV = InterestingVarFun+             -- Used for filtering sets as we build them+          -> VarSet+             -- Locally bound variables+          -> ([Var], VarSet)+             -- List to preserve ordering and set to check for membership,+             -- so that the list doesn't have duplicates+             -- For explanation of why using `VarSet` is not deterministic see+             -- Note [Deterministic UniqFM] in UniqDFM.+          -> ([Var], VarSet)++-- Note [FV naming conventions]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- To get the performance and determinism that FV provides, FV computations+-- need to built up from smaller FV computations and then evaluated with+-- one of `fvVarList`, `fvDVarSet`, `fvVarListVarSet`. That means the functions+-- returning FV need to be exported.+--+-- The conventions are:+--+-- a) non-deterministic functions:+--   * a function that returns VarSet+--       e.g. `tyVarsOfType`+-- b) deterministic functions:+--   * a worker that returns FV+--       e.g. `tyFVsOfType`+--   * a function that returns [Var]+--       e.g. `tyVarsOfTypeList`+--   * a function that returns DVarSet+--       e.g. `tyVarsOfTypeDSet`+--+-- Where tyVarsOfType, tyVarsOfTypeList, tyVarsOfTypeDSet are implemented+-- in terms of the worker evaluated with fvVarSet, fvVarList, fvDVarSet+-- respectively.++-- | Run a free variable computation, returning a list of distinct free+-- variables in deterministic order and a non-deterministic set containing+-- those variables.+fvVarListVarSet :: FV ->  ([Var], VarSet)+fvVarListVarSet fv = fv (const True) emptyVarSet ([], emptyVarSet)++-- | Run a free variable computation, returning a list of distinct free+-- variables in deterministic order.+fvVarList :: FV -> [Var]+fvVarList = fst . fvVarListVarSet++-- | Run a free variable computation, returning a deterministic set of free+-- variables. Note that this is just a wrapper around the version that+-- returns a deterministic list. If you need a list you should use+-- `fvVarList`.+fvDVarSet :: FV -> DVarSet+fvDVarSet = mkDVarSet . fst . fvVarListVarSet++-- | Run a free variable computation, returning a non-deterministic set of+-- free variables. Don't use if the set will be later converted to a list+-- and the order of that list will impact the generated code.+fvVarSet :: FV -> VarSet+fvVarSet = snd . fvVarListVarSet++-- Note [FV eta expansion]+-- ~~~~~~~~~~~~~~~~~~~~~~~+-- Let's consider an eta-reduced implementation of freeVarsOf using FV:+--+-- freeVarsOf (App a b) = freeVarsOf a `unionFV` freeVarsOf b+--+-- If GHC doesn't eta-expand it, after inlining unionFV we end up with+--+-- freeVarsOf = \x ->+--   case x of+--     App a b -> \fv_cand in_scope acc ->+--       freeVarsOf a fv_cand in_scope $! freeVarsOf b fv_cand in_scope $! acc+--+-- which has to create a thunk, resulting in more allocations.+--+-- On the other hand if it is eta-expanded:+--+-- freeVarsOf (App a b) fv_cand in_scope acc =+--   (freeVarsOf a `unionFV` freeVarsOf b) fv_cand in_scope acc+--+-- after inlining unionFV we have:+--+-- freeVarsOf = \x fv_cand in_scope acc ->+--   case x of+--     App a b ->+--       freeVarsOf a fv_cand in_scope $! freeVarsOf b fv_cand in_scope $! acc+--+-- which saves allocations.+--+-- GHC when presented with knowledge about all the call sites, correctly+-- eta-expands in this case. Unfortunately due to the fact that freeVarsOf gets+-- exported to be composed with other functions, GHC doesn't have that+-- information and has to be more conservative here.+--+-- Hence functions that get exported and return FV need to be manually+-- eta-expanded. See also #11146.++-- | Add a variable - when free, to the returned free variables.+-- Ignores duplicates and respects the filtering function.+unitFV :: Id -> FV+unitFV var fv_cand in_scope acc@(have, haveSet)+  | var `elemVarSet` in_scope = acc+  | var `elemVarSet` haveSet = acc+  | fv_cand var = (var:have, extendVarSet haveSet var)+  | otherwise = acc+{-# INLINE unitFV #-}++-- | Return no free variables.+emptyFV :: FV+emptyFV _ _ acc = acc+{-# INLINE emptyFV #-}++-- | Union two free variable computations.+unionFV :: FV -> FV -> FV+unionFV fv1 fv2 fv_cand in_scope acc =+  fv1 fv_cand in_scope $! fv2 fv_cand in_scope $! acc+{-# INLINE unionFV #-}++-- | Mark the variable as not free by putting it in scope.+delFV :: Var -> FV -> FV+delFV var fv fv_cand !in_scope acc =+  fv fv_cand (extendVarSet in_scope var) acc+{-# INLINE delFV #-}++-- | Mark many free variables as not free.+delFVs :: VarSet -> FV -> FV+delFVs vars fv fv_cand !in_scope acc =+  fv fv_cand (in_scope `unionVarSet` vars) acc+{-# INLINE delFVs #-}++-- | Filter a free variable computation.+filterFV :: InterestingVarFun -> FV -> FV+filterFV fv_cand2 fv fv_cand1 in_scope acc =+  fv (\v -> fv_cand1 v && fv_cand2 v) in_scope acc+{-# INLINE filterFV #-}++-- | Map a free variable computation over a list and union the results.+mapUnionFV :: (a -> FV) -> [a] -> FV+mapUnionFV _f [] _fv_cand _in_scope acc = acc+mapUnionFV f (a:as) fv_cand in_scope acc =+  mapUnionFV f as fv_cand in_scope $! f a fv_cand in_scope $! acc+{-# INLINABLE mapUnionFV #-}++-- | Union many free variable computations.+unionsFV :: [FV] -> FV+unionsFV fvs fv_cand in_scope acc = mapUnionFV id fvs fv_cand in_scope acc+{-# INLINE unionsFV #-}++-- | Add multiple variables - when free, to the returned free variables.+-- Ignores duplicates and respects the filtering function.+mkFVs :: [Var] -> FV+mkFVs vars fv_cand in_scope acc =+  mapUnionFV unitFV vars fv_cand in_scope acc+{-# INLINE mkFVs #-}
+ compiler/utils/FastFunctions.hs view
@@ -0,0 +1,21 @@+{-+(c) The University of Glasgow, 2000-2006+-}++{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}++module FastFunctions (+    inlinePerformIO,+  ) where++#include "HsVersions.h"++import GhcPrelude ()++import GHC.Exts+import GHC.IO   (IO(..))++-- Just like unsafeDupablePerformIO, but we inline it.+{-# INLINE inlinePerformIO #-}+inlinePerformIO :: IO a -> a+inlinePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r
+ compiler/utils/FastMutInt.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}+{-# OPTIONS_GHC -O2 #-}+-- We always optimise this, otherwise performance of a non-optimised+-- compiler is severely affected+--+-- (c) The University of Glasgow 2002-2006+--+-- Unboxed mutable Ints++module FastMutInt(+        FastMutInt, newFastMutInt,+        readFastMutInt, writeFastMutInt,++        FastMutPtr, newFastMutPtr,+        readFastMutPtr, writeFastMutPtr+  ) where++import GhcPrelude++import Data.Bits+import GHC.Base+import GHC.Ptr++newFastMutInt :: IO FastMutInt+readFastMutInt :: FastMutInt -> IO Int+writeFastMutInt :: FastMutInt -> Int -> IO ()++newFastMutPtr :: IO FastMutPtr+readFastMutPtr :: FastMutPtr -> IO (Ptr a)+writeFastMutPtr :: FastMutPtr -> Ptr a -> IO ()++data FastMutInt = FastMutInt (MutableByteArray# RealWorld)++newFastMutInt = IO $ \s ->+  case newByteArray# size s of { (# s, arr #) ->+  (# s, FastMutInt arr #) }+  where !(I# size) = finiteBitSize (0 :: Int)++readFastMutInt (FastMutInt arr) = IO $ \s ->+  case readIntArray# arr 0# s of { (# s, i #) ->+  (# s, I# i #) }++writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->+  case writeIntArray# arr 0# i s of { s ->+  (# s, () #) }++data FastMutPtr = FastMutPtr (MutableByteArray# RealWorld)++newFastMutPtr = IO $ \s ->+  case newByteArray# size s of { (# s, arr #) ->+  (# s, FastMutPtr arr #) }+  -- GHC assumes 'sizeof (Int) == sizeof (Ptr a)'+  where !(I# size) = finiteBitSize (0 :: Int)++readFastMutPtr (FastMutPtr arr) = IO $ \s ->+  case readAddrArray# arr 0# s of { (# s, i #) ->+  (# s, Ptr i #) }++writeFastMutPtr (FastMutPtr arr) (Ptr i) = IO $ \s ->+  case writeAddrArray# arr 0# i s of { s ->+  (# s, () #) }
+ compiler/utils/FastString.hs view
@@ -0,0 +1,686 @@+-- (c) The University of Glasgow, 1997-2006++{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples,+    GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}+-- We always optimise this, otherwise performance of a non-optimised+-- compiler is severely affected++-- |+-- There are two principal string types used internally by GHC:+--+-- ['FastString']+--+--   * A compact, hash-consed, representation of character strings.+--   * Comparison is O(1), and you can get a 'Unique.Unique' from them.+--   * Generated by 'fsLit'.+--   * Turn into 'Outputable.SDoc' with 'Outputable.ftext'.+--+-- ['PtrString']+--+--   * Pointer and size of a Latin-1 encoded string.+--   * Practically no operations.+--   * Outputing them is fast.+--   * Generated by 'sLit'.+--   * Turn into 'Outputable.SDoc' with 'Outputable.ptext'+--   * Requires manual memory management.+--     Improper use may lead to memory leaks or dangling pointers.+--   * It assumes Latin-1 as the encoding, therefore it cannot represent+--     arbitrary Unicode strings.+--+-- Use 'PtrString' unless you want the facilities of 'FastString'.+module FastString+       (+        -- * ByteString+        bytesFS,            -- :: FastString -> ByteString+        fastStringToByteString, -- = bytesFS (kept for haddock)+        mkFastStringByteString,+        fastZStringToByteString,+        unsafeMkByteString,++        -- * FastZString+        FastZString,+        hPutFZS,+        zString,+        lengthFZS,++        -- * FastStrings+        FastString(..),     -- not abstract, for now.++        -- ** Construction+        fsLit,+        mkFastString,+        mkFastStringBytes,+        mkFastStringByteList,+        mkFastStringForeignPtr,+        mkFastString#,++        -- ** Deconstruction+        unpackFS,           -- :: FastString -> String++        -- ** Encoding+        zEncodeFS,++        -- ** Operations+        uniqueOfFS,+        lengthFS,+        nullFS,+        appendFS,+        headFS,+        tailFS,+        concatFS,+        consFS,+        nilFS,+        isUnderscoreFS,++        -- ** Outputing+        hPutFS,++        -- ** Internal+        getFastStringTable,+        hasZEncoding,++        -- * PtrStrings+        PtrString (..),++        -- ** Construction+        sLit,+        mkPtrString#,+        mkPtrString,++        -- ** Deconstruction+        unpackPtrString,++        -- ** Operations+        lengthPS+       ) where++#include "HsVersions.h"++import GhcPrelude as Prelude++import Encoding+import FastFunctions+import Panic+import Util++import Control.Concurrent.MVar+import Control.DeepSeq+import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString          as BS+import qualified Data.ByteString.Char8    as BSC+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Unsafe   as BS+import Foreign.C+import GHC.Exts+import System.IO+import Data.Data+import Data.IORef+import Data.Maybe       ( isJust )+import Data.Char+import Data.Semigroup as Semi++import GHC.IO++import Foreign++#if STAGE >= 2+import GHC.Conc.Sync    (sharedCAF)+#endif++import GHC.Base         ( unpackCString#, unpackNBytes# )+++-- | Gives the UTF-8 encoded bytes corresponding to a 'FastString'+bytesFS :: FastString -> ByteString+bytesFS f = fs_bs f++{-# DEPRECATED fastStringToByteString "Use `bytesFS` instead" #-}+fastStringToByteString :: FastString -> ByteString+fastStringToByteString = bytesFS++fastZStringToByteString :: FastZString -> ByteString+fastZStringToByteString (FastZString bs) = bs++-- This will drop information if any character > '\xFF'+unsafeMkByteString :: String -> ByteString+unsafeMkByteString = BSC.pack++hashFastString :: FastString -> Int+hashFastString (FastString _ _ bs _)+    = inlinePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) ->+      return $ hashStr (castPtr ptr) len++-- -----------------------------------------------------------------------------++newtype FastZString = FastZString ByteString+  deriving NFData++hPutFZS :: Handle -> FastZString -> IO ()+hPutFZS handle (FastZString bs) = BS.hPut handle bs++zString :: FastZString -> String+zString (FastZString bs) =+    inlinePerformIO $ BS.unsafeUseAsCStringLen bs peekCAStringLen++lengthFZS :: FastZString -> Int+lengthFZS (FastZString bs) = BS.length bs++mkFastZStringString :: String -> FastZString+mkFastZStringString str = FastZString (BSC.pack str)++-- -----------------------------------------------------------------------------++{-|+A 'FastString' is an array of bytes, hashed to support fast O(1)+comparison.  It is also associated with a character encoding, so that+we know how to convert a 'FastString' to the local encoding, or to the+Z-encoding used by the compiler internally.++'FastString's support a memoized conversion to the Z-encoding via zEncodeFS.+-}++data FastString = FastString {+      uniq    :: {-# UNPACK #-} !Int, -- unique id+      n_chars :: {-# UNPACK #-} !Int, -- number of chars+      fs_bs   :: {-# UNPACK #-} !ByteString,+      fs_ref  :: {-# UNPACK #-} !(IORef (Maybe FastZString))+  }++instance Eq FastString where+  f1 == f2  =  uniq f1 == uniq f2++instance Ord FastString where+    -- Compares lexicographically, not by unique+    a <= b = case cmpFS a b of { LT -> True;  EQ -> True;  GT -> False }+    a <  b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> False }+    a >= b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> True  }+    a >  b = case cmpFS a b of { LT -> False; EQ -> False; GT -> True  }+    max x y | x >= y    =  x+            | otherwise =  y+    min x y | x <= y    =  x+            | otherwise =  y+    compare a b = cmpFS a b++instance IsString FastString where+    fromString = fsLit++instance Semi.Semigroup FastString where+    (<>) = appendFS++instance Monoid FastString where+    mempty = nilFS+    mappend = (Semi.<>)+    mconcat = concatFS++instance Show FastString where+   show fs = show (unpackFS fs)++instance Data FastString where+  -- don't traverse?+  toConstr _   = abstractConstr "FastString"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "FastString"++cmpFS :: FastString -> FastString -> Ordering+cmpFS f1@(FastString u1 _ _ _) f2@(FastString u2 _ _ _) =+  if u1 == u2 then EQ else+  compare (bytesFS f1) (bytesFS f2)++foreign import ccall unsafe "memcmp"+  memcmp :: Ptr a -> Ptr b -> Int -> IO Int++-- -----------------------------------------------------------------------------+-- Construction++{-+Internally, the compiler will maintain a fast string symbol table, providing+sharing and fast comparison. Creation of new @FastString@s then covertly does a+lookup, re-using the @FastString@ if there was a hit.++The design of the FastString hash table allows for lockless concurrent reads+and updates to multiple buckets with low synchronization overhead.++See Note [Updating the FastString table] on how it's updated.+-}+data FastStringTable = FastStringTable+  {-# UNPACK #-} !(IORef Int) -- the unique ID counter shared with all buckets+  (Array# (IORef FastStringTableSegment)) -- concurrent segments++data FastStringTableSegment = FastStringTableSegment+  {-# UNPACK #-} !(MVar ()) -- the lock for write in each segment+  {-# UNPACK #-} !(IORef Int) -- the number of elements+  (MutableArray# RealWorld [FastString]) -- buckets in this segment++{-+Following parameters are determined based on:++* Benchmark based on testsuite/tests/utils/should_run/T14854.hs+* Stats of @echo :browse | ghc --interactive -dfaststring-stats >/dev/null@:+  on 2018-10-24, we have 13920 entries.+-}+segmentBits, numSegments, segmentMask, initialNumBuckets :: Int+segmentBits = 8+numSegments = 256   -- bit segmentBits+segmentMask = 0xff  -- bit segmentBits - 1+initialNumBuckets = 64++hashToSegment# :: Int# -> Int#+hashToSegment# hash# = hash# `andI#` segmentMask#+  where+    !(I# segmentMask#) = segmentMask++hashToIndex# :: MutableArray# RealWorld [FastString] -> Int# -> Int#+hashToIndex# buckets# hash# =+  (hash# `uncheckedIShiftRL#` segmentBits#) `remInt#` size#+  where+    !(I# segmentBits#) = segmentBits+    size# = sizeofMutableArray# buckets#++maybeResizeSegment :: IORef FastStringTableSegment -> IO FastStringTableSegment+maybeResizeSegment segmentRef = do+  segment@(FastStringTableSegment lock counter old#) <- readIORef segmentRef+  let oldSize# = sizeofMutableArray# old#+      newSize# = oldSize# *# 2#+  (I# n#) <- readIORef counter+  if isTrue# (n# <# newSize#) -- maximum load of 1+  then return segment+  else do+    resizedSegment@(FastStringTableSegment _ _ new#) <- IO $ \s1# ->+      case newArray# newSize# [] s1# of+        (# s2#, arr# #) -> (# s2#, FastStringTableSegment lock counter arr# #)+    forM_ [0 .. (I# oldSize#) - 1] $ \(I# i#) -> do+      fsList <- IO $ readArray# old# i#+      forM_ fsList $ \fs -> do+        let -- Shall we store in hash value in FastString instead?+            !(I# hash#) = hashFastString fs+            idx# = hashToIndex# new# hash#+        IO $ \s1# ->+          case readArray# new# idx# s1# of+            (# s2#, bucket #) -> case writeArray# new# idx# (fs: bucket) s2# of+              s3# -> (# s3#, () #)+    writeIORef segmentRef resizedSegment+    return resizedSegment++{-# NOINLINE stringTable #-}+stringTable :: FastStringTable+stringTable = unsafePerformIO $ do+  let !(I# numSegments#) = numSegments+      !(I# initialNumBuckets#) = initialNumBuckets+      loop a# i# s1#+        | isTrue# (i# ==# numSegments#) = s1#+        | otherwise = case newMVar () `unIO` s1# of+            (# s2#, lock #) -> case newIORef 0 `unIO` s2# of+              (# s3#, counter #) -> case newArray# initialNumBuckets# [] s3# of+                (# s4#, buckets# #) -> case newIORef+                    (FastStringTableSegment lock counter buckets#) `unIO` s4# of+                  (# s5#, segment #) -> case writeArray# a# i# segment s5# of+                    s6# -> loop a# (i# +# 1#) s6#+  uid <- newIORef 603979776 -- ord '$' * 0x01000000+  tab <- IO $ \s1# ->+    case newArray# numSegments# (panic "string_table") s1# of+      (# s2#, arr# #) -> case loop arr# 0# s2# of+        s3# -> case unsafeFreezeArray# arr# s3# of+          (# s4#, segments# #) -> (# s4#, FastStringTable uid segments# #)++  -- use the support wired into the RTS to share this CAF among all images of+  -- libHSghc+#if STAGE < 2+  return tab+#else+  sharedCAF tab getOrSetLibHSghcFastStringTable++-- from the RTS; thus we cannot use this mechanism when STAGE<2; the previous+-- RTS might not have this symbol+foreign import ccall unsafe "getOrSetLibHSghcFastStringTable"+  getOrSetLibHSghcFastStringTable :: Ptr a -> IO (Ptr a)+#endif++{-++We include the FastString table in the `sharedCAF` mechanism because we'd like+FastStrings created by a Core plugin to have the same uniques as corresponding+strings created by the host compiler itself.  For example, this allows plugins+to lookup known names (eg `mkTcOcc "MySpecialType"`) in the GlobalRdrEnv or+even re-invoke the parser.++In particular, the following little sanity test was failing in a plugin+prototyping safe newtype-coercions: GHC.NT.Type.NT was imported, but could not+be looked up /by the plugin/.++   let rdrName = mkModuleName "GHC.NT.Type" `mkRdrQual` mkTcOcc "NT"+   putMsgS $ showSDoc dflags $ ppr $ lookupGRE_RdrName rdrName $ mg_rdr_env guts++`mkTcOcc` involves the lookup (or creation) of a FastString.  Since the+plugin's FastString.string_table is empty, constructing the RdrName also+allocates new uniques for the FastStrings "GHC.NT.Type" and "NT".  These+uniques are almost certainly unequal to the ones that the host compiler+originally assigned to those FastStrings.  Thus the lookup fails since the+domain of the GlobalRdrEnv is affected by the RdrName's OccName's FastString's+unique.++Maintaining synchronization of the two instances of this global is rather+difficult because of the uses of `unsafePerformIO` in this module.  Not+synchronizing them risks breaking the rather major invariant that two+FastStrings with the same unique have the same string. Thus we use the+lower-level `sharedCAF` mechanism that relies on Globals.c.++-}++mkFastString# :: Addr# -> FastString+mkFastString# a# = mkFastStringBytes ptr (ptrStrLength ptr)+  where ptr = Ptr a#++{- Note [Updating the FastString table]++We use a concurrent hashtable which contains multiple segments, each hash value+always maps to the same segment. Read is lock-free, write to the a segment+should acquire a lock for that segment to avoid race condition, writes to+different segments are independent.++The procedure goes like this:++1. Find out which segment to operate on based on the hash value+2. Read the relevant bucket and perform a look up of the string.+3. If it exists, return it.+4. Otherwise grab a unique ID, create a new FastString and atomically attempt+   to update the relevant segment with this FastString:++   * Resize the segment by doubling the number of buckets when the number of+     FastStrings in this segment grows beyond the threshold.+   * Double check that the string is not in the bucket. Another thread may have+     inserted it while we were creating our string.+   * Return the existing FastString if it exists. The one we preemptively+     created will get GCed.+   * Otherwise, insert and return the string we created.+-}++mkFastStringWith :: (Int -> IO FastString) -> Ptr Word8 -> Int -> IO FastString+mkFastStringWith mk_fs !ptr !len = do+  FastStringTableSegment lock _ buckets# <- readIORef segmentRef+  let idx# = hashToIndex# buckets# hash#+  bucket <- IO $ readArray# buckets# idx#+  res <- bucket_match bucket len ptr+  case res of+    Just found -> return found+    Nothing -> do+      -- The withMVar below is not dupable. It can lead to deadlock if it is+      -- only run partially and putMVar is not called after takeMVar.+      noDuplicate+      n <- get_uid+      new_fs <- mk_fs n+      withMVar lock $ \_ -> insert new_fs+  where+    !(FastStringTable uid segments#) = stringTable+    get_uid = atomicModifyIORef' uid $ \n -> (n+1,n)++    !(I# hash#) = hashStr ptr len+    (# segmentRef #) = indexArray# segments# (hashToSegment# hash#)+    insert fs = do+      FastStringTableSegment _ counter buckets# <- maybeResizeSegment segmentRef+      let idx# = hashToIndex# buckets# hash#+      bucket <- IO $ readArray# buckets# idx#+      res <- bucket_match bucket len ptr+      case res of+        -- The FastString was added by another thread after previous read and+        -- before we acquired the write lock.+        Just found -> return found+        Nothing -> do+          IO $ \s1# ->+            case writeArray# buckets# idx# (fs: bucket) s1# of+              s2# -> (# s2#, () #)+          modifyIORef' counter succ+          return fs++bucket_match :: [FastString] -> Int -> Ptr Word8 -> IO (Maybe FastString)+bucket_match [] _ _ = return Nothing+bucket_match (v@(FastString _ _ bs _):ls) len ptr+      | len == BS.length bs = do+         b <- BS.unsafeUseAsCString bs $ \buf ->+             cmpStringPrefix ptr (castPtr buf) len+         if b then return (Just v)+              else bucket_match ls len ptr+      | otherwise =+         bucket_match ls len ptr++mkFastStringBytes :: Ptr Word8 -> Int -> FastString+mkFastStringBytes !ptr !len =+    -- NB: Might as well use unsafeDupablePerformIO, since mkFastStringWith is+    -- idempotent.+    unsafeDupablePerformIO $+        mkFastStringWith (copyNewFastString ptr len) ptr len++-- | Create a 'FastString' from an existing 'ForeignPtr'; the difference+-- between this and 'mkFastStringBytes' is that we don't have to copy+-- the bytes if the string is new to the table.+mkFastStringForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO FastString+mkFastStringForeignPtr ptr !fp len+    = mkFastStringWith (mkNewFastString fp ptr len) ptr len++-- | Create a 'FastString' from an existing 'ForeignPtr'; the difference+-- between this and 'mkFastStringBytes' is that we don't have to copy+-- the bytes if the string is new to the table.+mkFastStringByteString :: ByteString -> FastString+mkFastStringByteString bs =+    inlinePerformIO $+      BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> do+        let ptr' = castPtr ptr+        mkFastStringWith (mkNewFastStringByteString bs ptr' len) ptr' len++-- | Creates a UTF-8 encoded 'FastString' from a 'String'+mkFastString :: String -> FastString+mkFastString str =+  inlinePerformIO $ do+    let l = utf8EncodedLength str+    buf <- mallocForeignPtrBytes l+    withForeignPtr buf $ \ptr -> do+      utf8EncodeString ptr str+      mkFastStringForeignPtr ptr buf l++-- | Creates a 'FastString' from a UTF-8 encoded @[Word8]@+mkFastStringByteList :: [Word8] -> FastString+mkFastStringByteList str = mkFastStringByteString (BS.pack str)++-- | Creates a Z-encoded 'FastString' from a 'String'+mkZFastString :: String -> FastZString+mkZFastString = mkFastZStringString++mkNewFastString :: ForeignPtr Word8 -> Ptr Word8 -> Int -> Int+                -> IO FastString+mkNewFastString fp ptr len uid = do+  ref <- newIORef Nothing+  n_chars <- countUTF8Chars ptr len+  return (FastString uid n_chars (BS.fromForeignPtr fp 0 len) ref)++mkNewFastStringByteString :: ByteString -> Ptr Word8 -> Int -> Int+                          -> IO FastString+mkNewFastStringByteString bs ptr len uid = do+  ref <- newIORef Nothing+  n_chars <- countUTF8Chars ptr len+  return (FastString uid n_chars bs ref)++copyNewFastString :: Ptr Word8 -> Int -> Int -> IO FastString+copyNewFastString ptr len uid = do+  fp <- copyBytesToForeignPtr ptr len+  ref <- newIORef Nothing+  n_chars <- countUTF8Chars ptr len+  return (FastString uid n_chars (BS.fromForeignPtr fp 0 len) ref)++copyBytesToForeignPtr :: Ptr Word8 -> Int -> IO (ForeignPtr Word8)+copyBytesToForeignPtr ptr len = do+  fp <- mallocForeignPtrBytes len+  withForeignPtr fp $ \ptr' -> copyBytes ptr' ptr len+  return fp++cmpStringPrefix :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool+cmpStringPrefix ptr1 ptr2 len =+ do r <- memcmp ptr1 ptr2 len+    return (r == 0)+++hashStr  :: Ptr Word8 -> Int -> Int+ -- use the Addr to produce a hash value between 0 & m (inclusive)+hashStr (Ptr a#) (I# len#) = loop 0# 0#+   where+    loop h n | isTrue# (n ==# len#) = I# h+             | otherwise  = loop h2 (n +# 1#)+          where+            !c = ord# (indexCharOffAddr# a# n)+            !h2 = (h *# 16777619#) `xorI#` c++-- -----------------------------------------------------------------------------+-- Operations++-- | Returns the length of the 'FastString' in characters+lengthFS :: FastString -> Int+lengthFS f = n_chars f++-- | Returns @True@ if this 'FastString' is not Z-encoded but already has+-- a Z-encoding cached (used in producing stats).+hasZEncoding :: FastString -> Bool+hasZEncoding (FastString _ _ _ ref) =+      inlinePerformIO $ do+        m <- readIORef ref+        return (isJust m)++-- | Returns @True@ if the 'FastString' is empty+nullFS :: FastString -> Bool+nullFS f = BS.null (fs_bs f)++-- | Unpacks and decodes the FastString+unpackFS :: FastString -> String+unpackFS (FastString _ _ bs _) = utf8DecodeByteString bs++-- | Returns a Z-encoded version of a 'FastString'.  This might be the+-- original, if it was already Z-encoded.  The first time this+-- function is applied to a particular 'FastString', the results are+-- memoized.+--+zEncodeFS :: FastString -> FastZString+zEncodeFS fs@(FastString _ _ _ ref) =+      inlinePerformIO $ do+        m <- readIORef ref+        case m of+          Just zfs -> return zfs+          Nothing -> do+            atomicModifyIORef' ref $ \m' -> case m' of+              Nothing  -> let zfs = mkZFastString (zEncodeString (unpackFS fs))+                          in (Just zfs, zfs)+              Just zfs -> (m', zfs)++appendFS :: FastString -> FastString -> FastString+appendFS fs1 fs2 = mkFastStringByteString+                 $ BS.append (bytesFS fs1) (bytesFS fs2)++concatFS :: [FastString] -> FastString+concatFS = mkFastStringByteString . BS.concat . map fs_bs++headFS :: FastString -> Char+headFS (FastString _ 0 _ _) = panic "headFS: Empty FastString"+headFS (FastString _ _ bs _) =+  inlinePerformIO $ BS.unsafeUseAsCString bs $ \ptr ->+         return (fst (utf8DecodeChar (castPtr ptr)))++tailFS :: FastString -> FastString+tailFS (FastString _ 0 _ _) = panic "tailFS: Empty FastString"+tailFS (FastString _ _ bs _) =+    inlinePerformIO $ BS.unsafeUseAsCString bs $ \ptr ->+    do let (_, n) = utf8DecodeChar (castPtr ptr)+       return $! mkFastStringByteString (BS.drop n bs)++consFS :: Char -> FastString -> FastString+consFS c fs = mkFastString (c : unpackFS fs)++uniqueOfFS :: FastString -> Int+uniqueOfFS (FastString u _ _ _) = u++nilFS :: FastString+nilFS = mkFastString ""++isUnderscoreFS :: FastString -> Bool+isUnderscoreFS fs = fs == fsLit "_"++-- -----------------------------------------------------------------------------+-- Stats++getFastStringTable :: IO [[[FastString]]]+getFastStringTable =+  forM [0 .. numSegments - 1] $ \(I# i#) -> do+    let (# segmentRef #) = indexArray# segments# i#+    FastStringTableSegment _ _ buckets# <- readIORef segmentRef+    let bucketSize = I# (sizeofMutableArray# buckets#)+    forM [0 .. bucketSize - 1] $ \(I# j#) ->+      IO $ readArray# buckets# j#+  where+    !(FastStringTable _ segments#) = stringTable++-- -----------------------------------------------------------------------------+-- Outputting 'FastString's++-- |Outputs a 'FastString' with /no decoding at all/, that is, you+-- get the actual bytes in the 'FastString' written to the 'Handle'.+hPutFS :: Handle -> FastString -> IO ()+hPutFS handle fs = BS.hPut handle $ bytesFS fs++-- ToDo: we'll probably want an hPutFSLocal, or something, to output+-- in the current locale's encoding (for error messages and suchlike).++-- -----------------------------------------------------------------------------+-- PtrStrings, here for convenience only.++-- | A 'PtrString' is a pointer to some array of Latin-1 encoded chars.+data PtrString = PtrString !(Ptr Word8) !Int++-- | Wrap an unboxed address into a 'PtrString'.+mkPtrString# :: Addr# -> PtrString+mkPtrString# a# = PtrString (Ptr a#) (ptrStrLength (Ptr a#))++-- | Encode a 'String' into a newly allocated 'PtrString' using Latin-1+-- encoding.  The original string must not contain non-Latin-1 characters+-- (above codepoint @0xff@).+{-# INLINE mkPtrString #-}+mkPtrString :: String -> PtrString+mkPtrString s =+ -- we don't use `unsafeDupablePerformIO` here to avoid potential memory leaks+ -- and because someone might be using `eqAddr#` to check for string equality.+ unsafePerformIO (do+   let len = length s+   p <- mallocBytes len+   let+     loop :: Int -> String -> IO ()+     loop !_ []    = return ()+     loop n (c:cs) = do+        pokeByteOff p n (fromIntegral (ord c) :: Word8)+        loop (1+n) cs+   loop 0 s+   return (PtrString p len)+ )++-- | Decode a 'PtrString' back into a 'String' using Latin-1 encoding.+-- This does not free the memory associated with 'PtrString'.+unpackPtrString :: PtrString -> String+unpackPtrString (PtrString (Ptr p#) (I# n#)) = unpackNBytes# p# n#++-- | Return the length of a 'PtrString'+lengthPS :: PtrString -> Int+lengthPS (PtrString _ n) = n++-- -----------------------------------------------------------------------------+-- under the carpet++foreign import ccall unsafe "strlen"+  ptrStrLength :: Ptr Word8 -> Int++{-# NOINLINE sLit #-}+sLit :: String -> PtrString+sLit x  = mkPtrString x++{-# NOINLINE fsLit #-}+fsLit :: String -> FastString+fsLit x = mkFastString x++{-# RULES "slit"+    forall x . sLit  (unpackCString# x) = mkPtrString#  x #-}+{-# RULES "fslit"+    forall x . fsLit (unpackCString# x) = mkFastString# x #-}
+ compiler/utils/FastStringEnv.hs view
@@ -0,0 +1,100 @@+{-+%+% (c) The University of Glasgow 2006+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998+%+\section[FastStringEnv]{@FastStringEnv@: FastString environments}+-}++module FastStringEnv (+        -- * FastString environments (maps)+        FastStringEnv,++        -- ** Manipulating these environments+        mkFsEnv,+        emptyFsEnv, unitFsEnv,+        extendFsEnv_C, extendFsEnv_Acc, extendFsEnv,+        extendFsEnvList, extendFsEnvList_C,+        filterFsEnv,+        plusFsEnv, plusFsEnv_C, alterFsEnv,+        lookupFsEnv, lookupFsEnv_NF, delFromFsEnv, delListFromFsEnv,+        elemFsEnv, mapFsEnv,++        -- * Deterministic FastString environments (maps)+        DFastStringEnv,++        -- ** Manipulating these environments+        mkDFsEnv, emptyDFsEnv, dFsEnvElts, lookupDFsEnv+    ) where++import GhcPrelude++import UniqFM+import UniqDFM+import Maybes+import FastString+++-- | A non-deterministic set of FastStrings.+-- See Note [Deterministic UniqFM] in UniqDFM for explanation why it's not+-- deterministic and why it matters. Use DFastStringEnv if the set eventually+-- gets converted into a list or folded over in a way where the order+-- changes the generated code.+type FastStringEnv a = UniqFM a  -- Domain is FastString++emptyFsEnv         :: FastStringEnv a+mkFsEnv            :: [(FastString,a)] -> FastStringEnv a+alterFsEnv         :: (Maybe a-> Maybe a) -> FastStringEnv a -> FastString -> FastStringEnv a+extendFsEnv_C      :: (a->a->a) -> FastStringEnv a -> FastString -> a -> FastStringEnv a+extendFsEnv_Acc    :: (a->b->b) -> (a->b) -> FastStringEnv b -> FastString -> a -> FastStringEnv b+extendFsEnv        :: FastStringEnv a -> FastString -> a -> FastStringEnv a+plusFsEnv          :: FastStringEnv a -> FastStringEnv a -> FastStringEnv a+plusFsEnv_C        :: (a->a->a) -> FastStringEnv a -> FastStringEnv a -> FastStringEnv a+extendFsEnvList    :: FastStringEnv a -> [(FastString,a)] -> FastStringEnv a+extendFsEnvList_C  :: (a->a->a) -> FastStringEnv a -> [(FastString,a)] -> FastStringEnv a+delFromFsEnv       :: FastStringEnv a -> FastString -> FastStringEnv a+delListFromFsEnv   :: FastStringEnv a -> [FastString] -> FastStringEnv a+elemFsEnv          :: FastString -> FastStringEnv a -> Bool+unitFsEnv          :: FastString -> a -> FastStringEnv a+lookupFsEnv        :: FastStringEnv a -> FastString -> Maybe a+lookupFsEnv_NF     :: FastStringEnv a -> FastString -> a+filterFsEnv        :: (elt -> Bool) -> FastStringEnv elt -> FastStringEnv elt+mapFsEnv           :: (elt1 -> elt2) -> FastStringEnv elt1 -> FastStringEnv elt2++emptyFsEnv                = emptyUFM+unitFsEnv x y             = unitUFM x y+extendFsEnv x y z         = addToUFM x y z+extendFsEnvList x l       = addListToUFM x l+lookupFsEnv x y           = lookupUFM x y+alterFsEnv                = alterUFM+mkFsEnv     l             = listToUFM l+elemFsEnv x y             = elemUFM x y+plusFsEnv x y             = plusUFM x y+plusFsEnv_C f x y         = plusUFM_C f x y+extendFsEnv_C f x y z     = addToUFM_C f x y z+mapFsEnv f x              = mapUFM f x+extendFsEnv_Acc x y z a b = addToUFM_Acc x y z a b+extendFsEnvList_C x y z   = addListToUFM_C x y z+delFromFsEnv x y          = delFromUFM x y+delListFromFsEnv x y      = delListFromUFM x y+filterFsEnv x y           = filterUFM x y++lookupFsEnv_NF env n = expectJust "lookupFsEnv_NF" (lookupFsEnv env n)++-- Deterministic FastStringEnv+-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need+-- DFastStringEnv.++type DFastStringEnv a = UniqDFM a  -- Domain is FastString++emptyDFsEnv :: DFastStringEnv a+emptyDFsEnv = emptyUDFM++dFsEnvElts :: DFastStringEnv a -> [a]+dFsEnvElts = eltsUDFM++mkDFsEnv :: [(FastString,a)] -> DFastStringEnv a+mkDFsEnv l = listToUDFM l++lookupDFsEnv :: DFastStringEnv a -> FastString -> Maybe a+lookupDFsEnv = lookupUDFM
+ compiler/utils/Fingerprint.hsc view
@@ -0,0 +1,47 @@+{-# LANGUAGE CPP #-}++-- ----------------------------------------------------------------------------+--+--  (c) The University of Glasgow 2006+--+-- Fingerprints for recompilation checking and ABI versioning.+--+-- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance+--+-- ----------------------------------------------------------------------------++module Fingerprint (+        readHexFingerprint,+        fingerprintByteString,+        -- * Re-exported from GHC.Fingerprint+        Fingerprint(..), fingerprint0,+        fingerprintFingerprints,+        fingerprintData,+        fingerprintString,+        getFileHash+   ) where++#include "md5.h"+##include "HsVersions.h"++import GhcPrelude++import Foreign+import GHC.IO+import Numeric          ( readHex )++import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS++import GHC.Fingerprint++-- useful for parsing the output of 'md5sum', should we want to do that.+readHexFingerprint :: String -> Fingerprint+readHexFingerprint s = Fingerprint w1 w2+ where (s1,s2) = splitAt 16 s+       [(w1,"")] = readHex s1+       [(w2,"")] = readHex (take 16 s2)++fingerprintByteString :: BS.ByteString -> Fingerprint+fingerprintByteString bs = unsafeDupablePerformIO $+  BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> fingerprintData (castPtr ptr) len
+ compiler/utils/FiniteMap.hs view
@@ -0,0 +1,31 @@+-- Some extra functions to extend Data.Map++module FiniteMap (+        insertList,+        insertListWith,+        deleteList,+        foldRight, foldRightWithKey+    ) where++import GhcPrelude++import Data.Map (Map)+import qualified Data.Map as Map++insertList :: Ord key => [(key,elt)] -> Map key elt -> Map key elt+insertList xs m = foldl' (\m (k, v) -> Map.insert k v m) m xs++insertListWith :: Ord key+               => (elt -> elt -> elt)+               -> [(key,elt)]+               -> Map key elt+               -> Map key elt+insertListWith f xs m0 = foldl' (\m (k, v) -> Map.insertWith f k v m) m0 xs++deleteList :: Ord key => [key] -> Map key elt -> Map key elt+deleteList ks m = foldl' (flip Map.delete) m ks++foldRight        :: (elt -> a -> a) -> a -> Map key elt -> a+foldRight        = Map.foldr+foldRightWithKey :: (key -> elt -> a -> a) -> a -> Map key elt -> a+foldRightWithKey = Map.foldrWithKey
+ compiler/utils/GhcPrelude.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE CPP #-}++-- | Custom GHC "Prelude"+--+-- This module serves as a replacement for the "Prelude" module+-- and abstracts over differences between the bootstrapping+-- GHC version, and may also provide a common default vocabulary.++-- Every module in GHC+--   * Is compiled with -XNoImplicitPrelude+--   * Explicitly imports GhcPrelude++module GhcPrelude (module X) where++-- We export the 'Semigroup' class but w/o the (<>) operator to avoid+-- clashing with the (Outputable.<>) operator which is heavily used+-- through GHC's code-base.++import Prelude as X hiding ((<>))+import Data.Foldable as X (foldl')++{-+Note [Why do we import Prelude here?]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The files ghc-boot-th.cabal, ghc-boot.cabal, ghci.cabal and+ghc-heap.cabal contain the directive default-extensions:+NoImplicitPrelude. There are two motivations for this:+  - Consistency with the compiler directory, which enables+    NoImplicitPrelude;+  - Allows loading the above dependent packages with ghc-in-ghci,+    giving a smoother development experience when adding new+    extensions.+-}
+ compiler/utils/IOEnv.hs view
@@ -0,0 +1,225 @@+{-# LANGUAGE CPP #-}+--+-- (c) The University of Glasgow 2002-2006+--+-- The IO Monad with an environment+--+-- The environment is passed around as a Reader monad but+-- as its in the IO monad, mutable references can be used+-- for updating state.+--++module IOEnv (+        IOEnv, -- Instance of Monad++        -- Monad utilities+        module MonadUtils,++        -- Errors+        failM, failWithM,+        IOEnvFailure(..),++        -- Getting at the environment+        getEnv, setEnv, updEnv,++        runIOEnv, unsafeInterleaveM, uninterruptibleMaskM_,+        tryM, tryAllM, tryMostM, fixM,++        -- I/O operations+        IORef, newMutVar, readMutVar, writeMutVar, updMutVar,+        atomicUpdMutVar, atomicUpdMutVar'+  ) where++import GhcPrelude++import DynFlags+import Exception+import Module+import Panic++import Data.IORef       ( IORef, newIORef, readIORef, writeIORef, modifyIORef,+                          atomicModifyIORef, atomicModifyIORef' )+import System.IO.Unsafe ( unsafeInterleaveIO )+import System.IO        ( fixIO )+import Control.Monad+import qualified Control.Monad.Fail as MonadFail+import MonadUtils+import Control.Applicative (Alternative(..))++----------------------------------------------------------------------+-- Defining the monad type+----------------------------------------------------------------------+++newtype IOEnv env a = IOEnv (env -> IO a)++unIOEnv :: IOEnv env a -> (env -> IO a)+unIOEnv (IOEnv m) = m++instance Monad (IOEnv m) where+    (>>=)  = thenM+    (>>)   = (*>)+#if !MIN_VERSION_base(4,13,0)+    fail   = MonadFail.fail+#endif++instance MonadFail.MonadFail (IOEnv m) where+    fail _ = failM -- Ignore the string++instance Applicative (IOEnv m) where+    pure = returnM+    IOEnv f <*> IOEnv x = IOEnv (\ env -> f env <*> x env )+    (*>) = thenM_++instance Functor (IOEnv m) where+    fmap f (IOEnv m) = IOEnv (\ env -> fmap f (m env))++returnM :: a -> IOEnv env a+returnM a = IOEnv (\ _ -> return a)++thenM :: IOEnv env a -> (a -> IOEnv env b) -> IOEnv env b+thenM (IOEnv m) f = IOEnv (\ env -> do { r <- m env ;+                                         unIOEnv (f r) env })++thenM_ :: IOEnv env a -> IOEnv env b -> IOEnv env b+thenM_ (IOEnv m) f = IOEnv (\ env -> do { _ <- m env ; unIOEnv f env })++failM :: IOEnv env a+failM = IOEnv (\ _ -> throwIO IOEnvFailure)++failWithM :: String -> IOEnv env a+failWithM s = IOEnv (\ _ -> ioError (userError s))++data IOEnvFailure = IOEnvFailure++instance Show IOEnvFailure where+    show IOEnvFailure = "IOEnv failure"++instance Exception IOEnvFailure++instance ExceptionMonad (IOEnv a) where+  gcatch act handle =+      IOEnv $ \s -> unIOEnv act s `gcatch` \e -> unIOEnv (handle e) s+  gmask f =+      IOEnv $ \s -> gmask $ \io_restore ->+                             let+                                g_restore (IOEnv m) = IOEnv $ \s -> io_restore (m s)+                             in+                                unIOEnv (f g_restore) s++instance ContainsDynFlags env => HasDynFlags (IOEnv env) where+    getDynFlags = do env <- getEnv+                     return $! extractDynFlags env++instance ContainsModule env => HasModule (IOEnv env) where+    getModule = do env <- getEnv+                   return $ extractModule env++----------------------------------------------------------------------+-- Fundamental combinators specific to the monad+----------------------------------------------------------------------+++---------------------------+runIOEnv :: env -> IOEnv env a -> IO a+runIOEnv env (IOEnv m) = m env+++---------------------------+{-# NOINLINE fixM #-}+  -- Aargh!  Not inlining fixM alleviates a space leak problem.+  -- Normally fixM is used with a lazy tuple match: if the optimiser is+  -- shown the definition of fixM, it occasionally transforms the code+  -- in such a way that the code generator doesn't spot the selector+  -- thunks.  Sigh.++fixM :: (a -> IOEnv env a) -> IOEnv env a+fixM f = IOEnv (\ env -> fixIO (\ r -> unIOEnv (f r) env))+++---------------------------+tryM :: IOEnv env r -> IOEnv env (Either IOEnvFailure r)+-- Reflect UserError exceptions (only) into IOEnv monad+-- Other exceptions are not caught; they are simply propagated as exns+--+-- The idea is that errors in the program being compiled will give rise+-- to UserErrors.  But, say, pattern-match failures in GHC itself should+-- not be caught here, else they'll be reported as errors in the program+-- begin compiled!+tryM (IOEnv thing) = IOEnv (\ env -> tryIOEnvFailure (thing env))++tryIOEnvFailure :: IO a -> IO (Either IOEnvFailure a)+tryIOEnvFailure = try++-- XXX We shouldn't be catching everything, e.g. timeouts+tryAllM :: IOEnv env r -> IOEnv env (Either SomeException r)+-- Catch *all* exceptions+-- This is used when running a Template-Haskell splice, when+-- even a pattern-match failure is a programmer error+tryAllM (IOEnv thing) = IOEnv (\ env -> try (thing env))++tryMostM :: IOEnv env r -> IOEnv env (Either SomeException r)+tryMostM (IOEnv thing) = IOEnv (\ env -> tryMost (thing env))++---------------------------+unsafeInterleaveM :: IOEnv env a -> IOEnv env a+unsafeInterleaveM (IOEnv m) = IOEnv (\ env -> unsafeInterleaveIO (m env))++uninterruptibleMaskM_ :: IOEnv env a -> IOEnv env a+uninterruptibleMaskM_ (IOEnv m) = IOEnv (\ env -> uninterruptibleMask_ (m env))++----------------------------------------------------------------------+-- Alternative/MonadPlus+----------------------------------------------------------------------++instance Alternative (IOEnv env) where+    empty   = IOEnv (const empty)+    m <|> n = IOEnv (\env -> unIOEnv m env <|> unIOEnv n env)++instance MonadPlus (IOEnv env)++----------------------------------------------------------------------+-- Accessing input/output+----------------------------------------------------------------------++instance MonadIO (IOEnv env) where+    liftIO io = IOEnv (\ _ -> io)++newMutVar :: a -> IOEnv env (IORef a)+newMutVar val = liftIO (newIORef val)++writeMutVar :: IORef a -> a -> IOEnv env ()+writeMutVar var val = liftIO (writeIORef var val)++readMutVar :: IORef a -> IOEnv env a+readMutVar var = liftIO (readIORef var)++updMutVar :: IORef a -> (a -> a) -> IOEnv env ()+updMutVar var upd = liftIO (modifyIORef var upd)++-- | Atomically update the reference.  Does not force the evaluation of the+-- new variable contents.  For strict update, use 'atomicUpdMutVar''.+atomicUpdMutVar :: IORef a -> (a -> (a, b)) -> IOEnv env b+atomicUpdMutVar var upd = liftIO (atomicModifyIORef var upd)++-- | Strict variant of 'atomicUpdMutVar'.+atomicUpdMutVar' :: IORef a -> (a -> (a, b)) -> IOEnv env b+atomicUpdMutVar' var upd = liftIO (atomicModifyIORef' var upd)++----------------------------------------------------------------------+-- Accessing the environment+----------------------------------------------------------------------++getEnv :: IOEnv env env+{-# INLINE getEnv #-}+getEnv = IOEnv (\ env -> return env)++-- | Perform a computation with a different environment+setEnv :: env' -> IOEnv env' a -> IOEnv env a+{-# INLINE setEnv #-}+setEnv new_env (IOEnv m) = IOEnv (\ _ -> m new_env)++-- | Perform a computation with an altered environment+updEnv :: (env -> env') -> IOEnv env' a -> IOEnv env a+{-# INLINE updEnv #-}+updEnv upd (IOEnv m) = IOEnv (\ env -> m (upd env))
+ compiler/utils/Json.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE GADTs #-}+module Json where++import GhcPrelude++import Outputable+import Data.Char+import Numeric++-- | Simple data type to represent JSON documents.+data JsonDoc where+  JSNull :: JsonDoc+  JSBool :: Bool -> JsonDoc+  JSInt  :: Int  -> JsonDoc+  JSString :: String -> JsonDoc+  JSArray :: [JsonDoc] -> JsonDoc+  JSObject :: [(String, JsonDoc)] -> JsonDoc+++-- This is simple and slow as it is only used for error reporting+renderJSON :: JsonDoc -> SDoc+renderJSON d =+  case d of+    JSNull -> text "null"+    JSBool b -> text $ if b then "true" else "false"+    JSInt    n -> ppr n+    JSString s -> doubleQuotes $ text $ escapeJsonString s+    JSArray as -> brackets $ pprList renderJSON as+    JSObject fs -> braces $ pprList renderField fs+  where+    renderField :: (String, JsonDoc) -> SDoc+    renderField (s, j) = doubleQuotes (text s) <>  colon <+> renderJSON j++    pprList pp xs = hcat (punctuate comma (map pp xs))++escapeJsonString :: String -> String+escapeJsonString = concatMap escapeChar+  where+    escapeChar '\b' = "\\b"+    escapeChar '\f' = "\\f"+    escapeChar '\n' = "\\n"+    escapeChar '\r' = "\\r"+    escapeChar '\t' = "\\t"+    escapeChar '"'  = "\\\""+    escapeChar '\\'  = "\\\\"+    escapeChar c | isControl c || fromEnum c >= 0x7f  = uni_esc c+    escapeChar c = [c]++    uni_esc c = "\\u" ++ (pad 4 (showHex (fromEnum c) ""))++    pad n cs  | len < n   = replicate (n-len) '0' ++ cs+                          | otherwise = cs+                                   where len = length cs++class ToJson a where+  json :: a -> JsonDoc
+ compiler/utils/ListSetOps.hs view
@@ -0,0 +1,171 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998++\section[ListSetOps]{Set-like operations on lists}+-}++{-# LANGUAGE CPP #-}++module ListSetOps (+        unionLists, minusList, deleteBys,++        -- Association lists+        Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing,++        -- Duplicate handling+        hasNoDups, removeDups, findDupsEq,+        equivClasses,++        -- Indexing+        getNth+   ) where++#include "HsVersions.h"++import GhcPrelude++import Outputable+import Util++import Data.List+import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.Set as S++getNth :: Outputable a => [a] -> Int -> a+getNth xs n = ASSERT2( xs `lengthExceeds` n, ppr n $$ ppr xs )+             xs !! n++deleteBys :: (a -> a -> Bool) -> [a] -> [a] -> [a]+-- (deleteBys eq xs ys) returns xs-ys, using the given equality function+-- Just like 'Data.List.delete' but with an equality function+deleteBys eq xs ys = foldl' (flip (deleteBy eq)) xs ys++{-+************************************************************************+*                                                                      *+        Treating lists as sets+        Assumes the lists contain no duplicates, but are unordered+*                                                                      *+************************************************************************+-}+++unionLists :: (Outputable a, Eq a) => [a] -> [a] -> [a]+-- Assumes that the arguments contain no duplicates+unionLists xs ys+  = WARN(lengthExceeds xs 100 || lengthExceeds ys 100, ppr xs $$ ppr ys)+    [x | x <- xs, isn'tIn "unionLists" x ys] ++ ys++-- | Calculate the set difference of two lists. This is+-- /O((m + n) log n)/, where we subtract a list of /n/ elements+-- from a list of /m/ elements.+--+-- Extremely short cases are handled specially:+-- When /m/ or /n/ is 0, this takes /O(1)/ time. When /m/ is 1,+-- it takes /O(n)/ time.+minusList :: Ord a => [a] -> [a] -> [a]+-- There's no point building a set to perform just one lookup, so we handle+-- extremely short lists specially. It might actually be better to use+-- an O(m*n) algorithm when m is a little longer (perhaps up to 4 or even 5).+-- The tipping point will be somewhere in the area of where /m/ and /log n/+-- become comparable, but we probably don't want to work too hard on this.+minusList [] _ = []+minusList xs@[x] ys+  | x `elem` ys = []+  | otherwise = xs+-- Using an empty set or a singleton would also be silly, so let's not.+minusList xs [] = xs+minusList xs [y] = filter (/= y) xs+-- When each list has at least two elements, we build a set from the+-- second argument, allowing us to filter the first argument fairly+-- efficiently.+minusList xs ys = filter (`S.notMember` yss) xs+  where+    yss = S.fromList ys++{-+************************************************************************+*                                                                      *+\subsection[Utils-assoc]{Association lists}+*                                                                      *+************************************************************************++Inefficient finite maps based on association lists and equality.+-}++-- A finite mapping based on equality and association lists+type Assoc a b = [(a,b)]++assoc             :: (Eq a) => String -> Assoc a b -> a -> b+assocDefault      :: (Eq a) => b -> Assoc a b -> a -> b+assocUsing        :: (a -> a -> Bool) -> String -> Assoc a b -> a -> b+assocMaybe        :: (Eq a) => Assoc a b -> a -> Maybe b+assocDefaultUsing :: (a -> a -> Bool) -> b -> Assoc a b -> a -> b++assocDefaultUsing _  deflt []             _   = deflt+assocDefaultUsing eq deflt ((k,v) : rest) key+  | k `eq` key = v+  | otherwise  = assocDefaultUsing eq deflt rest key++assoc crash_msg         list key = assocDefaultUsing (==) (panic ("Failed in assoc: " ++ crash_msg)) list key+assocDefault deflt      list key = assocDefaultUsing (==) deflt list key+assocUsing eq crash_msg list key = assocDefaultUsing eq (panic ("Failed in assoc: " ++ crash_msg)) list key++assocMaybe alist key+  = lookup alist+  where+    lookup []             = Nothing+    lookup ((tv,ty):rest) = if key == tv then Just ty else lookup rest++{-+************************************************************************+*                                                                      *+\subsection[Utils-dups]{Duplicate-handling}+*                                                                      *+************************************************************************+-}++hasNoDups :: (Eq a) => [a] -> Bool++hasNoDups xs = f [] xs+  where+    f _           []     = True+    f seen_so_far (x:xs) = if x `is_elem` seen_so_far+                           then False+                           else f (x:seen_so_far) xs++    is_elem = isIn "hasNoDups"++equivClasses :: (a -> a -> Ordering) -- Comparison+             -> [a]+             -> [NonEmpty a]++equivClasses _   []      = []+equivClasses _   [stuff] = [stuff :| []]+equivClasses cmp items   = NE.groupBy eq (sortBy cmp items)+  where+    eq a b = case cmp a b of { EQ -> True; _ -> False }++removeDups :: (a -> a -> Ordering) -- Comparison function+           -> [a]+           -> ([a],          -- List with no duplicates+               [NonEmpty a]) -- List of duplicate groups.  One representative+                             -- from each group appears in the first result++removeDups _   []  = ([], [])+removeDups _   [x] = ([x],[])+removeDups cmp xs+  = case (mapAccumR collect_dups [] (equivClasses cmp xs)) of { (dups, xs') ->+    (xs', dups) }+  where+    collect_dups :: [NonEmpty a] -> NonEmpty a -> ([NonEmpty a], a)+    collect_dups dups_so_far (x :| [])     = (dups_so_far,      x)+    collect_dups dups_so_far dups@(x :| _) = (dups:dups_so_far, x)++findDupsEq :: (a->a->Bool) -> [a] -> [NonEmpty a]+findDupsEq _  [] = []+findDupsEq eq (x:xs) | null eq_xs  = findDupsEq eq xs+                     | otherwise   = (x :| eq_xs) : findDupsEq eq neq_xs+    where (eq_xs, neq_xs) = partition (eq x) xs
+ compiler/utils/Maybes.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE FlexibleContexts #-}++{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}++module Maybes (+        module Data.Maybe,++        MaybeErr(..), -- Instance of Monad+        failME, isSuccess,++        orElse,+        firstJust, firstJusts,+        whenIsJust,+        expectJust,+        rightToMaybe,++        -- * MaybeT+        MaybeT(..), liftMaybeT, tryMaybeT+    ) where++import GhcPrelude++import Control.Monad+import Control.Monad.Trans.Maybe+import Control.Exception (catch, SomeException(..))+import Data.Maybe+import Util (HasCallStack)++infixr 4 `orElse`++{-+************************************************************************+*                                                                      *+\subsection[Maybe type]{The @Maybe@ type}+*                                                                      *+************************************************************************+-}++firstJust :: Maybe a -> Maybe a -> Maybe a+firstJust a b = firstJusts [a, b]++-- | Takes a list of @Maybes@ and returns the first @Just@ if there is one, or+-- @Nothing@ otherwise.+firstJusts :: [Maybe a] -> Maybe a+firstJusts = msum++expectJust :: HasCallStack => String -> Maybe a -> a+{-# INLINE expectJust #-}+expectJust _   (Just x) = x+expectJust err Nothing  = error ("expectJust " ++ err)++whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()+whenIsJust (Just x) f = f x+whenIsJust Nothing  _ = return ()++-- | Flipped version of @fromMaybe@, useful for chaining.+orElse :: Maybe a -> a -> a+orElse = flip fromMaybe++rightToMaybe :: Either a b -> Maybe b+rightToMaybe (Left _)  = Nothing+rightToMaybe (Right x) = Just x++{-+************************************************************************+*                                                                      *+\subsection[MaybeT type]{The @MaybeT@ monad transformer}+*                                                                      *+************************************************************************+-}++-- We had our own MaybeT in the past. Now we reuse transformer's MaybeT++liftMaybeT :: Monad m => m a -> MaybeT m a+liftMaybeT act = MaybeT $ Just `liftM` act++-- | Try performing an 'IO' action, failing on error.+tryMaybeT :: IO a -> MaybeT IO a+tryMaybeT action = MaybeT $ catch (Just `fmap` action) handler+  where+    handler (SomeException _) = return Nothing++{-+************************************************************************+*                                                                      *+\subsection[MaybeErr type]{The @MaybeErr@ type}+*                                                                      *+************************************************************************+-}++data MaybeErr err val = Succeeded val | Failed err++instance Functor (MaybeErr err) where+  fmap = liftM++instance Applicative (MaybeErr err) where+  pure  = Succeeded+  (<*>) = ap++instance Monad (MaybeErr err) where+  Succeeded v >>= k = k v+  Failed e    >>= _ = Failed e++isSuccess :: MaybeErr err val -> Bool+isSuccess (Succeeded {}) = True+isSuccess (Failed {})    = False++failME :: err -> MaybeErr err val+failME e = Failed e
+ compiler/utils/MonadUtils.hs view
@@ -0,0 +1,247 @@+-- | Utilities related to Monad and Applicative classes+--   Mostly for backwards compatibility.++module MonadUtils+        ( Applicative(..)+        , (<$>)++        , MonadFix(..)+        , MonadIO(..)++        , liftIO1, liftIO2, liftIO3, liftIO4++        , zipWith3M, zipWith3M_, zipWith4M, zipWithAndUnzipM+        , mapAndUnzipM, mapAndUnzip3M, mapAndUnzip4M, mapAndUnzip5M+        , mapAccumLM+        , mapSndM+        , concatMapM+        , mapMaybeM+        , fmapMaybeM, fmapEitherM+        , anyM, allM, orM+        , foldlM, foldlM_, foldrM+        , maybeMapM+        , whenM, unlessM+        , filterOutM+        ) where++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++import GhcPrelude++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Control.Monad.IO.Class+import Data.Foldable (sequenceA_)+import Data.List (unzip4, unzip5, zipWith4)++-------------------------------------------------------------------------------+-- Lift combinators+--  These are used throughout the compiler+-------------------------------------------------------------------------------++-- | Lift an 'IO' operation with 1 argument into another monad+liftIO1 :: MonadIO m => (a -> IO b) -> a -> m b+liftIO1 = (.) liftIO++-- | Lift an 'IO' operation with 2 arguments into another monad+liftIO2 :: MonadIO m => (a -> b -> IO c) -> a -> b -> m c+liftIO2 = ((.).(.)) liftIO++-- | Lift an 'IO' operation with 3 arguments into another monad+liftIO3 :: MonadIO m => (a -> b -> c -> IO d) -> a -> b -> c -> m d+liftIO3 = ((.).((.).(.))) liftIO++-- | Lift an 'IO' operation with 4 arguments into another monad+liftIO4 :: MonadIO m => (a -> b -> c -> d -> IO e) -> a -> b -> c -> d -> m e+liftIO4 = (((.).(.)).((.).(.))) liftIO++-------------------------------------------------------------------------------+-- Common functions+--  These are used throughout the compiler+-------------------------------------------------------------------------------++{-++Note [Inline @zipWithNM@ functions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++The inline principle for 'zipWith3M', 'zipWith4M' and 'zipWith3M_' is the same+as for 'zipWithM' and 'zipWithM_' in "Control.Monad", see+Note [Fusion for zipN/zipWithN] in GHC/List.hs for more details.++The 'zipWithM'/'zipWithM_' functions are inlined so that the `zipWith` and+`sequenceA` functions with which they are defined have an opportunity to fuse.++Furthermore, 'zipWith3M'/'zipWith4M' and 'zipWith3M_' have been explicitly+rewritten in a non-recursive way similarly to 'zipWithM'/'zipWithM_', and for+more than just uniformity: after [D5241](https://phabricator.haskell.org/D5241)+for issue #14037, all @zipN@/@zipWithN@ functions fuse, meaning+'zipWith3M'/'zipWIth4M' and 'zipWith3M_'@ now behave like 'zipWithM' and+'zipWithM_', respectively, with regards to fusion.++As such, since there are not any differences between 2-ary 'zipWithM'/+'zipWithM_' and their n-ary counterparts below aside from the number of+arguments, the `INLINE` pragma should be replicated in the @zipWithNM@+functions below as well.++-}++zipWith3M :: Monad m => (a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m [d]+{-# INLINE zipWith3M #-}+-- Inline so that fusion with 'zipWith3' and 'sequenceA' has a chance to fire.+-- See Note [Inline @zipWithNM@ functions] above.+zipWith3M f xs ys zs = sequenceA (zipWith3 f xs ys zs)++zipWith3M_ :: Monad m => (a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m ()+{-# INLINE zipWith3M_ #-}+-- Inline so that fusion with 'zipWith4' and 'sequenceA' has a chance to fire.+-- See  Note [Inline @zipWithNM@ functions] above.+zipWith3M_ f xs ys zs = sequenceA_ (zipWith3 f xs ys zs)++zipWith4M :: Monad m => (a -> b -> c -> d -> m e)+          -> [a] -> [b] -> [c] -> [d] -> m [e]+{-# INLINE zipWith4M #-}+-- Inline so that fusion with 'zipWith5' and 'sequenceA' has a chance to fire.+-- See  Note [Inline @zipWithNM@ functions] above.+zipWith4M f xs ys ws zs = sequenceA (zipWith4 f xs ys ws zs)++zipWithAndUnzipM :: Monad m+                 => (a -> b -> m (c, d)) -> [a] -> [b] -> m ([c], [d])+{-# INLINABLE zipWithAndUnzipM #-}+-- See Note [flatten_many performance] in TcFlatten for why this+-- pragma is essential.+zipWithAndUnzipM f (x:xs) (y:ys)+  = do { (c, d) <- f x y+       ; (cs, ds) <- zipWithAndUnzipM f xs ys+       ; return (c:cs, d:ds) }+zipWithAndUnzipM _ _ _ = return ([], [])++{-++Note [Inline @mapAndUnzipNM@ functions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++The inline principle is the same as 'mapAndUnzipM' in "Control.Monad".+The 'mapAndUnzipM' function is inlined so that the `unzip` and `traverse`+functions with which it is defined have an opportunity to fuse, see+Note [Inline @unzipN@ functions] in Data/OldList.hs for more details.++Furthermore, the @mapAndUnzipNM@ functions have been explicitly rewritten in a+non-recursive way similarly to 'mapAndUnzipM', and for more than just+uniformity: after [D5249](https://phabricator.haskell.org/D5249) for Trac+ticket #14037, all @unzipN@ functions fuse, meaning 'mapAndUnzip3M',+'mapAndUnzip4M' and 'mapAndUnzip5M' now behave like 'mapAndUnzipM' with regards+to fusion.++As such, since there are not any differences between 2-ary 'mapAndUnzipM' and+its n-ary counterparts below aside from the number of arguments, the `INLINE`+pragma should be replicated in the @mapAndUnzipNM@ functions below as well.++-}++-- | mapAndUnzipM for triples+mapAndUnzip3M :: Monad m => (a -> m (b,c,d)) -> [a] -> m ([b],[c],[d])+{-# INLINE mapAndUnzip3M #-}+-- Inline so that fusion with 'unzip3' and 'traverse' has a chance to fire.+-- See Note [Inline @mapAndUnzipNM@ functions] above.+mapAndUnzip3M f xs =  unzip3 <$> traverse f xs++mapAndUnzip4M :: Monad m => (a -> m (b,c,d,e)) -> [a] -> m ([b],[c],[d],[e])+{-# INLINE mapAndUnzip4M #-}+-- Inline so that fusion with 'unzip4' and 'traverse' has a chance to fire.+-- See Note [Inline @mapAndUnzipNM@ functions] above.+mapAndUnzip4M f xs =  unzip4 <$> traverse f xs++mapAndUnzip5M :: Monad m => (a -> m (b,c,d,e,f)) -> [a] -> m ([b],[c],[d],[e],[f])+{-# INLINE mapAndUnzip5M #-}+-- Inline so that fusion with 'unzip5' and 'traverse' has a chance to fire.+-- See Note [Inline @mapAndUnzipNM@ functions] above.+mapAndUnzip5M f xs =  unzip5 <$> traverse f xs++-- | Monadic version of mapAccumL+mapAccumLM :: Monad m+            => (acc -> x -> m (acc, y)) -- ^ combining function+            -> acc                      -- ^ initial state+            -> [x]                      -- ^ inputs+            -> m (acc, [y])             -- ^ final state, outputs+mapAccumLM _ s []     = return (s, [])+mapAccumLM f s (x:xs) = do+    (s1, x')  <- f s x+    (s2, xs') <- mapAccumLM f s1 xs+    return    (s2, x' : xs')++-- | Monadic version of mapSnd+mapSndM :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)]+mapSndM _ []         = return []+mapSndM f ((a,b):xs) = do { c <- f b; rs <- mapSndM f xs; return ((a,c):rs) }++-- | Monadic version of concatMap+concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]+concatMapM f xs = liftM concat (mapM f xs)++-- | Applicative version of mapMaybe+mapMaybeM :: Applicative m => (a -> m (Maybe b)) -> [a] -> m [b]+mapMaybeM f = foldr g (pure [])+  where g a = liftA2 (maybe id (:)) (f a)++-- | Monadic version of fmap+fmapMaybeM :: (Monad m) => (a -> m b) -> Maybe a -> m (Maybe b)+fmapMaybeM _ Nothing  = return Nothing+fmapMaybeM f (Just x) = f x >>= (return . Just)++-- | Monadic version of fmap+fmapEitherM :: Monad m => (a -> m b) -> (c -> m d) -> Either a c -> m (Either b d)+fmapEitherM fl _ (Left  a) = fl a >>= (return . Left)+fmapEitherM _ fr (Right b) = fr b >>= (return . Right)++-- | Monadic version of 'any', aborts the computation at the first @True@ value+anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool+anyM _ []     = return False+anyM f (x:xs) = do b <- f x+                   if b then return True+                        else anyM f xs++-- | Monad version of 'all', aborts the computation at the first @False@ value+allM :: Monad m => (a -> m Bool) -> [a] -> m Bool+allM _ []     = return True+allM f (b:bs) = (f b) >>= (\bv -> if bv then allM f bs else return False)++-- | Monadic version of or+orM :: Monad m => m Bool -> m Bool -> m Bool+orM m1 m2 = m1 >>= \x -> if x then return True else m2++-- | Monadic version of foldl+foldlM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a+foldlM = foldM++-- | Monadic version of foldl that discards its result+foldlM_ :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()+foldlM_ = foldM_++-- | Monadic version of foldr+foldrM        :: (Monad m) => (b -> a -> m a) -> a -> [b] -> m a+foldrM _ z []     = return z+foldrM k z (x:xs) = do { r <- foldrM k z xs; k x r }++-- | Monadic version of fmap specialised for Maybe+maybeMapM :: Monad m => (a -> m b) -> (Maybe a -> m (Maybe b))+maybeMapM _ Nothing  = return Nothing+maybeMapM m (Just x) = liftM Just $ m x++-- | Monadic version of @when@, taking the condition in the monad+whenM :: Monad m => m Bool -> m () -> m ()+whenM mb thing = do { b <- mb+                    ; when b thing }++-- | Monadic version of @unless@, taking the condition in the monad+unlessM :: Monad m => m Bool -> m () -> m ()+unlessM condM acc = do { cond <- condM+                       ; unless cond acc }++-- | Like 'filterM', only it reverses the sense of the test.+filterOutM :: (Applicative m) => (a -> m Bool) -> [a] -> m [a]+filterOutM p =+  foldr (\ x -> liftA2 (\ flg -> if flg then id else (x:)) (p x)) (pure [])
+ compiler/utils/OrdList.hs view
@@ -0,0 +1,154 @@+{-+(c) The University of Glasgow 2006+(c) The AQUA Project, Glasgow University, 1993-1998+++This is useful, general stuff for the Native Code Generator.++Provide trees (of instructions), so that lists of instructions+can be appended in linear time.+-}++module OrdList (+        OrdList,+        nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL, lastOL,+        headOL,+        mapOL, fromOL, toOL, foldrOL, foldlOL, reverseOL, fromOLReverse+) where++import GhcPrelude++import Outputable++import qualified Data.Semigroup as Semigroup++infixl 5  `appOL`+infixl 5  `snocOL`+infixr 5  `consOL`++data OrdList a+  = None+  | One a+  | Many [a]          -- Invariant: non-empty+  | Cons a (OrdList a)+  | Snoc (OrdList a) a+  | Two (OrdList a) -- Invariant: non-empty+        (OrdList a) -- Invariant: non-empty++instance Outputable a => Outputable (OrdList a) where+  ppr ol = ppr (fromOL ol)  -- Convert to list and print that++instance Semigroup (OrdList a) where+  (<>) = appOL++instance Monoid (OrdList a) where+  mempty = nilOL+  mappend = (Semigroup.<>)+  mconcat = concatOL++instance Functor OrdList where+  fmap = mapOL++instance Foldable OrdList where+  foldr = foldrOL++instance Traversable OrdList where+  traverse f xs = toOL <$> traverse f (fromOL xs)++nilOL    :: OrdList a+isNilOL  :: OrdList a -> Bool++unitOL   :: a           -> OrdList a+snocOL   :: OrdList a   -> a         -> OrdList a+consOL   :: a           -> OrdList a -> OrdList a+appOL    :: OrdList a   -> OrdList a -> OrdList a+concatOL :: [OrdList a] -> OrdList a+headOL   :: OrdList a   -> a+lastOL   :: OrdList a   -> a+++nilOL        = None+unitOL as    = One as+snocOL as   b    = Snoc as b+consOL a    bs   = Cons a bs+concatOL aas = foldr appOL None aas++headOL None        = panic "headOL"+headOL (One a)     = a+headOL (Many as)   = head as+headOL (Cons a _)  = a+headOL (Snoc as _) = headOL as+headOL (Two as _)  = headOL as++lastOL None        = panic "lastOL"+lastOL (One a)     = a+lastOL (Many as)   = last as+lastOL (Cons _ as) = lastOL as+lastOL (Snoc _ a)  = a+lastOL (Two _ as)  = lastOL as++isNilOL None = True+isNilOL _    = False++None  `appOL` b     = b+a     `appOL` None  = a+One a `appOL` b     = Cons a b+a     `appOL` One b = Snoc a b+a     `appOL` b     = Two a b++fromOL :: OrdList a -> [a]+fromOL a = go a []+  where go None       acc = acc+        go (One a)    acc = a : acc+        go (Cons a b) acc = a : go b acc+        go (Snoc a b) acc = go a (b:acc)+        go (Two a b)  acc = go a (go b acc)+        go (Many xs)  acc = xs ++ acc++fromOLReverse :: OrdList a -> [a]+fromOLReverse a = go a []+        -- acc is already in reverse order+  where go :: OrdList a -> [a] -> [a]+        go None       acc = acc+        go (One a)    acc = a : acc+        go (Cons a b) acc = go b (a : acc)+        go (Snoc a b) acc = b : go a acc+        go (Two a b)  acc = go b (go a acc)+        go (Many xs)  acc = reverse xs ++ acc++mapOL :: (a -> b) -> OrdList a -> OrdList b+mapOL _ None = None+mapOL f (One x) = One (f x)+mapOL f (Cons x xs) = Cons (f x) (mapOL f xs)+mapOL f (Snoc xs x) = Snoc (mapOL f xs) (f x)+mapOL f (Two x y) = Two (mapOL f x) (mapOL f y)+mapOL f (Many xs) = Many (map f xs)++foldrOL :: (a->b->b) -> b -> OrdList a -> b+foldrOL _ z None        = z+foldrOL k z (One x)     = k x z+foldrOL k z (Cons x xs) = k x (foldrOL k z xs)+foldrOL k z (Snoc xs x) = foldrOL k (k x z) xs+foldrOL k z (Two b1 b2) = foldrOL k (foldrOL k z b2) b1+foldrOL k z (Many xs)   = foldr k z xs++foldlOL :: (b->a->b) -> b -> OrdList a -> b+foldlOL _ z None        = z+foldlOL k z (One x)     = k z x+foldlOL k z (Cons x xs) = foldlOL k (k z x) xs+foldlOL k z (Snoc xs x) = k (foldlOL k z xs) x+foldlOL k z (Two b1 b2) = foldlOL k (foldlOL k z b1) b2+foldlOL k z (Many xs)   = foldl k z xs++toOL :: [a] -> OrdList a+toOL [] = None+toOL [x] = One x+toOL xs = Many xs++reverseOL :: OrdList a -> OrdList a+reverseOL None = None+reverseOL (One x) = One x+reverseOL (Cons a b) = Snoc (reverseOL b) a+reverseOL (Snoc a b) = Cons b (reverseOL a)+reverseOL (Two a b)  = Two (reverseOL b) (reverseOL a)+reverseOL (Many xs)  = Many (reverse xs)
+ compiler/utils/Outputable.hs view
@@ -0,0 +1,1236 @@+{-+(c) The University of Glasgow 2006-2012+(c) The GRASP Project, Glasgow University, 1992-1998+-}++-- | This module defines classes and functions for pretty-printing. It also+-- exports a number of helpful debugging and other utilities such as 'trace' and 'panic'.+--+-- The interface to this module is very similar to the standard Hughes-PJ pretty printing+-- module, except that it exports a number of additional functions that are rarely used,+-- and works over the 'SDoc' type.+module Outputable (+        -- * Type classes+        Outputable(..), OutputableBndr(..),++        -- * Pretty printing combinators+        SDoc, runSDoc, initSDocContext,+        docToSDoc,+        interppSP, interpp'SP,+        pprQuotedList, pprWithCommas, quotedListWithOr, quotedListWithNor,+        pprWithBars,+        empty, isEmpty, nest,+        char,+        text, ftext, ptext, ztext,+        int, intWithCommas, integer, word, float, double, rational, doublePrec,+        parens, cparen, brackets, braces, quotes, quote,+        doubleQuotes, angleBrackets,+        semi, comma, colon, dcolon, space, equals, dot, vbar,+        arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt,+        lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,+        blankLine, forAllLit, kindType, bullet,+        (<>), (<+>), hcat, hsep,+        ($$), ($+$), vcat,+        sep, cat,+        fsep, fcat,+        hang, hangNotEmpty, punctuate, ppWhen, ppUnless,+        speakNth, speakN, speakNOf, plural, isOrAre, doOrDoes,+        unicodeSyntax,++        coloured, keyword,++        -- * Converting 'SDoc' into strings and outputing it+        printSDoc, printSDocLn, printForUser, printForUserPartWay,+        printForC, bufLeftRenderSDoc,+        pprCode, mkCodeStyle,+        showSDoc, showSDocUnsafe, showSDocOneLine,+        showSDocForUser, showSDocDebug, showSDocDump, showSDocDumpOneLine,+        showSDocUnqual, showPpr,+        renderWithStyle,++        pprInfixVar, pprPrefixVar,+        pprHsChar, pprHsString, pprHsBytes,++        primFloatSuffix, primCharSuffix, primWordSuffix, primDoubleSuffix,+        primInt64Suffix, primWord64Suffix, primIntSuffix,++        pprPrimChar, pprPrimInt, pprPrimWord, pprPrimInt64, pprPrimWord64,++        pprFastFilePath, pprFilePathString,++        -- * Controlling the style in which output is printed+        BindingSite(..),++        PprStyle, CodeStyle(..), PrintUnqualified(..),+        QueryQualifyName, QueryQualifyModule, QueryQualifyPackage,+        reallyAlwaysQualify, reallyAlwaysQualifyNames,+        alwaysQualify, alwaysQualifyNames, alwaysQualifyModules,+        neverQualify, neverQualifyNames, neverQualifyModules,+        alwaysQualifyPackages, neverQualifyPackages,+        QualifyName(..), queryQual,+        sdocWithDynFlags, sdocWithPlatform,+        updSDocDynFlags,+        getPprStyle, withPprStyle, withPprStyleDoc, setStyleColoured,+        pprDeeper, pprDeeperList, pprSetDepth,+        codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,+        qualName, qualModule, qualPackage,+        mkErrStyle, defaultErrStyle, defaultDumpStyle, mkDumpStyle, defaultUserStyle,+        mkUserStyle, cmdlineParserStyle, Depth(..),++        ifPprDebug, whenPprDebug, getPprDebug,++        -- * Error handling and debugging utilities+        pprPanic, pprSorry, assertPprPanic, pprPgmError,+        pprTrace, pprTraceDebug, pprTraceIt, warnPprTrace, pprSTrace,+        pprTraceException, pprTraceM,+        trace, pgmError, panic, sorry, assertPanic,+        pprDebugAndThen, callStackDoc,+    ) where++import GhcPrelude++import {-# SOURCE #-}   DynFlags( DynFlags, hasPprDebug, hasNoDebugOutput,+                                  targetPlatform, pprUserLength, pprCols,+                                  useUnicode, useUnicodeSyntax, useStarIsType,+                                  shouldUseColor, unsafeGlobalDynFlags,+                                  shouldUseHexWordLiterals )+import {-# SOURCE #-}   Module( UnitId, Module, ModuleName, moduleName )+import {-# SOURCE #-}   OccName( OccName )++import BufWrite (BufHandle)+import FastString+import qualified Pretty+import Util+import Platform+import qualified PprColour as Col+import Pretty           ( Doc, Mode(..) )+import Panic+import GHC.Serialized+import GHC.LanguageExtensions (Extension)++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Char+import qualified Data.Map as M+import Data.Int+import qualified Data.IntMap as IM+import Data.Set (Set)+import qualified Data.Set as Set+import Data.String+import Data.Word+import System.IO        ( Handle )+import System.FilePath+import Text.Printf+import Numeric (showFFloat)+import Data.Graph (SCC(..))+import Data.List (intersperse)++import GHC.Fingerprint+import GHC.Show         ( showMultiLineString )+import GHC.Stack        ( callStack, prettyCallStack )+import Control.Monad.IO.Class+import Exception++{-+************************************************************************+*                                                                      *+\subsection{The @PprStyle@ data type}+*                                                                      *+************************************************************************+-}++data PprStyle+  = PprUser PrintUnqualified Depth Coloured+                -- Pretty-print in a way that will make sense to the+                -- ordinary user; must be very close to Haskell+                -- syntax, etc.+                -- Assumes printing tidied code: non-system names are+                -- printed without uniques.++  | PprDump PrintUnqualified+                -- For -ddump-foo; less verbose than PprDebug, but more than PprUser+                -- Does not assume tidied code: non-external names+                -- are printed with uniques.++  | PprDebug    -- Full debugging output++  | PprCode CodeStyle+                -- Print code; either C or assembler++data CodeStyle = CStyle         -- The format of labels differs for C and assembler+               | AsmStyle++data Depth = AllTheWay+           | PartWay Int        -- 0 => stop++data Coloured+  = Uncoloured+  | Coloured++-- -----------------------------------------------------------------------------+-- Printing original names++-- | When printing code that contains original names, we need to map the+-- original names back to something the user understands.  This is the+-- purpose of the triple of functions that gets passed around+-- when rendering 'SDoc'.+data PrintUnqualified = QueryQualify {+    queryQualifyName    :: QueryQualifyName,+    queryQualifyModule  :: QueryQualifyModule,+    queryQualifyPackage :: QueryQualifyPackage+}++-- | Given a `Name`'s `Module` and `OccName`, decide whether and how to qualify+-- it.+type QueryQualifyName = Module -> OccName -> QualifyName++-- | For a given module, we need to know whether to print it with+-- a package name to disambiguate it.+type QueryQualifyModule = Module -> Bool++-- | For a given package, we need to know whether to print it with+-- the component id to disambiguate it.+type QueryQualifyPackage = UnitId -> Bool++-- See Note [Printing original names] in HscTypes+data QualifyName   -- Given P:M.T+  = NameUnqual           -- It's in scope unqualified as "T"+                         -- OR nothing called "T" is in scope++  | NameQual ModuleName  -- It's in scope qualified as "X.T"++  | NameNotInScope1      -- It's not in scope at all, but M.T is not bound+                         -- in the current scope, so we can refer to it as "M.T"++  | NameNotInScope2      -- It's not in scope at all, and M.T is already bound in+                         -- the current scope, so we must refer to it as "P:M.T"++instance Outputable QualifyName where+  ppr NameUnqual      = text "NameUnqual"+  ppr (NameQual _mod) = text "NameQual"  -- can't print the mod without module loops :(+  ppr NameNotInScope1 = text "NameNotInScope1"+  ppr NameNotInScope2 = text "NameNotInScope2"++reallyAlwaysQualifyNames :: QueryQualifyName+reallyAlwaysQualifyNames _ _ = NameNotInScope2++-- | NB: This won't ever show package IDs+alwaysQualifyNames :: QueryQualifyName+alwaysQualifyNames m _ = NameQual (moduleName m)++neverQualifyNames :: QueryQualifyName+neverQualifyNames _ _ = NameUnqual++alwaysQualifyModules :: QueryQualifyModule+alwaysQualifyModules _ = True++neverQualifyModules :: QueryQualifyModule+neverQualifyModules _ = False++alwaysQualifyPackages :: QueryQualifyPackage+alwaysQualifyPackages _ = True++neverQualifyPackages :: QueryQualifyPackage+neverQualifyPackages _ = False++reallyAlwaysQualify, alwaysQualify, neverQualify :: PrintUnqualified+reallyAlwaysQualify+              = QueryQualify reallyAlwaysQualifyNames+                             alwaysQualifyModules+                             alwaysQualifyPackages+alwaysQualify = QueryQualify alwaysQualifyNames+                             alwaysQualifyModules+                             alwaysQualifyPackages+neverQualify  = QueryQualify neverQualifyNames+                             neverQualifyModules+                             neverQualifyPackages++defaultUserStyle :: DynFlags -> PprStyle+defaultUserStyle dflags = mkUserStyle dflags neverQualify AllTheWay++defaultDumpStyle :: DynFlags -> PprStyle+ -- Print without qualifiers to reduce verbosity, unless -dppr-debug+defaultDumpStyle dflags+   | hasPprDebug dflags = PprDebug+   | otherwise          = PprDump neverQualify++mkDumpStyle :: DynFlags -> PrintUnqualified -> PprStyle+mkDumpStyle dflags print_unqual+   | hasPprDebug dflags = PprDebug+   | otherwise          = PprDump print_unqual++defaultErrStyle :: DynFlags -> PprStyle+-- Default style for error messages, when we don't know PrintUnqualified+-- It's a bit of a hack because it doesn't take into account what's in scope+-- Only used for desugarer warnings, and typechecker errors in interface sigs+-- NB that -dppr-debug will still get into PprDebug style+defaultErrStyle dflags = mkErrStyle dflags neverQualify++-- | Style for printing error messages+mkErrStyle :: DynFlags -> PrintUnqualified -> PprStyle+mkErrStyle dflags qual =+   mkUserStyle dflags qual (PartWay (pprUserLength dflags))++cmdlineParserStyle :: DynFlags -> PprStyle+cmdlineParserStyle dflags = mkUserStyle dflags alwaysQualify AllTheWay++mkUserStyle :: DynFlags -> PrintUnqualified -> Depth -> PprStyle+mkUserStyle dflags unqual depth+   | hasPprDebug dflags = PprDebug+   | otherwise          = PprUser unqual depth Uncoloured++setStyleColoured :: Bool -> PprStyle -> PprStyle+setStyleColoured col style =+  case style of+    PprUser q d _ -> PprUser q d c+    _             -> style+  where+    c | col       = Coloured+      | otherwise = Uncoloured++instance Outputable PprStyle where+  ppr (PprUser {})  = text "user-style"+  ppr (PprCode {})  = text "code-style"+  ppr (PprDump {})  = text "dump-style"+  ppr (PprDebug {}) = text "debug-style"++{-+Orthogonal to the above printing styles are (possibly) some+command-line flags that affect printing (often carried with the+style).  The most likely ones are variations on how much type info is+shown.++The following test decides whether or not we are actually generating+code (either C or assembly), or generating interface files.++************************************************************************+*                                                                      *+\subsection{The @SDoc@ data type}+*                                                                      *+************************************************************************+-}++-- | Represents a pretty-printable document.+--+-- To display an 'SDoc', use 'printSDoc', 'printSDocLn', 'bufLeftRenderSDoc',+-- or 'renderWithStyle'.  Avoid calling 'runSDoc' directly as it breaks the+-- abstraction layer.+newtype SDoc = SDoc { runSDoc :: SDocContext -> Doc }++data SDocContext = SDC+  { sdocStyle      :: !PprStyle+  , sdocLastColour :: !Col.PprColour+    -- ^ The most recently used colour.  This allows nesting colours.+  , sdocDynFlags   :: !DynFlags+  }++instance IsString SDoc where+  fromString = text++initSDocContext :: DynFlags -> PprStyle -> SDocContext+initSDocContext dflags sty = SDC+  { sdocStyle = sty+  , sdocLastColour = Col.colReset+  , sdocDynFlags = dflags+  }++withPprStyle :: PprStyle -> SDoc -> SDoc+withPprStyle sty d = SDoc $ \ctxt -> runSDoc d ctxt{sdocStyle=sty}++-- | This is not a recommended way to render 'SDoc', since it breaks the+-- abstraction layer of 'SDoc'.  Prefer to use 'printSDoc', 'printSDocLn',+-- 'bufLeftRenderSDoc', or 'renderWithStyle' instead.+withPprStyleDoc :: DynFlags -> PprStyle -> SDoc -> Doc+withPprStyleDoc dflags sty d = runSDoc d (initSDocContext dflags sty)++pprDeeper :: SDoc -> SDoc+pprDeeper d = SDoc $ \ctx -> case ctx of+  SDC{sdocStyle=PprUser _ (PartWay 0) _} -> Pretty.text "..."+  SDC{sdocStyle=PprUser q (PartWay n) c} ->+    runSDoc d ctx{sdocStyle = PprUser q (PartWay (n-1)) c}+  _ -> runSDoc d ctx++-- | Truncate a list that is longer than the current depth.+pprDeeperList :: ([SDoc] -> SDoc) -> [SDoc] -> SDoc+pprDeeperList f ds+  | null ds   = f []+  | otherwise = SDoc work+ where+  work ctx@SDC{sdocStyle=PprUser q (PartWay n) c}+   | n==0      = Pretty.text "..."+   | otherwise =+      runSDoc (f (go 0 ds)) ctx{sdocStyle = PprUser q (PartWay (n-1)) c}+   where+     go _ [] = []+     go i (d:ds) | i >= n    = [text "...."]+                 | otherwise = d : go (i+1) ds+  work other_ctx = runSDoc (f ds) other_ctx++pprSetDepth :: Depth -> SDoc -> SDoc+pprSetDepth depth doc = SDoc $ \ctx ->+    case ctx of+        SDC{sdocStyle=PprUser q _ c} ->+            runSDoc doc ctx{sdocStyle = PprUser q depth c}+        _ ->+            runSDoc doc ctx++getPprStyle :: (PprStyle -> SDoc) -> SDoc+getPprStyle df = SDoc $ \ctx -> runSDoc (df (sdocStyle ctx)) ctx++sdocWithDynFlags :: (DynFlags -> SDoc) -> SDoc+sdocWithDynFlags f = SDoc $ \ctx -> runSDoc (f (sdocDynFlags ctx)) ctx++sdocWithPlatform :: (Platform -> SDoc) -> SDoc+sdocWithPlatform f = sdocWithDynFlags (f . targetPlatform)++updSDocDynFlags :: (DynFlags -> DynFlags) -> SDoc -> SDoc+updSDocDynFlags upd doc+  = SDoc $ \ctx -> runSDoc doc (ctx { sdocDynFlags = upd (sdocDynFlags ctx) })++qualName :: PprStyle -> QueryQualifyName+qualName (PprUser q _ _) mod occ = queryQualifyName q mod occ+qualName (PprDump q)     mod occ = queryQualifyName q mod occ+qualName _other          mod _   = NameQual (moduleName mod)++qualModule :: PprStyle -> QueryQualifyModule+qualModule (PprUser q _ _)  m = queryQualifyModule q m+qualModule (PprDump q)      m = queryQualifyModule q m+qualModule _other          _m = True++qualPackage :: PprStyle -> QueryQualifyPackage+qualPackage (PprUser q _ _)  m = queryQualifyPackage q m+qualPackage (PprDump q)      m = queryQualifyPackage q m+qualPackage _other          _m = True++queryQual :: PprStyle -> PrintUnqualified+queryQual s = QueryQualify (qualName s)+                           (qualModule s)+                           (qualPackage s)++codeStyle :: PprStyle -> Bool+codeStyle (PprCode _)     = True+codeStyle _               = False++asmStyle :: PprStyle -> Bool+asmStyle (PprCode AsmStyle)  = True+asmStyle _other              = False++dumpStyle :: PprStyle -> Bool+dumpStyle (PprDump {}) = True+dumpStyle _other       = False++debugStyle :: PprStyle -> Bool+debugStyle PprDebug = True+debugStyle _other   = False++userStyle ::  PprStyle -> Bool+userStyle (PprUser {}) = True+userStyle _other       = False++getPprDebug :: (Bool -> SDoc) -> SDoc+getPprDebug d = getPprStyle $ \ sty -> d (debugStyle sty)++ifPprDebug :: SDoc -> SDoc -> SDoc+-- ^ Says what to do with and without -dppr-debug+ifPprDebug yes no = getPprDebug $ \ dbg -> if dbg then yes else no++whenPprDebug :: SDoc -> SDoc        -- Empty for non-debug style+-- ^ Says what to do with -dppr-debug; without, return empty+whenPprDebug d = ifPprDebug d empty++-- | The analog of 'Pretty.printDoc_' for 'SDoc', which tries to make sure the+--   terminal doesn't get screwed up by the ANSI color codes if an exception+--   is thrown during pretty-printing.+printSDoc :: Mode -> DynFlags -> Handle -> PprStyle -> SDoc -> IO ()+printSDoc mode dflags handle sty doc =+  Pretty.printDoc_ mode cols handle (runSDoc doc ctx)+    `finally`+      Pretty.printDoc_ mode cols handle+        (runSDoc (coloured Col.colReset empty) ctx)+  where+    cols = pprCols dflags+    ctx = initSDocContext dflags sty++-- | Like 'printSDoc' but appends an extra newline.+printSDocLn :: Mode -> DynFlags -> Handle -> PprStyle -> SDoc -> IO ()+printSDocLn mode dflags handle sty doc =+  printSDoc mode dflags handle sty (doc $$ text "")++printForUser :: DynFlags -> Handle -> PrintUnqualified -> SDoc -> IO ()+printForUser dflags handle unqual doc+  = printSDocLn PageMode dflags handle+               (mkUserStyle dflags unqual AllTheWay) doc++printForUserPartWay :: DynFlags -> Handle -> Int -> PrintUnqualified -> SDoc+                    -> IO ()+printForUserPartWay dflags handle d unqual doc+  = printSDocLn PageMode dflags handle+                (mkUserStyle dflags unqual (PartWay d)) doc++-- | Like 'printSDocLn' but specialized with 'LeftMode' and+-- @'PprCode' 'CStyle'@.  This is typically used to output C-- code.+printForC :: DynFlags -> Handle -> SDoc -> IO ()+printForC dflags handle doc =+  printSDocLn LeftMode dflags handle (PprCode CStyle) doc++-- | An efficient variant of 'printSDoc' specialized for 'LeftMode' that+-- outputs to a 'BufHandle'.+bufLeftRenderSDoc :: DynFlags -> BufHandle -> PprStyle -> SDoc -> IO ()+bufLeftRenderSDoc dflags bufHandle sty doc =+  Pretty.bufLeftRender bufHandle (runSDoc doc (initSDocContext dflags sty))++pprCode :: CodeStyle -> SDoc -> SDoc+pprCode cs d = withPprStyle (PprCode cs) d++mkCodeStyle :: CodeStyle -> PprStyle+mkCodeStyle = PprCode++-- Can't make SDoc an instance of Show because SDoc is just a function type+-- However, Doc *is* an instance of Show+-- showSDoc just blasts it out as a string+showSDoc :: DynFlags -> SDoc -> String+showSDoc dflags sdoc = renderWithStyle dflags sdoc (defaultUserStyle dflags)++-- showSDocUnsafe is unsafe, because `unsafeGlobalDynFlags` might not be+-- initialised yet.+showSDocUnsafe :: SDoc -> String+showSDocUnsafe sdoc = showSDoc unsafeGlobalDynFlags sdoc++showPpr :: Outputable a => DynFlags -> a -> String+showPpr dflags thing = showSDoc dflags (ppr thing)++showSDocUnqual :: DynFlags -> SDoc -> String+-- Only used by Haddock+showSDocUnqual dflags sdoc = showSDoc dflags sdoc++showSDocForUser :: DynFlags -> PrintUnqualified -> SDoc -> String+-- Allows caller to specify the PrintUnqualified to use+showSDocForUser dflags unqual doc+ = renderWithStyle dflags doc (mkUserStyle dflags unqual AllTheWay)++showSDocDump :: DynFlags -> SDoc -> String+showSDocDump dflags d = renderWithStyle dflags d (defaultDumpStyle dflags)++showSDocDebug :: DynFlags -> SDoc -> String+showSDocDebug dflags d = renderWithStyle dflags d PprDebug++renderWithStyle :: DynFlags -> SDoc -> PprStyle -> String+renderWithStyle dflags sdoc sty+  = let s = Pretty.style{ Pretty.mode = PageMode,+                          Pretty.lineLength = pprCols dflags }+    in Pretty.renderStyle s $ runSDoc sdoc (initSDocContext dflags sty)++-- This shows an SDoc, but on one line only. It's cheaper than a full+-- showSDoc, designed for when we're getting results like "Foo.bar"+-- and "foo{uniq strictness}" so we don't want fancy layout anyway.+showSDocOneLine :: DynFlags -> SDoc -> String+showSDocOneLine dflags d+ = let s = Pretty.style{ Pretty.mode = OneLineMode,+                         Pretty.lineLength = pprCols dflags } in+   Pretty.renderStyle s $+      runSDoc d (initSDocContext dflags (defaultUserStyle dflags))++showSDocDumpOneLine :: DynFlags -> SDoc -> String+showSDocDumpOneLine dflags d+ = let s = Pretty.style{ Pretty.mode = OneLineMode,+                         Pretty.lineLength = irrelevantNCols } in+   Pretty.renderStyle s $+      runSDoc d (initSDocContext dflags (defaultDumpStyle dflags))++irrelevantNCols :: Int+-- Used for OneLineMode and LeftMode when number of cols isn't used+irrelevantNCols = 1++isEmpty :: DynFlags -> SDoc -> Bool+isEmpty dflags sdoc = Pretty.isEmpty $ runSDoc sdoc dummySDocContext+   where dummySDocContext = initSDocContext dflags PprDebug++docToSDoc :: Doc -> SDoc+docToSDoc d = SDoc (\_ -> d)++empty    :: SDoc+char     :: Char       -> SDoc+text     :: String     -> SDoc+ftext    :: FastString -> SDoc+ptext    :: PtrString  -> SDoc+ztext    :: FastZString -> SDoc+int      :: Int        -> SDoc+integer  :: Integer    -> SDoc+word     :: Integer    -> SDoc+float    :: Float      -> SDoc+double   :: Double     -> SDoc+rational :: Rational   -> SDoc++empty       = docToSDoc $ Pretty.empty+char c      = docToSDoc $ Pretty.char c++text s      = docToSDoc $ Pretty.text s+{-# INLINE text #-}   -- Inline so that the RULE Pretty.text will fire++ftext s     = docToSDoc $ Pretty.ftext s+ptext s     = docToSDoc $ Pretty.ptext s+ztext s     = docToSDoc $ Pretty.ztext s+int n       = docToSDoc $ Pretty.int n+integer n   = docToSDoc $ Pretty.integer n+float n     = docToSDoc $ Pretty.float n+double n    = docToSDoc $ Pretty.double n+rational n  = docToSDoc $ Pretty.rational n+word n      = sdocWithDynFlags $ \dflags ->+    -- See Note [Print Hexadecimal Literals] in Pretty.hs+    if shouldUseHexWordLiterals dflags+        then docToSDoc $ Pretty.hex n+        else docToSDoc $ Pretty.integer n++-- | @doublePrec p n@ shows a floating point number @n@ with @p@+-- digits of precision after the decimal point.+doublePrec :: Int -> Double -> SDoc+doublePrec p n = text (showFFloat (Just p) n "")++parens, braces, brackets, quotes, quote,+        doubleQuotes, angleBrackets :: SDoc -> SDoc++parens d        = SDoc $ Pretty.parens . runSDoc d+braces d        = SDoc $ Pretty.braces . runSDoc d+brackets d      = SDoc $ Pretty.brackets . runSDoc d+quote d         = SDoc $ Pretty.quote . runSDoc d+doubleQuotes d  = SDoc $ Pretty.doubleQuotes . runSDoc d+angleBrackets d = char '<' <> d <> char '>'++cparen :: Bool -> SDoc -> SDoc+cparen b d = SDoc $ Pretty.maybeParens b . runSDoc d++-- 'quotes' encloses something in single quotes...+-- but it omits them if the thing begins or ends in a single quote+-- so that we don't get `foo''.  Instead we just have foo'.+quotes d =+      sdocWithDynFlags $ \dflags ->+      if useUnicode dflags+      then char '‘' <> d <> char '’'+      else SDoc $ \sty ->+           let pp_d = runSDoc d sty+               str  = show pp_d+           in case (str, lastMaybe str) of+             (_, Just '\'') -> pp_d+             ('\'' : _, _)       -> pp_d+             _other              -> Pretty.quotes pp_d++semi, comma, colon, equals, space, dcolon, underscore, dot, vbar :: SDoc+arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt :: SDoc+lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc++blankLine  = docToSDoc $ Pretty.text ""+dcolon     = unicodeSyntax (char '∷') (docToSDoc $ Pretty.text "::")+arrow      = unicodeSyntax (char '→') (docToSDoc $ Pretty.text "->")+larrow     = unicodeSyntax (char '←') (docToSDoc $ Pretty.text "<-")+darrow     = unicodeSyntax (char '⇒') (docToSDoc $ Pretty.text "=>")+arrowt     = unicodeSyntax (char '⤚') (docToSDoc $ Pretty.text ">-")+larrowt    = unicodeSyntax (char '⤙') (docToSDoc $ Pretty.text "-<")+arrowtt    = unicodeSyntax (char '⤜') (docToSDoc $ Pretty.text ">>-")+larrowtt   = unicodeSyntax (char '⤛') (docToSDoc $ Pretty.text "-<<")+semi       = docToSDoc $ Pretty.semi+comma      = docToSDoc $ Pretty.comma+colon      = docToSDoc $ Pretty.colon+equals     = docToSDoc $ Pretty.equals+space      = docToSDoc $ Pretty.space+underscore = char '_'+dot        = char '.'+vbar       = char '|'+lparen     = docToSDoc $ Pretty.lparen+rparen     = docToSDoc $ Pretty.rparen+lbrack     = docToSDoc $ Pretty.lbrack+rbrack     = docToSDoc $ Pretty.rbrack+lbrace     = docToSDoc $ Pretty.lbrace+rbrace     = docToSDoc $ Pretty.rbrace++forAllLit :: SDoc+forAllLit = unicodeSyntax (char '∀') (text "forall")++kindType :: SDoc+kindType = sdocWithDynFlags $ \dflags ->+    if useStarIsType dflags+    then unicodeSyntax (char '★') (char '*')+    else text "Type"++bullet :: SDoc+bullet = unicode (char '•') (char '*')++unicodeSyntax :: SDoc -> SDoc -> SDoc+unicodeSyntax unicode plain = sdocWithDynFlags $ \dflags ->+    if useUnicode dflags && useUnicodeSyntax dflags+    then unicode+    else plain++unicode :: SDoc -> SDoc -> SDoc+unicode unicode plain = sdocWithDynFlags $ \dflags ->+    if useUnicode dflags+    then unicode+    else plain++nest :: Int -> SDoc -> SDoc+-- ^ Indent 'SDoc' some specified amount+(<>) :: SDoc -> SDoc -> SDoc+-- ^ Join two 'SDoc' together horizontally without a gap+(<+>) :: SDoc -> SDoc -> SDoc+-- ^ Join two 'SDoc' together horizontally with a gap between them+($$) :: SDoc -> SDoc -> SDoc+-- ^ Join two 'SDoc' together vertically; if there is+-- no vertical overlap it "dovetails" the two onto one line+($+$) :: SDoc -> SDoc -> SDoc+-- ^ Join two 'SDoc' together vertically++nest n d    = SDoc $ Pretty.nest n . runSDoc d+(<>) d1 d2  = SDoc $ \sty -> (Pretty.<>)  (runSDoc d1 sty) (runSDoc d2 sty)+(<+>) d1 d2 = SDoc $ \sty -> (Pretty.<+>) (runSDoc d1 sty) (runSDoc d2 sty)+($$) d1 d2  = SDoc $ \sty -> (Pretty.$$)  (runSDoc d1 sty) (runSDoc d2 sty)+($+$) d1 d2 = SDoc $ \sty -> (Pretty.$+$) (runSDoc d1 sty) (runSDoc d2 sty)++hcat :: [SDoc] -> SDoc+-- ^ Concatenate 'SDoc' horizontally+hsep :: [SDoc] -> SDoc+-- ^ Concatenate 'SDoc' horizontally with a space between each one+vcat :: [SDoc] -> SDoc+-- ^ Concatenate 'SDoc' vertically with dovetailing+sep :: [SDoc] -> SDoc+-- ^ Separate: is either like 'hsep' or like 'vcat', depending on what fits+cat :: [SDoc] -> SDoc+-- ^ Catenate: is either like 'hcat' or like 'vcat', depending on what fits+fsep :: [SDoc] -> SDoc+-- ^ A paragraph-fill combinator. It's much like sep, only it+-- keeps fitting things on one line until it can't fit any more.+fcat :: [SDoc] -> SDoc+-- ^ This behaves like 'fsep', but it uses '<>' for horizontal conposition rather than '<+>'+++hcat ds = SDoc $ \sty -> Pretty.hcat [runSDoc d sty | d <- ds]+hsep ds = SDoc $ \sty -> Pretty.hsep [runSDoc d sty | d <- ds]+vcat ds = SDoc $ \sty -> Pretty.vcat [runSDoc d sty | d <- ds]+sep ds  = SDoc $ \sty -> Pretty.sep  [runSDoc d sty | d <- ds]+cat ds  = SDoc $ \sty -> Pretty.cat  [runSDoc d sty | d <- ds]+fsep ds = SDoc $ \sty -> Pretty.fsep [runSDoc d sty | d <- ds]+fcat ds = SDoc $ \sty -> Pretty.fcat [runSDoc d sty | d <- ds]++hang :: SDoc  -- ^ The header+      -> Int  -- ^ Amount to indent the hung body+      -> SDoc -- ^ The hung body, indented and placed below the header+      -> SDoc+hang d1 n d2   = SDoc $ \sty -> Pretty.hang (runSDoc d1 sty) n (runSDoc d2 sty)++-- | This behaves like 'hang', but does not indent the second document+-- when the header is empty.+hangNotEmpty :: SDoc -> Int -> SDoc -> SDoc+hangNotEmpty d1 n d2 =+    SDoc $ \sty -> Pretty.hangNotEmpty (runSDoc d1 sty) n (runSDoc d2 sty)++punctuate :: SDoc   -- ^ The punctuation+          -> [SDoc] -- ^ The list that will have punctuation added between every adjacent pair of elements+          -> [SDoc] -- ^ Punctuated list+punctuate _ []     = []+punctuate p (d:ds) = go d ds+                   where+                     go d [] = [d]+                     go d (e:es) = (d <> p) : go e es++ppWhen, ppUnless :: Bool -> SDoc -> SDoc+ppWhen True  doc = doc+ppWhen False _   = empty++ppUnless True  _   = empty+ppUnless False doc = doc++-- | Apply the given colour\/style for the argument.+--+-- Only takes effect if colours are enabled.+coloured :: Col.PprColour -> SDoc -> SDoc+coloured col sdoc =+  sdocWithDynFlags $ \dflags ->+    if shouldUseColor dflags+    then SDoc $ \ctx@SDC{ sdocLastColour = lastCol } ->+         case ctx of+           SDC{ sdocStyle = PprUser _ _ Coloured } ->+             let ctx' = ctx{ sdocLastColour = lastCol `mappend` col } in+             Pretty.zeroWidthText (Col.renderColour col)+               Pretty.<> runSDoc sdoc ctx'+               Pretty.<> Pretty.zeroWidthText (Col.renderColourAfresh lastCol)+           _ -> runSDoc sdoc ctx+    else sdoc++keyword :: SDoc -> SDoc+keyword = coloured Col.colBold++{-+************************************************************************+*                                                                      *+\subsection[Outputable-class]{The @Outputable@ class}+*                                                                      *+************************************************************************+-}++-- | Class designating that some type has an 'SDoc' representation+class Outputable a where+        ppr :: a -> SDoc+        pprPrec :: Rational -> a -> SDoc+                -- 0 binds least tightly+                -- We use Rational because there is always a+                -- Rational between any other two Rationals++        ppr = pprPrec 0+        pprPrec _ = ppr++instance Outputable Char where+    ppr c = text [c]++instance Outputable Bool where+    ppr True  = text "True"+    ppr False = text "False"++instance Outputable Ordering where+    ppr LT = text "LT"+    ppr EQ = text "EQ"+    ppr GT = text "GT"++instance Outputable Int32 where+   ppr n = integer $ fromIntegral n++instance Outputable Int64 where+   ppr n = integer $ fromIntegral n++instance Outputable Int where+    ppr n = int n++instance Outputable Integer where+    ppr n = integer n++instance Outputable Word16 where+    ppr n = integer $ fromIntegral n++instance Outputable Word32 where+    ppr n = integer $ fromIntegral n++instance Outputable Word where+    ppr n = integer $ fromIntegral n++instance Outputable () where+    ppr _ = text "()"++instance (Outputable a) => Outputable [a] where+    ppr xs = brackets (fsep (punctuate comma (map ppr xs)))++instance (Outputable a) => Outputable (Set a) where+    ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s))))++instance (Outputable a, Outputable b) => Outputable (a, b) where+    ppr (x,y) = parens (sep [ppr x <> comma, ppr y])++instance Outputable a => Outputable (Maybe a) where+    ppr Nothing  = text "Nothing"+    ppr (Just x) = text "Just" <+> ppr x++instance (Outputable a, Outputable b) => Outputable (Either a b) where+    ppr (Left x)  = text "Left"  <+> ppr x+    ppr (Right y) = text "Right" <+> ppr y++-- ToDo: may not be used+instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where+    ppr (x,y,z) =+      parens (sep [ppr x <> comma,+                   ppr y <> comma,+                   ppr z ])++instance (Outputable a, Outputable b, Outputable c, Outputable d) =>+         Outputable (a, b, c, d) where+    ppr (a,b,c,d) =+      parens (sep [ppr a <> comma,+                   ppr b <> comma,+                   ppr c <> comma,+                   ppr d])++instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e) =>+         Outputable (a, b, c, d, e) where+    ppr (a,b,c,d,e) =+      parens (sep [ppr a <> comma,+                   ppr b <> comma,+                   ppr c <> comma,+                   ppr d <> comma,+                   ppr e])++instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e, Outputable f) =>+         Outputable (a, b, c, d, e, f) where+    ppr (a,b,c,d,e,f) =+      parens (sep [ppr a <> comma,+                   ppr b <> comma,+                   ppr c <> comma,+                   ppr d <> comma,+                   ppr e <> comma,+                   ppr f])++instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e, Outputable f, Outputable g) =>+         Outputable (a, b, c, d, e, f, g) where+    ppr (a,b,c,d,e,f,g) =+      parens (sep [ppr a <> comma,+                   ppr b <> comma,+                   ppr c <> comma,+                   ppr d <> comma,+                   ppr e <> comma,+                   ppr f <> comma,+                   ppr g])++instance Outputable FastString where+    ppr fs = ftext fs           -- Prints an unadorned string,+                                -- no double quotes or anything++instance (Outputable key, Outputable elt) => Outputable (M.Map key elt) where+    ppr m = ppr (M.toList m)+instance (Outputable elt) => Outputable (IM.IntMap elt) where+    ppr m = ppr (IM.toList m)++instance Outputable Fingerprint where+    ppr (Fingerprint w1 w2) = text (printf "%016x%016x" w1 w2)++instance Outputable a => Outputable (SCC a) where+   ppr (AcyclicSCC v) = text "NONREC" $$ (nest 3 (ppr v))+   ppr (CyclicSCC vs) = text "REC" $$ (nest 3 (vcat (map ppr vs)))++instance Outputable Serialized where+    ppr (Serialized the_type bytes) = int (length bytes) <+> text "of type" <+> text (show the_type)++instance Outputable Extension where+    ppr = text . show++{-+************************************************************************+*                                                                      *+\subsection{The @OutputableBndr@ class}+*                                                                      *+************************************************************************+-}++-- | 'BindingSite' is used to tell the thing that prints binder what+-- language construct is binding the identifier.  This can be used+-- to decide how much info to print.+-- Also see Note [Binding-site specific printing] in PprCore+data BindingSite+    = LambdaBind  -- ^ The x in   (\x. e)+    | CaseBind    -- ^ The x in   case scrut of x { (y,z) -> ... }+    | CasePatBind -- ^ The y,z in case scrut of x { (y,z) -> ... }+    | LetBind     -- ^ The x in   (let x = rhs in e)++-- | When we print a binder, we often want to print its type too.+-- The @OutputableBndr@ class encapsulates this idea.+class Outputable a => OutputableBndr a where+   pprBndr :: BindingSite -> a -> SDoc+   pprBndr _b x = ppr x++   pprPrefixOcc, pprInfixOcc :: a -> SDoc+      -- Print an occurrence of the name, suitable either in the+      -- prefix position of an application, thus   (f a b) or  ((+) x)+      -- or infix position,                 thus   (a `f` b) or  (x + y)++   bndrIsJoin_maybe :: a -> Maybe Int+   bndrIsJoin_maybe _ = Nothing+      -- When pretty-printing we sometimes want to find+      -- whether the binder is a join point.  You might think+      -- we could have a function of type (a->Var), but Var+      -- isn't available yet, alas++{-+************************************************************************+*                                                                      *+\subsection{Random printing helpers}+*                                                                      *+************************************************************************+-}++-- We have 31-bit Chars and will simply use Show instances of Char and String.++-- | Special combinator for showing character literals.+pprHsChar :: Char -> SDoc+pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32))+            | otherwise      = text (show c)++-- | Special combinator for showing string literals.+pprHsString :: FastString -> SDoc+pprHsString fs = vcat (map text (showMultiLineString (unpackFS fs)))++-- | Special combinator for showing bytestring literals.+pprHsBytes :: ByteString -> SDoc+pprHsBytes bs = let escaped = concatMap escape $ BS.unpack bs+                in vcat (map text (showMultiLineString escaped)) <> char '#'+    where escape :: Word8 -> String+          escape w = let c = chr (fromIntegral w)+                     in if isAscii c+                        then [c]+                        else '\\' : show w++-- Postfix modifiers for unboxed literals.+-- See Note [Printing of literals in Core] in `basicTypes/Literal.hs`.+primCharSuffix, primFloatSuffix, primIntSuffix :: SDoc+primDoubleSuffix, primWordSuffix, primInt64Suffix, primWord64Suffix :: SDoc+primCharSuffix   = char '#'+primFloatSuffix  = char '#'+primIntSuffix    = char '#'+primDoubleSuffix = text "##"+primWordSuffix   = text "##"+primInt64Suffix  = text "L#"+primWord64Suffix = text "L##"++-- | Special combinator for showing unboxed literals.+pprPrimChar :: Char -> SDoc+pprPrimInt, pprPrimWord, pprPrimInt64, pprPrimWord64 :: Integer -> SDoc+pprPrimChar c   = pprHsChar c <> primCharSuffix+pprPrimInt i    = integer i   <> primIntSuffix+pprPrimWord w   = word    w   <> primWordSuffix+pprPrimInt64 i  = integer i   <> primInt64Suffix+pprPrimWord64 w = word    w   <> primWord64Suffix++---------------------+-- Put a name in parens if it's an operator+pprPrefixVar :: Bool -> SDoc -> SDoc+pprPrefixVar is_operator pp_v+  | is_operator = parens pp_v+  | otherwise   = pp_v++-- Put a name in backquotes if it's not an operator+pprInfixVar :: Bool -> SDoc -> SDoc+pprInfixVar is_operator pp_v+  | is_operator = pp_v+  | otherwise   = char '`' <> pp_v <> char '`'++---------------------+pprFastFilePath :: FastString -> SDoc+pprFastFilePath path = text $ normalise $ unpackFS path++-- | Normalise, escape and render a string representing a path+--+-- e.g. "c:\\whatever"+pprFilePathString :: FilePath -> SDoc+pprFilePathString path = doubleQuotes $ text (escape (normalise path))+   where+      escape []        = []+      escape ('\\':xs) = '\\':'\\':escape xs+      escape (x:xs)    = x:escape xs++{-+************************************************************************+*                                                                      *+\subsection{Other helper functions}+*                                                                      *+************************************************************************+-}++pprWithCommas :: (a -> SDoc) -- ^ The pretty printing function to use+              -> [a]         -- ^ The things to be pretty printed+              -> SDoc        -- ^ 'SDoc' where the things have been pretty printed,+                             -- comma-separated and finally packed into a paragraph.+pprWithCommas pp xs = fsep (punctuate comma (map pp xs))++pprWithBars :: (a -> SDoc) -- ^ The pretty printing function to use+            -> [a]         -- ^ The things to be pretty printed+            -> SDoc        -- ^ 'SDoc' where the things have been pretty printed,+                           -- bar-separated and finally packed into a paragraph.+pprWithBars pp xs = fsep (intersperse vbar (map pp xs))++-- | Returns the separated concatenation of the pretty printed things.+interppSP  :: Outputable a => [a] -> SDoc+interppSP  xs = sep (map ppr xs)++-- | Returns the comma-separated concatenation of the pretty printed things.+interpp'SP :: Outputable a => [a] -> SDoc+interpp'SP xs = sep (punctuate comma (map ppr xs))++-- | Returns the comma-separated concatenation of the quoted pretty printed things.+--+-- > [x,y,z]  ==>  `x', `y', `z'+pprQuotedList :: Outputable a => [a] -> SDoc+pprQuotedList = quotedList . map ppr++quotedList :: [SDoc] -> SDoc+quotedList xs = fsep (punctuate comma (map quotes xs))++quotedListWithOr :: [SDoc] -> SDoc+-- [x,y,z]  ==>  `x', `y' or `z'+quotedListWithOr xs@(_:_:_) = quotedList (init xs) <+> text "or" <+> quotes (last xs)+quotedListWithOr xs = quotedList xs++quotedListWithNor :: [SDoc] -> SDoc+-- [x,y,z]  ==>  `x', `y' nor `z'+quotedListWithNor xs@(_:_:_) = quotedList (init xs) <+> text "nor" <+> quotes (last xs)+quotedListWithNor xs = quotedList xs++{-+************************************************************************+*                                                                      *+\subsection{Printing numbers verbally}+*                                                                      *+************************************************************************+-}++intWithCommas :: Integral a => a -> SDoc+-- Prints a big integer with commas, eg 345,821+intWithCommas n+  | n < 0     = char '-' <> intWithCommas (-n)+  | q == 0    = int (fromIntegral r)+  | otherwise = intWithCommas q <> comma <> zeroes <> int (fromIntegral r)+  where+    (q,r) = n `quotRem` 1000+    zeroes | r >= 100  = empty+           | r >= 10   = char '0'+           | otherwise = text "00"++-- | Converts an integer to a verbal index:+--+-- > speakNth 1 = text "first"+-- > speakNth 5 = text "fifth"+-- > speakNth 21 = text "21st"+speakNth :: Int -> SDoc+speakNth 1 = text "first"+speakNth 2 = text "second"+speakNth 3 = text "third"+speakNth 4 = text "fourth"+speakNth 5 = text "fifth"+speakNth 6 = text "sixth"+speakNth n = hcat [ int n, text suffix ]+  where+    suffix | n <= 20       = "th"       -- 11,12,13 are non-std+           | last_dig == 1 = "st"+           | last_dig == 2 = "nd"+           | last_dig == 3 = "rd"+           | otherwise     = "th"++    last_dig = n `rem` 10++-- | Converts an integer to a verbal multiplicity:+--+-- > speakN 0 = text "none"+-- > speakN 5 = text "five"+-- > speakN 10 = text "10"+speakN :: Int -> SDoc+speakN 0 = text "none"  -- E.g.  "he has none"+speakN 1 = text "one"   -- E.g.  "he has one"+speakN 2 = text "two"+speakN 3 = text "three"+speakN 4 = text "four"+speakN 5 = text "five"+speakN 6 = text "six"+speakN n = int n++-- | Converts an integer and object description to a statement about the+-- multiplicity of those objects:+--+-- > speakNOf 0 (text "melon") = text "no melons"+-- > speakNOf 1 (text "melon") = text "one melon"+-- > speakNOf 3 (text "melon") = text "three melons"+speakNOf :: Int -> SDoc -> SDoc+speakNOf 0 d = text "no" <+> d <> char 's'+speakNOf 1 d = text "one" <+> d                 -- E.g. "one argument"+speakNOf n d = speakN n <+> d <> char 's'               -- E.g. "three arguments"++-- | Determines the pluralisation suffix appropriate for the length of a list:+--+-- > plural [] = char 's'+-- > plural ["Hello"] = empty+-- > plural ["Hello", "World"] = char 's'+plural :: [a] -> SDoc+plural [_] = empty  -- a bit frightening, but there you are+plural _   = char 's'++-- | Determines the form of to be appropriate for the length of a list:+--+-- > isOrAre [] = text "are"+-- > isOrAre ["Hello"] = text "is"+-- > isOrAre ["Hello", "World"] = text "are"+isOrAre :: [a] -> SDoc+isOrAre [_] = text "is"+isOrAre _   = text "are"++-- | Determines the form of to do appropriate for the length of a list:+--+-- > doOrDoes [] = text "do"+-- > doOrDoes ["Hello"] = text "does"+-- > doOrDoes ["Hello", "World"] = text "do"+doOrDoes :: [a] -> SDoc+doOrDoes [_] = text "does"+doOrDoes _   = text "do"++{-+************************************************************************+*                                                                      *+\subsection{Error handling}+*                                                                      *+************************************************************************+-}++callStackDoc :: HasCallStack => SDoc+callStackDoc =+    hang (text "Call stack:")+       4 (vcat $ map text $ lines (prettyCallStack callStack))++pprPanic :: HasCallStack => String -> SDoc -> a+-- ^ Throw an exception saying "bug in GHC"+pprPanic s doc = panicDoc s (doc $$ callStackDoc)++pprSorry :: String -> SDoc -> a+-- ^ Throw an exception saying "this isn't finished yet"+pprSorry    = sorryDoc+++pprPgmError :: String -> SDoc -> a+-- ^ Throw an exception saying "bug in pgm being compiled" (used for unusual program errors)+pprPgmError = pgmErrorDoc++pprTraceDebug :: String -> SDoc -> a -> a+pprTraceDebug str doc x+   | debugIsOn && hasPprDebug unsafeGlobalDynFlags = pprTrace str doc x+   | otherwise                                     = x++pprTrace :: String -> SDoc -> a -> a+-- ^ If debug output is on, show some 'SDoc' on the screen+pprTrace str doc x+   | hasNoDebugOutput unsafeGlobalDynFlags = x+   | otherwise                             =+      pprDebugAndThen unsafeGlobalDynFlags trace (text str) doc x++pprTraceM :: Applicative f => String -> SDoc -> f ()+pprTraceM str doc = pprTrace str doc (pure ())++-- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@+pprTraceIt :: Outputable a => String -> a -> a+pprTraceIt desc x = pprTrace desc (ppr x) x++-- | @pprTraceException desc x action@ runs action, printing a message+-- if it throws an exception.+pprTraceException :: ExceptionMonad m => String -> SDoc -> m a -> m a+pprTraceException heading doc =+    handleGhcException $ \exc -> liftIO $ do+        putStrLn $ showSDocDump unsafeGlobalDynFlags (sep [text heading, nest 2 doc])+        throwGhcExceptionIO exc++-- | If debug output is on, show some 'SDoc' on the screen along+-- with a call stack when available.+pprSTrace :: HasCallStack => SDoc -> a -> a+pprSTrace doc = pprTrace "" (doc $$ callStackDoc)++warnPprTrace :: HasCallStack => Bool -> String -> Int -> SDoc -> a -> a+-- ^ Just warn about an assertion failure, recording the given file and line number.+-- Should typically be accessed with the WARN macros+warnPprTrace _     _     _     _    x | not debugIsOn     = x+warnPprTrace _     _file _line _msg x+   | hasNoDebugOutput unsafeGlobalDynFlags = x+warnPprTrace False _file _line _msg x = x+warnPprTrace True   file  line  msg x+  = pprDebugAndThen unsafeGlobalDynFlags trace heading+                    (msg $$ callStackDoc )+                    x+  where+    heading = hsep [text "WARNING: file", text file <> comma, text "line", int line]++-- | Panic with an assertation failure, recording the given file and+-- line number. Should typically be accessed with the ASSERT family of macros+assertPprPanic :: HasCallStack => String -> Int -> SDoc -> a+assertPprPanic _file _line msg+  = pprPanic "ASSERT failed!" msg++pprDebugAndThen :: DynFlags -> (String -> a) -> SDoc -> SDoc -> a+pprDebugAndThen dflags cont heading pretty_msg+ = cont (showSDocDump dflags doc)+ where+     doc = sep [heading, nest 2 pretty_msg]
+ compiler/utils/Outputable.hs-boot view
@@ -0,0 +1,12 @@+module Outputable where++import GhcPrelude+import GHC.Stack( HasCallStack )++data SDoc++showSDocUnsafe :: SDoc -> String++warnPprTrace :: HasCallStack => Bool -> String -> Int -> SDoc -> a -> a++text :: String -> SDoc
+ compiler/utils/Pair.hs view
@@ -0,0 +1,60 @@+{-+A simple homogeneous pair type with useful Functor, Applicative, and+Traversable instances.+-}++{-# LANGUAGE CPP #-}++module Pair ( Pair(..), unPair, toPair, swap, pLiftFst, pLiftSnd ) where++#include "HsVersions.h"++import GhcPrelude++import Outputable+import qualified Data.Semigroup as Semi++data Pair a = Pair { pFst :: a, pSnd :: a }+-- Note that Pair is a *unary* type constructor+-- whereas (,) is binary++-- The important thing about Pair is that it has a *homogeneous*+-- Functor instance, so you can easily apply the same function+-- to both components+instance Functor Pair where+  fmap f (Pair x y) = Pair (f x) (f y)++instance Applicative Pair where+  pure x = Pair x x+  (Pair f g) <*> (Pair x y) = Pair (f x) (g y)++instance Foldable Pair where+  foldMap f (Pair x y) = f x `mappend` f y++instance Traversable Pair where+  traverse f (Pair x y) = Pair <$> f x <*> f y++instance Semi.Semigroup a => Semi.Semigroup (Pair a) where+  Pair a1 b1 <> Pair a2 b2 =  Pair (a1 Semi.<> a2) (b1 Semi.<> b2)++instance (Semi.Semigroup a, Monoid a) => Monoid (Pair a) where+  mempty = Pair mempty mempty+  mappend = (Semi.<>)++instance Outputable a => Outputable (Pair a) where+  ppr (Pair a b) = ppr a <+> char '~' <+> ppr b++unPair :: Pair a -> (a,a)+unPair (Pair x y) = (x,y)++toPair :: (a,a) -> Pair a+toPair (x,y) = Pair x y++swap :: Pair a -> Pair a+swap (Pair x y) = Pair y x++pLiftFst :: (a -> a) -> Pair a -> Pair a+pLiftFst f (Pair a b) = Pair (f a) b++pLiftSnd :: (a -> a) -> Pair a -> Pair a+pLiftSnd f (Pair a b) = Pair a (f b)
+ compiler/utils/Panic.hs view
@@ -0,0 +1,313 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP Project, Glasgow University, 1992-2000++Defines basic functions for printing error messages.++It's hard to put these functions anywhere else without causing+some unnecessary loops in the module dependency graph.+-}++{-# LANGUAGE CPP, ScopedTypeVariables, LambdaCase #-}++module Panic (+     GhcException(..), showGhcException,+     throwGhcException, throwGhcExceptionIO,+     handleGhcException,+     progName,+     pgmError,++     panic, sorry, assertPanic, trace,+     panicDoc, sorryDoc, pgmErrorDoc,++     cmdLineError, cmdLineErrorIO,++     Exception.Exception(..), showException, safeShowException,+     try, tryMost, throwTo,++     withSignalHandlers,+) where+#include "HsVersions.h"++import GhcPrelude++import {-# SOURCE #-} Outputable (SDoc, showSDocUnsafe)++import Config+import Exception++import Control.Monad.IO.Class+import Control.Concurrent+import Debug.Trace        ( trace )+import System.IO.Unsafe+import System.Environment++#if !defined(mingw32_HOST_OS)+import System.Posix.Signals as S+#endif++#if defined(mingw32_HOST_OS)+import GHC.ConsoleHandler as S+#endif++import GHC.Stack+import System.Mem.Weak  ( deRefWeak )++-- | GHC's own exception type+--   error messages all take the form:+--+--  @+--      <location>: <error>+--  @+--+--   If the location is on the command line, or in GHC itself, then+--   <location>="ghc".  All of the error types below correspond to+--   a <location> of "ghc", except for ProgramError (where the string is+--  assumed to contain a location already, so we don't print one).++data GhcException+  -- | Some other fatal signal (SIGHUP,SIGTERM)+  = Signal Int++  -- | Prints the short usage msg after the error+  | UsageError   String++  -- | A problem with the command line arguments, but don't print usage.+  | CmdLineError String++  -- | The 'impossible' happened.+  | Panic        String+  | PprPanic     String SDoc++  -- | The user tickled something that's known not to work yet,+  --   but we're not counting it as a bug.+  | Sorry        String+  | PprSorry     String SDoc++  -- | An installation problem.+  | InstallationError String++  -- | An error in the user's code, probably.+  | ProgramError    String+  | PprProgramError String SDoc++instance Exception GhcException++instance Show GhcException where+  showsPrec _ e@(ProgramError _) = showGhcException e+  showsPrec _ e@(CmdLineError _) = showString "<command line>: " . showGhcException e+  showsPrec _ e = showString progName . showString ": " . showGhcException e+++-- | The name of this GHC.+progName :: String+progName = unsafePerformIO (getProgName)+{-# NOINLINE progName #-}+++-- | Short usage information to display when we are given the wrong cmd line arguments.+short_usage :: String+short_usage = "Usage: For basic information, try the `--help' option."+++-- | Show an exception as a string.+showException :: Exception e => e -> String+showException = show++-- | Show an exception which can possibly throw other exceptions.+-- Used when displaying exception thrown within TH code.+safeShowException :: Exception e => e -> IO String+safeShowException e = do+    -- ensure the whole error message is evaluated inside try+    r <- try (return $! forceList (showException e))+    case r of+        Right msg -> return msg+        Left e' -> safeShowException (e' :: SomeException)+    where+        forceList [] = []+        forceList xs@(x : xt) = x `seq` forceList xt `seq` xs++-- | Append a description of the given exception to this string.+--+-- Note that this uses 'DynFlags.unsafeGlobalDynFlags', which may have some+-- uninitialized fields if invoked before 'GHC.initGhcMonad' has been called.+-- If the error message to be printed includes a pretty-printer document+-- which forces one of these fields this call may bottom.+showGhcException :: GhcException -> ShowS+showGhcException exception+ = case exception of+        UsageError str+         -> showString str . showChar '\n' . showString short_usage++        CmdLineError str        -> showString str+        PprProgramError str  sdoc  ->+            showString str . showString "\n\n" .+            showString (showSDocUnsafe sdoc)+        ProgramError str        -> showString str+        InstallationError str   -> showString str+        Signal n                -> showString "signal: " . shows n++        PprPanic  s sdoc ->+            panicMsg $ showString s . showString "\n\n"+                     . showString (showSDocUnsafe sdoc)+        Panic s -> panicMsg (showString s)++        PprSorry  s sdoc ->+            sorryMsg $ showString s . showString "\n\n"+                     . showString (showSDocUnsafe sdoc)+        Sorry s -> sorryMsg (showString s)+  where+    sorryMsg :: ShowS -> ShowS+    sorryMsg s =+        showString "sorry! (unimplemented feature or known bug)\n"+      . showString ("  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t")+      . s . showString "\n"++    panicMsg :: ShowS -> ShowS+    panicMsg s =+        showString "panic! (the 'impossible' happened)\n"+      . showString ("  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t")+      . s . showString "\n\n"+      . showString "Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug\n"+++throwGhcException :: GhcException -> a+throwGhcException = Exception.throw++throwGhcExceptionIO :: GhcException -> IO a+throwGhcExceptionIO = Exception.throwIO++handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a+handleGhcException = ghandle+++-- | Panics and asserts.+panic, sorry, pgmError :: String -> a+panic    x = unsafeDupablePerformIO $ do+   stack <- ccsToStrings =<< getCurrentCCS x+   if null stack+      then throwGhcException (Panic x)+      else throwGhcException (Panic (x ++ '\n' : renderStack stack))++sorry    x = throwGhcException (Sorry x)+pgmError x = throwGhcException (ProgramError x)++panicDoc, sorryDoc, pgmErrorDoc :: String -> SDoc -> a+panicDoc    x doc = throwGhcException (PprPanic        x doc)+sorryDoc    x doc = throwGhcException (PprSorry        x doc)+pgmErrorDoc x doc = throwGhcException (PprProgramError x doc)++cmdLineError :: String -> a+cmdLineError = unsafeDupablePerformIO . cmdLineErrorIO++cmdLineErrorIO :: String -> IO a+cmdLineErrorIO x = do+  stack <- ccsToStrings =<< getCurrentCCS x+  if null stack+    then throwGhcException (CmdLineError x)+    else throwGhcException (CmdLineError (x ++ '\n' : renderStack stack))++++-- | Throw a failed assertion exception for a given filename and line number.+assertPanic :: String -> Int -> a+assertPanic file line =+  Exception.throw (Exception.AssertionFailed+           ("ASSERT failed! file " ++ file ++ ", line " ++ show line))+++-- | Like try, but pass through UserInterrupt and Panic exceptions.+--   Used when we want soft failures when reading interface files, for example.+--   TODO: I'm not entirely sure if this is catching what we really want to catch+tryMost :: IO a -> IO (Either SomeException a)+tryMost action = do r <- try action+                    case r of+                        Left se ->+                            case fromException se of+                                -- Some GhcException's we rethrow,+                                Just (Signal _)  -> throwIO se+                                Just (Panic _)   -> throwIO se+                                -- others we return+                                Just _           -> return (Left se)+                                Nothing ->+                                    case fromException se of+                                        -- All IOExceptions are returned+                                        Just (_ :: IOException) ->+                                            return (Left se)+                                        -- Anything else is rethrown+                                        Nothing -> throwIO se+                        Right v -> return (Right v)++-- | We use reference counting for signal handlers+{-# NOINLINE signalHandlersRefCount #-}+#if !defined(mingw32_HOST_OS)+signalHandlersRefCount :: MVar (Word, Maybe (S.Handler,S.Handler+                                            ,S.Handler,S.Handler))+#else+signalHandlersRefCount :: MVar (Word, Maybe S.Handler)+#endif+signalHandlersRefCount = unsafePerformIO $ newMVar (0,Nothing)+++-- | Temporarily install standard signal handlers for catching ^C, which just+-- throw an exception in the current thread.+withSignalHandlers :: (ExceptionMonad m, MonadIO m) => m a -> m a+withSignalHandlers act = do+  main_thread <- liftIO myThreadId+  wtid <- liftIO (mkWeakThreadId main_thread)++  let+      interrupt = do+        r <- deRefWeak wtid+        case r of+          Nothing -> return ()+          Just t  -> throwTo t UserInterrupt++#if !defined(mingw32_HOST_OS)+  let installHandlers = do+        let installHandler' a b = installHandler a b Nothing+        hdlQUIT <- installHandler' sigQUIT  (Catch interrupt)+        hdlINT  <- installHandler' sigINT   (Catch interrupt)+        -- see #3656; in the future we should install these automatically for+        -- all Haskell programs in the same way that we install a ^C handler.+        let fatal_signal n = throwTo main_thread (Signal (fromIntegral n))+        hdlHUP  <- installHandler' sigHUP   (Catch (fatal_signal sigHUP))+        hdlTERM <- installHandler' sigTERM  (Catch (fatal_signal sigTERM))+        return (hdlQUIT,hdlINT,hdlHUP,hdlTERM)++  let uninstallHandlers (hdlQUIT,hdlINT,hdlHUP,hdlTERM) = do+        _ <- installHandler sigQUIT  hdlQUIT Nothing+        _ <- installHandler sigINT   hdlINT  Nothing+        _ <- installHandler sigHUP   hdlHUP  Nothing+        _ <- installHandler sigTERM  hdlTERM Nothing+        return ()+#else+  -- GHC 6.3+ has support for console events on Windows+  -- NOTE: running GHCi under a bash shell for some reason requires+  -- you to press Ctrl-Break rather than Ctrl-C to provoke+  -- an interrupt.  Ctrl-C is getting blocked somewhere, I don't know+  -- why --SDM 17/12/2004+  let sig_handler ControlC = interrupt+      sig_handler Break    = interrupt+      sig_handler _        = return ()++  let installHandlers   = installHandler (Catch sig_handler)+  let uninstallHandlers = installHandler -- directly install the old handler+#endif++  -- install signal handlers if necessary+  let mayInstallHandlers = liftIO $ modifyMVar_ signalHandlersRefCount $ \case+        (0,Nothing)     -> do+          hdls <- installHandlers+          return (1,Just hdls)+        (c,oldHandlers) -> return (c+1,oldHandlers)++  -- uninstall handlers if necessary+  let mayUninstallHandlers = liftIO $ modifyMVar_ signalHandlersRefCount $ \case+        (1,Just hdls)   -> do+          _ <- uninstallHandlers hdls+          return (0,Nothing)+        (c,oldHandlers) -> return (c-1,oldHandlers)++  mayInstallHandlers+  act `gfinally` mayUninstallHandlers
+ compiler/utils/Platform.hs view
@@ -0,0 +1,162 @@++-- | A description of the platform we're compiling for.+--+module Platform (+        Platform(..),+        Arch(..),+        OS(..),+        ArmISA(..),+        ArmISAExt(..),+        ArmABI(..),+        PPC_64ABI(..),++        target32Bit,+        isARM,+        osElfTarget,+        osMachOTarget,+        osSubsectionsViaSymbols,+        platformUsesFrameworks,+)++where++import GhcPrelude++-- | Contains enough information for the native code generator to emit+--      code for this platform.+data Platform+        = Platform {+              platformArch                     :: Arch,+              platformOS                       :: OS,+              -- Word size in bytes (i.e. normally 4 or 8,+              -- for 32bit and 64bit platforms respectively)+              platformWordSize                 :: {-# UNPACK #-} !Int,+              platformUnregisterised           :: Bool,+              platformHasGnuNonexecStack       :: Bool,+              platformHasIdentDirective        :: Bool,+              platformHasSubsectionsViaSymbols :: Bool,+              platformIsCrossCompiling         :: Bool+          }+        deriving (Read, Show, Eq)+++-- | Architectures that the native code generator knows about.+--      TODO: It might be nice to extend these constructors with information+--      about what instruction set extensions an architecture might support.+--+data Arch+        = ArchUnknown+        | ArchX86+        | ArchX86_64+        | ArchPPC+        | ArchPPC_64+          { ppc_64ABI :: PPC_64ABI+          }+        | ArchSPARC+        | ArchSPARC64+        | ArchARM+          { armISA    :: ArmISA+          , armISAExt :: [ArmISAExt]+          , armABI    :: ArmABI+          }+        | ArchARM64+        | ArchAlpha+        | ArchMipseb+        | ArchMipsel+        | ArchJavaScript+        deriving (Read, Show, Eq)++isARM :: Arch -> Bool+isARM (ArchARM {}) = True+isARM ArchARM64    = True+isARM _ = False++-- | Operating systems that the native code generator knows about.+--      Having OSUnknown should produce a sensible default, but no promises.+data OS+        = OSUnknown+        | OSLinux+        | OSDarwin+        | OSSolaris2+        | OSMinGW32+        | OSFreeBSD+        | OSDragonFly+        | OSOpenBSD+        | OSNetBSD+        | OSKFreeBSD+        | OSHaiku+        | OSQNXNTO+        | OSAIX+        | OSHurd+        deriving (Read, Show, Eq)++-- | ARM Instruction Set Architecture, Extensions and ABI+--+data ArmISA+    = ARMv5+    | ARMv6+    | ARMv7+    deriving (Read, Show, Eq)++data ArmISAExt+    = VFPv2+    | VFPv3+    | VFPv3D16+    | NEON+    | IWMMX2+    deriving (Read, Show, Eq)++data ArmABI+    = SOFT+    | SOFTFP+    | HARD+    deriving (Read, Show, Eq)++-- | PowerPC 64-bit ABI+--+data PPC_64ABI+    = ELF_V1+    | ELF_V2+    deriving (Read, Show, Eq)++-- | This predicate tells us whether the platform is 32-bit.+target32Bit :: Platform -> Bool+target32Bit p = platformWordSize p == 4++-- | This predicate tells us whether the OS supports ELF-like shared libraries.+osElfTarget :: OS -> Bool+osElfTarget OSLinux     = True+osElfTarget OSFreeBSD   = True+osElfTarget OSDragonFly = True+osElfTarget OSOpenBSD   = True+osElfTarget OSNetBSD    = True+osElfTarget OSSolaris2  = True+osElfTarget OSDarwin    = False+osElfTarget OSMinGW32   = False+osElfTarget OSKFreeBSD  = True+osElfTarget OSHaiku     = True+osElfTarget OSQNXNTO    = False+osElfTarget OSAIX       = False+osElfTarget OSHurd      = True+osElfTarget OSUnknown   = False+ -- Defaulting to False is safe; it means don't rely on any+ -- ELF-specific functionality.  It is important to have a default for+ -- portability, otherwise we have to answer this question for every+ -- new platform we compile on (even unreg).++-- | This predicate tells us whether the OS support Mach-O shared libraries.+osMachOTarget :: OS -> Bool+osMachOTarget OSDarwin = True+osMachOTarget _ = False++osUsesFrameworks :: OS -> Bool+osUsesFrameworks OSDarwin = True+osUsesFrameworks _        = False++platformUsesFrameworks :: Platform -> Bool+platformUsesFrameworks = osUsesFrameworks . platformOS++osSubsectionsViaSymbols :: OS -> Bool+osSubsectionsViaSymbols OSDarwin = True+osSubsectionsViaSymbols _        = False+
+ compiler/utils/PprColour.hs view
@@ -0,0 +1,101 @@+module PprColour where+import GhcPrelude++import Data.Maybe (fromMaybe)+import Util (OverridingBool(..), split)+import Data.Semigroup as Semi++-- | A colour\/style for use with 'coloured'.+newtype PprColour = PprColour { renderColour :: String }++instance Semi.Semigroup PprColour where+  PprColour s1 <> PprColour s2 = PprColour (s1 <> s2)++-- | Allow colours to be combined (e.g. bold + red);+--   In case of conflict, right side takes precedence.+instance Monoid PprColour where+  mempty = PprColour mempty+  mappend = (<>)++renderColourAfresh :: PprColour -> String+renderColourAfresh c = renderColour (colReset `mappend` c)++colCustom :: String -> PprColour+colCustom "" = mempty+colCustom s  = PprColour ("\27[" ++ s ++ "m")++colReset :: PprColour+colReset = colCustom "0"++colBold :: PprColour+colBold = colCustom ";1"++colBlackFg :: PprColour+colBlackFg = colCustom "30"++colRedFg :: PprColour+colRedFg = colCustom "31"++colGreenFg :: PprColour+colGreenFg = colCustom "32"++colYellowFg :: PprColour+colYellowFg = colCustom "33"++colBlueFg :: PprColour+colBlueFg = colCustom "34"++colMagentaFg :: PprColour+colMagentaFg = colCustom "35"++colCyanFg :: PprColour+colCyanFg = colCustom "36"++colWhiteFg :: PprColour+colWhiteFg = colCustom "37"++data Scheme =+  Scheme+  { sHeader  :: PprColour+  , sMessage :: PprColour+  , sWarning :: PprColour+  , sError   :: PprColour+  , sFatal   :: PprColour+  , sMargin  :: PprColour+  }++defaultScheme :: Scheme+defaultScheme =+  Scheme+  { sHeader  = mempty+  , sMessage = colBold+  , sWarning = colBold `mappend` colMagentaFg+  , sError   = colBold `mappend` colRedFg+  , sFatal   = colBold `mappend` colRedFg+  , sMargin  = colBold `mappend` colBlueFg+  }++-- | Parse the colour scheme from a string (presumably from the @GHC_COLORS@+-- environment variable).+parseScheme :: String -> (OverridingBool, Scheme) -> (OverridingBool, Scheme)+parseScheme "always" (_, cs) = (Always, cs)+parseScheme "auto"   (_, cs) = (Auto,   cs)+parseScheme "never"  (_, cs) = (Never,  cs)+parseScheme input    (b, cs) =+  ( b+  , Scheme+    { sHeader  = fromMaybe (sHeader cs)  (lookup "header" table)+    , sMessage = fromMaybe (sMessage cs) (lookup "message" table)+    , sWarning = fromMaybe (sWarning cs) (lookup "warning" table)+    , sError   = fromMaybe (sError cs)   (lookup "error"   table)+    , sFatal   = fromMaybe (sFatal cs)   (lookup "fatal"   table)+    , sMargin  = fromMaybe (sMargin cs)  (lookup "margin"  table)+    }+  )+  where+    table = do+      w <- split ':' input+      let (k, v') = break (== '=') w+      case v' of+        '=' : v -> return (k, colCustom v)+        _ -> []
+ compiler/utils/Pretty.hs view
@@ -0,0 +1,1108 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Pretty+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  David Terei <code@davidterei.com>+-- Stability   :  stable+-- Portability :  portable+--+-- John Hughes's and Simon Peyton Jones's Pretty Printer Combinators+--+-- Based on /The Design of a Pretty-printing Library/+-- in Advanced Functional Programming,+-- Johan Jeuring and Erik Meijer (eds), LNCS 925+-- <http://www.cs.chalmers.se/~rjmh/Papers/pretty.ps>+--+-----------------------------------------------------------------------------++{-+Note [Differences between libraries/pretty and compiler/utils/Pretty.hs]++For historical reasons, there are two different copies of `Pretty` in the GHC+source tree:+ * `libraries/pretty` is a submodule containing+   https://github.com/haskell/pretty. This is the `pretty` library as released+   on hackage. It is used by several other libraries in the GHC source tree+   (e.g. template-haskell and Cabal).+ * `compiler/utils/Pretty.hs` (this module). It is used by GHC only.++There is an ongoing effort in https://github.com/haskell/pretty/issues/1 and+https://gitlab.haskell.org/ghc/ghc/issues/10735 to try to get rid of GHC's copy+of Pretty.++Currently, GHC's copy of Pretty resembles pretty-1.1.2.0, with the following+major differences:+ * GHC's copy uses `Faststring` for performance reasons.+ * GHC's copy has received a backported bugfix for #12227, which was+   released as pretty-1.1.3.4 ("Remove harmful $! forcing in beside",+   https://github.com/haskell/pretty/pull/35).++Other differences are minor. Both copies define some extra functions and+instances not defined in the other copy. To see all differences, do this in a+ghc git tree:++    $ cd libraries/pretty+    $ git checkout v1.1.2.0+    $ cd -+    $ vimdiff compiler/utils/Pretty.hs \+              libraries/pretty/src/Text/PrettyPrint/HughesPJ.hs++For parity with `pretty-1.1.2.1`, the following two `pretty` commits would+have to be backported:+  * "Resolve foldr-strictness stack overflow bug"+    (307b8173f41cd776eae8f547267df6d72bff2d68)+  * "Special-case reduce for horiz/vert"+    (c57c7a9dfc49617ba8d6e4fcdb019a3f29f1044c)+This has not been done sofar, because these commits seem to cause more+allocation in the compiler (see thomie's comments in+https://github.com/haskell/pretty/pull/9).+-}++module Pretty (++        -- * The document type+        Doc, TextDetails(..),++        -- * Constructing documents++        -- ** Converting values into documents+        char, text, ftext, ptext, ztext, sizedText, zeroWidthText,+        int, integer, float, double, rational, hex,++        -- ** Simple derived documents+        semi, comma, colon, space, equals,+        lparen, rparen, lbrack, rbrack, lbrace, rbrace,++        -- ** Wrapping documents in delimiters+        parens, brackets, braces, quotes, quote, doubleQuotes,+        maybeParens,++        -- ** Combining documents+        empty,+        (<>), (<+>), hcat, hsep,+        ($$), ($+$), vcat,+        sep, cat,+        fsep, fcat,+        nest,+        hang, hangNotEmpty, punctuate,++        -- * Predicates on documents+        isEmpty,++        -- * Rendering documents++        -- ** Rendering with a particular style+        Style(..),+        style,+        renderStyle,+        Mode(..),++        -- ** General rendering+        fullRender, txtPrinter,++        -- ** GHC-specific rendering+        printDoc, printDoc_,+        bufLeftRender -- performance hack++  ) where++import GhcPrelude hiding (error)++import BufWrite+import FastString+import Panic+import System.IO+import Numeric (showHex)++--for a RULES+import GHC.Base ( unpackCString#, unpackNBytes#, Int(..) )+import GHC.Ptr  ( Ptr(..) )++-- Don't import Util( assertPanic ) because it makes a loop in the module structure+++-- ---------------------------------------------------------------------------+-- The Doc calculus++{-+Laws for $$+~~~~~~~~~~~+<a1>    (x $$ y) $$ z   = x $$ (y $$ z)+<a2>    empty $$ x      = x+<a3>    x $$ empty      = x++        ...ditto $+$...++Laws for <>+~~~~~~~~~~~+<b1>    (x <> y) <> z   = x <> (y <> z)+<b2>    empty <> x      = empty+<b3>    x <> empty      = x++        ...ditto <+>...++Laws for text+~~~~~~~~~~~~~+<t1>    text s <> text t        = text (s++t)+<t2>    text "" <> x            = x, if x non-empty++** because of law n6, t2 only holds if x doesn't+** start with `nest'.+++Laws for nest+~~~~~~~~~~~~~+<n1>    nest 0 x                = x+<n2>    nest k (nest k' x)      = nest (k+k') x+<n3>    nest k (x <> y)         = nest k x <> nest k y+<n4>    nest k (x $$ y)         = nest k x $$ nest k y+<n5>    nest k empty            = empty+<n6>    x <> nest k y           = x <> y, if x non-empty++** Note the side condition on <n6>!  It is this that+** makes it OK for empty to be a left unit for <>.++Miscellaneous+~~~~~~~~~~~~~+<m1>    (text s <> x) $$ y = text s <> ((text "" <> x) $$+                                         nest (-length s) y)++<m2>    (x $$ y) <> z = x $$ (y <> z)+        if y non-empty+++Laws for list versions+~~~~~~~~~~~~~~~~~~~~~~+<l1>    sep (ps++[empty]++qs)   = sep (ps ++ qs)+        ...ditto hsep, hcat, vcat, fill...++<l2>    nest k (sep ps) = sep (map (nest k) ps)+        ...ditto hsep, hcat, vcat, fill...++Laws for oneLiner+~~~~~~~~~~~~~~~~~+<o1>    oneLiner (nest k p) = nest k (oneLiner p)+<o2>    oneLiner (x <> y)   = oneLiner x <> oneLiner y++You might think that the following version of <m1> would+be neater:++<3 NO>  (text s <> x) $$ y = text s <> ((empty <> x)) $$+                                         nest (-length s) y)++But it doesn't work, for if x=empty, we would have++        text s $$ y = text s <> (empty $$ nest (-length s) y)+                    = text s <> nest (-length s) y+-}++-- ---------------------------------------------------------------------------+-- Operator fixity++infixl 6 <>+infixl 6 <+>+infixl 5 $$, $+$+++-- ---------------------------------------------------------------------------+-- The Doc data type++-- | The abstract type of documents.+-- A Doc represents a *set* of layouts. A Doc with+-- no occurrences of Union or NoDoc represents just one layout.+data Doc+  = Empty                                            -- empty+  | NilAbove Doc                                     -- text "" $$ x+  | TextBeside !TextDetails {-# UNPACK #-} !Int Doc  -- text s <> x+  | Nest {-# UNPACK #-} !Int Doc                     -- nest k x+  | Union Doc Doc                                    -- ul `union` ur+  | NoDoc                                            -- The empty set of documents+  | Beside Doc Bool Doc                              -- True <=> space between+  | Above Doc Bool Doc                               -- True <=> never overlap++{-+Here are the invariants:++1) The argument of NilAbove is never Empty. Therefore+   a NilAbove occupies at least two lines.++2) The argument of @TextBeside@ is never @Nest@.++3) The layouts of the two arguments of @Union@ both flatten to the same+   string.++4) The arguments of @Union@ are either @TextBeside@, or @NilAbove@.++5) A @NoDoc@ may only appear on the first line of the left argument of an+   union. Therefore, the right argument of an union can never be equivalent+   to the empty set (@NoDoc@).++6) An empty document is always represented by @Empty@.  It can't be+   hidden inside a @Nest@, or a @Union@ of two @Empty@s.++7) The first line of every layout in the left argument of @Union@ is+   longer than the first line of any layout in the right argument.+   (1) ensures that the left argument has a first line.  In view of+   (3), this invariant means that the right argument must have at+   least two lines.++Notice the difference between+   * NoDoc (no documents)+   * Empty (one empty document; no height and no width)+   * text "" (a document containing the empty string;+              one line high, but has no width)+-}+++-- | RDoc is a "reduced GDoc", guaranteed not to have a top-level Above or Beside.+type RDoc = Doc++-- | The TextDetails data type+--+-- A TextDetails represents a fragment of text that will be+-- output at some point.+data TextDetails = Chr  {-# UNPACK #-} !Char -- ^ A single Char fragment+                 | Str  String -- ^ A whole String fragment+                 | PStr FastString                      -- a hashed string+                 | ZStr FastZString                     -- a z-encoded string+                 | LStr {-# UNPACK #-} !PtrString+                   -- a '\0'-terminated array of bytes+                 | RStr {-# UNPACK #-} !Int {-# UNPACK #-} !Char+                   -- a repeated character (e.g., ' ')++instance Show Doc where+  showsPrec _ doc cont = fullRender (mode style) (lineLength style)+                                    (ribbonsPerLine style)+                                    txtPrinter cont doc+++-- ---------------------------------------------------------------------------+-- Values and Predicates on GDocs and TextDetails++-- | A document of height and width 1, containing a literal character.+char :: Char -> Doc+char c = textBeside_ (Chr c) 1 Empty++-- | A document of height 1 containing a literal string.+-- 'text' satisfies the following laws:+--+-- * @'text' s '<>' 'text' t = 'text' (s'++'t)@+--+-- * @'text' \"\" '<>' x = x@, if @x@ non-empty+--+-- The side condition on the last law is necessary because @'text' \"\"@+-- has height 1, while 'empty' has no height.+text :: String -> Doc+text s = textBeside_ (Str s) (length s) Empty+{-# NOINLINE [0] text #-}   -- Give the RULE a chance to fire+                            -- It must wait till after phase 1 when+                            -- the unpackCString first is manifested++-- RULE that turns (text "abc") into (ptext (A# "abc"#)) to avoid the+-- intermediate packing/unpacking of the string.+{-# RULES "text/str"+    forall a. text (unpackCString# a)  = ptext (mkPtrString# a)+  #-}+{-# RULES "text/unpackNBytes#"+    forall p n. text (unpackNBytes# p n) = ptext (PtrString (Ptr p) (I# n))+  #-}++ftext :: FastString -> Doc+ftext s = textBeside_ (PStr s) (lengthFS s) Empty++ptext :: PtrString -> Doc+ptext s = textBeside_ (LStr s) (lengthPS s) Empty++ztext :: FastZString -> Doc+ztext s = textBeside_ (ZStr s) (lengthFZS s) Empty++-- | Some text with any width. (@text s = sizedText (length s) s@)+sizedText :: Int -> String -> Doc+sizedText l s = textBeside_ (Str s) l Empty++-- | Some text, but without any width. Use for non-printing text+-- such as a HTML or Latex tags+zeroWidthText :: String -> Doc+zeroWidthText = sizedText 0++-- | The empty document, with no height and no width.+-- 'empty' is the identity for '<>', '<+>', '$$' and '$+$', and anywhere+-- in the argument list for 'sep', 'hcat', 'hsep', 'vcat', 'fcat' etc.+empty :: Doc+empty = Empty++-- | Returns 'True' if the document is empty+isEmpty :: Doc -> Bool+isEmpty Empty = True+isEmpty _     = False++{-+Q: What is the reason for negative indentation (i.e. argument to indent+   is < 0) ?++A:+This indicates an error in the library client's code.+If we compose a <> b, and the first line of b is more indented than some+other lines of b, the law <n6> (<> eats nests) may cause the pretty+printer to produce an invalid layout:++doc       |0123345+------------------+d1        |a...|+d2        |...b|+          |c...|++d1<>d2    |ab..|+         c|....|++Consider a <> b, let `s' be the length of the last line of `a', `k' the+indentation of the first line of b, and `k0' the indentation of the+left-most line b_i of b.++The produced layout will have negative indentation if `k - k0 > s', as+the first line of b will be put on the (s+1)th column, effectively+translating b horizontally by (k-s). Now if the i^th line of b has an+indentation k0 < (k-s), it is translated out-of-page, causing+`negative indentation'.+-}+++semi   :: Doc -- ^ A ';' character+comma  :: Doc -- ^ A ',' character+colon  :: Doc -- ^ A ':' character+space  :: Doc -- ^ A space character+equals :: Doc -- ^ A '=' character+lparen :: Doc -- ^ A '(' character+rparen :: Doc -- ^ A ')' character+lbrack :: Doc -- ^ A '[' character+rbrack :: Doc -- ^ A ']' character+lbrace :: Doc -- ^ A '{' character+rbrace :: Doc -- ^ A '}' character+semi   = char ';'+comma  = char ','+colon  = char ':'+space  = char ' '+equals = char '='+lparen = char '('+rparen = char ')'+lbrack = char '['+rbrack = char ']'+lbrace = char '{'+rbrace = char '}'++spaceText, nlText :: TextDetails+spaceText = Chr ' '+nlText    = Chr '\n'++int      :: Int      -> Doc -- ^ @int n = text (show n)@+integer  :: Integer  -> Doc -- ^ @integer n = text (show n)@+float    :: Float    -> Doc -- ^ @float n = text (show n)@+double   :: Double   -> Doc -- ^ @double n = text (show n)@+rational :: Rational -> Doc -- ^ @rational n = text (show n)@+hex      :: Integer  -> Doc -- ^ See Note [Print Hexadecimal Literals]+int      n = text (show n)+integer  n = text (show n)+float    n = text (show n)+double   n = text (show n)+rational n = text (show n)+hex      n = text ('0' : 'x' : padded)+    where+    str = showHex n ""+    strLen = max 1 (length str)+    len = 2 ^ (ceiling (logBase 2 (fromIntegral strLen :: Double)) :: Int)+    padded = replicate (len - strLen) '0' ++ str++parens       :: Doc -> Doc -- ^ Wrap document in @(...)@+brackets     :: Doc -> Doc -- ^ Wrap document in @[...]@+braces       :: Doc -> Doc -- ^ Wrap document in @{...}@+quotes       :: Doc -> Doc -- ^ Wrap document in @\'...\'@+quote        :: Doc -> Doc+doubleQuotes :: Doc -> Doc -- ^ Wrap document in @\"...\"@+quotes p       = char '`' <> p <> char '\''+quote p        = char '\'' <> p+doubleQuotes p = char '"' <> p <> char '"'+parens p       = char '(' <> p <> char ')'+brackets p     = char '[' <> p <> char ']'+braces p       = char '{' <> p <> char '}'++{-+Note [Print Hexadecimal Literals]++Relevant discussions:+ * Phabricator: https://phabricator.haskell.org/D4465+ * GHC Trac: https://gitlab.haskell.org/ghc/ghc/issues/14872++There is a flag `-dword-hex-literals` that causes literals of+type `Word#` or `Word64#` to be displayed in hexadecimal instead+of decimal when dumping GHC core. It also affects the presentation+of these in GHC's error messages. Additionally, the hexadecimal+encoding of these numbers is zero-padded so that its length is+a power of two. As an example of what this does,+consider the following haskell file `Literals.hs`:++    module Literals where++    alpha :: Int+    alpha = 100 + 200++    beta :: Word -> Word+    beta x = x + div maxBound 255 + div 0xFFFFFFFF 255 + 0x0202++We get the following dumped core when we compile on a 64-bit+machine with ghc -O2 -fforce-recomp -ddump-simpl -dsuppress-all+-dhex-word-literals literals.hs:++    ==================== Tidy Core ====================++    ... omitted for brevity ...++    -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}+    alpha+    alpha = I# 300#++    -- RHS size: {terms: 12, types: 3, coercions: 0, joins: 0/0}+    beta+    beta+      = \ x_aYE ->+          case x_aYE of { W# x#_a1v0 ->+          W#+            (plusWord#+               (plusWord# (plusWord# x#_a1v0 0x0101010101010101##) 0x01010101##)+               0x0202##)+          }++Notice that the word literals are in hexadecimals and that they have+been padded with zeroes so that their lengths are 16, 8, and 4, respectively.++-}++-- | Apply 'parens' to 'Doc' if boolean is true.+maybeParens :: Bool -> Doc -> Doc+maybeParens False = id+maybeParens True = parens++-- ---------------------------------------------------------------------------+-- Structural operations on GDocs++-- | Perform some simplification of a built up @GDoc@.+reduceDoc :: Doc -> RDoc+reduceDoc (Beside p g q) = p `seq` g `seq` (beside p g $! reduceDoc q)+reduceDoc (Above  p g q) = p `seq` g `seq` (above  p g $! reduceDoc q)+reduceDoc p              = p++-- | List version of '<>'.+hcat :: [Doc] -> Doc+hcat = reduceAB . foldr (beside_' False) empty++-- | List version of '<+>'.+hsep :: [Doc] -> Doc+hsep = reduceAB . foldr (beside_' True)  empty++-- | List version of '$$'.+vcat :: [Doc] -> Doc+vcat = reduceAB . foldr (above_' False) empty++-- | Nest (or indent) a document by a given number of positions+-- (which may also be negative).  'nest' satisfies the laws:+--+-- * @'nest' 0 x = x@+--+-- * @'nest' k ('nest' k' x) = 'nest' (k+k') x@+--+-- * @'nest' k (x '<>' y) = 'nest' k z '<>' 'nest' k y@+--+-- * @'nest' k (x '$$' y) = 'nest' k x '$$' 'nest' k y@+--+-- * @'nest' k 'empty' = 'empty'@+--+-- * @x '<>' 'nest' k y = x '<>' y@, if @x@ non-empty+--+-- The side condition on the last law is needed because+-- 'empty' is a left identity for '<>'.+nest :: Int -> Doc -> Doc+nest k p = mkNest k (reduceDoc p)++-- | @hang d1 n d2 = sep [d1, nest n d2]@+hang :: Doc -> Int -> Doc -> Doc+hang d1 n d2 = sep [d1, nest n d2]++-- | Apply 'hang' to the arguments if the first 'Doc' is not empty.+hangNotEmpty :: Doc -> Int -> Doc -> Doc+hangNotEmpty d1 n d2 = if isEmpty d1+                       then d2+                       else hang d1 n d2++-- | @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@+punctuate :: Doc -> [Doc] -> [Doc]+punctuate _ []     = []+punctuate p (x:xs) = go x xs+                   where go y []     = [y]+                         go y (z:zs) = (y <> p) : go z zs++-- mkNest checks for Nest's invariant that it doesn't have an Empty inside it+mkNest :: Int -> Doc -> Doc+mkNest k _ | k `seq` False = undefined+mkNest k (Nest k1 p)       = mkNest (k + k1) p+mkNest _ NoDoc             = NoDoc+mkNest _ Empty             = Empty+mkNest 0 p                 = p+mkNest k p                 = nest_ k p++-- mkUnion checks for an empty document+mkUnion :: Doc -> Doc -> Doc+mkUnion Empty _ = Empty+mkUnion p q     = p `union_` q++beside_' :: Bool -> Doc -> Doc -> Doc+beside_' _ p Empty = p+beside_' g p q     = Beside p g q++above_' :: Bool -> Doc -> Doc -> Doc+above_' _ p Empty = p+above_' g p q     = Above p g q++reduceAB :: Doc -> Doc+reduceAB (Above  Empty _ q) = q+reduceAB (Beside Empty _ q) = q+reduceAB doc                = doc++nilAbove_ :: RDoc -> RDoc+nilAbove_ = NilAbove++-- Arg of a TextBeside is always an RDoc+textBeside_ :: TextDetails -> Int -> RDoc -> RDoc+textBeside_ = TextBeside++nest_ :: Int -> RDoc -> RDoc+nest_ = Nest++union_ :: RDoc -> RDoc -> RDoc+union_ = Union+++-- ---------------------------------------------------------------------------+-- Vertical composition @$$@++-- | Above, except that if the last line of the first argument stops+-- at least one position before the first line of the second begins,+-- these two lines are overlapped.  For example:+--+-- >    text "hi" $$ nest 5 (text "there")+--+-- lays out as+--+-- >    hi   there+--+-- rather than+--+-- >    hi+-- >         there+--+-- '$$' is associative, with identity 'empty', and also satisfies+--+-- * @(x '$$' y) '<>' z = x '$$' (y '<>' z)@, if @y@ non-empty.+--+($$) :: Doc -> Doc -> Doc+p $$  q = above_ p False q++-- | Above, with no overlapping.+-- '$+$' is associative, with identity 'empty'.+($+$) :: Doc -> Doc -> Doc+p $+$ q = above_ p True q++above_ :: Doc -> Bool -> Doc -> Doc+above_ p _ Empty = p+above_ Empty _ q = q+above_ p g q     = Above p g q++above :: Doc -> Bool -> RDoc -> RDoc+above (Above p g1 q1)  g2 q2 = above p g1 (above q1 g2 q2)+above p@(Beside{})     g  q  = aboveNest (reduceDoc p) g 0 (reduceDoc q)+above p g q                  = aboveNest p             g 0 (reduceDoc q)++-- Specification: aboveNest p g k q = p $g$ (nest k q)+aboveNest :: RDoc -> Bool -> Int -> RDoc -> RDoc+aboveNest _                   _ k _ | k `seq` False = undefined+aboveNest NoDoc               _ _ _ = NoDoc+aboveNest (p1 `Union` p2)     g k q = aboveNest p1 g k q `union_`+                                      aboveNest p2 g k q++aboveNest Empty               _ k q = mkNest k q+aboveNest (Nest k1 p)         g k q = nest_ k1 (aboveNest p g (k - k1) q)+                                  -- p can't be Empty, so no need for mkNest++aboveNest (NilAbove p)        g k q = nilAbove_ (aboveNest p g k q)+aboveNest (TextBeside s sl p) g k q = textBeside_ s sl rest+                                    where+                                      !k1  = k - sl+                                      rest = case p of+                                                Empty -> nilAboveNest g k1 q+                                                _     -> aboveNest  p g k1 q+aboveNest (Above {})          _ _ _ = error "aboveNest Above"+aboveNest (Beside {})         _ _ _ = error "aboveNest Beside"++-- Specification: text s <> nilaboveNest g k q+--              = text s <> (text "" $g$ nest k q)+nilAboveNest :: Bool -> Int -> RDoc -> RDoc+nilAboveNest _ k _           | k `seq` False = undefined+nilAboveNest _ _ Empty       = Empty+                               -- Here's why the "text s <>" is in the spec!+nilAboveNest g k (Nest k1 q) = nilAboveNest g (k + k1) q+nilAboveNest g k q           | not g && k > 0      -- No newline if no overlap+                             = textBeside_ (RStr k ' ') k q+                             | otherwise           -- Put them really above+                             = nilAbove_ (mkNest k q)+++-- ---------------------------------------------------------------------------+-- Horizontal composition @<>@++-- We intentionally avoid Data.Monoid.(<>) here due to interactions of+-- Data.Monoid.(<>) and (<+>).  See+-- http://www.haskell.org/pipermail/libraries/2011-November/017066.html++-- | Beside.+-- '<>' is associative, with identity 'empty'.+(<>) :: Doc -> Doc -> Doc+p <>  q = beside_ p False q++-- | Beside, separated by space, unless one of the arguments is 'empty'.+-- '<+>' is associative, with identity 'empty'.+(<+>) :: Doc -> Doc -> Doc+p <+> q = beside_ p True  q++beside_ :: Doc -> Bool -> Doc -> Doc+beside_ p _ Empty = p+beside_ Empty _ q = q+beside_ p g q     = Beside p g q++-- Specification: beside g p q = p <g> q+beside :: Doc -> Bool -> RDoc -> RDoc+beside NoDoc               _ _   = NoDoc+beside (p1 `Union` p2)     g q   = beside p1 g q `union_` beside p2 g q+beside Empty               _ q   = q+beside (Nest k p)          g q   = nest_ k $! beside p g q+beside p@(Beside p1 g1 q1) g2 q2+         | g1 == g2              = beside p1 g1 $! beside q1 g2 q2+         | otherwise             = beside (reduceDoc p) g2 q2+beside p@(Above{})         g q   = let !d = reduceDoc p in beside d g q+beside (NilAbove p)        g q   = nilAbove_ $! beside p g q+beside (TextBeside s sl p) g q   = textBeside_ s sl rest+                               where+                                  rest = case p of+                                           Empty -> nilBeside g q+                                           _     -> beside p g q++-- Specification: text "" <> nilBeside g p+--              = text "" <g> p+nilBeside :: Bool -> RDoc -> RDoc+nilBeside _ Empty         = Empty -- Hence the text "" in the spec+nilBeside g (Nest _ p)    = nilBeside g p+nilBeside g p | g         = textBeside_ spaceText 1 p+              | otherwise = p+++-- ---------------------------------------------------------------------------+-- Separate, @sep@++-- Specification: sep ps  = oneLiner (hsep ps)+--                         `union`+--                          vcat ps++-- | Either 'hsep' or 'vcat'.+sep  :: [Doc] -> Doc+sep = sepX True   -- Separate with spaces++-- | Either 'hcat' or 'vcat'.+cat :: [Doc] -> Doc+cat = sepX False  -- Don't++sepX :: Bool -> [Doc] -> Doc+sepX _ []     = empty+sepX x (p:ps) = sep1 x (reduceDoc p) 0 ps+++-- Specification: sep1 g k ys = sep (x : map (nest k) ys)+--                            = oneLiner (x <g> nest k (hsep ys))+--                              `union` x $$ nest k (vcat ys)+sep1 :: Bool -> RDoc -> Int -> [Doc] -> RDoc+sep1 _ _                   k _  | k `seq` False = undefined+sep1 _ NoDoc               _ _  = NoDoc+sep1 g (p `Union` q)       k ys = sep1 g p k ys `union_`+                                  aboveNest q False k (reduceDoc (vcat ys))++sep1 g Empty               k ys = mkNest k (sepX g ys)+sep1 g (Nest n p)          k ys = nest_ n (sep1 g p (k - n) ys)++sep1 _ (NilAbove p)        k ys = nilAbove_+                                  (aboveNest p False k (reduceDoc (vcat ys)))+sep1 g (TextBeside s sl p) k ys = textBeside_ s sl (sepNB g p (k - sl) ys)+sep1 _ (Above {})          _ _  = error "sep1 Above"+sep1 _ (Beside {})         _ _  = error "sep1 Beside"++-- Specification: sepNB p k ys = sep1 (text "" <> p) k ys+-- Called when we have already found some text in the first item+-- We have to eat up nests+sepNB :: Bool -> Doc -> Int -> [Doc] -> Doc+sepNB g (Nest _ p) k ys+  = sepNB g p k ys -- Never triggered, because of invariant (2)+sepNB g Empty k ys+  = oneLiner (nilBeside g (reduceDoc rest)) `mkUnion`+    -- XXX: TODO: PRETTY: Used to use True here (but GHC used False...)+    nilAboveNest False k (reduceDoc (vcat ys))+  where+    rest | g         = hsep ys+         | otherwise = hcat ys+sepNB g p k ys+  = sep1 g p k ys+++-- ---------------------------------------------------------------------------+-- @fill@++-- | \"Paragraph fill\" version of 'cat'.+fcat :: [Doc] -> Doc+fcat = fill False++-- | \"Paragraph fill\" version of 'sep'.+fsep :: [Doc] -> Doc+fsep = fill True++-- Specification:+--+-- fill g docs = fillIndent 0 docs+--+-- fillIndent k [] = []+-- fillIndent k [p] = p+-- fillIndent k (p1:p2:ps) =+--    oneLiner p1 <g> fillIndent (k + length p1 + g ? 1 : 0)+--                               (remove_nests (oneLiner p2) : ps)+--     `Union`+--    (p1 $*$ nest (-k) (fillIndent 0 ps))+--+-- $*$ is defined for layouts (not Docs) as+-- layout1 $*$ layout2 | hasMoreThanOneLine layout1 = layout1 $$ layout2+--                     | otherwise                  = layout1 $+$ layout2++fill :: Bool -> [Doc] -> RDoc+fill _ []     = empty+fill g (p:ps) = fill1 g (reduceDoc p) 0 ps++fill1 :: Bool -> RDoc -> Int -> [Doc] -> Doc+fill1 _ _                   k _  | k `seq` False = undefined+fill1 _ NoDoc               _ _  = NoDoc+fill1 g (p `Union` q)       k ys = fill1 g p k ys `union_`+                                   aboveNest q False k (fill g ys)+fill1 g Empty               k ys = mkNest k (fill g ys)+fill1 g (Nest n p)          k ys = nest_ n (fill1 g p (k - n) ys)+fill1 g (NilAbove p)        k ys = nilAbove_ (aboveNest p False k (fill g ys))+fill1 g (TextBeside s sl p) k ys = textBeside_ s sl (fillNB g p (k - sl) ys)+fill1 _ (Above {})          _ _  = error "fill1 Above"+fill1 _ (Beside {})         _ _  = error "fill1 Beside"++fillNB :: Bool -> Doc -> Int -> [Doc] -> Doc+fillNB _ _           k _  | k `seq` False = undefined+fillNB g (Nest _ p)  k ys   = fillNB g p k ys+                              -- Never triggered, because of invariant (2)+fillNB _ Empty _ []         = Empty+fillNB g Empty k (Empty:ys) = fillNB g Empty k ys+fillNB g Empty k (y:ys)     = fillNBE g k y ys+fillNB g p k ys             = fill1 g p k ys+++fillNBE :: Bool -> Int -> Doc -> [Doc] -> Doc+fillNBE g k y ys+  = nilBeside g (fill1 g ((elideNest . oneLiner . reduceDoc) y) k' ys)+    -- XXX: TODO: PRETTY: Used to use True here (but GHC used False...)+    `mkUnion` nilAboveNest False k (fill g (y:ys))+  where k' = if g then k - 1 else k++elideNest :: Doc -> Doc+elideNest (Nest _ d) = d+elideNest d          = d++-- ---------------------------------------------------------------------------+-- Selecting the best layout++best :: Int   -- Line length+     -> Int   -- Ribbon length+     -> RDoc+     -> RDoc  -- No unions in here!+best w0 r = get w0+  where+    get :: Int          -- (Remaining) width of line+        -> Doc -> Doc+    get w _ | w == 0 && False = undefined+    get _ Empty               = Empty+    get _ NoDoc               = NoDoc+    get w (NilAbove p)        = nilAbove_ (get w p)+    get w (TextBeside s sl p) = textBeside_ s sl (get1 w sl p)+    get w (Nest k p)          = nest_ k (get (w - k) p)+    get w (p `Union` q)       = nicest w r (get w p) (get w q)+    get _ (Above {})          = error "best get Above"+    get _ (Beside {})         = error "best get Beside"++    get1 :: Int         -- (Remaining) width of line+         -> Int         -- Amount of first line already eaten up+         -> Doc         -- This is an argument to TextBeside => eat Nests+         -> Doc         -- No unions in here!++    get1 w _ _ | w == 0 && False  = undefined+    get1 _ _  Empty               = Empty+    get1 _ _  NoDoc               = NoDoc+    get1 w sl (NilAbove p)        = nilAbove_ (get (w - sl) p)+    get1 w sl (TextBeside t tl p) = textBeside_ t tl (get1 w (sl + tl) p)+    get1 w sl (Nest _ p)          = get1 w sl p+    get1 w sl (p `Union` q)       = nicest1 w r sl (get1 w sl p)+                                                   (get1 w sl q)+    get1 _ _  (Above {})          = error "best get1 Above"+    get1 _ _  (Beside {})         = error "best get1 Beside"++nicest :: Int -> Int -> Doc -> Doc -> Doc+nicest !w !r = nicest1 w r 0++nicest1 :: Int -> Int -> Int -> Doc -> Doc -> Doc+nicest1 !w !r !sl p q | fits ((w `min` r) - sl) p = p+                      | otherwise                 = q++fits :: Int  -- Space available+     -> Doc+     -> Bool -- True if *first line* of Doc fits in space available+fits n _ | n < 0           = False+fits _ NoDoc               = False+fits _ Empty               = True+fits _ (NilAbove _)        = True+fits n (TextBeside _ sl p) = fits (n - sl) p+fits _ (Above {})          = error "fits Above"+fits _ (Beside {})         = error "fits Beside"+fits _ (Union {})          = error "fits Union"+fits _ (Nest {})           = error "fits Nest"++-- | @first@ returns its first argument if it is non-empty, otherwise its second.+first :: Doc -> Doc -> Doc+first p q | nonEmptySet p = p -- unused, because (get OneLineMode) is unused+          | otherwise     = q++nonEmptySet :: Doc -> Bool+nonEmptySet NoDoc              = False+nonEmptySet (_ `Union` _)      = True+nonEmptySet Empty              = True+nonEmptySet (NilAbove _)       = True+nonEmptySet (TextBeside _ _ p) = nonEmptySet p+nonEmptySet (Nest _ p)         = nonEmptySet p+nonEmptySet (Above {})         = error "nonEmptySet Above"+nonEmptySet (Beside {})        = error "nonEmptySet Beside"++-- @oneLiner@ returns the one-line members of the given set of @GDoc@s.+oneLiner :: Doc -> Doc+oneLiner NoDoc               = NoDoc+oneLiner Empty               = Empty+oneLiner (NilAbove _)        = NoDoc+oneLiner (TextBeside s sl p) = textBeside_ s sl (oneLiner p)+oneLiner (Nest k p)          = nest_ k (oneLiner p)+oneLiner (p `Union` _)       = oneLiner p+oneLiner (Above {})          = error "oneLiner Above"+oneLiner (Beside {})         = error "oneLiner Beside"+++-- ---------------------------------------------------------------------------+-- Rendering++-- | A rendering style.+data Style+  = Style { mode           :: Mode  -- ^ The rendering mode+          , lineLength     :: Int   -- ^ Length of line, in chars+          , ribbonsPerLine :: Float -- ^ Ratio of line length to ribbon length+          }++-- | The default style (@mode=PageMode, lineLength=100, ribbonsPerLine=1.5@).+style :: Style+style = Style { lineLength = 100, ribbonsPerLine = 1.5, mode = PageMode }++-- | Rendering mode.+data Mode = PageMode     -- ^ Normal+          | ZigZagMode   -- ^ With zig-zag cuts+          | LeftMode     -- ^ No indentation, infinitely long lines+          | OneLineMode  -- ^ All on one line++-- | Render the @Doc@ to a String using the given @Style@.+renderStyle :: Style -> Doc -> String+renderStyle s = fullRender (mode s) (lineLength s) (ribbonsPerLine s)+                txtPrinter ""++-- | Default TextDetails printer+txtPrinter :: TextDetails -> String -> String+txtPrinter (Chr c)    s  = c:s+txtPrinter (Str s1)   s2 = s1 ++ s2+txtPrinter (PStr s1)  s2 = unpackFS s1 ++ s2+txtPrinter (ZStr s1)  s2 = zString s1 ++ s2+txtPrinter (LStr s1)  s2 = unpackPtrString s1 ++ s2+txtPrinter (RStr n c) s2 = replicate n c ++ s2++-- | The general rendering interface.+fullRender :: Mode                     -- ^ Rendering mode+           -> Int                      -- ^ Line length+           -> Float                    -- ^ Ribbons per line+           -> (TextDetails -> a -> a)  -- ^ What to do with text+           -> a                        -- ^ What to do at the end+           -> Doc                      -- ^ The document+           -> a                        -- ^ Result+fullRender OneLineMode _ _ txt end doc+  = easyDisplay spaceText (\_ y -> y) txt end (reduceDoc doc)+fullRender LeftMode    _ _ txt end doc+  = easyDisplay nlText first txt end (reduceDoc doc)++fullRender m lineLen ribbons txt rest doc+  = display m lineLen ribbonLen txt rest doc'+  where+    doc' = best bestLineLen ribbonLen (reduceDoc doc)++    bestLineLen, ribbonLen :: Int+    ribbonLen   = round (fromIntegral lineLen / ribbons)+    bestLineLen = case m of+                      ZigZagMode -> maxBound+                      _          -> lineLen++easyDisplay :: TextDetails+             -> (Doc -> Doc -> Doc)+             -> (TextDetails -> a -> a)+             -> a+             -> Doc+             -> a+easyDisplay nlSpaceText choose txt end+  = lay+  where+    lay NoDoc              = error "easyDisplay: NoDoc"+    lay (Union p q)        = lay (choose p q)+    lay (Nest _ p)         = lay p+    lay Empty              = end+    lay (NilAbove p)       = nlSpaceText `txt` lay p+    lay (TextBeside s _ p) = s `txt` lay p+    lay (Above {})         = error "easyDisplay Above"+    lay (Beside {})        = error "easyDisplay Beside"++display :: Mode -> Int -> Int -> (TextDetails -> a -> a) -> a -> Doc -> a+display m !page_width !ribbon_width txt end doc+  = case page_width - ribbon_width of { gap_width ->+    case gap_width `quot` 2 of { shift ->+    let+        lay k _            | k `seq` False = undefined+        lay k (Nest k1 p)  = lay (k + k1) p+        lay _ Empty        = end+        lay k (NilAbove p) = nlText `txt` lay k p+        lay k (TextBeside s sl p)+            = case m of+                    ZigZagMode |  k >= gap_width+                               -> nlText `txt` (+                                  Str (replicate shift '/') `txt` (+                                  nlText `txt`+                                  lay1 (k - shift) s sl p ))++                               |  k < 0+                               -> nlText `txt` (+                                  Str (replicate shift '\\') `txt` (+                                  nlText `txt`+                                  lay1 (k + shift) s sl p ))++                    _ -> lay1 k s sl p+        lay _ (Above {})   = error "display lay Above"+        lay _ (Beside {})  = error "display lay Beside"+        lay _ NoDoc        = error "display lay NoDoc"+        lay _ (Union {})   = error "display lay Union"++        lay1 !k s !sl p    = let !r = k + sl+                             in indent k (s `txt` lay2 r p)++        lay2 k _ | k `seq` False   = undefined+        lay2 k (NilAbove p)        = nlText `txt` lay k p+        lay2 k (TextBeside s sl p) = s `txt` lay2 (k + sl) p+        lay2 k (Nest _ p)          = lay2 k p+        lay2 _ Empty               = end+        lay2 _ (Above {})          = error "display lay2 Above"+        lay2 _ (Beside {})         = error "display lay2 Beside"+        lay2 _ NoDoc               = error "display lay2 NoDoc"+        lay2 _ (Union {})          = error "display lay2 Union"++        indent !n r                = RStr n ' ' `txt` r+    in+    lay 0 doc+    }}++printDoc :: Mode -> Int -> Handle -> Doc -> IO ()+-- printDoc adds a newline to the end+printDoc mode cols hdl doc = printDoc_ mode cols hdl (doc $$ text "")++printDoc_ :: Mode -> Int -> Handle -> Doc -> IO ()+-- printDoc_ does not add a newline at the end, so that+-- successive calls can output stuff on the same line+-- Rather like putStr vs putStrLn+printDoc_ LeftMode _ hdl doc+  = do { printLeftRender hdl doc; hFlush hdl }+printDoc_ mode pprCols hdl doc+  = do { fullRender mode pprCols 1.5 put done doc ;+         hFlush hdl }+  where+    put (Chr c)    next = hPutChar hdl c >> next+    put (Str s)    next = hPutStr  hdl s >> next+    put (PStr s)   next = hPutStr  hdl (unpackFS s) >> next+                          -- NB. not hPutFS, we want this to go through+                          -- the I/O library's encoding layer. (#3398)+    put (ZStr s)   next = hPutFZS  hdl s >> next+    put (LStr s)   next = hPutPtrString hdl s >> next+    put (RStr n c) next = hPutStr hdl (replicate n c) >> next++    done = return () -- hPutChar hdl '\n'++  -- some versions of hPutBuf will barf if the length is zero+hPutPtrString :: Handle -> PtrString -> IO ()+hPutPtrString _handle (PtrString _ 0) = return ()+hPutPtrString handle  (PtrString a l) = hPutBuf handle a l++-- Printing output in LeftMode is performance critical: it's used when+-- dumping C and assembly output, so we allow ourselves a few dirty+-- hacks:+--+-- (1) we specialise fullRender for LeftMode with IO output.+--+-- (2) we add a layer of buffering on top of Handles.  Handles+--     don't perform well with lots of hPutChars, which is mostly+--     what we're doing here, because Handles have to be thread-safe+--     and async exception-safe.  We only have a single thread and don't+--     care about exceptions, so we add a layer of fast buffering+--     over the Handle interface.++printLeftRender :: Handle -> Doc -> IO ()+printLeftRender hdl doc = do+  b <- newBufHandle hdl+  bufLeftRender b doc+  bFlush b++bufLeftRender :: BufHandle -> Doc -> IO ()+bufLeftRender b doc = layLeft b (reduceDoc doc)++layLeft :: BufHandle -> Doc -> IO ()+layLeft b _ | b `seq` False  = undefined -- make it strict in b+layLeft _ NoDoc              = error "layLeft: NoDoc"+layLeft b (Union p q)        = layLeft b $! first p q+layLeft b (Nest _ p)         = layLeft b $! p+layLeft b Empty              = bPutChar b '\n'+layLeft b (NilAbove p)       = p `seq` (bPutChar b '\n' >> layLeft b p)+layLeft b (TextBeside s _ p) = s `seq` (put b s >> layLeft b p)+ where+    put b _ | b `seq` False = undefined+    put b (Chr c)    = bPutChar b c+    put b (Str s)    = bPutStr  b s+    put b (PStr s)   = bPutFS   b s+    put b (ZStr s)   = bPutFZS  b s+    put b (LStr s)   = bPutPtrString b s+    put b (RStr n c) = bPutReplicate b n c+layLeft _ _                  = panic "layLeft: Unhandled case"++-- Define error=panic, for easier comparison with libraries/pretty.+error :: String -> a+error = panic
+ compiler/utils/StringBuffer.hs view
@@ -0,0 +1,328 @@+{-+(c) The University of Glasgow 2006+(c) The University of Glasgow, 1997-2006+++Buffers for scanning string input stored in external arrays.+-}++{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}+{-# OPTIONS_GHC -O2 #-}+-- We always optimise this, otherwise performance of a non-optimised+-- compiler is severely affected++module StringBuffer+       (+        StringBuffer(..),+        -- non-abstract for vs\/HaskellService++         -- * Creation\/destruction+        hGetStringBuffer,+        hGetStringBufferBlock,+        appendStringBuffers,+        stringToStringBuffer,++        -- * Inspection+        nextChar,+        currentChar,+        prevChar,+        atEnd,++        -- * Moving and comparison+        stepOn,+        offsetBytes,+        byteDiff,+        atLine,++        -- * Conversion+        lexemeToString,+        lexemeToFastString,+        decodePrevNChars,++         -- * Parsing integers+        parseUnsignedInteger,+       ) where++#include "HsVersions.h"++import GhcPrelude++import Encoding+import FastString+import FastFunctions+import Outputable+import Util++import Data.Maybe+import Control.Exception+import System.IO+import System.IO.Unsafe         ( unsafePerformIO )+import GHC.IO.Encoding.UTF8     ( mkUTF8 )+import GHC.IO.Encoding.Failure  ( CodingFailureMode(IgnoreCodingFailure) )++import GHC.Exts++import Foreign++-- -----------------------------------------------------------------------------+-- The StringBuffer type++-- |A StringBuffer is an internal pointer to a sized chunk of bytes.+-- The bytes are intended to be *immutable*.  There are pure+-- operations to read the contents of a StringBuffer.+--+-- A StringBuffer may have a finalizer, depending on how it was+-- obtained.+--+data StringBuffer+ = StringBuffer {+     buf :: {-# UNPACK #-} !(ForeignPtr Word8),+     len :: {-# UNPACK #-} !Int,        -- length+     cur :: {-# UNPACK #-} !Int         -- current pos+  }+  -- The buffer is assumed to be UTF-8 encoded, and furthermore+  -- we add three @\'\\0\'@ bytes to the end as sentinels so that the+  -- decoder doesn't have to check for overflow at every single byte+  -- of a multibyte sequence.++instance Show StringBuffer where+        showsPrec _ s = showString "<stringbuffer("+                      . shows (len s) . showString "," . shows (cur s)+                      . showString ")>"++-- -----------------------------------------------------------------------------+-- Creation / Destruction++-- | Read a file into a 'StringBuffer'.  The resulting buffer is automatically+-- managed by the garbage collector.+hGetStringBuffer :: FilePath -> IO StringBuffer+hGetStringBuffer fname = do+   h <- openBinaryFile fname ReadMode+   size_i <- hFileSize h+   offset_i <- skipBOM h size_i 0  -- offset is 0 initially+   let size = fromIntegral $ size_i - offset_i+   buf <- mallocForeignPtrArray (size+3)+   withForeignPtr buf $ \ptr -> do+     r <- if size == 0 then return 0 else hGetBuf h ptr size+     hClose h+     if (r /= size)+        then ioError (userError "short read of file")+        else newUTF8StringBuffer buf ptr size++hGetStringBufferBlock :: Handle -> Int -> IO StringBuffer+hGetStringBufferBlock handle wanted+    = do size_i <- hFileSize handle+         offset_i <- hTell handle >>= skipBOM handle size_i+         let size = min wanted (fromIntegral $ size_i-offset_i)+         buf <- mallocForeignPtrArray (size+3)+         withForeignPtr buf $ \ptr ->+             do r <- if size == 0 then return 0 else hGetBuf handle ptr size+                if r /= size+                   then ioError (userError $ "short read of file: "++show(r,size,size_i,handle))+                   else newUTF8StringBuffer buf ptr size++-- | Skip the byte-order mark if there is one (see #1744 and #6016),+-- and return the new position of the handle in bytes.+--+-- This is better than treating #FEFF as whitespace,+-- because that would mess up layout.  We don't have a concept+-- of zero-width whitespace in Haskell: all whitespace codepoints+-- have a width of one column.+skipBOM :: Handle -> Integer -> Integer -> IO Integer+skipBOM h size offset =+  -- Only skip BOM at the beginning of a file.+  if size > 0 && offset == 0+    then do+      -- Validate assumption that handle is in binary mode.+      ASSERTM( hGetEncoding h >>= return . isNothing )+      -- Temporarily select utf8 encoding with error ignoring,+      -- to make `hLookAhead` and `hGetChar` return full Unicode characters.+      bracket_ (hSetEncoding h safeEncoding) (hSetBinaryMode h True) $ do+        c <- hLookAhead h+        if c == '\xfeff'+          then hGetChar h >> hTell h+          else return offset+    else return offset+  where+    safeEncoding = mkUTF8 IgnoreCodingFailure++newUTF8StringBuffer :: ForeignPtr Word8 -> Ptr Word8 -> Int -> IO StringBuffer+newUTF8StringBuffer buf ptr size = do+  pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0]+  -- sentinels for UTF-8 decoding+  return $ StringBuffer buf size 0++appendStringBuffers :: StringBuffer -> StringBuffer -> IO StringBuffer+appendStringBuffers sb1 sb2+    = do newBuf <- mallocForeignPtrArray (size+3)+         withForeignPtr newBuf $ \ptr ->+          withForeignPtr (buf sb1) $ \sb1Ptr ->+           withForeignPtr (buf sb2) $ \sb2Ptr ->+             do copyArray ptr (sb1Ptr `advancePtr` cur sb1) sb1_len+                copyArray (ptr `advancePtr` sb1_len) (sb2Ptr `advancePtr` cur sb2) sb2_len+                pokeArray (ptr `advancePtr` size) [0,0,0]+                return (StringBuffer newBuf size 0)+    where sb1_len = calcLen sb1+          sb2_len = calcLen sb2+          calcLen sb = len sb - cur sb+          size =  sb1_len + sb2_len++-- | Encode a 'String' into a 'StringBuffer' as UTF-8.  The resulting buffer+-- is automatically managed by the garbage collector.+stringToStringBuffer :: String -> StringBuffer+stringToStringBuffer str =+ unsafePerformIO $ do+  let size = utf8EncodedLength str+  buf <- mallocForeignPtrArray (size+3)+  withForeignPtr buf $ \ptr -> do+    utf8EncodeString ptr str+    pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0]+    -- sentinels for UTF-8 decoding+  return (StringBuffer buf size 0)++-- -----------------------------------------------------------------------------+-- Grab a character++-- | Return the first UTF-8 character of a nonempty 'StringBuffer' and as well+-- the remaining portion (analogous to 'Data.List.uncons').  __Warning:__ The+-- behavior is undefined if the 'StringBuffer' is empty.  The result shares+-- the same buffer as the original.  Similar to 'utf8DecodeChar', if the+-- character cannot be decoded as UTF-8, @\'\\0\'@ is returned.+{-# INLINE nextChar #-}+nextChar :: StringBuffer -> (Char,StringBuffer)+nextChar (StringBuffer buf len (I# cur#)) =+  -- Getting our fingers dirty a little here, but this is performance-critical+  inlinePerformIO $ do+    withForeignPtr buf $ \(Ptr a#) -> do+        case utf8DecodeChar# (a# `plusAddr#` cur#) of+          (# c#, nBytes# #) ->+             let cur' = I# (cur# +# nBytes#) in+             return (C# c#, StringBuffer buf len cur')++-- | Return the first UTF-8 character of a nonempty 'StringBuffer' (analogous+-- to 'Data.List.head').  __Warning:__ The behavior is undefined if the+-- 'StringBuffer' is empty.  Similar to 'utf8DecodeChar', if the character+-- cannot be decoded as UTF-8, @\'\\0\'@ is returned.+currentChar :: StringBuffer -> Char+currentChar = fst . nextChar++prevChar :: StringBuffer -> Char -> Char+prevChar (StringBuffer _   _   0)   deflt = deflt+prevChar (StringBuffer buf _   cur) _     =+  inlinePerformIO $ do+    withForeignPtr buf $ \p -> do+      p' <- utf8PrevChar (p `plusPtr` cur)+      return (fst (utf8DecodeChar p'))++-- -----------------------------------------------------------------------------+-- Moving++-- | Return a 'StringBuffer' with the first UTF-8 character removed (analogous+-- to 'Data.List.tail').  __Warning:__ The behavior is undefined if the+-- 'StringBuffer' is empty.  The result shares the same buffer as the+-- original.+stepOn :: StringBuffer -> StringBuffer+stepOn s = snd (nextChar s)++-- | Return a 'StringBuffer' with the first @n@ bytes removed.  __Warning:__+-- If there aren't enough characters, the returned 'StringBuffer' will be+-- invalid and any use of it may lead to undefined behavior.  The result+-- shares the same buffer as the original.+offsetBytes :: Int                      -- ^ @n@, the number of bytes+            -> StringBuffer+            -> StringBuffer+offsetBytes i s = s { cur = cur s + i }++-- | Compute the difference in offset between two 'StringBuffer's that share+-- the same buffer.  __Warning:__ The behavior is undefined if the+-- 'StringBuffer's use separate buffers.+byteDiff :: StringBuffer -> StringBuffer -> Int+byteDiff s1 s2 = cur s2 - cur s1++-- | Check whether a 'StringBuffer' is empty (analogous to 'Data.List.null').+atEnd :: StringBuffer -> Bool+atEnd (StringBuffer _ l c) = l == c++-- | Computes a 'StringBuffer' which points to the first character of the+-- wanted line. Lines begin at 1.+atLine :: Int -> StringBuffer -> Maybe StringBuffer+atLine line sb@(StringBuffer buf len _) =+  inlinePerformIO $+    withForeignPtr buf $ \p -> do+      p' <- skipToLine line len p+      if p' == nullPtr+        then return Nothing+        else+          let+            delta = p' `minusPtr` p+          in return $ Just (sb { cur = delta+                               , len = len - delta+                               })++skipToLine :: Int -> Int -> Ptr Word8 -> IO (Ptr Word8)+skipToLine !line !len !op0 = go 1 op0+  where+    !opend = op0 `plusPtr` len++    go !i_line !op+      | op >= opend    = pure nullPtr+      | i_line == line = pure op+      | otherwise      = do+          w <- peek op :: IO Word8+          case w of+            10 -> go (i_line + 1) (plusPtr op 1)+            13 -> do+              -- this is safe because a 'StringBuffer' is+              -- guaranteed to have 3 bytes sentinel values.+              w' <- peek (plusPtr op 1) :: IO Word8+              case w' of+                10 -> go (i_line + 1) (plusPtr op 2)+                _  -> go (i_line + 1) (plusPtr op 1)+            _  -> go i_line (plusPtr op 1)++-- -----------------------------------------------------------------------------+-- Conversion++-- | Decode the first @n@ bytes of a 'StringBuffer' as UTF-8 into a 'String'.+-- Similar to 'utf8DecodeChar', if the character cannot be decoded as UTF-8,+-- they will be replaced with @\'\\0\'@.+lexemeToString :: StringBuffer+               -> Int                   -- ^ @n@, the number of bytes+               -> String+lexemeToString _ 0 = ""+lexemeToString (StringBuffer buf _ cur) bytes =+  utf8DecodeStringLazy buf cur bytes++lexemeToFastString :: StringBuffer+                   -> Int               -- ^ @n@, the number of bytes+                   -> FastString+lexemeToFastString _ 0 = nilFS+lexemeToFastString (StringBuffer buf _ cur) len =+   inlinePerformIO $+     withForeignPtr buf $ \ptr ->+       return $! mkFastStringBytes (ptr `plusPtr` cur) len++-- | Return the previous @n@ characters (or fewer if we are less than @n@+-- characters into the buffer.+decodePrevNChars :: Int -> StringBuffer -> String+decodePrevNChars n (StringBuffer buf _ cur) =+    inlinePerformIO $ withForeignPtr buf $ \p0 ->+      go p0 n "" (p0 `plusPtr` (cur - 1))+  where+    go :: Ptr Word8 -> Int -> String -> Ptr Word8 -> IO String+    go buf0 n acc p | n == 0 || buf0 >= p = return acc+    go buf0 n acc p = do+        p' <- utf8PrevChar p+        let (c,_) = utf8DecodeChar p'+        go buf0 (n - 1) (c:acc) p'++-- -----------------------------------------------------------------------------+-- Parsing integer strings in various bases+parseUnsignedInteger :: StringBuffer -> Int -> Integer -> (Char->Int) -> Integer+parseUnsignedInteger (StringBuffer buf _ cur) len radix char_to_int+  = inlinePerformIO $ withForeignPtr buf $ \ptr -> return $! let+    go i x | i == len  = x+           | otherwise = case fst (utf8DecodeChar (ptr `plusPtr` (cur + i))) of+               '_'  -> go (i + 1) x    -- skip "_" (#14473)+               char -> go (i + 1) (x * radix + toInteger (char_to_int char))+  in go 0 0
+ compiler/utils/TrieMap.hs view
@@ -0,0 +1,405 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}++{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+module TrieMap(+   -- * Maps over 'Maybe' values+   MaybeMap,+   -- * Maps over 'List' values+   ListMap,+   -- * Maps over 'Literal's+   LiteralMap,+   -- * 'TrieMap' class+   TrieMap(..), insertTM, deleteTM,++   -- * Things helpful for adding additional Instances.+   (>.>), (|>), (|>>), XT,+   foldMaybe,+   -- * Map for leaf compression+   GenMap,+   lkG, xtG, mapG, fdG,+   xtList, lkList++ ) where++import GhcPrelude++import Literal+import UniqDFM+import Unique( Unique )++import qualified Data.Map    as Map+import qualified Data.IntMap as IntMap+import Outputable+import Control.Monad( (>=>) )++{-+This module implements TrieMaps, which are finite mappings+whose key is a structured value like a CoreExpr or Type.++This file implements tries over general data structures.+Implementation for tries over Core Expressions/Types are+available in coreSyn/TrieMap.++The regular pattern for handling TrieMaps on data structures was first+described (to my knowledge) in Connelly and Morris's 1995 paper "A+generalization of the Trie Data Structure"; there is also an accessible+description of the idea in Okasaki's book "Purely Functional Data+Structures", Section 10.3.2++************************************************************************+*                                                                      *+                   The TrieMap class+*                                                                      *+************************************************************************+-}++type XT a = Maybe a -> Maybe a  -- How to alter a non-existent elt (Nothing)+                                --               or an existing elt (Just)++class TrieMap m where+   type Key m :: *+   emptyTM  :: m a+   lookupTM :: forall b. Key m -> m b -> Maybe b+   alterTM  :: forall b. Key m -> XT b -> m b -> m b+   mapTM    :: (a->b) -> m a -> m b++   foldTM   :: (a -> b -> b) -> m a -> b -> b+      -- The unusual argument order here makes+      -- it easy to compose calls to foldTM;+      -- see for example fdE below++insertTM :: TrieMap m => Key m -> a -> m a -> m a+insertTM k v m = alterTM k (\_ -> Just v) m++deleteTM :: TrieMap m => Key m -> m a -> m a+deleteTM k m = alterTM k (\_ -> Nothing) m++----------------------+-- Recall that+--   Control.Monad.(>=>) :: (a -> Maybe b) -> (b -> Maybe c) -> a -> Maybe c++(>.>) :: (a -> b) -> (b -> c) -> a -> c+-- Reverse function composition (do f first, then g)+infixr 1 >.>+(f >.> g) x = g (f x)+infixr 1 |>, |>>++(|>) :: a -> (a->b) -> b     -- Reverse application+x |> f = f x++----------------------+(|>>) :: TrieMap m2+      => (XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))+      -> (m2 a -> m2 a)+      -> m1 (m2 a) -> m1 (m2 a)+(|>>) f g = f (Just . g . deMaybe)++deMaybe :: TrieMap m => Maybe (m a) -> m a+deMaybe Nothing  = emptyTM+deMaybe (Just m) = m++{-+************************************************************************+*                                                                      *+                   IntMaps+*                                                                      *+************************************************************************+-}++instance TrieMap IntMap.IntMap where+  type Key IntMap.IntMap = Int+  emptyTM = IntMap.empty+  lookupTM k m = IntMap.lookup k m+  alterTM = xtInt+  foldTM k m z = IntMap.foldr k z m+  mapTM f m = IntMap.map f m++xtInt :: Int -> XT a -> IntMap.IntMap a -> IntMap.IntMap a+xtInt k f m = IntMap.alter f k m++instance Ord k => TrieMap (Map.Map k) where+  type Key (Map.Map k) = k+  emptyTM = Map.empty+  lookupTM = Map.lookup+  alterTM k f m = Map.alter f k m+  foldTM k m z = Map.foldr k z m+  mapTM f m = Map.map f m+++{-+Note [foldTM determinism]+~~~~~~~~~~~~~~~~~~~~~~~~~+We want foldTM to be deterministic, which is why we have an instance of+TrieMap for UniqDFM, but not for UniqFM. Here's an example of some things that+go wrong if foldTM is nondeterministic. Consider:++  f a b = return (a <> b)++Depending on the order that the typechecker generates constraints you+get either:++  f :: (Monad m, Monoid a) => a -> a -> m a++or:++  f :: (Monoid a, Monad m) => a -> a -> m a++The generated code will be different after desugaring as the dictionaries+will be bound in different orders, leading to potential ABI incompatibility.++One way to solve this would be to notice that the typeclasses could be+sorted alphabetically.++Unfortunately that doesn't quite work with this example:++  f a b = let x = a <> a; y = b <> b in x++where you infer:++  f :: (Monoid m, Monoid m1) => m1 -> m -> m1++or:++  f :: (Monoid m1, Monoid m) => m1 -> m -> m1++Here you could decide to take the order of the type variables in the type+according to depth first traversal and use it to order the constraints.++The real trouble starts when the user enables incoherent instances and+the compiler has to make an arbitrary choice. Consider:++  class T a b where+    go :: a -> b -> String++  instance (Show b) => T Int b where+    go a b = show a ++ show b++  instance (Show a) => T a Bool where+    go a b = show a ++ show b++  f = go 10 True++GHC is free to choose either dictionary to implement f, but for the sake of+determinism we'd like it to be consistent when compiling the same sources+with the same flags.++inert_dicts :: DictMap is implemented with a TrieMap. In getUnsolvedInerts it+gets converted to a bag of (Wanted) Cts using a fold. Then in+solve_simple_wanteds it's merged with other WantedConstraints. We want the+conversion to a bag to be deterministic. For that purpose we use UniqDFM+instead of UniqFM to implement the TrieMap.++See Note [Deterministic UniqFM] in UniqDFM for more details on how it's made+deterministic.+-}++instance TrieMap UniqDFM where+  type Key UniqDFM = Unique+  emptyTM = emptyUDFM+  lookupTM k m = lookupUDFM m k+  alterTM k f m = alterUDFM f m k+  foldTM k m z = foldUDFM k z m+  mapTM f m = mapUDFM f m++{-+************************************************************************+*                                                                      *+                   Maybes+*                                                                      *+************************************************************************++If              m is a map from k -> val+then (MaybeMap m) is a map from (Maybe k) -> val+-}++data MaybeMap m a = MM { mm_nothing  :: Maybe a, mm_just :: m a }++instance TrieMap m => TrieMap (MaybeMap m) where+   type Key (MaybeMap m) = Maybe (Key m)+   emptyTM  = MM { mm_nothing = Nothing, mm_just = emptyTM }+   lookupTM = lkMaybe lookupTM+   alterTM  = xtMaybe alterTM+   foldTM   = fdMaybe+   mapTM    = mapMb++mapMb :: TrieMap m => (a->b) -> MaybeMap m a -> MaybeMap m b+mapMb f (MM { mm_nothing = mn, mm_just = mj })+  = MM { mm_nothing = fmap f mn, mm_just = mapTM f mj }++lkMaybe :: (forall b. k -> m b -> Maybe b)+        -> Maybe k -> MaybeMap m a -> Maybe a+lkMaybe _  Nothing  = mm_nothing+lkMaybe lk (Just x) = mm_just >.> lk x++xtMaybe :: (forall b. k -> XT b -> m b -> m b)+        -> Maybe k -> XT a -> MaybeMap m a -> MaybeMap m a+xtMaybe _  Nothing  f m = m { mm_nothing  = f (mm_nothing m) }+xtMaybe tr (Just x) f m = m { mm_just = mm_just m |> tr x f }++fdMaybe :: TrieMap m => (a -> b -> b) -> MaybeMap m a -> b -> b+fdMaybe k m = foldMaybe k (mm_nothing m)+            . foldTM k (mm_just m)++{-+************************************************************************+*                                                                      *+                   Lists+*                                                                      *+************************************************************************+-}++data ListMap m a+  = LM { lm_nil  :: Maybe a+       , lm_cons :: m (ListMap m a) }++instance TrieMap m => TrieMap (ListMap m) where+   type Key (ListMap m) = [Key m]+   emptyTM  = LM { lm_nil = Nothing, lm_cons = emptyTM }+   lookupTM = lkList lookupTM+   alterTM  = xtList alterTM+   foldTM   = fdList+   mapTM    = mapList++instance (TrieMap m, Outputable a) => Outputable (ListMap m a) where+  ppr m = text "List elts" <+> ppr (foldTM (:) m [])++mapList :: TrieMap m => (a->b) -> ListMap m a -> ListMap m b+mapList f (LM { lm_nil = mnil, lm_cons = mcons })+  = LM { lm_nil = fmap f mnil, lm_cons = mapTM (mapTM f) mcons }++lkList :: TrieMap m => (forall b. k -> m b -> Maybe b)+        -> [k] -> ListMap m a -> Maybe a+lkList _  []     = lm_nil+lkList lk (x:xs) = lm_cons >.> lk x >=> lkList lk xs++xtList :: TrieMap m => (forall b. k -> XT b -> m b -> m b)+        -> [k] -> XT a -> ListMap m a -> ListMap m a+xtList _  []     f m = m { lm_nil  = f (lm_nil m) }+xtList tr (x:xs) f m = m { lm_cons = lm_cons m |> tr x |>> xtList tr xs f }++fdList :: forall m a b. TrieMap m+       => (a -> b -> b) -> ListMap m a -> b -> b+fdList k m = foldMaybe k          (lm_nil m)+           . foldTM    (fdList k) (lm_cons m)++foldMaybe :: (a -> b -> b) -> Maybe a -> b -> b+foldMaybe _ Nothing  b = b+foldMaybe k (Just a) b = k a b++{-+************************************************************************+*                                                                      *+                   Basic maps+*                                                                      *+************************************************************************+-}++type LiteralMap  a = Map.Map Literal a++{-+************************************************************************+*                                                                      *+                   GenMap+*                                                                      *+************************************************************************++Note [Compressed TrieMap]+~~~~~~~~~~~~~~~~~~~~~~~~~++The GenMap constructor augments TrieMaps with leaf compression.  This helps+solve the performance problem detailed in #9960: suppose we have a handful+H of entries in a TrieMap, each with a very large key, size K. If you fold over+such a TrieMap you'd expect time O(H). That would certainly be true of an+association list! But with TrieMap we actually have to navigate down a long+singleton structure to get to the elements, so it takes time O(K*H).  This+can really hurt on many type-level computation benchmarks:+see for example T9872d.++The point of a TrieMap is that you need to navigate to the point where only one+key remains, and then things should be fast.  So the point of a SingletonMap+is that, once we are down to a single (key,value) pair, we stop and+just use SingletonMap.++'EmptyMap' provides an even more basic (but essential) optimization: if there is+nothing in the map, don't bother building out the (possibly infinite) recursive+TrieMap structure!++Compressed triemaps are heavily used by CoreMap. So we have to mark some things+as INLINEABLE to permit specialization.+-}++data GenMap m a+   = EmptyMap+   | SingletonMap (Key m) a+   | MultiMap (m a)++instance (Outputable a, Outputable (m a)) => Outputable (GenMap m a) where+  ppr EmptyMap = text "Empty map"+  ppr (SingletonMap _ v) = text "Singleton map" <+> ppr v+  ppr (MultiMap m) = ppr m++-- TODO undecidable instance+instance (Eq (Key m), TrieMap m) => TrieMap (GenMap m) where+   type Key (GenMap m) = Key m+   emptyTM  = EmptyMap+   lookupTM = lkG+   alterTM  = xtG+   foldTM   = fdG+   mapTM    = mapG++--We want to be able to specialize these functions when defining eg+--tries over (GenMap CoreExpr) which requires INLINEABLE++{-# INLINEABLE lkG #-}+lkG :: (Eq (Key m), TrieMap m) => Key m -> GenMap m a -> Maybe a+lkG _ EmptyMap                         = Nothing+lkG k (SingletonMap k' v') | k == k'   = Just v'+                           | otherwise = Nothing+lkG k (MultiMap m)                     = lookupTM k m++{-# INLINEABLE xtG #-}+xtG :: (Eq (Key m), TrieMap m) => Key m -> XT a -> GenMap m a -> GenMap m a+xtG k f EmptyMap+    = case f Nothing of+        Just v  -> SingletonMap k v+        Nothing -> EmptyMap+xtG k f m@(SingletonMap k' v')+    | k' == k+    -- The new key matches the (single) key already in the tree.  Hence,+    -- apply @f@ to @Just v'@ and build a singleton or empty map depending+    -- on the 'Just'/'Nothing' response respectively.+    = case f (Just v') of+        Just v'' -> SingletonMap k' v''+        Nothing  -> EmptyMap+    | otherwise+    -- We've hit a singleton tree for a different key than the one we are+    -- searching for. Hence apply @f@ to @Nothing@. If result is @Nothing@ then+    -- we can just return the old map. If not, we need a map with *two*+    -- entries. The easiest way to do that is to insert two items into an empty+    -- map of type @m a@.+    = case f Nothing of+        Nothing  -> m+        Just v   -> emptyTM |> alterTM k' (const (Just v'))+                           >.> alterTM k  (const (Just v))+                           >.> MultiMap+xtG k f (MultiMap m) = MultiMap (alterTM k f m)++{-# INLINEABLE mapG #-}+mapG :: TrieMap m => (a -> b) -> GenMap m a -> GenMap m b+mapG _ EmptyMap = EmptyMap+mapG f (SingletonMap k v) = SingletonMap k (f v)+mapG f (MultiMap m) = MultiMap (mapTM f m)++{-# INLINEABLE fdG #-}+fdG :: TrieMap m => (a -> b -> b) -> GenMap m a -> b -> b+fdG _ EmptyMap = \z -> z+fdG k (SingletonMap _ v) = \z -> k v z+fdG k (MultiMap m) = foldTM k m
+ compiler/utils/UniqDFM.hs view
@@ -0,0 +1,412 @@+{-+(c) Bartosz Nitka, Facebook, 2015++UniqDFM: Specialised deterministic finite maps, for things with @Uniques@.++Basically, the things need to be in class @Uniquable@, and we use the+@getUnique@ method to grab their @Uniques@.++This is very similar to @UniqFM@, the major difference being that the order of+folding is not dependent on @Unique@ ordering, giving determinism.+Currently the ordering is determined by insertion order.++See Note [Unique Determinism] in Unique for explanation why @Unique@ ordering+is not deterministic.+-}++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -Wall #-}++module UniqDFM (+        -- * Unique-keyed deterministic mappings+        UniqDFM,       -- abstract type++        -- ** Manipulating those mappings+        emptyUDFM,+        unitUDFM,+        addToUDFM,+        addToUDFM_C,+        addListToUDFM,+        delFromUDFM,+        delListFromUDFM,+        adjustUDFM,+        alterUDFM,+        mapUDFM,+        plusUDFM,+        plusUDFM_C,+        lookupUDFM, lookupUDFM_Directly,+        elemUDFM,+        foldUDFM,+        eltsUDFM,+        filterUDFM, filterUDFM_Directly,+        isNullUDFM,+        sizeUDFM,+        intersectUDFM, udfmIntersectUFM,+        intersectsUDFM,+        disjointUDFM, disjointUdfmUfm,+        equalKeysUDFM,+        minusUDFM,+        listToUDFM,+        udfmMinusUFM,+        partitionUDFM,+        anyUDFM, allUDFM,+        pprUniqDFM, pprUDFM,++        udfmToList,+        udfmToUfm,+        nonDetFoldUDFM,+        alwaysUnsafeUfmToUdfm,+    ) where++import GhcPrelude++import Unique           ( Uniquable(..), Unique, getKey )+import Outputable++import qualified Data.IntMap as M+import Data.Data+import Data.Functor.Classes (Eq1 (..))+import Data.List (sortBy)+import Data.Function (on)+import qualified Data.Semigroup as Semi+import UniqFM (UniqFM, listToUFM_Directly, nonDetUFMToList, ufmToIntMap)++-- Note [Deterministic UniqFM]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- A @UniqDFM@ is just like @UniqFM@ with the following additional+-- property: the function `udfmToList` returns the elements in some+-- deterministic order not depending on the Unique key for those elements.+--+-- If the client of the map performs operations on the map in deterministic+-- order then `udfmToList` returns them in deterministic order.+--+-- There is an implementation cost: each element is given a serial number+-- as it is added, and `udfmToList` sorts it's result by this serial+-- number. So you should only use `UniqDFM` if you need the deterministic+-- property.+--+-- `foldUDFM` also preserves determinism.+--+-- Normal @UniqFM@ when you turn it into a list will use+-- Data.IntMap.toList function that returns the elements in the order of+-- the keys. The keys in @UniqFM@ are always @Uniques@, so you end up with+-- with a list ordered by @Uniques@.+-- The order of @Uniques@ is known to be not stable across rebuilds.+-- See Note [Unique Determinism] in Unique.+--+--+-- There's more than one way to implement this. The implementation here tags+-- every value with the insertion time that can later be used to sort the+-- values when asked to convert to a list.+--+-- An alternative would be to have+--+--   data UniqDFM ele = UDFM (M.IntMap ele) [ele]+--+-- where the list determines the order. This makes deletion tricky as we'd+-- only accumulate elements in that list, but makes merging easier as you+-- can just merge both structures independently.+-- Deletion can probably be done in amortized fashion when the size of the+-- list is twice the size of the set.++-- | A type of values tagged with insertion time+data TaggedVal val =+  TaggedVal+    val+    {-# UNPACK #-} !Int -- ^ insertion time+  deriving Data++taggedFst :: TaggedVal val -> val+taggedFst (TaggedVal v _) = v++taggedSnd :: TaggedVal val -> Int+taggedSnd (TaggedVal _ i) = i++instance Eq val => Eq (TaggedVal val) where+  (TaggedVal v1 _) == (TaggedVal v2 _) = v1 == v2++instance Functor TaggedVal where+  fmap f (TaggedVal val i) = TaggedVal (f val) i++-- | Type of unique deterministic finite maps+data UniqDFM ele =+  UDFM+    !(M.IntMap (TaggedVal ele)) -- A map where keys are Unique's values and+                                -- values are tagged with insertion time.+                                -- The invariant is that all the tags will+                                -- be distinct within a single map+    {-# UNPACK #-} !Int         -- Upper bound on the values' insertion+                                -- time. See Note [Overflow on plusUDFM]+  deriving (Data, Functor)++emptyUDFM :: UniqDFM elt+emptyUDFM = UDFM M.empty 0++unitUDFM :: Uniquable key => key -> elt -> UniqDFM elt+unitUDFM k v = UDFM (M.singleton (getKey $ getUnique k) (TaggedVal v 0)) 1++-- The new binding always goes to the right of existing ones+addToUDFM :: Uniquable key => UniqDFM elt -> key -> elt  -> UniqDFM elt+addToUDFM m k v = addToUDFM_Directly m (getUnique k) v++-- The new binding always goes to the right of existing ones+addToUDFM_Directly :: UniqDFM elt -> Unique -> elt -> UniqDFM elt+addToUDFM_Directly (UDFM m i) u v+  = UDFM (M.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1)+  where+    tf (TaggedVal new_v _) (TaggedVal _ old_i) = TaggedVal new_v old_i+      -- Keep the old tag, but insert the new value+      -- This means that udfmToList typically returns elements+      -- in the order of insertion, rather than the reverse++addToUDFM_Directly_C+  :: (elt -> elt -> elt)   -- old -> new -> result+  -> UniqDFM elt+  -> Unique -> elt+  -> UniqDFM elt+addToUDFM_Directly_C f (UDFM m i) u v+  = UDFM (M.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1)+    where+      tf (TaggedVal new_v _) (TaggedVal old_v old_i)+         = TaggedVal (f old_v new_v) old_i+          -- Flip the arguments, because M.insertWith uses  (new->old->result)+          --                         but f            needs (old->new->result)+          -- Like addToUDFM_Directly, keep the old tag++addToUDFM_C+  :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result+  -> UniqDFM elt -- old+  -> key -> elt -- new+  -> UniqDFM elt -- result+addToUDFM_C f m k v = addToUDFM_Directly_C f m (getUnique k) v++addListToUDFM :: Uniquable key => UniqDFM elt -> [(key,elt)] -> UniqDFM elt+addListToUDFM = foldl' (\m (k, v) -> addToUDFM m k v)++addListToUDFM_Directly :: UniqDFM elt -> [(Unique,elt)] -> UniqDFM elt+addListToUDFM_Directly = foldl' (\m (k, v) -> addToUDFM_Directly m k v)++addListToUDFM_Directly_C+  :: (elt -> elt -> elt) -> UniqDFM elt -> [(Unique,elt)] -> UniqDFM elt+addListToUDFM_Directly_C f = foldl' (\m (k, v) -> addToUDFM_Directly_C f m k v)++delFromUDFM :: Uniquable key => UniqDFM elt -> key -> UniqDFM elt+delFromUDFM (UDFM m i) k = UDFM (M.delete (getKey $ getUnique k) m) i++plusUDFM_C :: (elt -> elt -> elt) -> UniqDFM elt -> UniqDFM elt -> UniqDFM elt+plusUDFM_C f udfml@(UDFM _ i) udfmr@(UDFM _ j)+  -- we will use the upper bound on the tag as a proxy for the set size,+  -- to insert the smaller one into the bigger one+  | i > j = insertUDFMIntoLeft_C f udfml udfmr+  | otherwise = insertUDFMIntoLeft_C f udfmr udfml++-- Note [Overflow on plusUDFM]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- There are multiple ways of implementing plusUDFM.+-- The main problem that needs to be solved is overlap on times of+-- insertion between different keys in two maps.+-- Consider:+--+-- A = fromList [(a, (x, 1))]+-- B = fromList [(b, (y, 1))]+--+-- If you merge them naively you end up with:+--+-- C = fromList [(a, (x, 1)), (b, (y, 1))]+--+-- Which loses information about ordering and brings us back into+-- non-deterministic world.+--+-- The solution I considered before would increment the tags on one of the+-- sets by the upper bound of the other set. The problem with this approach+-- is that you'll run out of tags for some merge patterns.+-- Say you start with A with upper bound 1, you merge A with A to get A' and+-- the upper bound becomes 2. You merge A' with A' and the upper bound+-- doubles again. After 64 merges you overflow.+-- This solution would have the same time complexity as plusUFM, namely O(n+m).+--+-- The solution I ended up with has time complexity of+-- O(m log m + m * min (n+m, W)) where m is the smaller set.+-- It simply inserts the elements of the smaller set into the larger+-- set in the order that they were inserted into the smaller set. That's+-- O(m log m) for extracting the elements from the smaller set in the+-- insertion order and O(m * min(n+m, W)) to insert them into the bigger+-- set.++plusUDFM :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt+plusUDFM udfml@(UDFM _ i) udfmr@(UDFM _ j)+  -- we will use the upper bound on the tag as a proxy for the set size,+  -- to insert the smaller one into the bigger one+  | i > j = insertUDFMIntoLeft udfml udfmr+  | otherwise = insertUDFMIntoLeft udfmr udfml++insertUDFMIntoLeft :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt+insertUDFMIntoLeft udfml udfmr = addListToUDFM_Directly udfml $ udfmToList udfmr++insertUDFMIntoLeft_C+  :: (elt -> elt -> elt) -> UniqDFM elt -> UniqDFM elt -> UniqDFM elt+insertUDFMIntoLeft_C f udfml udfmr =+  addListToUDFM_Directly_C f udfml $ udfmToList udfmr++lookupUDFM :: Uniquable key => UniqDFM elt -> key -> Maybe elt+lookupUDFM (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey $ getUnique k) m++lookupUDFM_Directly :: UniqDFM elt -> Unique -> Maybe elt+lookupUDFM_Directly (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey k) m++elemUDFM :: Uniquable key => key -> UniqDFM elt -> Bool+elemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m++-- | Performs a deterministic fold over the UniqDFM.+-- It's O(n log n) while the corresponding function on `UniqFM` is O(n).+foldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a+foldUDFM k z m = foldr k z (eltsUDFM m)++-- | Performs a nondeterministic fold over the UniqDFM.+-- It's O(n), same as the corresponding function on `UniqFM`.+-- If you use this please provide a justification why it doesn't introduce+-- nondeterminism.+nonDetFoldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a+nonDetFoldUDFM k z (UDFM m _i) = foldr k z $ map taggedFst $ M.elems m++eltsUDFM :: UniqDFM elt -> [elt]+eltsUDFM (UDFM m _i) =+  map taggedFst $ sortBy (compare `on` taggedSnd) $ M.elems m++filterUDFM :: (elt -> Bool) -> UniqDFM elt -> UniqDFM elt+filterUDFM p (UDFM m i) = UDFM (M.filter (\(TaggedVal v _) -> p v) m) i++filterUDFM_Directly :: (Unique -> elt -> Bool) -> UniqDFM elt -> UniqDFM elt+filterUDFM_Directly p (UDFM m i) = UDFM (M.filterWithKey p' m) i+  where+  p' k (TaggedVal v _) = p (getUnique k) v++-- | Converts `UniqDFM` to a list, with elements in deterministic order.+-- It's O(n log n) while the corresponding function on `UniqFM` is O(n).+udfmToList :: UniqDFM elt -> [(Unique, elt)]+udfmToList (UDFM m _i) =+  [ (getUnique k, taggedFst v)+  | (k, v) <- sortBy (compare `on` (taggedSnd . snd)) $ M.toList m ]++-- Determines whether two 'UniqDFM's contain the same keys.+equalKeysUDFM :: UniqDFM a -> UniqDFM b -> Bool+equalKeysUDFM (UDFM m1 _) (UDFM m2 _) = liftEq (\_ _ -> True) m1 m2++isNullUDFM :: UniqDFM elt -> Bool+isNullUDFM (UDFM m _) = M.null m++sizeUDFM :: UniqDFM elt -> Int+sizeUDFM (UDFM m _i) = M.size m++intersectUDFM :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt+intersectUDFM (UDFM x i) (UDFM y _j) = UDFM (M.intersection x y) i+  -- M.intersection is left biased, that means the result will only have+  -- a subset of elements from the left set, so `i` is a good upper bound.++udfmIntersectUFM :: UniqDFM elt1 -> UniqFM elt2 -> UniqDFM elt1+udfmIntersectUFM (UDFM x i) y = UDFM (M.intersection x (ufmToIntMap y)) i+  -- M.intersection is left biased, that means the result will only have+  -- a subset of elements from the left set, so `i` is a good upper bound.++intersectsUDFM :: UniqDFM elt -> UniqDFM elt -> Bool+intersectsUDFM x y = isNullUDFM (x `intersectUDFM` y)++disjointUDFM :: UniqDFM elt -> UniqDFM elt -> Bool+disjointUDFM (UDFM x _i) (UDFM y _j) = M.null (M.intersection x y)++disjointUdfmUfm :: UniqDFM elt -> UniqFM elt2 -> Bool+disjointUdfmUfm (UDFM x _i) y = M.null (M.intersection x (ufmToIntMap y))++minusUDFM :: UniqDFM elt1 -> UniqDFM elt2 -> UniqDFM elt1+minusUDFM (UDFM x i) (UDFM y _j) = UDFM (M.difference x y) i+  -- M.difference returns a subset of a left set, so `i` is a good upper+  -- bound.++udfmMinusUFM :: UniqDFM elt1 -> UniqFM elt2 -> UniqDFM elt1+udfmMinusUFM (UDFM x i) y = UDFM (M.difference x (ufmToIntMap y)) i+  -- M.difference returns a subset of a left set, so `i` is a good upper+  -- bound.++-- | Partition UniqDFM into two UniqDFMs according to the predicate+partitionUDFM :: (elt -> Bool) -> UniqDFM elt -> (UniqDFM elt, UniqDFM elt)+partitionUDFM p (UDFM m i) =+  case M.partition (p . taggedFst) m of+    (left, right) -> (UDFM left i, UDFM right i)++-- | Delete a list of elements from a UniqDFM+delListFromUDFM  :: Uniquable key => UniqDFM elt -> [key] -> UniqDFM elt+delListFromUDFM = foldl' delFromUDFM++-- | This allows for lossy conversion from UniqDFM to UniqFM+udfmToUfm :: UniqDFM elt -> UniqFM elt+udfmToUfm (UDFM m _i) =+  listToUFM_Directly [(getUnique k, taggedFst tv) | (k, tv) <- M.toList m]++listToUDFM :: Uniquable key => [(key,elt)] -> UniqDFM elt+listToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) emptyUDFM++listToUDFM_Directly :: [(Unique, elt)] -> UniqDFM elt+listToUDFM_Directly = foldl' (\m (u, v) -> addToUDFM_Directly m u v) emptyUDFM++-- | Apply a function to a particular element+adjustUDFM :: Uniquable key => (elt -> elt) -> UniqDFM elt -> key -> UniqDFM elt+adjustUDFM f (UDFM m i) k = UDFM (M.adjust (fmap f) (getKey $ getUnique k) m) i++-- | The expression (alterUDFM f k map) alters value x at k, or absence+-- thereof. alterUDFM can be used to insert, delete, or update a value in+-- UniqDFM. Use addToUDFM, delFromUDFM or adjustUDFM when possible, they are+-- more efficient.+alterUDFM+  :: Uniquable key+  => (Maybe elt -> Maybe elt)  -- How to adjust+  -> UniqDFM elt               -- old+  -> key                       -- new+  -> UniqDFM elt               -- result+alterUDFM f (UDFM m i) k =+  UDFM (M.alter alterf (getKey $ getUnique k) m) (i + 1)+  where+  alterf Nothing = inject $ f Nothing+  alterf (Just (TaggedVal v _)) = inject $ f (Just v)+  inject Nothing = Nothing+  inject (Just v) = Just $ TaggedVal v i++-- | Map a function over every value in a UniqDFM+mapUDFM :: (elt1 -> elt2) -> UniqDFM elt1 -> UniqDFM elt2+mapUDFM f (UDFM m i) = UDFM (M.map (fmap f) m) i++anyUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool+anyUDFM p (UDFM m _i) = M.foldr ((||) . p . taggedFst) False m++allUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool+allUDFM p (UDFM m _i) = M.foldr ((&&) . p . taggedFst) True m++instance Semi.Semigroup (UniqDFM a) where+  (<>) = plusUDFM++instance Monoid (UniqDFM a) where+  mempty = emptyUDFM+  mappend = (Semi.<>)++-- This should not be used in commited code, provided for convenience to+-- make ad-hoc conversions when developing+alwaysUnsafeUfmToUdfm :: UniqFM elt -> UniqDFM elt+alwaysUnsafeUfmToUdfm = listToUDFM_Directly . nonDetUFMToList++-- Output-ery++instance Outputable a => Outputable (UniqDFM a) where+    ppr ufm = pprUniqDFM ppr ufm++pprUniqDFM :: (a -> SDoc) -> UniqDFM a -> SDoc+pprUniqDFM ppr_elt ufm+  = brackets $ fsep $ punctuate comma $+    [ ppr uq <+> text ":->" <+> ppr_elt elt+    | (uq, elt) <- udfmToList ufm ]++pprUDFM :: UniqDFM a    -- ^ The things to be pretty printed+       -> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements+       -> SDoc          -- ^ 'SDoc' where the things have been pretty+                        -- printed+pprUDFM ufm pp = pp (eltsUDFM ufm)
+ compiler/utils/UniqDSet.hs view
@@ -0,0 +1,141 @@+-- (c) Bartosz Nitka, Facebook, 2015++-- |+-- Specialised deterministic sets, for things with @Uniques@+--+-- Based on 'UniqDFM's (as you would expect).+-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need it.+--+-- Basically, the things need to be in class 'Uniquable'.++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}++module UniqDSet (+        -- * Unique set type+        UniqDSet,    -- type synonym for UniqFM a+        getUniqDSet,+        pprUniqDSet,++        -- ** Manipulating these sets+        delOneFromUniqDSet, delListFromUniqDSet,+        emptyUniqDSet,+        unitUniqDSet,+        mkUniqDSet,+        addOneToUniqDSet, addListToUniqDSet,+        unionUniqDSets, unionManyUniqDSets,+        minusUniqDSet, uniqDSetMinusUniqSet,+        intersectUniqDSets, uniqDSetIntersectUniqSet,+        foldUniqDSet,+        elementOfUniqDSet,+        filterUniqDSet,+        sizeUniqDSet,+        isEmptyUniqDSet,+        lookupUniqDSet,+        uniqDSetToList,+        partitionUniqDSet,+        mapUniqDSet+    ) where++import GhcPrelude++import Outputable+import UniqDFM+import UniqSet+import Unique++import Data.Coerce+import Data.Data+import qualified Data.Semigroup as Semi++-- See Note [UniqSet invariant] in UniqSet.hs for why we want a newtype here.+-- Beyond preserving invariants, we may also want to 'override' typeclass+-- instances.++newtype UniqDSet a = UniqDSet {getUniqDSet' :: UniqDFM a}+                   deriving (Data, Semi.Semigroup, Monoid)++emptyUniqDSet :: UniqDSet a+emptyUniqDSet = UniqDSet emptyUDFM++unitUniqDSet :: Uniquable a => a -> UniqDSet a+unitUniqDSet x = UniqDSet (unitUDFM x x)++mkUniqDSet :: Uniquable a => [a] -> UniqDSet a+mkUniqDSet = foldl' addOneToUniqDSet emptyUniqDSet++-- The new element always goes to the right of existing ones.+addOneToUniqDSet :: Uniquable a => UniqDSet a -> a -> UniqDSet a+addOneToUniqDSet (UniqDSet set) x = UniqDSet (addToUDFM set x x)++addListToUniqDSet :: Uniquable a => UniqDSet a -> [a] -> UniqDSet a+addListToUniqDSet = foldl' addOneToUniqDSet++delOneFromUniqDSet :: Uniquable a => UniqDSet a -> a -> UniqDSet a+delOneFromUniqDSet (UniqDSet s) = UniqDSet . delFromUDFM s++delListFromUniqDSet :: Uniquable a => UniqDSet a -> [a] -> UniqDSet a+delListFromUniqDSet (UniqDSet s) = UniqDSet . delListFromUDFM s++unionUniqDSets :: UniqDSet a -> UniqDSet a -> UniqDSet a+unionUniqDSets (UniqDSet s) (UniqDSet t) = UniqDSet (plusUDFM s t)++unionManyUniqDSets :: [UniqDSet a] -> UniqDSet a+unionManyUniqDSets [] = emptyUniqDSet+unionManyUniqDSets sets = foldr1 unionUniqDSets sets++minusUniqDSet :: UniqDSet a -> UniqDSet a -> UniqDSet a+minusUniqDSet (UniqDSet s) (UniqDSet t) = UniqDSet (minusUDFM s t)++uniqDSetMinusUniqSet :: UniqDSet a -> UniqSet b -> UniqDSet a+uniqDSetMinusUniqSet xs ys+  = UniqDSet (udfmMinusUFM (getUniqDSet xs) (getUniqSet ys))++intersectUniqDSets :: UniqDSet a -> UniqDSet a -> UniqDSet a+intersectUniqDSets (UniqDSet s) (UniqDSet t) = UniqDSet (intersectUDFM s t)++uniqDSetIntersectUniqSet :: UniqDSet a -> UniqSet b -> UniqDSet a+uniqDSetIntersectUniqSet xs ys+  = UniqDSet (udfmIntersectUFM (getUniqDSet xs) (getUniqSet ys))++foldUniqDSet :: (a -> b -> b) -> b -> UniqDSet a -> b+foldUniqDSet c n (UniqDSet s) = foldUDFM c n s++elementOfUniqDSet :: Uniquable a => a -> UniqDSet a -> Bool+elementOfUniqDSet k = elemUDFM k . getUniqDSet++filterUniqDSet :: (a -> Bool) -> UniqDSet a -> UniqDSet a+filterUniqDSet p (UniqDSet s) = UniqDSet (filterUDFM p s)++sizeUniqDSet :: UniqDSet a -> Int+sizeUniqDSet = sizeUDFM . getUniqDSet++isEmptyUniqDSet :: UniqDSet a -> Bool+isEmptyUniqDSet = isNullUDFM . getUniqDSet++lookupUniqDSet :: Uniquable a => UniqDSet a -> a -> Maybe a+lookupUniqDSet = lookupUDFM . getUniqDSet++uniqDSetToList :: UniqDSet a -> [a]+uniqDSetToList = eltsUDFM . getUniqDSet++partitionUniqDSet :: (a -> Bool) -> UniqDSet a -> (UniqDSet a, UniqDSet a)+partitionUniqDSet p = coerce . partitionUDFM p . getUniqDSet++-- See Note [UniqSet invariant] in UniqSet.hs+mapUniqDSet :: Uniquable b => (a -> b) -> UniqDSet a -> UniqDSet b+mapUniqDSet f = mkUniqDSet . map f . uniqDSetToList++-- Two 'UniqDSet's are considered equal if they contain the same+-- uniques.+instance Eq (UniqDSet a) where+  UniqDSet a == UniqDSet b = equalKeysUDFM a b++getUniqDSet :: UniqDSet a -> UniqDFM a+getUniqDSet = getUniqDSet'++instance Outputable a => Outputable (UniqDSet a) where+  ppr = pprUniqDSet ppr++pprUniqDSet :: (a -> SDoc) -> UniqDSet a -> SDoc+pprUniqDSet f = braces . pprWithCommas f . uniqDSetToList
+ compiler/utils/UniqFM.hs view
@@ -0,0 +1,393 @@+{-+(c) The University of Glasgow 2006+(c) The AQUA Project, Glasgow University, 1994-1998+++UniqFM: Specialised finite maps, for things with @Uniques@.++Basically, the things need to be in class @Uniquable@, and we use the+@getUnique@ method to grab their @Uniques@.++(A similar thing to @UniqSet@, as opposed to @Set@.)++The interface is based on @FiniteMap@s, but the implementation uses+@Data.IntMap@, which is both maintained and faster than the past+implementation (see commit log).++The @UniqFM@ interface maps directly to Data.IntMap, only+``Data.IntMap.union'' is left-biased and ``plusUFM'' right-biased+and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order+of arguments of combining function.+-}++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -Wall #-}++module UniqFM (+        -- * Unique-keyed mappings+        UniqFM,       -- abstract type++        -- ** Manipulating those mappings+        emptyUFM,+        unitUFM,+        unitDirectlyUFM,+        listToUFM,+        listToUFM_Directly,+        listToUFM_C,+        addToUFM,addToUFM_C,addToUFM_Acc,+        addListToUFM,addListToUFM_C,+        addToUFM_Directly,+        addListToUFM_Directly,+        adjustUFM, alterUFM,+        adjustUFM_Directly,+        delFromUFM,+        delFromUFM_Directly,+        delListFromUFM,+        delListFromUFM_Directly,+        plusUFM,+        plusUFM_C,+        plusUFM_CD,+        plusMaybeUFM_C,+        plusUFMList,+        minusUFM,+        intersectUFM,+        intersectUFM_C,+        disjointUFM,+        equalKeysUFM,+        nonDetFoldUFM, foldUFM, nonDetFoldUFM_Directly,+        anyUFM, allUFM, seqEltsUFM,+        mapUFM, mapUFM_Directly,+        elemUFM, elemUFM_Directly,+        filterUFM, filterUFM_Directly, partitionUFM,+        sizeUFM,+        isNullUFM,+        lookupUFM, lookupUFM_Directly,+        lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,+        nonDetEltsUFM, eltsUFM, nonDetKeysUFM,+        ufmToSet_Directly,+        nonDetUFMToList, ufmToIntMap,+        pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM+    ) where++import GhcPrelude++import Unique           ( Uniquable(..), Unique, getKey )+import Outputable++import qualified Data.IntMap as M+import qualified Data.IntSet as S+import Data.Data+import qualified Data.Semigroup as Semi+import Data.Functor.Classes (Eq1 (..))+++newtype UniqFM ele = UFM (M.IntMap ele)+  deriving (Data, Eq, Functor)+  -- We used to derive Traversable and Foldable, but they were nondeterministic+  -- and not obvious at the call site. You can use explicit nonDetEltsUFM+  -- and fold a list if needed.+  -- See Note [Deterministic UniqFM] in UniqDFM to learn about determinism.++emptyUFM :: UniqFM elt+emptyUFM = UFM M.empty++isNullUFM :: UniqFM elt -> Bool+isNullUFM (UFM m) = M.null m++unitUFM :: Uniquable key => key -> elt -> UniqFM elt+unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v)++-- when you've got the Unique already+unitDirectlyUFM :: Unique -> elt -> UniqFM elt+unitDirectlyUFM u v = UFM (M.singleton (getKey u) v)++listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt+listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM++listToUFM_Directly :: [(Unique, elt)] -> UniqFM elt+listToUFM_Directly = foldl' (\m (u, v) -> addToUFM_Directly m u v) emptyUFM++listToUFM_C+  :: Uniquable key+  => (elt -> elt -> elt)+  -> [(key, elt)]+  -> UniqFM elt+listToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) emptyUFM++addToUFM :: Uniquable key => UniqFM elt -> key -> elt  -> UniqFM elt+addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m)++addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt+addListToUFM = foldl' (\m (k, v) -> addToUFM m k v)++addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt+addListToUFM_Directly = foldl' (\m (k, v) -> addToUFM_Directly m k v)++addToUFM_Directly :: UniqFM elt -> Unique -> elt -> UniqFM elt+addToUFM_Directly (UFM m) u v = UFM (M.insert (getKey u) v m)++addToUFM_C+  :: Uniquable key+  => (elt -> elt -> elt)  -- old -> new -> result+  -> UniqFM elt           -- old+  -> key -> elt           -- new+  -> UniqFM elt           -- result+-- Arguments of combining function of M.insertWith and addToUFM_C are flipped.+addToUFM_C f (UFM m) k v =+  UFM (M.insertWith (flip f) (getKey $ getUnique k) v m)++addToUFM_Acc+  :: Uniquable key+  => (elt -> elts -> elts)  -- Add to existing+  -> (elt -> elts)          -- New element+  -> UniqFM elts            -- old+  -> key -> elt             -- new+  -> UniqFM elts            -- result+addToUFM_Acc exi new (UFM m) k v =+  UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m)++alterUFM+  :: Uniquable key+  => (Maybe elt -> Maybe elt)  -- How to adjust+  -> UniqFM elt                -- old+  -> key                       -- new+  -> UniqFM elt                -- result+alterUFM f (UFM m) k = UFM (M.alter f (getKey $ getUnique k) m)++addListToUFM_C+  :: Uniquable key+  => (elt -> elt -> elt)+  -> UniqFM elt -> [(key,elt)]+  -> UniqFM elt+addListToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v)++adjustUFM :: Uniquable key => (elt -> elt) -> UniqFM elt -> key -> UniqFM elt+adjustUFM f (UFM m) k = UFM (M.adjust f (getKey $ getUnique k) m)++adjustUFM_Directly :: (elt -> elt) -> UniqFM elt -> Unique -> UniqFM elt+adjustUFM_Directly f (UFM m) u = UFM (M.adjust f (getKey u) m)++delFromUFM :: Uniquable key => UniqFM elt -> key    -> UniqFM elt+delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m)++delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt+delListFromUFM = foldl' delFromUFM++delListFromUFM_Directly :: UniqFM elt -> [Unique] -> UniqFM elt+delListFromUFM_Directly = foldl' delFromUFM_Directly++delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt+delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)++-- Bindings in right argument shadow those in the left+plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt+-- M.union is left-biased, plusUFM should be right-biased.+plusUFM (UFM x) (UFM y) = UFM (M.union y x)+     -- Note (M.union y x), with arguments flipped+     -- M.union is left-biased, plusUFM should be right-biased.++plusUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> UniqFM elt -> UniqFM elt+plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)++-- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the+-- combinding function and `d1` resp. `d2` as the default value if+-- there is no entry in `m1` reps. `m2`. The domain is the union of+-- the domains of `m1` and `m2`.+--+-- Representative example:+--+-- @+-- plusUFM_CD f {A: 1, B: 2} 23 {B: 3, C: 4} 42+--    == {A: f 1 42, B: f 2 3, C: f 23 4 }+-- @+plusUFM_CD+  :: (elt -> elt -> elt)+  -> UniqFM elt  -- map X+  -> elt         -- default for X+  -> UniqFM elt  -- map Y+  -> elt         -- default for Y+  -> UniqFM elt+plusUFM_CD f (UFM xm) dx (UFM ym) dy+  = UFM $ M.mergeWithKey+      (\_ x y -> Just (x `f` y))+      (M.map (\x -> x `f` dy))+      (M.map (\y -> dx `f` y))+      xm ym++plusMaybeUFM_C :: (elt -> elt -> Maybe elt)+               -> UniqFM elt -> UniqFM elt -> UniqFM elt+plusMaybeUFM_C f (UFM xm) (UFM ym)+    = UFM $ M.mergeWithKey+        (\_ x y -> x `f` y)+        id+        id+        xm ym++plusUFMList :: [UniqFM elt] -> UniqFM elt+plusUFMList = foldl' plusUFM emptyUFM++minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1+minusUFM (UFM x) (UFM y) = UFM (M.difference x y)++intersectUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1+intersectUFM (UFM x) (UFM y) = UFM (M.intersection x y)++intersectUFM_C+  :: (elt1 -> elt2 -> elt3)+  -> UniqFM elt1+  -> UniqFM elt2+  -> UniqFM elt3+intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)++disjointUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool+disjointUFM (UFM x) (UFM y) = M.null (M.intersection x y)++foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a+foldUFM k z (UFM m) = M.foldr k z m++mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2+mapUFM f (UFM m) = UFM (M.map f m)++mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2+mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m)++filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt+filterUFM p (UFM m) = UFM (M.filter p m)++filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt+filterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . getUnique) m)++partitionUFM :: (elt -> Bool) -> UniqFM elt -> (UniqFM elt, UniqFM elt)+partitionUFM p (UFM m) =+  case M.partition p m of+    (left, right) -> (UFM left, UFM right)++sizeUFM :: UniqFM elt -> Int+sizeUFM (UFM m) = M.size m++elemUFM :: Uniquable key => key -> UniqFM elt -> Bool+elemUFM k (UFM m) = M.member (getKey $ getUnique k) m++elemUFM_Directly :: Unique -> UniqFM elt -> Bool+elemUFM_Directly u (UFM m) = M.member (getKey u) m++lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt+lookupUFM (UFM m) k = M.lookup (getKey $ getUnique k) m++-- when you've got the Unique already+lookupUFM_Directly :: UniqFM elt -> Unique -> Maybe elt+lookupUFM_Directly (UFM m) u = M.lookup (getKey u) m++lookupWithDefaultUFM :: Uniquable key => UniqFM elt -> elt -> key -> elt+lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m++lookupWithDefaultUFM_Directly :: UniqFM elt -> elt -> Unique -> elt+lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m++eltsUFM :: UniqFM elt -> [elt]+eltsUFM (UFM m) = M.elems m++ufmToSet_Directly :: UniqFM elt -> S.IntSet+ufmToSet_Directly (UFM m) = M.keysSet m++anyUFM :: (elt -> Bool) -> UniqFM elt -> Bool+anyUFM p (UFM m) = M.foldr ((||) . p) False m++allUFM :: (elt -> Bool) -> UniqFM elt -> Bool+allUFM p (UFM m) = M.foldr ((&&) . p) True m++seqEltsUFM :: ([elt] -> ()) -> UniqFM elt -> ()+seqEltsUFM seqList = seqList . nonDetEltsUFM+  -- It's OK to use nonDetEltsUFM here because the type guarantees that+  -- the only interesting thing this function can do is to force the+  -- elements.++-- See Note [Deterministic UniqFM] to learn about nondeterminism.+-- If you use this please provide a justification why it doesn't introduce+-- nondeterminism.+nonDetEltsUFM :: UniqFM elt -> [elt]+nonDetEltsUFM (UFM m) = M.elems m++-- See Note [Deterministic UniqFM] to learn about nondeterminism.+-- If you use this please provide a justification why it doesn't introduce+-- nondeterminism.+nonDetKeysUFM :: UniqFM elt -> [Unique]+nonDetKeysUFM (UFM m) = map getUnique $ M.keys m++-- See Note [Deterministic UniqFM] to learn about nondeterminism.+-- If you use this please provide a justification why it doesn't introduce+-- nondeterminism.+nonDetFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a+nonDetFoldUFM k z (UFM m) = M.foldr k z m++-- See Note [Deterministic UniqFM] to learn about nondeterminism.+-- If you use this please provide a justification why it doesn't introduce+-- nondeterminism.+nonDetFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a+nonDetFoldUFM_Directly k z (UFM m) = M.foldrWithKey (k . getUnique) z m++-- See Note [Deterministic UniqFM] to learn about nondeterminism.+-- If you use this please provide a justification why it doesn't introduce+-- nondeterminism.+nonDetUFMToList :: UniqFM elt -> [(Unique, elt)]+nonDetUFMToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m++ufmToIntMap :: UniqFM elt -> M.IntMap elt+ufmToIntMap (UFM m) = m++-- Determines whether two 'UniqFM's contain the same keys.+equalKeysUFM :: UniqFM a -> UniqFM b -> Bool+equalKeysUFM (UFM m1) (UFM m2) = liftEq (\_ _ -> True) m1 m2++-- Instances++instance Semi.Semigroup (UniqFM a) where+  (<>) = plusUFM++instance Monoid (UniqFM a) where+    mempty = emptyUFM+    mappend = (Semi.<>)++-- Output-ery++instance Outputable a => Outputable (UniqFM a) where+    ppr ufm = pprUniqFM ppr ufm++pprUniqFM :: (a -> SDoc) -> UniqFM a -> SDoc+pprUniqFM ppr_elt ufm+  = brackets $ fsep $ punctuate comma $+    [ ppr uq <+> text ":->" <+> ppr_elt elt+    | (uq, elt) <- nonDetUFMToList ufm ]+  -- It's OK to use nonDetUFMToList here because we only use it for+  -- pretty-printing.++-- | Pretty-print a non-deterministic set.+-- The order of variables is non-deterministic and for pretty-printing that+-- shouldn't be a problem.+-- Having this function helps contain the non-determinism created with+-- nonDetEltsUFM.+pprUFM :: UniqFM a      -- ^ The things to be pretty printed+       -> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements+       -> SDoc          -- ^ 'SDoc' where the things have been pretty+                        -- printed+pprUFM ufm pp = pp (nonDetEltsUFM ufm)++-- | Pretty-print a non-deterministic set.+-- The order of variables is non-deterministic and for pretty-printing that+-- shouldn't be a problem.+-- Having this function helps contain the non-determinism created with+-- nonDetUFMToList.+pprUFMWithKeys+       :: UniqFM a                -- ^ The things to be pretty printed+       -> ([(Unique, a)] -> SDoc) -- ^ The pretty printing function to use on the elements+       -> SDoc                    -- ^ 'SDoc' where the things have been pretty+                                  -- printed+pprUFMWithKeys ufm pp = pp (nonDetUFMToList ufm)++-- | Determines the pluralisation suffix appropriate for the length of a set+-- in the same way that plural from Outputable does for lists.+pluralUFM :: UniqFM a -> SDoc+pluralUFM ufm+  | sizeUFM ufm == 1 = empty+  | otherwise = char 's'
+ compiler/utils/UniqSet.hs view
@@ -0,0 +1,195 @@+{-+(c) The University of Glasgow 2006+(c) The AQUA Project, Glasgow University, 1994-1998++\section[UniqSet]{Specialised sets, for things with @Uniques@}++Based on @UniqFMs@ (as you would expect).++Basically, the things need to be in class @Uniquable@.+-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}++module UniqSet (+        -- * Unique set type+        UniqSet,    -- type synonym for UniqFM a+        getUniqSet,+        pprUniqSet,++        -- ** Manipulating these sets+        emptyUniqSet,+        unitUniqSet,+        mkUniqSet,+        addOneToUniqSet, addListToUniqSet,+        delOneFromUniqSet, delOneFromUniqSet_Directly, delListFromUniqSet,+        delListFromUniqSet_Directly,+        unionUniqSets, unionManyUniqSets,+        minusUniqSet, uniqSetMinusUFM,+        intersectUniqSets,+        restrictUniqSetToUFM,+        uniqSetAny, uniqSetAll,+        elementOfUniqSet,+        elemUniqSet_Directly,+        filterUniqSet,+        filterUniqSet_Directly,+        sizeUniqSet,+        isEmptyUniqSet,+        lookupUniqSet,+        lookupUniqSet_Directly,+        partitionUniqSet,+        mapUniqSet,+        unsafeUFMToUniqSet,+        nonDetEltsUniqSet,+        nonDetKeysUniqSet,+        nonDetFoldUniqSet,+        nonDetFoldUniqSet_Directly+    ) where++import GhcPrelude++import UniqFM+import Unique+import Data.Coerce+import Outputable+import Data.Data+import qualified Data.Semigroup as Semi++-- Note [UniqSet invariant]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~+-- UniqSet has the following invariant:+--   The keys in the map are the uniques of the values+-- It means that to implement mapUniqSet you have to update+-- both the keys and the values.++newtype UniqSet a = UniqSet {getUniqSet' :: UniqFM a}+                  deriving (Data, Semi.Semigroup, Monoid)++emptyUniqSet :: UniqSet a+emptyUniqSet = UniqSet emptyUFM++unitUniqSet :: Uniquable a => a -> UniqSet a+unitUniqSet x = UniqSet $ unitUFM x x++mkUniqSet :: Uniquable a => [a]  -> UniqSet a+mkUniqSet = foldl' addOneToUniqSet emptyUniqSet++addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a+addOneToUniqSet (UniqSet set) x = UniqSet (addToUFM set x x)++addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a+addListToUniqSet = foldl' addOneToUniqSet++delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a+delOneFromUniqSet (UniqSet s) a = UniqSet (delFromUFM s a)++delOneFromUniqSet_Directly :: UniqSet a -> Unique -> UniqSet a+delOneFromUniqSet_Directly (UniqSet s) u = UniqSet (delFromUFM_Directly s u)++delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a+delListFromUniqSet (UniqSet s) l = UniqSet (delListFromUFM s l)++delListFromUniqSet_Directly :: UniqSet a -> [Unique] -> UniqSet a+delListFromUniqSet_Directly (UniqSet s) l =+    UniqSet (delListFromUFM_Directly s l)++unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a+unionUniqSets (UniqSet s) (UniqSet t) = UniqSet (plusUFM s t)++unionManyUniqSets :: [UniqSet a] -> UniqSet a+unionManyUniqSets = foldl' (flip unionUniqSets) emptyUniqSet++minusUniqSet  :: UniqSet a -> UniqSet a -> UniqSet a+minusUniqSet (UniqSet s) (UniqSet t) = UniqSet (minusUFM s t)++intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a+intersectUniqSets (UniqSet s) (UniqSet t) = UniqSet (intersectUFM s t)++restrictUniqSetToUFM :: UniqSet a -> UniqFM b -> UniqSet a+restrictUniqSetToUFM (UniqSet s) m = UniqSet (intersectUFM s m)++uniqSetMinusUFM :: UniqSet a -> UniqFM b -> UniqSet a+uniqSetMinusUFM (UniqSet s) t = UniqSet (minusUFM s t)++elementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool+elementOfUniqSet a (UniqSet s) = elemUFM a s++elemUniqSet_Directly :: Unique -> UniqSet a -> Bool+elemUniqSet_Directly a (UniqSet s) = elemUFM_Directly a s++filterUniqSet :: (a -> Bool) -> UniqSet a -> UniqSet a+filterUniqSet p (UniqSet s) = UniqSet (filterUFM p s)++filterUniqSet_Directly :: (Unique -> elt -> Bool) -> UniqSet elt -> UniqSet elt+filterUniqSet_Directly f (UniqSet s) = UniqSet (filterUFM_Directly f s)++partitionUniqSet :: (a -> Bool) -> UniqSet a -> (UniqSet a, UniqSet a)+partitionUniqSet p (UniqSet s) = coerce (partitionUFM p s)++uniqSetAny :: (a -> Bool) -> UniqSet a -> Bool+uniqSetAny p (UniqSet s) = anyUFM p s++uniqSetAll :: (a -> Bool) -> UniqSet a -> Bool+uniqSetAll p (UniqSet s) = allUFM p s++sizeUniqSet :: UniqSet a -> Int+sizeUniqSet (UniqSet s) = sizeUFM s++isEmptyUniqSet :: UniqSet a -> Bool+isEmptyUniqSet (UniqSet s) = isNullUFM s++lookupUniqSet :: Uniquable a => UniqSet b -> a -> Maybe b+lookupUniqSet (UniqSet s) k = lookupUFM s k++lookupUniqSet_Directly :: UniqSet a -> Unique -> Maybe a+lookupUniqSet_Directly (UniqSet s) k = lookupUFM_Directly s k++-- See Note [Deterministic UniqFM] to learn about nondeterminism.+-- If you use this please provide a justification why it doesn't introduce+-- nondeterminism.+nonDetEltsUniqSet :: UniqSet elt -> [elt]+nonDetEltsUniqSet = nonDetEltsUFM . getUniqSet'++-- See Note [Deterministic UniqFM] to learn about nondeterminism.+-- If you use this please provide a justification why it doesn't introduce+-- nondeterminism.+nonDetKeysUniqSet :: UniqSet elt -> [Unique]+nonDetKeysUniqSet = nonDetKeysUFM . getUniqSet'++-- See Note [Deterministic UniqFM] to learn about nondeterminism.+-- If you use this please provide a justification why it doesn't introduce+-- nondeterminism.+nonDetFoldUniqSet :: (elt -> a -> a) -> a -> UniqSet elt -> a+nonDetFoldUniqSet c n (UniqSet s) = nonDetFoldUFM c n s++-- See Note [Deterministic UniqFM] to learn about nondeterminism.+-- If you use this please provide a justification why it doesn't introduce+-- nondeterminism.+nonDetFoldUniqSet_Directly:: (Unique -> elt -> a -> a) -> a -> UniqSet elt -> a+nonDetFoldUniqSet_Directly f n (UniqSet s) = nonDetFoldUFM_Directly f n s++-- See Note [UniqSet invariant]+mapUniqSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b+mapUniqSet f = mkUniqSet . map f . nonDetEltsUniqSet++-- Two 'UniqSet's are considered equal if they contain the same+-- uniques.+instance Eq (UniqSet a) where+  UniqSet a == UniqSet b = equalKeysUFM a b++getUniqSet :: UniqSet a -> UniqFM a+getUniqSet = getUniqSet'++-- | 'unsafeUFMToUniqSet' converts a @'UniqFM' a@ into a @'UniqSet' a@+-- assuming, without checking, that it maps each 'Unique' to a value+-- that has that 'Unique'. See Note [UniqSet invariant].+unsafeUFMToUniqSet :: UniqFM a -> UniqSet a+unsafeUFMToUniqSet = UniqSet++instance Outputable a => Outputable (UniqSet a) where+    ppr = pprUniqSet ppr++pprUniqSet :: (a -> SDoc) -> UniqSet a -> SDoc+-- It's OK to use nonDetUFMToList here because we only use it for+-- pretty-printing.+pprUniqSet f = braces . pprWithCommas f . nonDetEltsUniqSet
+ compiler/utils/Util.hs view
@@ -0,0 +1,1505 @@+-- (c) The University of Glasgow 2006++{-# LANGUAGE CPP #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TupleSections #-}++-- | Highly random utility functions+--+module Util (+        -- * Flags dependent on the compiler build+        ghciSupported, debugIsOn, ncgDebugIsOn,+        ghciTablesNextToCode,+        isWindowsHost, isDarwinHost,++        -- * General list processing+        zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,+        zipLazy, stretchZipWith, zipWithAndUnzip, zipAndUnzip,++        zipWithLazy, zipWith3Lazy,++        filterByList, filterByLists, partitionByList,++        unzipWith,++        mapFst, mapSnd, chkAppend,+        mapAndUnzip, mapAndUnzip3, mapAccumL2,+        filterOut, partitionWith,++        dropWhileEndLE, spanEnd, last2, lastMaybe,++        foldl1', foldl2, count, countWhile, all2,++        lengthExceeds, lengthIs, lengthIsNot,+        lengthAtLeast, lengthAtMost, lengthLessThan,+        listLengthCmp, atLength,+        equalLength, neLength, compareLength, leLength, ltLength,++        isSingleton, only, singleton,+        notNull, snocView,++        isIn, isn'tIn,++        chunkList,++        changeLast,++        -- * Tuples+        fstOf3, sndOf3, thdOf3,+        firstM, first3M, secondM,+        fst3, snd3, third3,+        uncurry3,+        liftFst, liftSnd,++        -- * List operations controlled by another list+        takeList, dropList, splitAtList, split,+        dropTail, capitalise,++        -- * For loop+        nTimes,++        -- * Sorting+        sortWith, minWith, nubSort, ordNub,++        -- * Comparisons+        isEqual, eqListBy, eqMaybeBy,+        thenCmp, cmpList,+        removeSpaces,+        (<&&>), (<||>),++        -- * Edit distance+        fuzzyMatch, fuzzyLookup,++        -- * Transitive closures+        transitiveClosure,++        -- * Strictness+        seqList,++        -- * Module names+        looksLikeModuleName,+        looksLikePackageName,++        -- * Argument processing+        getCmd, toCmdArgs, toArgs,++        -- * Integers+        exactLog2,++        -- * Floating point+        readRational,+        readHexRational,++        -- * read helpers+        maybeRead, maybeReadFuzzy,++        -- * IO-ish utilities+        doesDirNameExist,+        getModificationUTCTime,+        modificationTimeIfExists,+        withAtomicRename,++        global, consIORef, globalM,+        sharedGlobal, sharedGlobalM,++        -- * Filenames and paths+        Suffix,+        splitLongestPrefix,+        escapeSpaces,+        Direction(..), reslash,+        makeRelativeTo,++        -- * Utils for defining Data instances+        abstractConstr, abstractDataType, mkNoRepType,++        -- * Utils for printing C code+        charToC,++        -- * Hashing+        hashString,++        -- * Call stacks+        HasCallStack,+        HasDebugCallStack,++        -- * Utils for flags+        OverridingBool(..),+        overrideWith,+    ) where++#include "HsVersions.h"++import GhcPrelude++import Exception+import Panic++import Data.Data+import Data.IORef       ( IORef, newIORef, atomicModifyIORef' )+import System.IO.Unsafe ( unsafePerformIO )+import Data.List        hiding (group)++import GHC.Exts+import GHC.Stack (HasCallStack)++import Control.Applicative ( liftA2 )+import Control.Monad    ( liftM, guard )+import Control.Monad.IO.Class ( MonadIO, liftIO )+import GHC.Conc.Sync ( sharedCAF )+import System.IO.Error as IO ( isDoesNotExistError )+import System.Directory ( doesDirectoryExist, getModificationTime, renameFile )+import System.FilePath++import Data.Char        ( isUpper, isAlphaNum, isSpace, chr, ord, isDigit, toUpper+                        , isHexDigit, digitToInt )+import Data.Int+import Data.Ratio       ( (%) )+import Data.Ord         ( comparing )+import Data.Bits+import Data.Word+import qualified Data.IntMap as IM+import qualified Data.Set as Set++import Data.Time++#if defined(DEBUG)+import {-# SOURCE #-} Outputable ( warnPprTrace, text )+#endif++infixr 9 `thenCmp`++{-+************************************************************************+*                                                                      *+\subsection{Is DEBUG on, are we on Windows, etc?}+*                                                                      *+************************************************************************++These booleans are global constants, set by CPP flags.  They allow us to+recompile a single module (this one) to change whether or not debug output+appears. They sometimes let us avoid even running CPP elsewhere.++It's important that the flags are literal constants (True/False). Then,+with -0, tests of the flags in other modules will simplify to the correct+branch of the conditional, thereby dropping debug code altogether when+the flags are off.+-}++ghciSupported :: Bool+#if defined(GHCI)+ghciSupported = True+#else+ghciSupported = False+#endif++debugIsOn :: Bool+#if defined(DEBUG)+debugIsOn = True+#else+debugIsOn = False+#endif++ncgDebugIsOn :: Bool+#if defined(NCG_DEBUG)+ncgDebugIsOn = True+#else+ncgDebugIsOn = False+#endif++ghciTablesNextToCode :: Bool+#if defined(GHCI_TABLES_NEXT_TO_CODE)+ghciTablesNextToCode = True+#else+ghciTablesNextToCode = False+#endif++isWindowsHost :: Bool+#if defined(mingw32_HOST_OS)+isWindowsHost = True+#else+isWindowsHost = False+#endif++isDarwinHost :: Bool+#if defined(darwin_HOST_OS)+isDarwinHost = True+#else+isDarwinHost = False+#endif++{-+************************************************************************+*                                                                      *+\subsection{A for loop}+*                                                                      *+************************************************************************+-}++-- | Compose a function with itself n times.  (nth rather than twice)+nTimes :: Int -> (a -> a) -> (a -> a)+nTimes 0 _ = id+nTimes 1 f = f+nTimes n f = f . nTimes (n-1) f++fstOf3   :: (a,b,c) -> a+sndOf3   :: (a,b,c) -> b+thdOf3   :: (a,b,c) -> c+fstOf3      (a,_,_) =  a+sndOf3      (_,b,_) =  b+thdOf3      (_,_,c) =  c++fst3 :: (a -> d) -> (a, b, c) -> (d, b, c)+fst3 f (a, b, c) = (f a, b, c)++snd3 :: (b -> d) -> (a, b, c) -> (a, d, c)+snd3 f (a, b, c) = (a, f b, c)++third3 :: (c -> d) -> (a, b, c) -> (a, b, d)+third3 f (a, b, c) = (a, b, f c)++uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d+uncurry3 f (a, b, c) = f a b c++liftFst :: (a -> b) -> (a, c) -> (b, c)+liftFst f (a,c) = (f a, c)++liftSnd :: (a -> b) -> (c, a) -> (c, b)+liftSnd f (c,a) = (c, f a)++firstM :: Monad m => (a -> m c) -> (a, b) -> m (c, b)+firstM f (x, y) = liftM (\x' -> (x', y)) (f x)++first3M :: Monad m => (a -> m d) -> (a, b, c) -> m (d, b, c)+first3M f (x, y, z) = liftM (\x' -> (x', y, z)) (f x)++secondM :: Monad m => (b -> m c) -> (a, b) -> m (a, c)+secondM f (x, y) = (x,) <$> f y++{-+************************************************************************+*                                                                      *+\subsection[Utils-lists]{General list processing}+*                                                                      *+************************************************************************+-}++filterOut :: (a->Bool) -> [a] -> [a]+-- ^ Like filter, only it reverses the sense of the test+filterOut _ [] = []+filterOut p (x:xs) | p x       = filterOut p xs+                   | otherwise = x : filterOut p xs++partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])+-- ^ Uses a function to determine which of two output lists an input element should join+partitionWith _ [] = ([],[])+partitionWith f (x:xs) = case f x of+                         Left  b -> (b:bs, cs)+                         Right c -> (bs, c:cs)+    where (bs,cs) = partitionWith f xs++chkAppend :: [a] -> [a] -> [a]+-- Checks for the second argument being empty+-- Used in situations where that situation is common+chkAppend xs ys+  | null ys   = xs+  | otherwise = xs ++ ys++{-+A paranoid @zip@ (and some @zipWith@ friends) that checks the lists+are of equal length.  Alastair Reid thinks this should only happen if+DEBUGging on; hey, why not?+-}++zipEqual        :: String -> [a] -> [b] -> [(a,b)]+zipWithEqual    :: String -> (a->b->c) -> [a]->[b]->[c]+zipWith3Equal   :: String -> (a->b->c->d) -> [a]->[b]->[c]->[d]+zipWith4Equal   :: String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]++#if !defined(DEBUG)+zipEqual      _ = zip+zipWithEqual  _ = zipWith+zipWith3Equal _ = zipWith3+zipWith4Equal _ = zipWith4+#else+zipEqual _   []     []     = []+zipEqual msg (a:as) (b:bs) = (a,b) : zipEqual msg as bs+zipEqual msg _      _      = panic ("zipEqual: unequal lists:"++msg)++zipWithEqual msg z (a:as) (b:bs)=  z a b : zipWithEqual msg z as bs+zipWithEqual _   _ [] []        =  []+zipWithEqual msg _ _ _          =  panic ("zipWithEqual: unequal lists:"++msg)++zipWith3Equal msg z (a:as) (b:bs) (c:cs)+                                =  z a b c : zipWith3Equal msg z as bs cs+zipWith3Equal _   _ [] []  []   =  []+zipWith3Equal msg _ _  _   _    =  panic ("zipWith3Equal: unequal lists:"++msg)++zipWith4Equal msg z (a:as) (b:bs) (c:cs) (d:ds)+                                =  z a b c d : zipWith4Equal msg z as bs cs ds+zipWith4Equal _   _ [] [] [] [] =  []+zipWith4Equal msg _ _  _  _  _  =  panic ("zipWith4Equal: unequal lists:"++msg)+#endif++-- | 'zipLazy' is a kind of 'zip' that is lazy in the second list (observe the ~)+zipLazy :: [a] -> [b] -> [(a,b)]+zipLazy []     _       = []+zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys++-- | 'zipWithLazy' is like 'zipWith' but is lazy in the second list.+-- The length of the output is always the same as the length of the first+-- list.+zipWithLazy :: (a -> b -> c) -> [a] -> [b] -> [c]+zipWithLazy _ []     _       = []+zipWithLazy f (a:as) ~(b:bs) = f a b : zipWithLazy f as bs++-- | 'zipWith3Lazy' is like 'zipWith3' but is lazy in the second and third lists.+-- The length of the output is always the same as the length of the first+-- list.+zipWith3Lazy :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]+zipWith3Lazy _ []     _       _       = []+zipWith3Lazy f (a:as) ~(b:bs) ~(c:cs) = f a b c : zipWith3Lazy f as bs cs++-- | 'filterByList' takes a list of Bools and a list of some elements and+-- filters out these elements for which the corresponding value in the list of+-- Bools is False. This function does not check whether the lists have equal+-- length.+filterByList :: [Bool] -> [a] -> [a]+filterByList (True:bs)  (x:xs) = x : filterByList bs xs+filterByList (False:bs) (_:xs) =     filterByList bs xs+filterByList _          _      = []++-- | 'filterByLists' takes a list of Bools and two lists as input, and+-- outputs a new list consisting of elements from the last two input lists. For+-- each Bool in the list, if it is 'True', then it takes an element from the+-- former list. If it is 'False', it takes an element from the latter list.+-- The elements taken correspond to the index of the Bool in its list.+-- For example:+--+-- @+-- filterByLists [True, False, True, False] \"abcd\" \"wxyz\" = \"axcz\"+-- @+--+-- This function does not check whether the lists have equal length.+filterByLists :: [Bool] -> [a] -> [a] -> [a]+filterByLists (True:bs)  (x:xs) (_:ys) = x : filterByLists bs xs ys+filterByLists (False:bs) (_:xs) (y:ys) = y : filterByLists bs xs ys+filterByLists _          _      _      = []++-- | 'partitionByList' takes a list of Bools and a list of some elements and+-- partitions the list according to the list of Bools. Elements corresponding+-- to 'True' go to the left; elements corresponding to 'False' go to the right.+-- For example, @partitionByList [True, False, True] [1,2,3] == ([1,3], [2])@+-- This function does not check whether the lists have equal+-- length.+partitionByList :: [Bool] -> [a] -> ([a], [a])+partitionByList = go [] []+  where+    go trues falses (True  : bs) (x : xs) = go (x:trues) falses bs xs+    go trues falses (False : bs) (x : xs) = go trues (x:falses) bs xs+    go trues falses _ _ = (reverse trues, reverse falses)++stretchZipWith :: (a -> Bool) -> b -> (a->b->c) -> [a] -> [b] -> [c]+-- ^ @stretchZipWith p z f xs ys@ stretches @ys@ by inserting @z@ in+-- the places where @p@ returns @True@++stretchZipWith _ _ _ []     _ = []+stretchZipWith p z f (x:xs) ys+  | p x       = f x z : stretchZipWith p z f xs ys+  | otherwise = case ys of+                []     -> []+                (y:ys) -> f x y : stretchZipWith p z f xs ys++mapFst :: (a->c) -> [(a,b)] -> [(c,b)]+mapSnd :: (b->c) -> [(a,b)] -> [(a,c)]++mapFst f xys = [(f x, y) | (x,y) <- xys]+mapSnd f xys = [(x, f y) | (x,y) <- xys]++mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c])++mapAndUnzip _ [] = ([], [])+mapAndUnzip f (x:xs)+  = let (r1,  r2)  = f x+        (rs1, rs2) = mapAndUnzip f xs+    in+    (r1:rs1, r2:rs2)++mapAndUnzip3 :: (a -> (b, c, d)) -> [a] -> ([b], [c], [d])++mapAndUnzip3 _ [] = ([], [], [])+mapAndUnzip3 f (x:xs)+  = let (r1,  r2,  r3)  = f x+        (rs1, rs2, rs3) = mapAndUnzip3 f xs+    in+    (r1:rs1, r2:rs2, r3:rs3)++zipWithAndUnzip :: (a -> b -> (c,d)) -> [a] -> [b] -> ([c],[d])+zipWithAndUnzip f (a:as) (b:bs)+  = let (r1,  r2)  = f a b+        (rs1, rs2) = zipWithAndUnzip f as bs+    in+    (r1:rs1, r2:rs2)+zipWithAndUnzip _ _ _ = ([],[])++-- | This has the effect of making the two lists have equal length by dropping+-- the tail of the longer one.+zipAndUnzip :: [a] -> [b] -> ([a],[b])+zipAndUnzip (a:as) (b:bs)+  = let (rs1, rs2) = zipAndUnzip as bs+    in+    (a:rs1, b:rs2)+zipAndUnzip _ _ = ([],[])++mapAccumL2 :: (s1 -> s2 -> a -> (s1, s2, b)) -> s1 -> s2 -> [a] -> (s1, s2, [b])+mapAccumL2 f s1 s2 xs = (s1', s2', ys)+  where ((s1', s2'), ys) = mapAccumL (\(s1, s2) x -> case f s1 s2 x of+                                                       (s1', s2', y) -> ((s1', s2'), y))+                                     (s1, s2) xs++-- | @atLength atLen atEnd ls n@ unravels list @ls@ to position @n@. Precisely:+--+-- @+--  atLength atLenPred atEndPred ls n+--   | n < 0         = atLenPred ls+--   | length ls < n = atEndPred (n - length ls)+--   | otherwise     = atLenPred (drop n ls)+-- @+atLength :: ([a] -> b)   -- Called when length ls >= n, passed (drop n ls)+                         --    NB: arg passed to this function may be []+         -> b            -- Called when length ls <  n+         -> [a]+         -> Int+         -> b+atLength atLenPred atEnd ls0 n0+  | n0 < 0    = atLenPred ls0+  | otherwise = go n0 ls0+  where+    -- go's first arg n >= 0+    go 0 ls     = atLenPred ls+    go _ []     = atEnd           -- n > 0 here+    go n (_:xs) = go (n-1) xs++-- Some special cases of atLength:++-- | @(lengthExceeds xs n) = (length xs > n)@+lengthExceeds :: [a] -> Int -> Bool+lengthExceeds lst n+  | n < 0+  = True+  | otherwise+  = atLength notNull False lst n++-- | @(lengthAtLeast xs n) = (length xs >= n)@+lengthAtLeast :: [a] -> Int -> Bool+lengthAtLeast = atLength (const True) False++-- | @(lengthIs xs n) = (length xs == n)@+lengthIs :: [a] -> Int -> Bool+lengthIs lst n+  | n < 0+  = False+  | otherwise+  = atLength null False lst n++-- | @(lengthIsNot xs n) = (length xs /= n)@+lengthIsNot :: [a] -> Int -> Bool+lengthIsNot lst n+  | n < 0 = True+  | otherwise = atLength notNull True lst n++-- | @(lengthAtMost xs n) = (length xs <= n)@+lengthAtMost :: [a] -> Int -> Bool+lengthAtMost lst n+  | n < 0+  = False+  | otherwise+  = atLength null True lst n++-- | @(lengthLessThan xs n) == (length xs < n)@+lengthLessThan :: [a] -> Int -> Bool+lengthLessThan = atLength (const False) True++listLengthCmp :: [a] -> Int -> Ordering+listLengthCmp = atLength atLen atEnd+ where+  atEnd = LT    -- Not yet seen 'n' elts, so list length is < n.++  atLen []     = EQ+  atLen _      = GT++equalLength :: [a] -> [b] -> Bool+-- ^ True if length xs == length ys+equalLength []     []     = True+equalLength (_:xs) (_:ys) = equalLength xs ys+equalLength _      _      = False++neLength :: [a] -> [b] -> Bool+-- ^ True if length xs /= length ys+neLength []     []     = False+neLength (_:xs) (_:ys) = neLength xs ys+neLength _      _      = True++compareLength :: [a] -> [b] -> Ordering+compareLength []     []     = EQ+compareLength (_:xs) (_:ys) = compareLength xs ys+compareLength []     _      = LT+compareLength _      []     = GT++leLength :: [a] -> [b] -> Bool+-- ^ True if length xs <= length ys+leLength xs ys = case compareLength xs ys of+                   LT -> True+                   EQ -> True+                   GT -> False++ltLength :: [a] -> [b] -> Bool+-- ^ True if length xs < length ys+ltLength xs ys = case compareLength xs ys of+                   LT -> True+                   EQ -> False+                   GT -> False++----------------------------+singleton :: a -> [a]+singleton x = [x]++isSingleton :: [a] -> Bool+isSingleton [_] = True+isSingleton _   = False++notNull :: [a] -> Bool+notNull [] = False+notNull _  = True++only :: [a] -> a+#if defined(DEBUG)+only [a] = a+#else+only (a:_) = a+#endif+only _ = panic "Util: only"++-- Debugging/specialising versions of \tr{elem} and \tr{notElem}++isIn, isn'tIn :: Eq a => String -> a -> [a] -> Bool++# ifndef DEBUG+isIn    _msg x ys = x `elem` ys+isn'tIn _msg x ys = x `notElem` ys++# else /* DEBUG */+isIn msg x ys+  = elem100 0 x ys+  where+    elem100 :: Eq a => Int -> a -> [a] -> Bool+    elem100 _ _ [] = False+    elem100 i x (y:ys)+      | i > 100 = WARN(True, text ("Over-long elem in " ++ msg)) (x `elem` (y:ys))+      | otherwise = x == y || elem100 (i + 1) x ys++isn'tIn msg x ys+  = notElem100 0 x ys+  where+    notElem100 :: Eq a => Int -> a -> [a] -> Bool+    notElem100 _ _ [] =  True+    notElem100 i x (y:ys)+      | i > 100 = WARN(True, text ("Over-long notElem in " ++ msg)) (x `notElem` (y:ys))+      | otherwise = x /= y && notElem100 (i + 1) x ys+# endif /* DEBUG */+++-- | Split a list into chunks of /n/ elements+chunkList :: Int -> [a] -> [[a]]+chunkList _ [] = []+chunkList n xs = as : chunkList n bs where (as,bs) = splitAt n xs++-- | Replace the last element of a list with another element.+changeLast :: [a] -> a -> [a]+changeLast []     _  = panic "changeLast"+changeLast [_]    x  = [x]+changeLast (x:xs) x' = x : changeLast xs x'++{-+************************************************************************+*                                                                      *+\subsubsection{Sort utils}+*                                                                      *+************************************************************************+-}++minWith :: Ord b => (a -> b) -> [a] -> a+minWith get_key xs = ASSERT( not (null xs) )+                     head (sortWith get_key xs)++nubSort :: Ord a => [a] -> [a]+nubSort = Set.toAscList . Set.fromList++-- | Remove duplicates but keep elements in order.+--   O(n * log n)+ordNub :: Ord a => [a] -> [a]+ordNub xs+  = go Set.empty xs+  where+    go _ [] = []+    go s (x:xs)+      | Set.member x s = go s xs+      | otherwise = x : go (Set.insert x s) xs+++{-+************************************************************************+*                                                                      *+\subsection[Utils-transitive-closure]{Transitive closure}+*                                                                      *+************************************************************************++This algorithm for transitive closure is straightforward, albeit quadratic.+-}++transitiveClosure :: (a -> [a])         -- Successor function+                  -> (a -> a -> Bool)   -- Equality predicate+                  -> [a]+                  -> [a]                -- The transitive closure++transitiveClosure succ eq xs+ = go [] xs+ where+   go done []                      = done+   go done (x:xs) | x `is_in` done = go done xs+                  | otherwise      = go (x:done) (succ x ++ xs)++   _ `is_in` []                 = False+   x `is_in` (y:ys) | eq x y    = True+                    | otherwise = x `is_in` ys++{-+************************************************************************+*                                                                      *+\subsection[Utils-accum]{Accumulating}+*                                                                      *+************************************************************************++A combination of foldl with zip.  It works with equal length lists.+-}++foldl2 :: (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc+foldl2 _ z [] [] = z+foldl2 k z (a:as) (b:bs) = foldl2 k (k z a b) as bs+foldl2 _ _ _      _      = panic "Util: foldl2"++all2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool+-- True if the lists are the same length, and+-- all corresponding elements satisfy the predicate+all2 _ []     []     = True+all2 p (x:xs) (y:ys) = p x y && all2 p xs ys+all2 _ _      _      = False++-- Count the number of times a predicate is true++count :: (a -> Bool) -> [a] -> Int+count p = go 0+  where go !n [] = n+        go !n (x:xs) | p x       = go (n+1) xs+                     | otherwise = go n xs++countWhile :: (a -> Bool) -> [a] -> Int+-- Length of an /initial prefix/ of the list satsifying p+countWhile p = go 0+  where go !n (x:xs) | p x = go (n+1) xs+        go !n _            = n++{-+@splitAt@, @take@, and @drop@ but with length of another+list giving the break-off point:+-}++takeList :: [b] -> [a] -> [a]+-- (takeList as bs) trims bs to the be same length+-- as as, unless as is longer in which case it's a no-op+takeList [] _ = []+takeList (_:xs) ls =+   case ls of+     [] -> []+     (y:ys) -> y : takeList xs ys++dropList :: [b] -> [a] -> [a]+dropList [] xs    = xs+dropList _  xs@[] = xs+dropList (_:xs) (_:ys) = dropList xs ys+++splitAtList :: [b] -> [a] -> ([a], [a])+splitAtList [] xs     = ([], xs)+splitAtList _ xs@[]   = (xs, xs)+splitAtList (_:xs) (y:ys) = (y:ys', ys'')+    where+      (ys', ys'') = splitAtList xs ys++-- drop from the end of a list+dropTail :: Int -> [a] -> [a]+-- Specification: dropTail n = reverse . drop n . reverse+-- Better implemention due to Joachim Breitner+-- http://www.joachim-breitner.de/blog/archives/600-On-taking-the-last-n-elements-of-a-list.html+dropTail n xs+  = go (drop n xs) xs+  where+    go (_:ys) (x:xs) = x : go ys xs+    go _      _      = []  -- Stop when ys runs out+                           -- It'll always run out before xs does++-- dropWhile from the end of a list. This is similar to Data.List.dropWhileEnd,+-- but is lazy in the elements and strict in the spine. For reasonably short lists,+-- such as path names and typical lines of text, dropWhileEndLE is generally+-- faster than dropWhileEnd. Its advantage is magnified when the predicate is+-- expensive--using dropWhileEndLE isSpace to strip the space off a line of text+-- is generally much faster than using dropWhileEnd isSpace for that purpose.+-- Specification: dropWhileEndLE p = reverse . dropWhile p . reverse+-- Pay attention to the short-circuit (&&)! The order of its arguments is the only+-- difference between dropWhileEnd and dropWhileEndLE.+dropWhileEndLE :: (a -> Bool) -> [a] -> [a]+dropWhileEndLE p = foldr (\x r -> if null r && p x then [] else x:r) []++-- | @spanEnd p l == reverse (span p (reverse l))@. The first list+-- returns actually comes after the second list (when you look at the+-- input list).+spanEnd :: (a -> Bool) -> [a] -> ([a], [a])+spanEnd p l = go l [] [] l+  where go yes _rev_yes rev_no [] = (yes, reverse rev_no)+        go yes rev_yes  rev_no (x:xs)+          | p x       = go yes (x : rev_yes) rev_no                  xs+          | otherwise = go xs  []            (x : rev_yes ++ rev_no) xs++-- | Get the last two elements in a list. Partial!+{-# INLINE last2 #-}+last2 :: [a] -> (a,a)+last2 = foldl' (\(_,x2) x -> (x2,x)) (partialError,partialError)+  where+    partialError = panic "last2 - list length less than two"++lastMaybe :: [a] -> Maybe a+lastMaybe [] = Nothing+lastMaybe xs = Just $ last xs++-- | Split a list into its last element and the initial part of the list.+-- @snocView xs = Just (init xs, last xs)@ for non-empty lists.+-- @snocView xs = Nothing@ otherwise.+-- Unless both parts of the result are guaranteed to be used+-- prefer separate calls to @last@ + @init@.+-- If you are guaranteed to use both, this will+-- be more efficient.+snocView :: [a] -> Maybe ([a],a)+snocView [] = Nothing+snocView xs+    | (xs,x) <- go xs+    = Just (xs,x)+  where+    go :: [a] -> ([a],a)+    go [x] = ([],x)+    go (x:xs)+        | !(xs',x') <- go xs+        = (x:xs', x')+    go [] = error "impossible"++split :: Char -> String -> [String]+split c s = case rest of+                []     -> [chunk]+                _:rest -> chunk : split c rest+  where (chunk, rest) = break (==c) s++-- | Convert a word to title case by capitalising the first letter+capitalise :: String -> String+capitalise [] = []+capitalise (c:cs) = toUpper c : cs+++{-+************************************************************************+*                                                                      *+\subsection[Utils-comparison]{Comparisons}+*                                                                      *+************************************************************************+-}++isEqual :: Ordering -> Bool+-- Often used in (isEqual (a `compare` b))+isEqual GT = False+isEqual EQ = True+isEqual LT = False++thenCmp :: Ordering -> Ordering -> Ordering+{-# INLINE thenCmp #-}+thenCmp EQ       ordering = ordering+thenCmp ordering _        = ordering++eqListBy :: (a->a->Bool) -> [a] -> [a] -> Bool+eqListBy _  []     []     = True+eqListBy eq (x:xs) (y:ys) = eq x y && eqListBy eq xs ys+eqListBy _  _      _      = False++eqMaybeBy :: (a ->a->Bool) -> Maybe a -> Maybe a -> Bool+eqMaybeBy _  Nothing  Nothing  = True+eqMaybeBy eq (Just x) (Just y) = eq x y+eqMaybeBy _  _        _        = False++cmpList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering+    -- `cmpList' uses a user-specified comparer++cmpList _   []     [] = EQ+cmpList _   []     _  = LT+cmpList _   _      [] = GT+cmpList cmp (a:as) (b:bs)+  = case cmp a b of { EQ -> cmpList cmp as bs; xxx -> xxx }++removeSpaces :: String -> String+removeSpaces = dropWhileEndLE isSpace . dropWhile isSpace++-- Boolean operators lifted to Applicative+(<&&>) :: Applicative f => f Bool -> f Bool -> f Bool+(<&&>) = liftA2 (&&)+infixr 3 <&&> -- same as (&&)++(<||>) :: Applicative f => f Bool -> f Bool -> f Bool+(<||>) = liftA2 (||)+infixr 2 <||> -- same as (||)++{-+************************************************************************+*                                                                      *+\subsection{Edit distance}+*                                                                      *+************************************************************************+-}++-- | Find the "restricted" Damerau-Levenshtein edit distance between two strings.+-- See: <http://en.wikipedia.org/wiki/Damerau-Levenshtein_distance>.+-- Based on the algorithm presented in "A Bit-Vector Algorithm for Computing+-- Levenshtein and Damerau Edit Distances" in PSC'02 (Heikki Hyyro).+-- See http://www.cs.uta.fi/~helmu/pubs/psc02.pdf and+--     http://www.cs.uta.fi/~helmu/pubs/PSCerr.html for an explanation+restrictedDamerauLevenshteinDistance :: String -> String -> Int+restrictedDamerauLevenshteinDistance str1 str2+  = restrictedDamerauLevenshteinDistanceWithLengths m n str1 str2+  where+    m = length str1+    n = length str2++restrictedDamerauLevenshteinDistanceWithLengths+  :: Int -> Int -> String -> String -> Int+restrictedDamerauLevenshteinDistanceWithLengths m n str1 str2+  | m <= n+  = if n <= 32 -- n must be larger so this check is sufficient+    then restrictedDamerauLevenshteinDistance' (undefined :: Word32) m n str1 str2+    else restrictedDamerauLevenshteinDistance' (undefined :: Integer) m n str1 str2++  | otherwise+  = if m <= 32 -- m must be larger so this check is sufficient+    then restrictedDamerauLevenshteinDistance' (undefined :: Word32) n m str2 str1+    else restrictedDamerauLevenshteinDistance' (undefined :: Integer) n m str2 str1++restrictedDamerauLevenshteinDistance'+  :: (Bits bv, Num bv) => bv -> Int -> Int -> String -> String -> Int+restrictedDamerauLevenshteinDistance' _bv_dummy m n str1 str2+  | [] <- str1 = n+  | otherwise  = extractAnswer $+                 foldl' (restrictedDamerauLevenshteinDistanceWorker+                             (matchVectors str1) top_bit_mask vector_mask)+                        (0, 0, m_ones, 0, m) str2+  where+    m_ones@vector_mask = (2 ^ m) - 1+    top_bit_mask = (1 `shiftL` (m - 1)) `asTypeOf` _bv_dummy+    extractAnswer (_, _, _, _, distance) = distance++restrictedDamerauLevenshteinDistanceWorker+      :: (Bits bv, Num bv) => IM.IntMap bv -> bv -> bv+      -> (bv, bv, bv, bv, Int) -> Char -> (bv, bv, bv, bv, Int)+restrictedDamerauLevenshteinDistanceWorker str1_mvs top_bit_mask vector_mask+                                           (pm, d0, vp, vn, distance) char2+  = seq str1_mvs $ seq top_bit_mask $ seq vector_mask $+    seq pm' $ seq d0' $ seq vp' $ seq vn' $+    seq distance'' $ seq char2 $+    (pm', d0', vp', vn', distance'')+  where+    pm' = IM.findWithDefault 0 (ord char2) str1_mvs++    d0' = ((((sizedComplement vector_mask d0) .&. pm') `shiftL` 1) .&. pm)+      .|. ((((pm' .&. vp) + vp) .&. vector_mask) `xor` vp) .|. pm' .|. vn+          -- No need to mask the shiftL because of the restricted range of pm++    hp' = vn .|. sizedComplement vector_mask (d0' .|. vp)+    hn' = d0' .&. vp++    hp'_shift = ((hp' `shiftL` 1) .|. 1) .&. vector_mask+    hn'_shift = (hn' `shiftL` 1) .&. vector_mask+    vp' = hn'_shift .|. sizedComplement vector_mask (d0' .|. hp'_shift)+    vn' = d0' .&. hp'_shift++    distance' = if hp' .&. top_bit_mask /= 0 then distance + 1 else distance+    distance'' = if hn' .&. top_bit_mask /= 0 then distance' - 1 else distance'++sizedComplement :: Bits bv => bv -> bv -> bv+sizedComplement vector_mask vect = vector_mask `xor` vect++matchVectors :: (Bits bv, Num bv) => String -> IM.IntMap bv+matchVectors = snd . foldl' go (0 :: Int, IM.empty)+  where+    go (ix, im) char = let ix' = ix + 1+                           im' = IM.insertWith (.|.) (ord char) (2 ^ ix) im+                       in seq ix' $ seq im' $ (ix', im')++{-# SPECIALIZE INLINE restrictedDamerauLevenshteinDistance'+                      :: Word32 -> Int -> Int -> String -> String -> Int #-}+{-# SPECIALIZE INLINE restrictedDamerauLevenshteinDistance'+                      :: Integer -> Int -> Int -> String -> String -> Int #-}++{-# SPECIALIZE restrictedDamerauLevenshteinDistanceWorker+               :: IM.IntMap Word32 -> Word32 -> Word32+               -> (Word32, Word32, Word32, Word32, Int)+               -> Char -> (Word32, Word32, Word32, Word32, Int) #-}+{-# SPECIALIZE restrictedDamerauLevenshteinDistanceWorker+               :: IM.IntMap Integer -> Integer -> Integer+               -> (Integer, Integer, Integer, Integer, Int)+               -> Char -> (Integer, Integer, Integer, Integer, Int) #-}++{-# SPECIALIZE INLINE sizedComplement :: Word32 -> Word32 -> Word32 #-}+{-# SPECIALIZE INLINE sizedComplement :: Integer -> Integer -> Integer #-}++{-# SPECIALIZE matchVectors :: String -> IM.IntMap Word32 #-}+{-# SPECIALIZE matchVectors :: String -> IM.IntMap Integer #-}++fuzzyMatch :: String -> [String] -> [String]+fuzzyMatch key vals = fuzzyLookup key [(v,v) | v <- vals]++-- | Search for possible matches to the users input in the given list,+-- returning a small number of ranked results+fuzzyLookup :: String -> [(String,a)] -> [a]+fuzzyLookup user_entered possibilites+  = map fst $ take mAX_RESULTS $ sortBy (comparing snd)+    [ (poss_val, distance) | (poss_str, poss_val) <- possibilites+                       , let distance = restrictedDamerauLevenshteinDistance+                                            poss_str user_entered+                       , distance <= fuzzy_threshold ]+  where+    -- Work out an approriate match threshold:+    -- We report a candidate if its edit distance is <= the threshold,+    -- The threshold is set to about a quarter of the # of characters the user entered+    --   Length    Threshold+    --     1         0          -- Don't suggest *any* candidates+    --     2         1          -- for single-char identifiers+    --     3         1+    --     4         1+    --     5         1+    --     6         2+    --+    fuzzy_threshold = truncate $ fromIntegral (length user_entered + 2) / (4 :: Rational)+    mAX_RESULTS = 3++{-+************************************************************************+*                                                                      *+\subsection[Utils-pairs]{Pairs}+*                                                                      *+************************************************************************+-}++unzipWith :: (a -> b -> c) -> [(a, b)] -> [c]+unzipWith f pairs = map ( \ (a, b) -> f a b ) pairs++seqList :: [a] -> b -> b+seqList [] b = b+seqList (x:xs) b = x `seq` seqList xs b+++{-+************************************************************************+*                                                                      *+                        Globals and the RTS+*                                                                      *+************************************************************************++When a plugin is loaded, it currently gets linked against a *newly+loaded* copy of the GHC package. This would not be a problem, except+that the new copy has its own mutable state that is not shared with+that state that has already been initialized by the original GHC+package.++(Note that if the GHC executable was dynamically linked this+wouldn't be a problem, because we could share the GHC library it+links to; this is only a problem if DYNAMIC_GHC_PROGRAMS=NO.)++The solution is to make use of @sharedCAF@ through @sharedGlobal@+for globals that are shared between multiple copies of ghc packages.+-}++-- Global variables:++global :: a -> IORef a+global a = unsafePerformIO (newIORef a)++consIORef :: IORef [a] -> a -> IO ()+consIORef var x = do+  atomicModifyIORef' var (\xs -> (x:xs,()))++globalM :: IO a -> IORef a+globalM ma = unsafePerformIO (ma >>= newIORef)++-- Shared global variables:++sharedGlobal :: a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a+sharedGlobal a get_or_set = unsafePerformIO $+  newIORef a >>= flip sharedCAF get_or_set++sharedGlobalM :: IO a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a+sharedGlobalM ma get_or_set = unsafePerformIO $+  ma >>= newIORef >>= flip sharedCAF get_or_set++-- Module names:++looksLikeModuleName :: String -> Bool+looksLikeModuleName [] = False+looksLikeModuleName (c:cs) = isUpper c && go cs+  where go [] = True+        go ('.':cs) = looksLikeModuleName cs+        go (c:cs)   = (isAlphaNum c || c == '_' || c == '\'') && go cs++-- Similar to 'parse' for Distribution.Package.PackageName,+-- but we don't want to depend on Cabal.+looksLikePackageName :: String -> Bool+looksLikePackageName = all (all isAlphaNum <&&> not . (all isDigit)) . split '-'++{-+Akin to @Prelude.words@, but acts like the Bourne shell, treating+quoted strings as Haskell Strings, and also parses Haskell [String]+syntax.+-}++getCmd :: String -> Either String             -- Error+                           (String, String) -- (Cmd, Rest)+getCmd s = case break isSpace $ dropWhile isSpace s of+           ([], _) -> Left ("Couldn't find command in " ++ show s)+           res -> Right res++toCmdArgs :: String -> Either String             -- Error+                              (String, [String]) -- (Cmd, Args)+toCmdArgs s = case getCmd s of+              Left err -> Left err+              Right (cmd, s') -> case toArgs s' of+                                 Left err -> Left err+                                 Right args -> Right (cmd, args)++toArgs :: String -> Either String   -- Error+                           [String] -- Args+toArgs str+    = case dropWhile isSpace str of+      s@('[':_) -> case reads s of+                   [(args, spaces)]+                    | all isSpace spaces ->+                       Right args+                   _ ->+                       Left ("Couldn't read " ++ show str ++ " as [String]")+      s -> toArgs' s+ where+  toArgs' :: String -> Either String [String]+  -- Remove outer quotes:+  -- > toArgs' "\"foo\" \"bar baz\""+  -- Right ["foo", "bar baz"]+  --+  -- Keep inner quotes:+  -- > toArgs' "-DFOO=\"bar baz\""+  -- Right ["-DFOO=\"bar baz\""]+  toArgs' s = case dropWhile isSpace s of+              [] -> Right []+              ('"' : _) -> do+                    -- readAsString removes outer quotes+                    (arg, rest) <- readAsString s+                    (arg:) `fmap` toArgs' rest+              s' -> case break (isSpace <||> (== '"')) s' of+                    (argPart1, s''@('"':_)) -> do+                        (argPart2, rest) <- readAsString s''+                        -- show argPart2 to keep inner quotes+                        ((argPart1 ++ show argPart2):) `fmap` toArgs' rest+                    (arg, s'') -> (arg:) `fmap` toArgs' s''++  readAsString :: String -> Either String (String, String)+  readAsString s = case reads s of+                [(arg, rest)]+                    -- rest must either be [] or start with a space+                    | all isSpace (take 1 rest) ->+                    Right (arg, rest)+                _ ->+                    Left ("Couldn't read " ++ show s ++ " as String")+-----------------------------------------------------------------------------+-- Integers++-- This algorithm for determining the $\log_2$ of exact powers of 2 comes+-- from GCC.  It requires bit manipulation primitives, and we use GHC+-- extensions.  Tough.++exactLog2 :: Integer -> Maybe Integer+exactLog2 x+  = if (x <= 0 || x >= 2147483648) then+       Nothing+    else+       if (x .&. (-x)) /= x then+          Nothing+       else+          Just (pow2 x)+  where+    pow2 x | x == 1 = 0+           | otherwise = 1 + pow2 (x `shiftR` 1)+++{-+-- -----------------------------------------------------------------------------+-- Floats+-}++readRational__ :: ReadS Rational -- NB: doesn't handle leading "-"+readRational__ r = do+     (n,d,s) <- readFix r+     (k,t)   <- readExp s+     return ((n%1)*10^^(k-d), t)+ where+     readFix r = do+        (ds,s)  <- lexDecDigits r+        (ds',t) <- lexDotDigits s+        return (read (ds++ds'), length ds', t)++     readExp (e:s) | e `elem` "eE" = readExp' s+     readExp s                     = return (0,s)++     readExp' ('+':s) = readDec s+     readExp' ('-':s) = do (k,t) <- readDec s+                           return (-k,t)+     readExp' s       = readDec s++     readDec s = do+        (ds,r) <- nonnull isDigit s+        return (foldl1 (\n d -> n * 10 + d) [ ord d - ord '0' | d <- ds ],+                r)++     lexDecDigits = nonnull isDigit++     lexDotDigits ('.':s) = return (span' isDigit s)+     lexDotDigits s       = return ("",s)++     nonnull p s = do (cs@(_:_),t) <- return (span' p s)+                      return (cs,t)++     span' _ xs@[]         =  (xs, xs)+     span' p xs@(x:xs')+               | x == '_'  = span' p xs'   -- skip "_" (#14473)+               | p x       =  let (ys,zs) = span' p xs' in (x:ys,zs)+               | otherwise =  ([],xs)++readRational :: String -> Rational -- NB: *does* handle a leading "-"+readRational top_s+  = case top_s of+      '-' : xs -> - (read_me xs)+      xs       -> read_me xs+  where+    read_me s+      = case (do { (x,"") <- readRational__ s ; return x }) of+          [x] -> x+          []  -> error ("readRational: no parse:"        ++ top_s)+          _   -> error ("readRational: ambiguous parse:" ++ top_s)+++readHexRational :: String -> Rational+readHexRational str =+  case str of+    '-' : xs -> - (readMe xs)+    xs       -> readMe xs+  where+  readMe as =+    case readHexRational__ as of+      Just n -> n+      _      -> error ("readHexRational: no parse:" ++ str)+++readHexRational__ :: String -> Maybe Rational+readHexRational__ ('0' : x : rest)+  | x == 'X' || x == 'x' =+  do let (front,rest2) = span' isHexDigit rest+     guard (not (null front))+     let frontNum = steps 16 0 front+     case rest2 of+       '.' : rest3 ->+          do let (back,rest4) = span' isHexDigit rest3+             guard (not (null back))+             let backNum = steps 16 frontNum back+                 exp1    = -4 * length back+             case rest4 of+               p : ps | isExp p -> fmap (mk backNum . (+ exp1)) (getExp ps)+               _ -> return (mk backNum exp1)+       p : ps | isExp p -> fmap (mk frontNum) (getExp ps)+       _ -> Nothing++  where+  isExp p = p == 'p' || p == 'P'++  getExp ('+' : ds) = dec ds+  getExp ('-' : ds) = fmap negate (dec ds)+  getExp ds         = dec ds++  mk :: Integer -> Int -> Rational+  mk n e = fromInteger n * 2^^e++  dec cs = case span' isDigit cs of+             (ds,"") | not (null ds) -> Just (steps 10 0 ds)+             _ -> Nothing++  steps base n ds = foldl' (step base) n ds+  step  base n d  = base * n + fromIntegral (digitToInt d)++  span' _ xs@[]         =  (xs, xs)+  span' p xs@(x:xs')+            | x == '_'  = span' p xs'   -- skip "_"  (#14473)+            | p x       =  let (ys,zs) = span' p xs' in (x:ys,zs)+            | otherwise =  ([],xs)++readHexRational__ _ = Nothing+++++-----------------------------------------------------------------------------+-- read helpers++maybeRead :: Read a => String -> Maybe a+maybeRead str = case reads str of+                [(x, "")] -> Just x+                _         -> Nothing++maybeReadFuzzy :: Read a => String -> Maybe a+maybeReadFuzzy str = case reads str of+                     [(x, s)]+                      | all isSpace s ->+                         Just x+                     _ ->+                         Nothing++-----------------------------------------------------------------------------+-- Verify that the 'dirname' portion of a FilePath exists.+--+doesDirNameExist :: FilePath -> IO Bool+doesDirNameExist fpath = doesDirectoryExist (takeDirectory fpath)++-----------------------------------------------------------------------------+-- Backwards compatibility definition of getModificationTime++getModificationUTCTime :: FilePath -> IO UTCTime+getModificationUTCTime = getModificationTime++-- --------------------------------------------------------------+-- check existence & modification time at the same time++modificationTimeIfExists :: FilePath -> IO (Maybe UTCTime)+modificationTimeIfExists f = do+  (do t <- getModificationUTCTime f; return (Just t))+        `catchIO` \e -> if isDoesNotExistError e+                        then return Nothing+                        else ioError e++-- --------------------------------------------------------------+-- atomic file writing by writing to a temporary file first (see #14533)+--+-- This should be used in all cases where GHC writes files to disk+-- and uses their modification time to skip work later,+-- as otherwise a partially written file (e.g. due to crash or Ctrl+C)+-- also results in a skip.++withAtomicRename :: (MonadIO m) => FilePath -> (FilePath -> m a) -> m a+withAtomicRename targetFile f+  | enableAtomicRename = do+  -- The temp file must be on the same file system (mount) as the target file+  -- to result in an atomic move on most platforms.+  -- The standard way to ensure that is to place it into the same directory.+  -- This can still be fooled when somebody mounts a different file system+  -- at just the right time, but that is not a case we aim to cover here.+  let temp = targetFile <.> "tmp"+  res <- f temp+  liftIO $ renameFile temp targetFile+  return res++  | otherwise = f targetFile+  where+    -- As described in #16450, enabling this causes spurious build failures due+    -- to apparently missing files.+    enableAtomicRename :: Bool+#if defined(mingw32_BUILD_OS)+    enableAtomicRename = False+#else+    enableAtomicRename = True+#endif++-- --------------------------------------------------------------+-- split a string at the last character where 'pred' is True,+-- returning a pair of strings. The first component holds the string+-- up (but not including) the last character for which 'pred' returned+-- True, the second whatever comes after (but also not including the+-- last character).+--+-- If 'pred' returns False for all characters in the string, the original+-- string is returned in the first component (and the second one is just+-- empty).+splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)+splitLongestPrefix str pred+  | null r_pre = (str,           [])+  | otherwise  = (reverse (tail r_pre), reverse r_suf)+                           -- 'tail' drops the char satisfying 'pred'+  where (r_suf, r_pre) = break pred (reverse str)++escapeSpaces :: String -> String+escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) ""++type Suffix = String++--------------------------------------------------------------+-- * Search path+--------------------------------------------------------------++data Direction = Forwards | Backwards++reslash :: Direction -> FilePath -> FilePath+reslash d = f+    where f ('/'  : xs) = slash : f xs+          f ('\\' : xs) = slash : f xs+          f (x    : xs) = x     : f xs+          f ""          = ""+          slash = case d of+                  Forwards -> '/'+                  Backwards -> '\\'++makeRelativeTo :: FilePath -> FilePath -> FilePath+this `makeRelativeTo` that = directory </> thisFilename+    where (thisDirectory, thisFilename) = splitFileName this+          thatDirectory = dropFileName that+          directory = joinPath $ f (splitPath thisDirectory)+                                   (splitPath thatDirectory)++          f (x : xs) (y : ys)+           | x == y = f xs ys+          f xs ys = replicate (length ys) ".." ++ xs++{-+************************************************************************+*                                                                      *+\subsection[Utils-Data]{Utils for defining Data instances}+*                                                                      *+************************************************************************++These functions helps us to define Data instances for abstract types.+-}++abstractConstr :: String -> Constr+abstractConstr n = mkConstr (abstractDataType n) ("{abstract:"++n++"}") [] Prefix++abstractDataType :: String -> DataType+abstractDataType n = mkDataType n [abstractConstr n]++{-+************************************************************************+*                                                                      *+\subsection[Utils-C]{Utils for printing C code}+*                                                                      *+************************************************************************+-}++charToC :: Word8 -> String+charToC w =+  case chr (fromIntegral w) of+        '\"' -> "\\\""+        '\'' -> "\\\'"+        '\\' -> "\\\\"+        c | c >= ' ' && c <= '~' -> [c]+          | otherwise -> ['\\',+                         chr (ord '0' + ord c `div` 64),+                         chr (ord '0' + ord c `div` 8 `mod` 8),+                         chr (ord '0' + ord c         `mod` 8)]++{-+************************************************************************+*                                                                      *+\subsection[Utils-Hashing]{Utils for hashing}+*                                                                      *+************************************************************************+-}++-- | A sample hash function for Strings.  We keep multiplying by the+-- golden ratio and adding.  The implementation is:+--+-- > hashString = foldl' f golden+-- >   where f m c = fromIntegral (ord c) * magic + hashInt32 m+-- >         magic = 0xdeadbeef+--+-- Where hashInt32 works just as hashInt shown above.+--+-- Knuth argues that repeated multiplication by the golden ratio+-- will minimize gaps in the hash space, and thus it's a good choice+-- for combining together multiple keys to form one.+--+-- Here we know that individual characters c are often small, and this+-- produces frequent collisions if we use ord c alone.  A+-- particular problem are the shorter low ASCII and ISO-8859-1+-- character strings.  We pre-multiply by a magic twiddle factor to+-- obtain a good distribution.  In fact, given the following test:+--+-- > testp :: Int32 -> Int+-- > testp k = (n - ) . length . group . sort . map hs . take n $ ls+-- >   where ls = [] : [c : l | l <- ls, c <- ['\0'..'\xff']]+-- >         hs = foldl' f golden+-- >         f m c = fromIntegral (ord c) * k + hashInt32 m+-- >         n = 100000+--+-- We discover that testp magic = 0.+hashString :: String -> Int32+hashString = foldl' f golden+   where f m c = fromIntegral (ord c) * magic + hashInt32 m+         magic = fromIntegral (0xdeadbeef :: Word32)++golden :: Int32+golden = 1013904242 -- = round ((sqrt 5 - 1) * 2^32) :: Int32+-- was -1640531527 = round ((sqrt 5 - 1) * 2^31) :: Int32+-- but that has bad mulHi properties (even adding 2^32 to get its inverse)+-- Whereas the above works well and contains no hash duplications for+-- [-32767..65536]++-- | A sample (and useful) hash function for Int32,+-- implemented by extracting the uppermost 32 bits of the 64-bit+-- result of multiplying by a 33-bit constant.  The constant is from+-- Knuth, derived from the golden ratio:+--+-- > golden = round ((sqrt 5 - 1) * 2^32)+--+-- We get good key uniqueness on small inputs+-- (a problem with previous versions):+--  (length $ group $ sort $ map hashInt32 [-32767..65536]) == 65536 + 32768+--+hashInt32 :: Int32 -> Int32+hashInt32 x = mulHi x golden + x++-- hi 32 bits of a x-bit * 32 bit -> 64-bit multiply+mulHi :: Int32 -> Int32 -> Int32+mulHi a b = fromIntegral (r `shiftR` 32)+   where r :: Int64+         r = fromIntegral a * fromIntegral b++-- | A call stack constraint, but only when 'isDebugOn'.+#if defined(DEBUG)+type HasDebugCallStack = HasCallStack+#else+type HasDebugCallStack = (() :: Constraint)+#endif++data OverridingBool+  = Auto+  | Always+  | Never+  deriving Show++overrideWith :: Bool -> OverridingBool -> Bool+overrideWith b Auto   = b+overrideWith _ Always = True+overrideWith _ Never  = False
+ compiler/utils/md5.h view
@@ -0,0 +1,18 @@+/* MD5 message digest */+#pragma once++#include "HsFFI.h"++typedef HsWord32 word32;+typedef HsWord8  byte;++struct MD5Context {+        word32 buf[4];+        word32 bytes[2];+        word32 in[16];+};++void MD5Init(struct MD5Context *context);+void MD5Update(struct MD5Context *context, byte const *buf, int len);+void MD5Final(byte digest[16], struct MD5Context *context);+void MD5Transform(word32 buf[4], word32 const in[16]);
+ ghc-lib-parser.cabal view
@@ -0,0 +1,335 @@+cabal-version: >=1.22+build-type: Simple+name: ghc-lib-parser+version: 0.20190402+license: BSD3+license-file: LICENSE+category: Development+author: The GHC Team and Digital Asset+maintainer: Digital Asset+synopsis: The GHC API, decoupled from GHC versions+description: A package equivalent to the @ghc@ package, but which can be loaded on many compiler versions.+homepage: https://github.com/digital-asset/ghc-lib+bug-reports: https://github.com/digital-asset/ghc-lib/issues+data-dir: ghc-lib/stage1/lib+data-files:+    settings+    llvm-targets+    llvm-passes+    platformConstants+extra-source-files:+    ghc-lib/generated/ghcautoconf.h+    ghc-lib/generated/ghcplatform.h+    ghc-lib/generated/ghcversion.h+    ghc-lib/generated/DerivedConstants.h+    ghc-lib/generated/GHCConstantsHaskellExports.hs+    ghc-lib/generated/GHCConstantsHaskellType.hs+    ghc-lib/generated/GHCConstantsHaskellWrappers.hs+    ghc-lib/stage1/compiler/build/ghc_boot_platform.h+    ghc-lib/stage1/compiler/build/primop-can-fail.hs-incl+    ghc-lib/stage1/compiler/build/primop-code-size.hs-incl+    ghc-lib/stage1/compiler/build/primop-commutable.hs-incl+    ghc-lib/stage1/compiler/build/primop-data-decl.hs-incl+    ghc-lib/stage1/compiler/build/primop-fixity.hs-incl+    ghc-lib/stage1/compiler/build/primop-has-side-effects.hs-incl+    ghc-lib/stage1/compiler/build/primop-list.hs-incl+    ghc-lib/stage1/compiler/build/primop-out-of-line.hs-incl+    ghc-lib/stage1/compiler/build/primop-primop-info.hs-incl+    ghc-lib/stage1/compiler/build/primop-strictness.hs-incl+    ghc-lib/stage1/compiler/build/primop-tag.hs-incl+    ghc-lib/stage1/compiler/build/primop-vector-tycons.hs-incl+    ghc-lib/stage1/compiler/build/primop-vector-tys-exports.hs-incl+    ghc-lib/stage1/compiler/build/primop-vector-tys.hs-incl+    ghc-lib/stage1/compiler/build/primop-vector-uniques.hs-incl+    ghc-lib/stage1/compiler/build/Config.hs+    ghc-lib/stage0/compiler/build/Parser.hs+    ghc-lib/stage0/compiler/build/Lexer.hs+    includes/*.h+    includes/CodeGen.Platform.hs+    includes/rts/*.h+    includes/rts/storage/*.h+    includes/rts/prof/*.h+    compiler/nativeGen/*.h+    compiler/utils/*.h+    compiler/*.h+tested-with:GHC==8.6.3+source-repository head+    type: git+    location: git://git.haskell.org/ghc.git++library+    default-language:   Haskell2010+    default-extensions: NoImplicitPrelude+    include-dirs:+        ghc-lib/generated+        ghc-lib/stage0/compiler/build+        ghc-lib/stage1/compiler/build+        compiler+        compiler/utils+    ghc-options: -fobject-code -package=ghc-boot-th -optc-DTHREADED_RTS+    cc-options: -DTHREADED_RTS+    cpp-options: -DSTAGE=2 -DTHREADED_RTS -DGHCI -DGHC_IN_GHCI+    if !os(windows)+        build-depends: unix+    else+        build-depends: Win32+    build-depends:+        ghc-prim > 0.2 && < 0.6,+        base >= 4.11 && < 4.14,+        containers >= 0.5 && < 0.7,+        bytestring >= 0.9 && < 0.11,+        binary == 0.8.*,+        filepath >= 1 && < 1.5,+        directory >= 1 && < 1.4,+        array >= 0.1 && < 0.6,+        deepseq >= 1.4 && < 1.5,+        pretty == 1.1.*,+        time >= 1.4 && < 1.10,+        transformers == 0.5.*,+        process >= 1 && < 1.7,+        hpc == 0.6.*+    build-tools: alex >= 3.1, happy >= 1.19.4+    other-extensions:+        BangPatterns+        CPP+        DataKinds+        DefaultSignatures+        DeriveDataTypeable+        DeriveFoldable+        DeriveFunctor+        DeriveGeneric+        DeriveTraversable+        DisambiguateRecordFields+        ExistentialQuantification+        ExplicitForAll+        FlexibleContexts+        FlexibleInstances+        GADTs+        GeneralizedNewtypeDeriving+        InstanceSigs+        MagicHash+        MultiParamTypeClasses+        NamedFieldPuns+        NondecreasingIndentation+        RankNTypes+        RecordWildCards+        RoleAnnotations+        ScopedTypeVariables+        StandaloneDeriving+        Trustworthy+        TupleSections+        TypeFamilies+        TypeSynonymInstances+        UnboxedTuples+        UndecidableInstances+    c-sources:+        compiler/cbits/genSym.c+        compiler/ghci/keepCAFsForGHCi.c+        compiler/parser/cutils.c+    hs-source-dirs:+        compiler+        compiler/backpack+        compiler/basicTypes+        compiler/cmm+        compiler/coreSyn+        compiler/deSugar+        compiler/ghci+        compiler/hsSyn+        compiler/iface+        compiler/main+        compiler/nativeGen+        compiler/parser+        compiler/prelude+        compiler/profiling+        compiler/simplCore+        compiler/simplStg+        compiler/specialise+        compiler/typecheck+        compiler/types+        compiler/utils+        ghc-lib/stage0/compiler/build+        ghc-lib/stage1/compiler/build+        libraries/ghc-boot+        libraries/ghc-boot-th+        libraries/ghc-heap+        libraries/ghci+        libraries/template-haskell+    autogen-modules:+        Lexer+        Parser+    exposed-modules:+        Annotations+        ApiAnnotation+        Avail+        Bag+        BasicTypes+        BinFingerprint+        Binary+        BkpSyn+        BooleanFormula+        BufWrite+        ByteCodeTypes+        Class+        CmdLineParser+        CmmType+        CoAxiom+        Coercion+        ConLike+        Config+        Constants+        CoreArity+        CoreFVs+        CoreMap+        CoreMonad+        CoreOpt+        CoreSeq+        CoreStats+        CoreSubst+        CoreSyn+        CoreTidy+        CoreUnfold+        CoreUtils+        CostCentre+        CostCentreState+        Ctype+        DataCon+        Demand+        Digraph+        DriverPhases+        DynFlags+        Encoding+        EnumSet+        ErrUtils+        Exception+        FV+        FamInstEnv+        FastFunctions+        FastMutInt+        FastString+        FastStringEnv+        FieldLabel+        FileCleanup+        Fingerprint+        FiniteMap+        ForeignCall+        GHC.Exts.Heap+        GHC.Exts.Heap.ClosureTypes+        GHC.Exts.Heap.Closures+        GHC.Exts.Heap.Constants+        GHC.Exts.Heap.InfoTable+        GHC.Exts.Heap.InfoTable.Types+        GHC.Exts.Heap.InfoTableProf+        GHC.Exts.Heap.Utils+        GHC.ForeignSrcLang+        GHC.ForeignSrcLang.Type+        GHC.LanguageExtensions+        GHC.LanguageExtensions.Type+        GHC.Lexeme+        GHC.PackageDb+        GHC.Serialized+        GHCi.BreakArray+        GHCi.FFI+        GHCi.Message+        GHCi.RemoteTypes+        GHCi.TH.Binary+        GhcMonad+        GhcPrelude+        HaddockUtils+        Hooks+        HsBinds+        HsDecls+        HsDoc+        HsExpr+        HsExtension+        HsImpExp+        HsInstances+        HsLit+        HsPat+        HsSyn+        HsTypes+        HsUtils+        HscTypes+        IOEnv+        Id+        IdInfo+        IfaceSyn+        IfaceType+        InstEnv+        InteractiveEvalTypes+        Json+        Kind+        KnownUniques+        Language.Haskell.TH+        Language.Haskell.TH.LanguageExtensions+        Language.Haskell.TH.Lib+        Language.Haskell.TH.Lib.Internal+        Language.Haskell.TH.Lib.Map+        Language.Haskell.TH.Ppr+        Language.Haskell.TH.PprLib+        Language.Haskell.TH.Syntax+        Lexeme+        Lexer+        ListSetOps+        Literal+        Maybes+        MkCore+        MkId+        Module+        MonadUtils+        Name+        NameCache+        NameEnv+        NameSet+        OccName+        OccurAnal+        OptCoercion+        OrdList+        Outputable+        PackageConfig+        Packages+        Pair+        Panic+        Parser+        PatSyn+        PipelineMonad+        PlaceHolder+        Platform+        PlatformConstants+        Plugins+        PmExpr+        PprColour+        PprCore+        PrelNames+        PrelRules+        Pretty+        PrimOp+        RdrHsSyn+        RdrName+        RepType+        Rules+        SizedSeq+        SrcLoc+        StringBuffer+        SysTools.BaseDir+        SysTools.Terminal+        TcEvidence+        TcRnTypes+        TcType+        ToIface+        TrieMap+        TyCoRep+        TyCon+        Type+        TysPrim+        TysWiredIn+        Unify+        UniqDFM+        UniqDSet+        UniqFM+        UniqSet+        UniqSupply+        Unique+        Util+        Var+        VarEnv+        VarSet
+ ghc-lib/generated/DerivedConstants.h view
@@ -0,0 +1,554 @@+/* This file is created automatically.  Do not edit by hand.*/++#define CONTROL_GROUP_CONST_291 291+#define STD_HDR_SIZE 1+#define PROF_HDR_SIZE 2+#define BLOCK_SIZE 4096+#define MBLOCK_SIZE 1048576+#define BLOCKS_PER_MBLOCK 252+#define TICKY_BIN_COUNT 9+#define OFFSET_StgRegTable_rR1 0+#define OFFSET_StgRegTable_rR2 8+#define OFFSET_StgRegTable_rR3 16+#define OFFSET_StgRegTable_rR4 24+#define OFFSET_StgRegTable_rR5 32+#define OFFSET_StgRegTable_rR6 40+#define OFFSET_StgRegTable_rR7 48+#define OFFSET_StgRegTable_rR8 56+#define OFFSET_StgRegTable_rR9 64+#define OFFSET_StgRegTable_rR10 72+#define OFFSET_StgRegTable_rF1 80+#define OFFSET_StgRegTable_rF2 84+#define OFFSET_StgRegTable_rF3 88+#define OFFSET_StgRegTable_rF4 92+#define OFFSET_StgRegTable_rF5 96+#define OFFSET_StgRegTable_rF6 100+#define OFFSET_StgRegTable_rD1 104+#define OFFSET_StgRegTable_rD2 112+#define OFFSET_StgRegTable_rD3 120+#define OFFSET_StgRegTable_rD4 128+#define OFFSET_StgRegTable_rD5 136+#define OFFSET_StgRegTable_rD6 144+#define OFFSET_StgRegTable_rXMM1 152+#define OFFSET_StgRegTable_rXMM2 168+#define OFFSET_StgRegTable_rXMM3 184+#define OFFSET_StgRegTable_rXMM4 200+#define OFFSET_StgRegTable_rXMM5 216+#define OFFSET_StgRegTable_rXMM6 232+#define OFFSET_StgRegTable_rYMM1 248+#define OFFSET_StgRegTable_rYMM2 280+#define OFFSET_StgRegTable_rYMM3 312+#define OFFSET_StgRegTable_rYMM4 344+#define OFFSET_StgRegTable_rYMM5 376+#define OFFSET_StgRegTable_rYMM6 408+#define OFFSET_StgRegTable_rZMM1 440+#define OFFSET_StgRegTable_rZMM2 504+#define OFFSET_StgRegTable_rZMM3 568+#define OFFSET_StgRegTable_rZMM4 632+#define OFFSET_StgRegTable_rZMM5 696+#define OFFSET_StgRegTable_rZMM6 760+#define OFFSET_StgRegTable_rL1 824+#define OFFSET_StgRegTable_rSp 832+#define OFFSET_StgRegTable_rSpLim 840+#define OFFSET_StgRegTable_rHp 848+#define OFFSET_StgRegTable_rHpLim 856+#define OFFSET_StgRegTable_rCCCS 864+#define OFFSET_StgRegTable_rCurrentTSO 872+#define OFFSET_StgRegTable_rCurrentNursery 888+#define OFFSET_StgRegTable_rHpAlloc 904+#define OFFSET_StgRegTable_rRet 912+#define REP_StgRegTable_rRet b64+#define StgRegTable_rRet(__ptr__) REP_StgRegTable_rRet[__ptr__+OFFSET_StgRegTable_rRet]+#define OFFSET_StgRegTable_rNursery 880+#define REP_StgRegTable_rNursery b64+#define StgRegTable_rNursery(__ptr__) REP_StgRegTable_rNursery[__ptr__+OFFSET_StgRegTable_rNursery]+#define OFFSET_stgEagerBlackholeInfo -24+#define OFFSET_stgGCEnter1 -16+#define OFFSET_stgGCFun -8+#define OFFSET_Capability_r 24+#define OFFSET_Capability_lock 1096+#define OFFSET_Capability_no 944+#define REP_Capability_no b32+#define Capability_no(__ptr__) REP_Capability_no[__ptr__+OFFSET_Capability_no]+#define OFFSET_Capability_mut_lists 1016+#define REP_Capability_mut_lists b64+#define Capability_mut_lists(__ptr__) REP_Capability_mut_lists[__ptr__+OFFSET_Capability_mut_lists]+#define OFFSET_Capability_context_switch 1064+#define REP_Capability_context_switch b32+#define Capability_context_switch(__ptr__) REP_Capability_context_switch[__ptr__+OFFSET_Capability_context_switch]+#define OFFSET_Capability_interrupt 1068+#define REP_Capability_interrupt b32+#define Capability_interrupt(__ptr__) REP_Capability_interrupt[__ptr__+OFFSET_Capability_interrupt]+#define OFFSET_Capability_sparks 1200+#define REP_Capability_sparks b64+#define Capability_sparks(__ptr__) REP_Capability_sparks[__ptr__+OFFSET_Capability_sparks]+#define OFFSET_Capability_total_allocated 1072+#define REP_Capability_total_allocated b64+#define Capability_total_allocated(__ptr__) REP_Capability_total_allocated[__ptr__+OFFSET_Capability_total_allocated]+#define OFFSET_Capability_weak_ptr_list_hd 1048+#define REP_Capability_weak_ptr_list_hd b64+#define Capability_weak_ptr_list_hd(__ptr__) REP_Capability_weak_ptr_list_hd[__ptr__+OFFSET_Capability_weak_ptr_list_hd]+#define OFFSET_Capability_weak_ptr_list_tl 1056+#define REP_Capability_weak_ptr_list_tl b64+#define Capability_weak_ptr_list_tl(__ptr__) REP_Capability_weak_ptr_list_tl[__ptr__+OFFSET_Capability_weak_ptr_list_tl]+#define OFFSET_bdescr_start 0+#define REP_bdescr_start b64+#define bdescr_start(__ptr__) REP_bdescr_start[__ptr__+OFFSET_bdescr_start]+#define OFFSET_bdescr_free 8+#define REP_bdescr_free b64+#define bdescr_free(__ptr__) REP_bdescr_free[__ptr__+OFFSET_bdescr_free]+#define OFFSET_bdescr_blocks 48+#define REP_bdescr_blocks b32+#define bdescr_blocks(__ptr__) REP_bdescr_blocks[__ptr__+OFFSET_bdescr_blocks]+#define OFFSET_bdescr_gen_no 40+#define REP_bdescr_gen_no b16+#define bdescr_gen_no(__ptr__) REP_bdescr_gen_no[__ptr__+OFFSET_bdescr_gen_no]+#define OFFSET_bdescr_link 16+#define REP_bdescr_link b64+#define bdescr_link(__ptr__) REP_bdescr_link[__ptr__+OFFSET_bdescr_link]+#define OFFSET_bdescr_flags 46+#define REP_bdescr_flags b16+#define bdescr_flags(__ptr__) REP_bdescr_flags[__ptr__+OFFSET_bdescr_flags]+#define SIZEOF_generation 384+#define OFFSET_generation_n_new_large_words 56+#define REP_generation_n_new_large_words b64+#define generation_n_new_large_words(__ptr__) REP_generation_n_new_large_words[__ptr__+OFFSET_generation_n_new_large_words]+#define OFFSET_generation_weak_ptr_list 112+#define REP_generation_weak_ptr_list b64+#define generation_weak_ptr_list(__ptr__) REP_generation_weak_ptr_list[__ptr__+OFFSET_generation_weak_ptr_list]+#define SIZEOF_CostCentreStack 96+#define OFFSET_CostCentreStack_ccsID 0+#define REP_CostCentreStack_ccsID b64+#define CostCentreStack_ccsID(__ptr__) REP_CostCentreStack_ccsID[__ptr__+OFFSET_CostCentreStack_ccsID]+#define OFFSET_CostCentreStack_mem_alloc 72+#define REP_CostCentreStack_mem_alloc b64+#define CostCentreStack_mem_alloc(__ptr__) REP_CostCentreStack_mem_alloc[__ptr__+OFFSET_CostCentreStack_mem_alloc]+#define OFFSET_CostCentreStack_scc_count 48+#define REP_CostCentreStack_scc_count b64+#define CostCentreStack_scc_count(__ptr__) REP_CostCentreStack_scc_count[__ptr__+OFFSET_CostCentreStack_scc_count]+#define OFFSET_CostCentreStack_prevStack 16+#define REP_CostCentreStack_prevStack b64+#define CostCentreStack_prevStack(__ptr__) REP_CostCentreStack_prevStack[__ptr__+OFFSET_CostCentreStack_prevStack]+#define OFFSET_CostCentre_ccID 0+#define REP_CostCentre_ccID b64+#define CostCentre_ccID(__ptr__) REP_CostCentre_ccID[__ptr__+OFFSET_CostCentre_ccID]+#define OFFSET_CostCentre_link 56+#define REP_CostCentre_link b64+#define CostCentre_link(__ptr__) REP_CostCentre_link[__ptr__+OFFSET_CostCentre_link]+#define OFFSET_StgHeader_info 0+#define REP_StgHeader_info b64+#define StgHeader_info(__ptr__) REP_StgHeader_info[__ptr__+OFFSET_StgHeader_info]+#define OFFSET_StgHeader_ccs 8+#define REP_StgHeader_ccs b64+#define StgHeader_ccs(__ptr__) REP_StgHeader_ccs[__ptr__+OFFSET_StgHeader_ccs]+#define OFFSET_StgHeader_ldvw 16+#define REP_StgHeader_ldvw b64+#define StgHeader_ldvw(__ptr__) REP_StgHeader_ldvw[__ptr__+OFFSET_StgHeader_ldvw]+#define SIZEOF_StgSMPThunkHeader 8+#define OFFSET_StgClosure_payload 0+#define StgClosure_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgClosure_payload + WDS(__ix__)]+#define OFFSET_StgEntCounter_allocs 48+#define REP_StgEntCounter_allocs b64+#define StgEntCounter_allocs(__ptr__) REP_StgEntCounter_allocs[__ptr__+OFFSET_StgEntCounter_allocs]+#define OFFSET_StgEntCounter_allocd 16+#define REP_StgEntCounter_allocd b64+#define StgEntCounter_allocd(__ptr__) REP_StgEntCounter_allocd[__ptr__+OFFSET_StgEntCounter_allocd]+#define OFFSET_StgEntCounter_registeredp 0+#define REP_StgEntCounter_registeredp b64+#define StgEntCounter_registeredp(__ptr__) REP_StgEntCounter_registeredp[__ptr__+OFFSET_StgEntCounter_registeredp]+#define OFFSET_StgEntCounter_link 56+#define REP_StgEntCounter_link b64+#define StgEntCounter_link(__ptr__) REP_StgEntCounter_link[__ptr__+OFFSET_StgEntCounter_link]+#define OFFSET_StgEntCounter_entry_count 40+#define REP_StgEntCounter_entry_count b64+#define StgEntCounter_entry_count(__ptr__) REP_StgEntCounter_entry_count[__ptr__+OFFSET_StgEntCounter_entry_count]+#define SIZEOF_StgUpdateFrame_NoHdr 8+#define SIZEOF_StgUpdateFrame (SIZEOF_StgHeader+8)+#define SIZEOF_StgCatchFrame_NoHdr 16+#define SIZEOF_StgCatchFrame (SIZEOF_StgHeader+16)+#define SIZEOF_StgStopFrame_NoHdr 0+#define SIZEOF_StgStopFrame (SIZEOF_StgHeader+0)+#define SIZEOF_StgMutArrPtrs_NoHdr 16+#define SIZEOF_StgMutArrPtrs (SIZEOF_StgHeader+16)+#define OFFSET_StgMutArrPtrs_ptrs 0+#define REP_StgMutArrPtrs_ptrs b64+#define StgMutArrPtrs_ptrs(__ptr__) REP_StgMutArrPtrs_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutArrPtrs_ptrs]+#define OFFSET_StgMutArrPtrs_size 8+#define REP_StgMutArrPtrs_size b64+#define StgMutArrPtrs_size(__ptr__) REP_StgMutArrPtrs_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutArrPtrs_size]+#define SIZEOF_StgSmallMutArrPtrs_NoHdr 8+#define SIZEOF_StgSmallMutArrPtrs (SIZEOF_StgHeader+8)+#define OFFSET_StgSmallMutArrPtrs_ptrs 0+#define REP_StgSmallMutArrPtrs_ptrs b64+#define StgSmallMutArrPtrs_ptrs(__ptr__) REP_StgSmallMutArrPtrs_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgSmallMutArrPtrs_ptrs]+#define SIZEOF_StgArrBytes_NoHdr 8+#define SIZEOF_StgArrBytes (SIZEOF_StgHeader+8)+#define OFFSET_StgArrBytes_bytes 0+#define REP_StgArrBytes_bytes b64+#define StgArrBytes_bytes(__ptr__) REP_StgArrBytes_bytes[__ptr__+SIZEOF_StgHeader+OFFSET_StgArrBytes_bytes]+#define OFFSET_StgArrBytes_payload 8+#define StgArrBytes_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgArrBytes_payload + WDS(__ix__)]+#define OFFSET_StgTSO__link 0+#define REP_StgTSO__link b64+#define StgTSO__link(__ptr__) REP_StgTSO__link[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO__link]+#define OFFSET_StgTSO_global_link 8+#define REP_StgTSO_global_link b64+#define StgTSO_global_link(__ptr__) REP_StgTSO_global_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_global_link]+#define OFFSET_StgTSO_what_next 24+#define REP_StgTSO_what_next b16+#define StgTSO_what_next(__ptr__) REP_StgTSO_what_next[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_what_next]+#define OFFSET_StgTSO_why_blocked 26+#define REP_StgTSO_why_blocked b16+#define StgTSO_why_blocked(__ptr__) REP_StgTSO_why_blocked[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_why_blocked]+#define OFFSET_StgTSO_block_info 32+#define REP_StgTSO_block_info b64+#define StgTSO_block_info(__ptr__) REP_StgTSO_block_info[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_block_info]+#define OFFSET_StgTSO_blocked_exceptions 80+#define REP_StgTSO_blocked_exceptions b64+#define StgTSO_blocked_exceptions(__ptr__) REP_StgTSO_blocked_exceptions[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_blocked_exceptions]+#define OFFSET_StgTSO_id 40+#define REP_StgTSO_id b32+#define StgTSO_id(__ptr__) REP_StgTSO_id[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_id]+#define OFFSET_StgTSO_cap 64+#define REP_StgTSO_cap b64+#define StgTSO_cap(__ptr__) REP_StgTSO_cap[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_cap]+#define OFFSET_StgTSO_saved_errno 44+#define REP_StgTSO_saved_errno b32+#define StgTSO_saved_errno(__ptr__) REP_StgTSO_saved_errno[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_saved_errno]+#define OFFSET_StgTSO_trec 72+#define REP_StgTSO_trec b64+#define StgTSO_trec(__ptr__) REP_StgTSO_trec[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_trec]+#define OFFSET_StgTSO_flags 28+#define REP_StgTSO_flags b32+#define StgTSO_flags(__ptr__) REP_StgTSO_flags[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_flags]+#define OFFSET_StgTSO_dirty 48+#define REP_StgTSO_dirty b32+#define StgTSO_dirty(__ptr__) REP_StgTSO_dirty[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_dirty]+#define OFFSET_StgTSO_bq 88+#define REP_StgTSO_bq b64+#define StgTSO_bq(__ptr__) REP_StgTSO_bq[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_bq]+#define OFFSET_StgTSO_alloc_limit 96+#define REP_StgTSO_alloc_limit b64+#define StgTSO_alloc_limit(__ptr__) REP_StgTSO_alloc_limit[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_alloc_limit]+#define OFFSET_StgTSO_cccs 112+#define REP_StgTSO_cccs b64+#define StgTSO_cccs(__ptr__) REP_StgTSO_cccs[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_cccs]+#define OFFSET_StgTSO_stackobj 16+#define REP_StgTSO_stackobj b64+#define StgTSO_stackobj(__ptr__) REP_StgTSO_stackobj[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_stackobj]+#define OFFSET_StgStack_sp 8+#define REP_StgStack_sp b64+#define StgStack_sp(__ptr__) REP_StgStack_sp[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_sp]+#define OFFSET_StgStack_stack 16+#define OFFSET_StgStack_stack_size 0+#define REP_StgStack_stack_size b32+#define StgStack_stack_size(__ptr__) REP_StgStack_stack_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_stack_size]+#define OFFSET_StgStack_dirty 4+#define REP_StgStack_dirty b32+#define StgStack_dirty(__ptr__) REP_StgStack_dirty[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_dirty]+#define SIZEOF_StgTSOProfInfo 8+#define OFFSET_StgUpdateFrame_updatee 0+#define REP_StgUpdateFrame_updatee b64+#define StgUpdateFrame_updatee(__ptr__) REP_StgUpdateFrame_updatee[__ptr__+SIZEOF_StgHeader+OFFSET_StgUpdateFrame_updatee]+#define OFFSET_StgCatchFrame_handler 8+#define REP_StgCatchFrame_handler b64+#define StgCatchFrame_handler(__ptr__) REP_StgCatchFrame_handler[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchFrame_handler]+#define OFFSET_StgCatchFrame_exceptions_blocked 0+#define REP_StgCatchFrame_exceptions_blocked b64+#define StgCatchFrame_exceptions_blocked(__ptr__) REP_StgCatchFrame_exceptions_blocked[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchFrame_exceptions_blocked]+#define SIZEOF_StgPAP_NoHdr 16+#define SIZEOF_StgPAP (SIZEOF_StgHeader+16)+#define OFFSET_StgPAP_n_args 4+#define REP_StgPAP_n_args b32+#define StgPAP_n_args(__ptr__) REP_StgPAP_n_args[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_n_args]+#define OFFSET_StgPAP_fun 8+#define REP_StgPAP_fun gcptr+#define StgPAP_fun(__ptr__) REP_StgPAP_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_fun]+#define OFFSET_StgPAP_arity 0+#define REP_StgPAP_arity b32+#define StgPAP_arity(__ptr__) REP_StgPAP_arity[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_arity]+#define OFFSET_StgPAP_payload 16+#define StgPAP_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_payload + WDS(__ix__)]+#define SIZEOF_StgAP_NoThunkHdr 16+#define SIZEOF_StgAP_NoHdr 24+#define SIZEOF_StgAP (SIZEOF_StgHeader+24)+#define OFFSET_StgAP_n_args 12+#define REP_StgAP_n_args b32+#define StgAP_n_args(__ptr__) REP_StgAP_n_args[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_n_args]+#define OFFSET_StgAP_fun 16+#define REP_StgAP_fun gcptr+#define StgAP_fun(__ptr__) REP_StgAP_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_fun]+#define OFFSET_StgAP_payload 24+#define StgAP_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_payload + WDS(__ix__)]+#define SIZEOF_StgAP_STACK_NoThunkHdr 16+#define SIZEOF_StgAP_STACK_NoHdr 24+#define SIZEOF_StgAP_STACK (SIZEOF_StgHeader+24)+#define OFFSET_StgAP_STACK_size 8+#define REP_StgAP_STACK_size b64+#define StgAP_STACK_size(__ptr__) REP_StgAP_STACK_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_size]+#define OFFSET_StgAP_STACK_fun 16+#define REP_StgAP_STACK_fun gcptr+#define StgAP_STACK_fun(__ptr__) REP_StgAP_STACK_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_fun]+#define OFFSET_StgAP_STACK_payload 24+#define StgAP_STACK_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_payload + WDS(__ix__)]+#define SIZEOF_StgSelector_NoThunkHdr 8+#define SIZEOF_StgSelector_NoHdr 16+#define SIZEOF_StgSelector (SIZEOF_StgHeader+16)+#define OFFSET_StgInd_indirectee 0+#define REP_StgInd_indirectee gcptr+#define StgInd_indirectee(__ptr__) REP_StgInd_indirectee[__ptr__+SIZEOF_StgHeader+OFFSET_StgInd_indirectee]+#define SIZEOF_StgMutVar_NoHdr 8+#define SIZEOF_StgMutVar (SIZEOF_StgHeader+8)+#define OFFSET_StgMutVar_var 0+#define REP_StgMutVar_var b64+#define StgMutVar_var(__ptr__) REP_StgMutVar_var[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutVar_var]+#define SIZEOF_StgAtomicallyFrame_NoHdr 16+#define SIZEOF_StgAtomicallyFrame (SIZEOF_StgHeader+16)+#define OFFSET_StgAtomicallyFrame_code 0+#define REP_StgAtomicallyFrame_code b64+#define StgAtomicallyFrame_code(__ptr__) REP_StgAtomicallyFrame_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgAtomicallyFrame_code]+#define OFFSET_StgAtomicallyFrame_result 8+#define REP_StgAtomicallyFrame_result b64+#define StgAtomicallyFrame_result(__ptr__) REP_StgAtomicallyFrame_result[__ptr__+SIZEOF_StgHeader+OFFSET_StgAtomicallyFrame_result]+#define OFFSET_StgTRecHeader_enclosing_trec 0+#define REP_StgTRecHeader_enclosing_trec b64+#define StgTRecHeader_enclosing_trec(__ptr__) REP_StgTRecHeader_enclosing_trec[__ptr__+SIZEOF_StgHeader+OFFSET_StgTRecHeader_enclosing_trec]+#define SIZEOF_StgCatchSTMFrame_NoHdr 16+#define SIZEOF_StgCatchSTMFrame (SIZEOF_StgHeader+16)+#define OFFSET_StgCatchSTMFrame_handler 8+#define REP_StgCatchSTMFrame_handler b64+#define StgCatchSTMFrame_handler(__ptr__) REP_StgCatchSTMFrame_handler[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchSTMFrame_handler]+#define OFFSET_StgCatchSTMFrame_code 0+#define REP_StgCatchSTMFrame_code b64+#define StgCatchSTMFrame_code(__ptr__) REP_StgCatchSTMFrame_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchSTMFrame_code]+#define SIZEOF_StgCatchRetryFrame_NoHdr 24+#define SIZEOF_StgCatchRetryFrame (SIZEOF_StgHeader+24)+#define OFFSET_StgCatchRetryFrame_running_alt_code 0+#define REP_StgCatchRetryFrame_running_alt_code b64+#define StgCatchRetryFrame_running_alt_code(__ptr__) REP_StgCatchRetryFrame_running_alt_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_running_alt_code]+#define OFFSET_StgCatchRetryFrame_first_code 8+#define REP_StgCatchRetryFrame_first_code b64+#define StgCatchRetryFrame_first_code(__ptr__) REP_StgCatchRetryFrame_first_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_first_code]+#define OFFSET_StgCatchRetryFrame_alt_code 16+#define REP_StgCatchRetryFrame_alt_code b64+#define StgCatchRetryFrame_alt_code(__ptr__) REP_StgCatchRetryFrame_alt_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_alt_code]+#define OFFSET_StgTVarWatchQueue_closure 0+#define REP_StgTVarWatchQueue_closure b64+#define StgTVarWatchQueue_closure(__ptr__) REP_StgTVarWatchQueue_closure[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_closure]+#define OFFSET_StgTVarWatchQueue_next_queue_entry 8+#define REP_StgTVarWatchQueue_next_queue_entry b64+#define StgTVarWatchQueue_next_queue_entry(__ptr__) REP_StgTVarWatchQueue_next_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_next_queue_entry]+#define OFFSET_StgTVarWatchQueue_prev_queue_entry 16+#define REP_StgTVarWatchQueue_prev_queue_entry b64+#define StgTVarWatchQueue_prev_queue_entry(__ptr__) REP_StgTVarWatchQueue_prev_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_prev_queue_entry]+#define SIZEOF_StgTVar_NoHdr 24+#define SIZEOF_StgTVar (SIZEOF_StgHeader+24)+#define OFFSET_StgTVar_current_value 0+#define REP_StgTVar_current_value b64+#define StgTVar_current_value(__ptr__) REP_StgTVar_current_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_current_value]+#define OFFSET_StgTVar_first_watch_queue_entry 8+#define REP_StgTVar_first_watch_queue_entry b64+#define StgTVar_first_watch_queue_entry(__ptr__) REP_StgTVar_first_watch_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_first_watch_queue_entry]+#define OFFSET_StgTVar_num_updates 16+#define REP_StgTVar_num_updates b64+#define StgTVar_num_updates(__ptr__) REP_StgTVar_num_updates[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_num_updates]+#define SIZEOF_StgWeak_NoHdr 40+#define SIZEOF_StgWeak (SIZEOF_StgHeader+40)+#define OFFSET_StgWeak_link 32+#define REP_StgWeak_link b64+#define StgWeak_link(__ptr__) REP_StgWeak_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_link]+#define OFFSET_StgWeak_key 8+#define REP_StgWeak_key b64+#define StgWeak_key(__ptr__) REP_StgWeak_key[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_key]+#define OFFSET_StgWeak_value 16+#define REP_StgWeak_value b64+#define StgWeak_value(__ptr__) REP_StgWeak_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_value]+#define OFFSET_StgWeak_finalizer 24+#define REP_StgWeak_finalizer b64+#define StgWeak_finalizer(__ptr__) REP_StgWeak_finalizer[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_finalizer]+#define OFFSET_StgWeak_cfinalizers 0+#define REP_StgWeak_cfinalizers b64+#define StgWeak_cfinalizers(__ptr__) REP_StgWeak_cfinalizers[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_cfinalizers]+#define SIZEOF_StgCFinalizerList_NoHdr 40+#define SIZEOF_StgCFinalizerList (SIZEOF_StgHeader+40)+#define OFFSET_StgCFinalizerList_link 0+#define REP_StgCFinalizerList_link b64+#define StgCFinalizerList_link(__ptr__) REP_StgCFinalizerList_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_link]+#define OFFSET_StgCFinalizerList_fptr 8+#define REP_StgCFinalizerList_fptr b64+#define StgCFinalizerList_fptr(__ptr__) REP_StgCFinalizerList_fptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_fptr]+#define OFFSET_StgCFinalizerList_ptr 16+#define REP_StgCFinalizerList_ptr b64+#define StgCFinalizerList_ptr(__ptr__) REP_StgCFinalizerList_ptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_ptr]+#define OFFSET_StgCFinalizerList_eptr 24+#define REP_StgCFinalizerList_eptr b64+#define StgCFinalizerList_eptr(__ptr__) REP_StgCFinalizerList_eptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_eptr]+#define OFFSET_StgCFinalizerList_flag 32+#define REP_StgCFinalizerList_flag b64+#define StgCFinalizerList_flag(__ptr__) REP_StgCFinalizerList_flag[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_flag]+#define SIZEOF_StgMVar_NoHdr 24+#define SIZEOF_StgMVar (SIZEOF_StgHeader+24)+#define OFFSET_StgMVar_head 0+#define REP_StgMVar_head b64+#define StgMVar_head(__ptr__) REP_StgMVar_head[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_head]+#define OFFSET_StgMVar_tail 8+#define REP_StgMVar_tail b64+#define StgMVar_tail(__ptr__) REP_StgMVar_tail[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_tail]+#define OFFSET_StgMVar_value 16+#define REP_StgMVar_value b64+#define StgMVar_value(__ptr__) REP_StgMVar_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_value]+#define SIZEOF_StgMVarTSOQueue_NoHdr 16+#define SIZEOF_StgMVarTSOQueue (SIZEOF_StgHeader+16)+#define OFFSET_StgMVarTSOQueue_link 0+#define REP_StgMVarTSOQueue_link b64+#define StgMVarTSOQueue_link(__ptr__) REP_StgMVarTSOQueue_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVarTSOQueue_link]+#define OFFSET_StgMVarTSOQueue_tso 8+#define REP_StgMVarTSOQueue_tso b64+#define StgMVarTSOQueue_tso(__ptr__) REP_StgMVarTSOQueue_tso[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVarTSOQueue_tso]+#define SIZEOF_StgBCO_NoHdr 32+#define SIZEOF_StgBCO (SIZEOF_StgHeader+32)+#define OFFSET_StgBCO_instrs 0+#define REP_StgBCO_instrs b64+#define StgBCO_instrs(__ptr__) REP_StgBCO_instrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_instrs]+#define OFFSET_StgBCO_literals 8+#define REP_StgBCO_literals b64+#define StgBCO_literals(__ptr__) REP_StgBCO_literals[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_literals]+#define OFFSET_StgBCO_ptrs 16+#define REP_StgBCO_ptrs b64+#define StgBCO_ptrs(__ptr__) REP_StgBCO_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_ptrs]+#define OFFSET_StgBCO_arity 24+#define REP_StgBCO_arity b32+#define StgBCO_arity(__ptr__) REP_StgBCO_arity[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_arity]+#define OFFSET_StgBCO_size 28+#define REP_StgBCO_size b32+#define StgBCO_size(__ptr__) REP_StgBCO_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_size]+#define OFFSET_StgBCO_bitmap 32+#define StgBCO_bitmap(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_bitmap + WDS(__ix__)]+#define SIZEOF_StgStableName_NoHdr 8+#define SIZEOF_StgStableName (SIZEOF_StgHeader+8)+#define OFFSET_StgStableName_sn 0+#define REP_StgStableName_sn b64+#define StgStableName_sn(__ptr__) REP_StgStableName_sn[__ptr__+SIZEOF_StgHeader+OFFSET_StgStableName_sn]+#define SIZEOF_StgBlockingQueue_NoHdr 32+#define SIZEOF_StgBlockingQueue (SIZEOF_StgHeader+32)+#define OFFSET_StgBlockingQueue_bh 8+#define REP_StgBlockingQueue_bh b64+#define StgBlockingQueue_bh(__ptr__) REP_StgBlockingQueue_bh[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_bh]+#define OFFSET_StgBlockingQueue_owner 16+#define REP_StgBlockingQueue_owner b64+#define StgBlockingQueue_owner(__ptr__) REP_StgBlockingQueue_owner[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_owner]+#define OFFSET_StgBlockingQueue_queue 24+#define REP_StgBlockingQueue_queue b64+#define StgBlockingQueue_queue(__ptr__) REP_StgBlockingQueue_queue[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_queue]+#define OFFSET_StgBlockingQueue_link 0+#define REP_StgBlockingQueue_link b64+#define StgBlockingQueue_link(__ptr__) REP_StgBlockingQueue_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_link]+#define SIZEOF_MessageBlackHole_NoHdr 24+#define SIZEOF_MessageBlackHole (SIZEOF_StgHeader+24)+#define OFFSET_MessageBlackHole_link 0+#define REP_MessageBlackHole_link b64+#define MessageBlackHole_link(__ptr__) REP_MessageBlackHole_link[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_link]+#define OFFSET_MessageBlackHole_tso 8+#define REP_MessageBlackHole_tso b64+#define MessageBlackHole_tso(__ptr__) REP_MessageBlackHole_tso[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_tso]+#define OFFSET_MessageBlackHole_bh 16+#define REP_MessageBlackHole_bh b64+#define MessageBlackHole_bh(__ptr__) REP_MessageBlackHole_bh[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_bh]+#define SIZEOF_StgCompactNFData_NoHdr 64+#define SIZEOF_StgCompactNFData (SIZEOF_StgHeader+64)+#define OFFSET_StgCompactNFData_totalW 0+#define REP_StgCompactNFData_totalW b64+#define StgCompactNFData_totalW(__ptr__) REP_StgCompactNFData_totalW[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_totalW]+#define OFFSET_StgCompactNFData_autoBlockW 8+#define REP_StgCompactNFData_autoBlockW b64+#define StgCompactNFData_autoBlockW(__ptr__) REP_StgCompactNFData_autoBlockW[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_autoBlockW]+#define OFFSET_StgCompactNFData_nursery 32+#define REP_StgCompactNFData_nursery b64+#define StgCompactNFData_nursery(__ptr__) REP_StgCompactNFData_nursery[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_nursery]+#define OFFSET_StgCompactNFData_last 40+#define REP_StgCompactNFData_last b64+#define StgCompactNFData_last(__ptr__) REP_StgCompactNFData_last[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_last]+#define OFFSET_StgCompactNFData_hp 16+#define REP_StgCompactNFData_hp b64+#define StgCompactNFData_hp(__ptr__) REP_StgCompactNFData_hp[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hp]+#define OFFSET_StgCompactNFData_hpLim 24+#define REP_StgCompactNFData_hpLim b64+#define StgCompactNFData_hpLim(__ptr__) REP_StgCompactNFData_hpLim[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hpLim]+#define OFFSET_StgCompactNFData_hash 48+#define REP_StgCompactNFData_hash b64+#define StgCompactNFData_hash(__ptr__) REP_StgCompactNFData_hash[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hash]+#define OFFSET_StgCompactNFData_result 56+#define REP_StgCompactNFData_result b64+#define StgCompactNFData_result(__ptr__) REP_StgCompactNFData_result[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_result]+#define SIZEOF_StgCompactNFDataBlock 24+#define OFFSET_StgCompactNFDataBlock_self 0+#define REP_StgCompactNFDataBlock_self b64+#define StgCompactNFDataBlock_self(__ptr__) REP_StgCompactNFDataBlock_self[__ptr__+OFFSET_StgCompactNFDataBlock_self]+#define OFFSET_StgCompactNFDataBlock_owner 8+#define REP_StgCompactNFDataBlock_owner b64+#define StgCompactNFDataBlock_owner(__ptr__) REP_StgCompactNFDataBlock_owner[__ptr__+OFFSET_StgCompactNFDataBlock_owner]+#define OFFSET_StgCompactNFDataBlock_next 16+#define REP_StgCompactNFDataBlock_next b64+#define StgCompactNFDataBlock_next(__ptr__) REP_StgCompactNFDataBlock_next[__ptr__+OFFSET_StgCompactNFDataBlock_next]+#define OFFSET_RtsFlags_ProfFlags_showCCSOnException 269+#define REP_RtsFlags_ProfFlags_showCCSOnException b8+#define RtsFlags_ProfFlags_showCCSOnException(__ptr__) REP_RtsFlags_ProfFlags_showCCSOnException[__ptr__+OFFSET_RtsFlags_ProfFlags_showCCSOnException]+#define OFFSET_RtsFlags_DebugFlags_apply 210+#define REP_RtsFlags_DebugFlags_apply b8+#define RtsFlags_DebugFlags_apply(__ptr__) REP_RtsFlags_DebugFlags_apply[__ptr__+OFFSET_RtsFlags_DebugFlags_apply]+#define OFFSET_RtsFlags_DebugFlags_sanity 206+#define REP_RtsFlags_DebugFlags_sanity b8+#define RtsFlags_DebugFlags_sanity(__ptr__) REP_RtsFlags_DebugFlags_sanity[__ptr__+OFFSET_RtsFlags_DebugFlags_sanity]+#define OFFSET_RtsFlags_DebugFlags_weak 202+#define REP_RtsFlags_DebugFlags_weak b8+#define RtsFlags_DebugFlags_weak(__ptr__) REP_RtsFlags_DebugFlags_weak[__ptr__+OFFSET_RtsFlags_DebugFlags_weak]+#define OFFSET_RtsFlags_GcFlags_initialStkSize 16+#define REP_RtsFlags_GcFlags_initialStkSize b32+#define RtsFlags_GcFlags_initialStkSize(__ptr__) REP_RtsFlags_GcFlags_initialStkSize[__ptr__+OFFSET_RtsFlags_GcFlags_initialStkSize]+#define OFFSET_RtsFlags_MiscFlags_tickInterval 176+#define REP_RtsFlags_MiscFlags_tickInterval b64+#define RtsFlags_MiscFlags_tickInterval(__ptr__) REP_RtsFlags_MiscFlags_tickInterval[__ptr__+OFFSET_RtsFlags_MiscFlags_tickInterval]+#define SIZEOF_StgFunInfoExtraFwd 32+#define OFFSET_StgFunInfoExtraFwd_slow_apply 24+#define REP_StgFunInfoExtraFwd_slow_apply b64+#define StgFunInfoExtraFwd_slow_apply(__ptr__) REP_StgFunInfoExtraFwd_slow_apply[__ptr__+OFFSET_StgFunInfoExtraFwd_slow_apply]+#define OFFSET_StgFunInfoExtraFwd_fun_type 0+#define REP_StgFunInfoExtraFwd_fun_type b32+#define StgFunInfoExtraFwd_fun_type(__ptr__) REP_StgFunInfoExtraFwd_fun_type[__ptr__+OFFSET_StgFunInfoExtraFwd_fun_type]+#define OFFSET_StgFunInfoExtraFwd_arity 4+#define REP_StgFunInfoExtraFwd_arity b32+#define StgFunInfoExtraFwd_arity(__ptr__) REP_StgFunInfoExtraFwd_arity[__ptr__+OFFSET_StgFunInfoExtraFwd_arity]+#define OFFSET_StgFunInfoExtraFwd_bitmap 16+#define REP_StgFunInfoExtraFwd_bitmap b64+#define StgFunInfoExtraFwd_bitmap(__ptr__) REP_StgFunInfoExtraFwd_bitmap[__ptr__+OFFSET_StgFunInfoExtraFwd_bitmap]+#define SIZEOF_StgFunInfoExtraRev 24+#define OFFSET_StgFunInfoExtraRev_slow_apply_offset 0+#define REP_StgFunInfoExtraRev_slow_apply_offset b32+#define StgFunInfoExtraRev_slow_apply_offset(__ptr__) REP_StgFunInfoExtraRev_slow_apply_offset[__ptr__+OFFSET_StgFunInfoExtraRev_slow_apply_offset]+#define OFFSET_StgFunInfoExtraRev_fun_type 16+#define REP_StgFunInfoExtraRev_fun_type b32+#define StgFunInfoExtraRev_fun_type(__ptr__) REP_StgFunInfoExtraRev_fun_type[__ptr__+OFFSET_StgFunInfoExtraRev_fun_type]+#define OFFSET_StgFunInfoExtraRev_arity 20+#define REP_StgFunInfoExtraRev_arity b32+#define StgFunInfoExtraRev_arity(__ptr__) REP_StgFunInfoExtraRev_arity[__ptr__+OFFSET_StgFunInfoExtraRev_arity]+#define OFFSET_StgFunInfoExtraRev_bitmap 8+#define REP_StgFunInfoExtraRev_bitmap b64+#define StgFunInfoExtraRev_bitmap(__ptr__) REP_StgFunInfoExtraRev_bitmap[__ptr__+OFFSET_StgFunInfoExtraRev_bitmap]+#define OFFSET_StgFunInfoExtraRev_bitmap_offset 8+#define REP_StgFunInfoExtraRev_bitmap_offset b32+#define StgFunInfoExtraRev_bitmap_offset(__ptr__) REP_StgFunInfoExtraRev_bitmap_offset[__ptr__+OFFSET_StgFunInfoExtraRev_bitmap_offset]+#define OFFSET_StgLargeBitmap_size 0+#define REP_StgLargeBitmap_size b64+#define StgLargeBitmap_size(__ptr__) REP_StgLargeBitmap_size[__ptr__+OFFSET_StgLargeBitmap_size]+#define OFFSET_StgLargeBitmap_bitmap 8+#define SIZEOF_snEntry 24+#define OFFSET_snEntry_sn_obj 16+#define REP_snEntry_sn_obj b64+#define snEntry_sn_obj(__ptr__) REP_snEntry_sn_obj[__ptr__+OFFSET_snEntry_sn_obj]+#define OFFSET_snEntry_addr 0+#define REP_snEntry_addr b64+#define snEntry_addr(__ptr__) REP_snEntry_addr[__ptr__+OFFSET_snEntry_addr]+#define SIZEOF_spEntry 8+#define OFFSET_spEntry_addr 0+#define REP_spEntry_addr b64+#define spEntry_addr(__ptr__) REP_spEntry_addr[__ptr__+OFFSET_spEntry_addr]
+ ghc-lib/generated/GHCConstantsHaskellExports.hs view
@@ -0,0 +1,125 @@+    cONTROL_GROUP_CONST_291,+    sTD_HDR_SIZE,+    pROF_HDR_SIZE,+    bLOCK_SIZE,+    bLOCKS_PER_MBLOCK,+    tICKY_BIN_COUNT,+    oFFSET_StgRegTable_rR1,+    oFFSET_StgRegTable_rR2,+    oFFSET_StgRegTable_rR3,+    oFFSET_StgRegTable_rR4,+    oFFSET_StgRegTable_rR5,+    oFFSET_StgRegTable_rR6,+    oFFSET_StgRegTable_rR7,+    oFFSET_StgRegTable_rR8,+    oFFSET_StgRegTable_rR9,+    oFFSET_StgRegTable_rR10,+    oFFSET_StgRegTable_rF1,+    oFFSET_StgRegTable_rF2,+    oFFSET_StgRegTable_rF3,+    oFFSET_StgRegTable_rF4,+    oFFSET_StgRegTable_rF5,+    oFFSET_StgRegTable_rF6,+    oFFSET_StgRegTable_rD1,+    oFFSET_StgRegTable_rD2,+    oFFSET_StgRegTable_rD3,+    oFFSET_StgRegTable_rD4,+    oFFSET_StgRegTable_rD5,+    oFFSET_StgRegTable_rD6,+    oFFSET_StgRegTable_rXMM1,+    oFFSET_StgRegTable_rXMM2,+    oFFSET_StgRegTable_rXMM3,+    oFFSET_StgRegTable_rXMM4,+    oFFSET_StgRegTable_rXMM5,+    oFFSET_StgRegTable_rXMM6,+    oFFSET_StgRegTable_rYMM1,+    oFFSET_StgRegTable_rYMM2,+    oFFSET_StgRegTable_rYMM3,+    oFFSET_StgRegTable_rYMM4,+    oFFSET_StgRegTable_rYMM5,+    oFFSET_StgRegTable_rYMM6,+    oFFSET_StgRegTable_rZMM1,+    oFFSET_StgRegTable_rZMM2,+    oFFSET_StgRegTable_rZMM3,+    oFFSET_StgRegTable_rZMM4,+    oFFSET_StgRegTable_rZMM5,+    oFFSET_StgRegTable_rZMM6,+    oFFSET_StgRegTable_rL1,+    oFFSET_StgRegTable_rSp,+    oFFSET_StgRegTable_rSpLim,+    oFFSET_StgRegTable_rHp,+    oFFSET_StgRegTable_rHpLim,+    oFFSET_StgRegTable_rCCCS,+    oFFSET_StgRegTable_rCurrentTSO,+    oFFSET_StgRegTable_rCurrentNursery,+    oFFSET_StgRegTable_rHpAlloc,+    oFFSET_stgEagerBlackholeInfo,+    oFFSET_stgGCEnter1,+    oFFSET_stgGCFun,+    oFFSET_Capability_r,+    oFFSET_bdescr_start,+    oFFSET_bdescr_free,+    oFFSET_bdescr_blocks,+    oFFSET_bdescr_flags,+    sIZEOF_CostCentreStack,+    oFFSET_CostCentreStack_mem_alloc,+    oFFSET_CostCentreStack_scc_count,+    oFFSET_StgHeader_ccs,+    oFFSET_StgHeader_ldvw,+    sIZEOF_StgSMPThunkHeader,+    oFFSET_StgEntCounter_allocs,+    oFFSET_StgEntCounter_allocd,+    oFFSET_StgEntCounter_registeredp,+    oFFSET_StgEntCounter_link,+    oFFSET_StgEntCounter_entry_count,+    sIZEOF_StgUpdateFrame_NoHdr,+    sIZEOF_StgMutArrPtrs_NoHdr,+    oFFSET_StgMutArrPtrs_ptrs,+    oFFSET_StgMutArrPtrs_size,+    sIZEOF_StgSmallMutArrPtrs_NoHdr,+    oFFSET_StgSmallMutArrPtrs_ptrs,+    sIZEOF_StgArrBytes_NoHdr,+    oFFSET_StgArrBytes_bytes,+    oFFSET_StgTSO_alloc_limit,+    oFFSET_StgTSO_cccs,+    oFFSET_StgTSO_stackobj,+    oFFSET_StgStack_sp,+    oFFSET_StgStack_stack,+    oFFSET_StgUpdateFrame_updatee,+    oFFSET_StgFunInfoExtraFwd_arity,+    sIZEOF_StgFunInfoExtraRev,+    oFFSET_StgFunInfoExtraRev_arity,+    mAX_SPEC_SELECTEE_SIZE,+    mAX_SPEC_AP_SIZE,+    mIN_PAYLOAD_SIZE,+    mIN_INTLIKE,+    mAX_INTLIKE,+    mIN_CHARLIKE,+    mAX_CHARLIKE,+    mUT_ARR_PTRS_CARD_BITS,+    mAX_Vanilla_REG,+    mAX_Float_REG,+    mAX_Double_REG,+    mAX_Long_REG,+    mAX_XMM_REG,+    mAX_Real_Vanilla_REG,+    mAX_Real_Float_REG,+    mAX_Real_Double_REG,+    mAX_Real_XMM_REG,+    mAX_Real_Long_REG,+    rESERVED_C_STACK_BYTES,+    rESERVED_STACK_WORDS,+    aP_STACK_SPLIM,+    wORD_SIZE,+    dOUBLE_SIZE,+    cINT_SIZE,+    cLONG_SIZE,+    cLONG_LONG_SIZE,+    bITMAP_BITS_SHIFT,+    tAG_BITS,+    wORDS_BIGENDIAN,+    dYNAMIC_BY_DEFAULT,+    lDV_SHIFT,+    iLDV_CREATE_MASK,+    iLDV_STATE_CREATE,+    iLDV_STATE_USE,
+ ghc-lib/generated/GHCConstantsHaskellType.hs view
@@ -0,0 +1,134 @@+data PlatformConstants = PlatformConstants {+    pc_platformConstants :: ()+    , pc_CONTROL_GROUP_CONST_291 :: Int+    , pc_STD_HDR_SIZE :: Int+    , pc_PROF_HDR_SIZE :: Int+    , pc_BLOCK_SIZE :: Int+    , pc_BLOCKS_PER_MBLOCK :: Int+    , pc_TICKY_BIN_COUNT :: Int+    , pc_OFFSET_StgRegTable_rR1 :: Int+    , pc_OFFSET_StgRegTable_rR2 :: Int+    , pc_OFFSET_StgRegTable_rR3 :: Int+    , pc_OFFSET_StgRegTable_rR4 :: Int+    , pc_OFFSET_StgRegTable_rR5 :: Int+    , pc_OFFSET_StgRegTable_rR6 :: Int+    , pc_OFFSET_StgRegTable_rR7 :: Int+    , pc_OFFSET_StgRegTable_rR8 :: Int+    , pc_OFFSET_StgRegTable_rR9 :: Int+    , pc_OFFSET_StgRegTable_rR10 :: Int+    , pc_OFFSET_StgRegTable_rF1 :: Int+    , pc_OFFSET_StgRegTable_rF2 :: Int+    , pc_OFFSET_StgRegTable_rF3 :: Int+    , pc_OFFSET_StgRegTable_rF4 :: Int+    , pc_OFFSET_StgRegTable_rF5 :: Int+    , pc_OFFSET_StgRegTable_rF6 :: Int+    , pc_OFFSET_StgRegTable_rD1 :: Int+    , pc_OFFSET_StgRegTable_rD2 :: Int+    , pc_OFFSET_StgRegTable_rD3 :: Int+    , pc_OFFSET_StgRegTable_rD4 :: Int+    , pc_OFFSET_StgRegTable_rD5 :: Int+    , pc_OFFSET_StgRegTable_rD6 :: Int+    , pc_OFFSET_StgRegTable_rXMM1 :: Int+    , pc_OFFSET_StgRegTable_rXMM2 :: Int+    , pc_OFFSET_StgRegTable_rXMM3 :: Int+    , pc_OFFSET_StgRegTable_rXMM4 :: Int+    , pc_OFFSET_StgRegTable_rXMM5 :: Int+    , pc_OFFSET_StgRegTable_rXMM6 :: Int+    , pc_OFFSET_StgRegTable_rYMM1 :: Int+    , pc_OFFSET_StgRegTable_rYMM2 :: Int+    , pc_OFFSET_StgRegTable_rYMM3 :: Int+    , pc_OFFSET_StgRegTable_rYMM4 :: Int+    , pc_OFFSET_StgRegTable_rYMM5 :: Int+    , pc_OFFSET_StgRegTable_rYMM6 :: Int+    , pc_OFFSET_StgRegTable_rZMM1 :: Int+    , pc_OFFSET_StgRegTable_rZMM2 :: Int+    , pc_OFFSET_StgRegTable_rZMM3 :: Int+    , pc_OFFSET_StgRegTable_rZMM4 :: Int+    , pc_OFFSET_StgRegTable_rZMM5 :: Int+    , pc_OFFSET_StgRegTable_rZMM6 :: Int+    , pc_OFFSET_StgRegTable_rL1 :: Int+    , pc_OFFSET_StgRegTable_rSp :: Int+    , pc_OFFSET_StgRegTable_rSpLim :: Int+    , pc_OFFSET_StgRegTable_rHp :: Int+    , pc_OFFSET_StgRegTable_rHpLim :: Int+    , pc_OFFSET_StgRegTable_rCCCS :: Int+    , pc_OFFSET_StgRegTable_rCurrentTSO :: Int+    , pc_OFFSET_StgRegTable_rCurrentNursery :: Int+    , pc_OFFSET_StgRegTable_rHpAlloc :: Int+    , pc_OFFSET_stgEagerBlackholeInfo :: Int+    , pc_OFFSET_stgGCEnter1 :: Int+    , pc_OFFSET_stgGCFun :: Int+    , pc_OFFSET_Capability_r :: Int+    , pc_OFFSET_bdescr_start :: Int+    , pc_OFFSET_bdescr_free :: Int+    , pc_OFFSET_bdescr_blocks :: Int+    , pc_OFFSET_bdescr_flags :: Int+    , pc_SIZEOF_CostCentreStack :: Int+    , pc_OFFSET_CostCentreStack_mem_alloc :: Int+    , pc_REP_CostCentreStack_mem_alloc :: Int+    , pc_OFFSET_CostCentreStack_scc_count :: Int+    , pc_REP_CostCentreStack_scc_count :: Int+    , pc_OFFSET_StgHeader_ccs :: Int+    , pc_OFFSET_StgHeader_ldvw :: Int+    , pc_SIZEOF_StgSMPThunkHeader :: Int+    , pc_OFFSET_StgEntCounter_allocs :: Int+    , pc_REP_StgEntCounter_allocs :: Int+    , pc_OFFSET_StgEntCounter_allocd :: Int+    , pc_REP_StgEntCounter_allocd :: Int+    , pc_OFFSET_StgEntCounter_registeredp :: Int+    , pc_OFFSET_StgEntCounter_link :: Int+    , pc_OFFSET_StgEntCounter_entry_count :: Int+    , pc_SIZEOF_StgUpdateFrame_NoHdr :: Int+    , pc_SIZEOF_StgMutArrPtrs_NoHdr :: Int+    , pc_OFFSET_StgMutArrPtrs_ptrs :: Int+    , pc_OFFSET_StgMutArrPtrs_size :: Int+    , pc_SIZEOF_StgSmallMutArrPtrs_NoHdr :: Int+    , pc_OFFSET_StgSmallMutArrPtrs_ptrs :: Int+    , pc_SIZEOF_StgArrBytes_NoHdr :: Int+    , pc_OFFSET_StgArrBytes_bytes :: Int+    , pc_OFFSET_StgTSO_alloc_limit :: Int+    , pc_OFFSET_StgTSO_cccs :: Int+    , pc_OFFSET_StgTSO_stackobj :: Int+    , pc_OFFSET_StgStack_sp :: Int+    , pc_OFFSET_StgStack_stack :: Int+    , pc_OFFSET_StgUpdateFrame_updatee :: Int+    , pc_OFFSET_StgFunInfoExtraFwd_arity :: Int+    , pc_REP_StgFunInfoExtraFwd_arity :: Int+    , pc_SIZEOF_StgFunInfoExtraRev :: Int+    , pc_OFFSET_StgFunInfoExtraRev_arity :: Int+    , pc_REP_StgFunInfoExtraRev_arity :: Int+    , pc_MAX_SPEC_SELECTEE_SIZE :: Int+    , pc_MAX_SPEC_AP_SIZE :: Int+    , pc_MIN_PAYLOAD_SIZE :: Int+    , pc_MIN_INTLIKE :: Int+    , pc_MAX_INTLIKE :: Int+    , pc_MIN_CHARLIKE :: Int+    , pc_MAX_CHARLIKE :: Int+    , pc_MUT_ARR_PTRS_CARD_BITS :: Int+    , pc_MAX_Vanilla_REG :: Int+    , pc_MAX_Float_REG :: Int+    , pc_MAX_Double_REG :: Int+    , pc_MAX_Long_REG :: Int+    , pc_MAX_XMM_REG :: Int+    , pc_MAX_Real_Vanilla_REG :: Int+    , pc_MAX_Real_Float_REG :: Int+    , pc_MAX_Real_Double_REG :: Int+    , pc_MAX_Real_XMM_REG :: Int+    , pc_MAX_Real_Long_REG :: Int+    , pc_RESERVED_C_STACK_BYTES :: Int+    , pc_RESERVED_STACK_WORDS :: Int+    , pc_AP_STACK_SPLIM :: Int+    , pc_WORD_SIZE :: Int+    , pc_DOUBLE_SIZE :: Int+    , pc_CINT_SIZE :: Int+    , pc_CLONG_SIZE :: Int+    , pc_CLONG_LONG_SIZE :: Int+    , pc_BITMAP_BITS_SHIFT :: Int+    , pc_TAG_BITS :: Int+    , pc_WORDS_BIGENDIAN :: Bool+    , pc_DYNAMIC_BY_DEFAULT :: Bool+    , pc_LDV_SHIFT :: Int+    , pc_ILDV_CREATE_MASK :: Integer+    , pc_ILDV_STATE_CREATE :: Integer+    , pc_ILDV_STATE_USE :: Integer+  } deriving Read
+ ghc-lib/generated/GHCConstantsHaskellWrappers.hs view
@@ -0,0 +1,250 @@+cONTROL_GROUP_CONST_291 :: DynFlags -> Int+cONTROL_GROUP_CONST_291 dflags = pc_CONTROL_GROUP_CONST_291 (sPlatformConstants (settings dflags))+sTD_HDR_SIZE :: DynFlags -> Int+sTD_HDR_SIZE dflags = pc_STD_HDR_SIZE (sPlatformConstants (settings dflags))+pROF_HDR_SIZE :: DynFlags -> Int+pROF_HDR_SIZE dflags = pc_PROF_HDR_SIZE (sPlatformConstants (settings dflags))+bLOCK_SIZE :: DynFlags -> Int+bLOCK_SIZE dflags = pc_BLOCK_SIZE (sPlatformConstants (settings dflags))+bLOCKS_PER_MBLOCK :: DynFlags -> Int+bLOCKS_PER_MBLOCK dflags = pc_BLOCKS_PER_MBLOCK (sPlatformConstants (settings dflags))+tICKY_BIN_COUNT :: DynFlags -> Int+tICKY_BIN_COUNT dflags = pc_TICKY_BIN_COUNT (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR1 :: DynFlags -> Int+oFFSET_StgRegTable_rR1 dflags = pc_OFFSET_StgRegTable_rR1 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR2 :: DynFlags -> Int+oFFSET_StgRegTable_rR2 dflags = pc_OFFSET_StgRegTable_rR2 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR3 :: DynFlags -> Int+oFFSET_StgRegTable_rR3 dflags = pc_OFFSET_StgRegTable_rR3 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR4 :: DynFlags -> Int+oFFSET_StgRegTable_rR4 dflags = pc_OFFSET_StgRegTable_rR4 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR5 :: DynFlags -> Int+oFFSET_StgRegTable_rR5 dflags = pc_OFFSET_StgRegTable_rR5 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR6 :: DynFlags -> Int+oFFSET_StgRegTable_rR6 dflags = pc_OFFSET_StgRegTable_rR6 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR7 :: DynFlags -> Int+oFFSET_StgRegTable_rR7 dflags = pc_OFFSET_StgRegTable_rR7 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR8 :: DynFlags -> Int+oFFSET_StgRegTable_rR8 dflags = pc_OFFSET_StgRegTable_rR8 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR9 :: DynFlags -> Int+oFFSET_StgRegTable_rR9 dflags = pc_OFFSET_StgRegTable_rR9 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rR10 :: DynFlags -> Int+oFFSET_StgRegTable_rR10 dflags = pc_OFFSET_StgRegTable_rR10 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rF1 :: DynFlags -> Int+oFFSET_StgRegTable_rF1 dflags = pc_OFFSET_StgRegTable_rF1 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rF2 :: DynFlags -> Int+oFFSET_StgRegTable_rF2 dflags = pc_OFFSET_StgRegTable_rF2 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rF3 :: DynFlags -> Int+oFFSET_StgRegTable_rF3 dflags = pc_OFFSET_StgRegTable_rF3 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rF4 :: DynFlags -> Int+oFFSET_StgRegTable_rF4 dflags = pc_OFFSET_StgRegTable_rF4 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rF5 :: DynFlags -> Int+oFFSET_StgRegTable_rF5 dflags = pc_OFFSET_StgRegTable_rF5 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rF6 :: DynFlags -> Int+oFFSET_StgRegTable_rF6 dflags = pc_OFFSET_StgRegTable_rF6 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rD1 :: DynFlags -> Int+oFFSET_StgRegTable_rD1 dflags = pc_OFFSET_StgRegTable_rD1 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rD2 :: DynFlags -> Int+oFFSET_StgRegTable_rD2 dflags = pc_OFFSET_StgRegTable_rD2 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rD3 :: DynFlags -> Int+oFFSET_StgRegTable_rD3 dflags = pc_OFFSET_StgRegTable_rD3 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rD4 :: DynFlags -> Int+oFFSET_StgRegTable_rD4 dflags = pc_OFFSET_StgRegTable_rD4 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rD5 :: DynFlags -> Int+oFFSET_StgRegTable_rD5 dflags = pc_OFFSET_StgRegTable_rD5 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rD6 :: DynFlags -> Int+oFFSET_StgRegTable_rD6 dflags = pc_OFFSET_StgRegTable_rD6 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rXMM1 :: DynFlags -> Int+oFFSET_StgRegTable_rXMM1 dflags = pc_OFFSET_StgRegTable_rXMM1 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rXMM2 :: DynFlags -> Int+oFFSET_StgRegTable_rXMM2 dflags = pc_OFFSET_StgRegTable_rXMM2 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rXMM3 :: DynFlags -> Int+oFFSET_StgRegTable_rXMM3 dflags = pc_OFFSET_StgRegTable_rXMM3 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rXMM4 :: DynFlags -> Int+oFFSET_StgRegTable_rXMM4 dflags = pc_OFFSET_StgRegTable_rXMM4 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rXMM5 :: DynFlags -> Int+oFFSET_StgRegTable_rXMM5 dflags = pc_OFFSET_StgRegTable_rXMM5 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rXMM6 :: DynFlags -> Int+oFFSET_StgRegTable_rXMM6 dflags = pc_OFFSET_StgRegTable_rXMM6 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rYMM1 :: DynFlags -> Int+oFFSET_StgRegTable_rYMM1 dflags = pc_OFFSET_StgRegTable_rYMM1 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rYMM2 :: DynFlags -> Int+oFFSET_StgRegTable_rYMM2 dflags = pc_OFFSET_StgRegTable_rYMM2 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rYMM3 :: DynFlags -> Int+oFFSET_StgRegTable_rYMM3 dflags = pc_OFFSET_StgRegTable_rYMM3 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rYMM4 :: DynFlags -> Int+oFFSET_StgRegTable_rYMM4 dflags = pc_OFFSET_StgRegTable_rYMM4 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rYMM5 :: DynFlags -> Int+oFFSET_StgRegTable_rYMM5 dflags = pc_OFFSET_StgRegTable_rYMM5 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rYMM6 :: DynFlags -> Int+oFFSET_StgRegTable_rYMM6 dflags = pc_OFFSET_StgRegTable_rYMM6 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rZMM1 :: DynFlags -> Int+oFFSET_StgRegTable_rZMM1 dflags = pc_OFFSET_StgRegTable_rZMM1 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rZMM2 :: DynFlags -> Int+oFFSET_StgRegTable_rZMM2 dflags = pc_OFFSET_StgRegTable_rZMM2 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rZMM3 :: DynFlags -> Int+oFFSET_StgRegTable_rZMM3 dflags = pc_OFFSET_StgRegTable_rZMM3 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rZMM4 :: DynFlags -> Int+oFFSET_StgRegTable_rZMM4 dflags = pc_OFFSET_StgRegTable_rZMM4 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rZMM5 :: DynFlags -> Int+oFFSET_StgRegTable_rZMM5 dflags = pc_OFFSET_StgRegTable_rZMM5 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rZMM6 :: DynFlags -> Int+oFFSET_StgRegTable_rZMM6 dflags = pc_OFFSET_StgRegTable_rZMM6 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rL1 :: DynFlags -> Int+oFFSET_StgRegTable_rL1 dflags = pc_OFFSET_StgRegTable_rL1 (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rSp :: DynFlags -> Int+oFFSET_StgRegTable_rSp dflags = pc_OFFSET_StgRegTable_rSp (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rSpLim :: DynFlags -> Int+oFFSET_StgRegTable_rSpLim dflags = pc_OFFSET_StgRegTable_rSpLim (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rHp :: DynFlags -> Int+oFFSET_StgRegTable_rHp dflags = pc_OFFSET_StgRegTable_rHp (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rHpLim :: DynFlags -> Int+oFFSET_StgRegTable_rHpLim dflags = pc_OFFSET_StgRegTable_rHpLim (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rCCCS :: DynFlags -> Int+oFFSET_StgRegTable_rCCCS dflags = pc_OFFSET_StgRegTable_rCCCS (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rCurrentTSO :: DynFlags -> Int+oFFSET_StgRegTable_rCurrentTSO dflags = pc_OFFSET_StgRegTable_rCurrentTSO (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rCurrentNursery :: DynFlags -> Int+oFFSET_StgRegTable_rCurrentNursery dflags = pc_OFFSET_StgRegTable_rCurrentNursery (sPlatformConstants (settings dflags))+oFFSET_StgRegTable_rHpAlloc :: DynFlags -> Int+oFFSET_StgRegTable_rHpAlloc dflags = pc_OFFSET_StgRegTable_rHpAlloc (sPlatformConstants (settings dflags))+oFFSET_stgEagerBlackholeInfo :: DynFlags -> Int+oFFSET_stgEagerBlackholeInfo dflags = pc_OFFSET_stgEagerBlackholeInfo (sPlatformConstants (settings dflags))+oFFSET_stgGCEnter1 :: DynFlags -> Int+oFFSET_stgGCEnter1 dflags = pc_OFFSET_stgGCEnter1 (sPlatformConstants (settings dflags))+oFFSET_stgGCFun :: DynFlags -> Int+oFFSET_stgGCFun dflags = pc_OFFSET_stgGCFun (sPlatformConstants (settings dflags))+oFFSET_Capability_r :: DynFlags -> Int+oFFSET_Capability_r dflags = pc_OFFSET_Capability_r (sPlatformConstants (settings dflags))+oFFSET_bdescr_start :: DynFlags -> Int+oFFSET_bdescr_start dflags = pc_OFFSET_bdescr_start (sPlatformConstants (settings dflags))+oFFSET_bdescr_free :: DynFlags -> Int+oFFSET_bdescr_free dflags = pc_OFFSET_bdescr_free (sPlatformConstants (settings dflags))+oFFSET_bdescr_blocks :: DynFlags -> Int+oFFSET_bdescr_blocks dflags = pc_OFFSET_bdescr_blocks (sPlatformConstants (settings dflags))+oFFSET_bdescr_flags :: DynFlags -> Int+oFFSET_bdescr_flags dflags = pc_OFFSET_bdescr_flags (sPlatformConstants (settings dflags))+sIZEOF_CostCentreStack :: DynFlags -> Int+sIZEOF_CostCentreStack dflags = pc_SIZEOF_CostCentreStack (sPlatformConstants (settings dflags))+oFFSET_CostCentreStack_mem_alloc :: DynFlags -> Int+oFFSET_CostCentreStack_mem_alloc dflags = pc_OFFSET_CostCentreStack_mem_alloc (sPlatformConstants (settings dflags))+oFFSET_CostCentreStack_scc_count :: DynFlags -> Int+oFFSET_CostCentreStack_scc_count dflags = pc_OFFSET_CostCentreStack_scc_count (sPlatformConstants (settings dflags))+oFFSET_StgHeader_ccs :: DynFlags -> Int+oFFSET_StgHeader_ccs dflags = pc_OFFSET_StgHeader_ccs (sPlatformConstants (settings dflags))+oFFSET_StgHeader_ldvw :: DynFlags -> Int+oFFSET_StgHeader_ldvw dflags = pc_OFFSET_StgHeader_ldvw (sPlatformConstants (settings dflags))+sIZEOF_StgSMPThunkHeader :: DynFlags -> Int+sIZEOF_StgSMPThunkHeader dflags = pc_SIZEOF_StgSMPThunkHeader (sPlatformConstants (settings dflags))+oFFSET_StgEntCounter_allocs :: DynFlags -> Int+oFFSET_StgEntCounter_allocs dflags = pc_OFFSET_StgEntCounter_allocs (sPlatformConstants (settings dflags))+oFFSET_StgEntCounter_allocd :: DynFlags -> Int+oFFSET_StgEntCounter_allocd dflags = pc_OFFSET_StgEntCounter_allocd (sPlatformConstants (settings dflags))+oFFSET_StgEntCounter_registeredp :: DynFlags -> Int+oFFSET_StgEntCounter_registeredp dflags = pc_OFFSET_StgEntCounter_registeredp (sPlatformConstants (settings dflags))+oFFSET_StgEntCounter_link :: DynFlags -> Int+oFFSET_StgEntCounter_link dflags = pc_OFFSET_StgEntCounter_link (sPlatformConstants (settings dflags))+oFFSET_StgEntCounter_entry_count :: DynFlags -> Int+oFFSET_StgEntCounter_entry_count dflags = pc_OFFSET_StgEntCounter_entry_count (sPlatformConstants (settings dflags))+sIZEOF_StgUpdateFrame_NoHdr :: DynFlags -> Int+sIZEOF_StgUpdateFrame_NoHdr dflags = pc_SIZEOF_StgUpdateFrame_NoHdr (sPlatformConstants (settings dflags))+sIZEOF_StgMutArrPtrs_NoHdr :: DynFlags -> Int+sIZEOF_StgMutArrPtrs_NoHdr dflags = pc_SIZEOF_StgMutArrPtrs_NoHdr (sPlatformConstants (settings dflags))+oFFSET_StgMutArrPtrs_ptrs :: DynFlags -> Int+oFFSET_StgMutArrPtrs_ptrs dflags = pc_OFFSET_StgMutArrPtrs_ptrs (sPlatformConstants (settings dflags))+oFFSET_StgMutArrPtrs_size :: DynFlags -> Int+oFFSET_StgMutArrPtrs_size dflags = pc_OFFSET_StgMutArrPtrs_size (sPlatformConstants (settings dflags))+sIZEOF_StgSmallMutArrPtrs_NoHdr :: DynFlags -> Int+sIZEOF_StgSmallMutArrPtrs_NoHdr dflags = pc_SIZEOF_StgSmallMutArrPtrs_NoHdr (sPlatformConstants (settings dflags))+oFFSET_StgSmallMutArrPtrs_ptrs :: DynFlags -> Int+oFFSET_StgSmallMutArrPtrs_ptrs dflags = pc_OFFSET_StgSmallMutArrPtrs_ptrs (sPlatformConstants (settings dflags))+sIZEOF_StgArrBytes_NoHdr :: DynFlags -> Int+sIZEOF_StgArrBytes_NoHdr dflags = pc_SIZEOF_StgArrBytes_NoHdr (sPlatformConstants (settings dflags))+oFFSET_StgArrBytes_bytes :: DynFlags -> Int+oFFSET_StgArrBytes_bytes dflags = pc_OFFSET_StgArrBytes_bytes (sPlatformConstants (settings dflags))+oFFSET_StgTSO_alloc_limit :: DynFlags -> Int+oFFSET_StgTSO_alloc_limit dflags = pc_OFFSET_StgTSO_alloc_limit (sPlatformConstants (settings dflags))+oFFSET_StgTSO_cccs :: DynFlags -> Int+oFFSET_StgTSO_cccs dflags = pc_OFFSET_StgTSO_cccs (sPlatformConstants (settings dflags))+oFFSET_StgTSO_stackobj :: DynFlags -> Int+oFFSET_StgTSO_stackobj dflags = pc_OFFSET_StgTSO_stackobj (sPlatformConstants (settings dflags))+oFFSET_StgStack_sp :: DynFlags -> Int+oFFSET_StgStack_sp dflags = pc_OFFSET_StgStack_sp (sPlatformConstants (settings dflags))+oFFSET_StgStack_stack :: DynFlags -> Int+oFFSET_StgStack_stack dflags = pc_OFFSET_StgStack_stack (sPlatformConstants (settings dflags))+oFFSET_StgUpdateFrame_updatee :: DynFlags -> Int+oFFSET_StgUpdateFrame_updatee dflags = pc_OFFSET_StgUpdateFrame_updatee (sPlatformConstants (settings dflags))+oFFSET_StgFunInfoExtraFwd_arity :: DynFlags -> Int+oFFSET_StgFunInfoExtraFwd_arity dflags = pc_OFFSET_StgFunInfoExtraFwd_arity (sPlatformConstants (settings dflags))+sIZEOF_StgFunInfoExtraRev :: DynFlags -> Int+sIZEOF_StgFunInfoExtraRev dflags = pc_SIZEOF_StgFunInfoExtraRev (sPlatformConstants (settings dflags))+oFFSET_StgFunInfoExtraRev_arity :: DynFlags -> Int+oFFSET_StgFunInfoExtraRev_arity dflags = pc_OFFSET_StgFunInfoExtraRev_arity (sPlatformConstants (settings dflags))+mAX_SPEC_SELECTEE_SIZE :: DynFlags -> Int+mAX_SPEC_SELECTEE_SIZE dflags = pc_MAX_SPEC_SELECTEE_SIZE (sPlatformConstants (settings dflags))+mAX_SPEC_AP_SIZE :: DynFlags -> Int+mAX_SPEC_AP_SIZE dflags = pc_MAX_SPEC_AP_SIZE (sPlatformConstants (settings dflags))+mIN_PAYLOAD_SIZE :: DynFlags -> Int+mIN_PAYLOAD_SIZE dflags = pc_MIN_PAYLOAD_SIZE (sPlatformConstants (settings dflags))+mIN_INTLIKE :: DynFlags -> Int+mIN_INTLIKE dflags = pc_MIN_INTLIKE (sPlatformConstants (settings dflags))+mAX_INTLIKE :: DynFlags -> Int+mAX_INTLIKE dflags = pc_MAX_INTLIKE (sPlatformConstants (settings dflags))+mIN_CHARLIKE :: DynFlags -> Int+mIN_CHARLIKE dflags = pc_MIN_CHARLIKE (sPlatformConstants (settings dflags))+mAX_CHARLIKE :: DynFlags -> Int+mAX_CHARLIKE dflags = pc_MAX_CHARLIKE (sPlatformConstants (settings dflags))+mUT_ARR_PTRS_CARD_BITS :: DynFlags -> Int+mUT_ARR_PTRS_CARD_BITS dflags = pc_MUT_ARR_PTRS_CARD_BITS (sPlatformConstants (settings dflags))+mAX_Vanilla_REG :: DynFlags -> Int+mAX_Vanilla_REG dflags = pc_MAX_Vanilla_REG (sPlatformConstants (settings dflags))+mAX_Float_REG :: DynFlags -> Int+mAX_Float_REG dflags = pc_MAX_Float_REG (sPlatformConstants (settings dflags))+mAX_Double_REG :: DynFlags -> Int+mAX_Double_REG dflags = pc_MAX_Double_REG (sPlatformConstants (settings dflags))+mAX_Long_REG :: DynFlags -> Int+mAX_Long_REG dflags = pc_MAX_Long_REG (sPlatformConstants (settings dflags))+mAX_XMM_REG :: DynFlags -> Int+mAX_XMM_REG dflags = pc_MAX_XMM_REG (sPlatformConstants (settings dflags))+mAX_Real_Vanilla_REG :: DynFlags -> Int+mAX_Real_Vanilla_REG dflags = pc_MAX_Real_Vanilla_REG (sPlatformConstants (settings dflags))+mAX_Real_Float_REG :: DynFlags -> Int+mAX_Real_Float_REG dflags = pc_MAX_Real_Float_REG (sPlatformConstants (settings dflags))+mAX_Real_Double_REG :: DynFlags -> Int+mAX_Real_Double_REG dflags = pc_MAX_Real_Double_REG (sPlatformConstants (settings dflags))+mAX_Real_XMM_REG :: DynFlags -> Int+mAX_Real_XMM_REG dflags = pc_MAX_Real_XMM_REG (sPlatformConstants (settings dflags))+mAX_Real_Long_REG :: DynFlags -> Int+mAX_Real_Long_REG dflags = pc_MAX_Real_Long_REG (sPlatformConstants (settings dflags))+rESERVED_C_STACK_BYTES :: DynFlags -> Int+rESERVED_C_STACK_BYTES dflags = pc_RESERVED_C_STACK_BYTES (sPlatformConstants (settings dflags))+rESERVED_STACK_WORDS :: DynFlags -> Int+rESERVED_STACK_WORDS dflags = pc_RESERVED_STACK_WORDS (sPlatformConstants (settings dflags))+aP_STACK_SPLIM :: DynFlags -> Int+aP_STACK_SPLIM dflags = pc_AP_STACK_SPLIM (sPlatformConstants (settings dflags))+wORD_SIZE :: DynFlags -> Int+wORD_SIZE dflags = pc_WORD_SIZE (sPlatformConstants (settings dflags))+dOUBLE_SIZE :: DynFlags -> Int+dOUBLE_SIZE dflags = pc_DOUBLE_SIZE (sPlatformConstants (settings dflags))+cINT_SIZE :: DynFlags -> Int+cINT_SIZE dflags = pc_CINT_SIZE (sPlatformConstants (settings dflags))+cLONG_SIZE :: DynFlags -> Int+cLONG_SIZE dflags = pc_CLONG_SIZE (sPlatformConstants (settings dflags))+cLONG_LONG_SIZE :: DynFlags -> Int+cLONG_LONG_SIZE dflags = pc_CLONG_LONG_SIZE (sPlatformConstants (settings dflags))+bITMAP_BITS_SHIFT :: DynFlags -> Int+bITMAP_BITS_SHIFT dflags = pc_BITMAP_BITS_SHIFT (sPlatformConstants (settings dflags))+tAG_BITS :: DynFlags -> Int+tAG_BITS dflags = pc_TAG_BITS (sPlatformConstants (settings dflags))+wORDS_BIGENDIAN :: DynFlags -> Bool+wORDS_BIGENDIAN dflags = pc_WORDS_BIGENDIAN (sPlatformConstants (settings dflags))+dYNAMIC_BY_DEFAULT :: DynFlags -> Bool+dYNAMIC_BY_DEFAULT dflags = pc_DYNAMIC_BY_DEFAULT (sPlatformConstants (settings dflags))+lDV_SHIFT :: DynFlags -> Int+lDV_SHIFT dflags = pc_LDV_SHIFT (sPlatformConstants (settings dflags))+iLDV_CREATE_MASK :: DynFlags -> Integer+iLDV_CREATE_MASK dflags = pc_ILDV_CREATE_MASK (sPlatformConstants (settings dflags))+iLDV_STATE_CREATE :: DynFlags -> Integer+iLDV_STATE_CREATE dflags = pc_ILDV_STATE_CREATE (sPlatformConstants (settings dflags))+iLDV_STATE_USE :: DynFlags -> Integer+iLDV_STATE_USE dflags = pc_ILDV_STATE_USE (sPlatformConstants (settings dflags))
+ ghc-lib/generated/ghcautoconf.h view
@@ -0,0 +1,542 @@+#ifndef __GHCAUTOCONF_H__+#define __GHCAUTOCONF_H__+/* mk/config.h.  Generated from config.h.in by configure.  */+/* mk/config.h.in.  Generated from configure.ac by autoheader.  */++/* Define if building universal (internal helper macro) */+/* #undef AC_APPLE_UNIVERSAL_BUILD */++/* The alignment of a `char'. */+#define ALIGNMENT_CHAR 1++/* The alignment of a `double'. */+#define ALIGNMENT_DOUBLE 8++/* The alignment of a `float'. */+#define ALIGNMENT_FLOAT 4++/* The alignment of a `int'. */+#define ALIGNMENT_INT 4++/* The alignment of a `int16_t'. */+#define ALIGNMENT_INT16_T 2++/* The alignment of a `int32_t'. */+#define ALIGNMENT_INT32_T 4++/* The alignment of a `int64_t'. */+#define ALIGNMENT_INT64_T 8++/* The alignment of a `int8_t'. */+#define ALIGNMENT_INT8_T 1++/* The alignment of a `long'. */+#define ALIGNMENT_LONG 8++/* The alignment of a `long long'. */+#define ALIGNMENT_LONG_LONG 8++/* The alignment of a `short'. */+#define ALIGNMENT_SHORT 2++/* The alignment of a `uint16_t'. */+#define ALIGNMENT_UINT16_T 2++/* The alignment of a `uint32_t'. */+#define ALIGNMENT_UINT32_T 4++/* The alignment of a `uint64_t'. */+#define ALIGNMENT_UINT64_T 8++/* The alignment of a `uint8_t'. */+#define ALIGNMENT_UINT8_T 1++/* The alignment of a `unsigned char'. */+#define ALIGNMENT_UNSIGNED_CHAR 1++/* The alignment of a `unsigned int'. */+#define ALIGNMENT_UNSIGNED_INT 4++/* The alignment of a `unsigned long'. */+#define ALIGNMENT_UNSIGNED_LONG 8++/* The alignment of a `unsigned long long'. */+#define ALIGNMENT_UNSIGNED_LONG_LONG 8++/* The alignment of a `unsigned short'. */+#define ALIGNMENT_UNSIGNED_SHORT 2++/* The alignment of a `void *'. */+#define ALIGNMENT_VOID_P 8++/* Define to 1 if __thread is supported */+#define CC_SUPPORTS_TLS 1++/* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP+   systems. This function is required for `alloca.c' support on those systems.+   */+/* #undef CRAY_STACKSEG_END */++/* Define to 1 if using `alloca.c'. */+/* #undef C_ALLOCA */++/* Define to 1 if your processor stores words of floats with the most+   significant byte first */+/* #undef FLOAT_WORDS_BIGENDIAN */++/* Has visibility hidden */+#define HAS_VISIBILITY_HIDDEN 1++/* Define to 1 if you have `alloca', as a function or macro. */+#define HAVE_ALLOCA 1++/* Define to 1 if you have <alloca.h> and it should be used (not on Ultrix).+   */+#define HAVE_ALLOCA_H 1++/* Define to 1 if you have the <bfd.h> header file. */+/* #undef HAVE_BFD_H */++/* Does GCC support __atomic primitives? */+#define HAVE_C11_ATOMICS $CONF_GCC_SUPPORTS__ATOMICS++/* Define to 1 if you have the `clock_gettime' function. */+#define HAVE_CLOCK_GETTIME 1++/* Define to 1 if you have the `ctime_r' function. */+#define HAVE_CTIME_R 1++/* Define to 1 if you have the <ctype.h> header file. */+#define HAVE_CTYPE_H 1++/* Define to 1 if you have the declaration of `ctime_r', and to 0 if you+   don't. */+#define HAVE_DECL_CTIME_R 1++/* Define to 1 if you have the declaration of `MADV_DONTNEED', and to 0 if you+   don't. */+/* #undef HAVE_DECL_MADV_DONTNEED */++/* Define to 1 if you have the declaration of `MADV_FREE', and to 0 if you+   don't. */+/* #undef HAVE_DECL_MADV_FREE */++/* Define to 1 if you have the declaration of `MAP_NORESERVE', and to 0 if you+   don't. */+/* #undef HAVE_DECL_MAP_NORESERVE */++/* Define to 1 if you have the <dirent.h> header file. */+#define HAVE_DIRENT_H 1++/* Define to 1 if you have the <dlfcn.h> header file. */+#define HAVE_DLFCN_H 1++/* Define to 1 if you have the <errno.h> header file. */+#define HAVE_ERRNO_H 1++/* Define to 1 if you have the `eventfd' function. */+/* #undef HAVE_EVENTFD */++/* Define to 1 if you have the <fcntl.h> header file. */+#define HAVE_FCNTL_H 1++/* Define to 1 if you have the <ffi.h> header file. */+/* #undef HAVE_FFI_H */++/* Define to 1 if you have the `fork' function. */+#define HAVE_FORK 1++/* Define to 1 if you have the `getclock' function. */+/* #undef HAVE_GETCLOCK */++/* Define to 1 if you have the `GetModuleFileName' function. */+/* #undef HAVE_GETMODULEFILENAME */++/* Define to 1 if you have the `getrusage' function. */+#define HAVE_GETRUSAGE 1++/* Define to 1 if you have the `gettimeofday' function. */+#define HAVE_GETTIMEOFDAY 1++/* Define to 1 if you have the <grp.h> header file. */+#define HAVE_GRP_H 1++/* Define to 1 if you have the <inttypes.h> header file. */+#define HAVE_INTTYPES_H 1++/* Define to 1 if you have the `bfd' library (-lbfd). */+/* #undef HAVE_LIBBFD */++/* Define to 1 if you have the `dl' library (-ldl). */+#define HAVE_LIBDL 1++/* Define to 1 if you have libffi. */+/* #undef HAVE_LIBFFI */++/* Define to 1 if you have the `iberty' library (-liberty). */+/* #undef HAVE_LIBIBERTY */++/* Define to 1 if you need to link with libm */+#define HAVE_LIBM 1++/* Define to 1 if you have libnuma */+#define HAVE_LIBNUMA 0++/* Define to 1 if you have the `pthread' library (-lpthread). */+#define HAVE_LIBPTHREAD 1++/* Define to 1 if you have the `rt' library (-lrt). */+/* #undef HAVE_LIBRT */++/* Define to 1 if you have the <limits.h> header file. */+#define HAVE_LIMITS_H 1++/* Define to 1 if you have the <locale.h> header file. */+#define HAVE_LOCALE_H 1++/* Define to 1 if the system has the type `long long'. */+#define HAVE_LONG_LONG 1++/* Define to 1 if you have the <memory.h> header file. */+#define HAVE_MEMORY_H 1++/* Define to 1 if you have the mingwex library. */+/* #undef HAVE_MINGWEX */++/* Define to 1 if you have the <nlist.h> header file. */+#define HAVE_NLIST_H 1++/* Define to 1 if you have the <numaif.h> header file. */+/* #undef HAVE_NUMAIF_H */++/* Define to 1 if you have the <numa.h> header file. */+/* #undef HAVE_NUMA_H */++/* Define to 1 if we have printf$LDBLStub (Apple Mac OS >= 10.4, PPC). */+#define HAVE_PRINTF_LDBLSTUB 0++/* Define to 1 if you have the <pthread.h> header file. */+#define HAVE_PTHREAD_H 1++/* Define to 1 if you have the glibc version of pthread_setname_np */+/* #undef HAVE_PTHREAD_SETNAME_NP */++/* Define to 1 if you have the <pwd.h> header file. */+#define HAVE_PWD_H 1++/* Define to 1 if you have the <sched.h> header file. */+#define HAVE_SCHED_H 1++/* Define to 1 if you have the `sched_setaffinity' function. */+/* #undef HAVE_SCHED_SETAFFINITY */++/* Define to 1 if you have the `setitimer' function. */+#define HAVE_SETITIMER 1++/* Define to 1 if you have the `setlocale' function. */+#define HAVE_SETLOCALE 1++/* Define to 1 if you have the `siginterrupt' function. */+#define HAVE_SIGINTERRUPT 1++/* Define to 1 if you have the <signal.h> header file. */+#define HAVE_SIGNAL_H 1++/* Define to 1 if you have the <stdint.h> header file. */+#define HAVE_STDINT_H 1++/* Define to 1 if you have the <stdlib.h> header file. */+#define HAVE_STDLIB_H 1++/* Define to 1 if you have the <strings.h> header file. */+#define HAVE_STRINGS_H 1++/* Define to 1 if you have the <string.h> header file. */+#define HAVE_STRING_H 1++/* Define to 1 if Apple-style dead-stripping is supported. */+#define HAVE_SUBSECTIONS_VIA_SYMBOLS 1++/* Define to 1 if you have the `sysconf' function. */+#define HAVE_SYSCONF 1++/* Define to 1 if you have the <sys/cpuset.h> header file. */+/* #undef HAVE_SYS_CPUSET_H */++/* Define to 1 if you have the <sys/eventfd.h> header file. */+/* #undef HAVE_SYS_EVENTFD_H */++/* Define to 1 if you have the <sys/mman.h> header file. */+#define HAVE_SYS_MMAN_H 1++/* Define to 1 if you have the <sys/param.h> header file. */+#define HAVE_SYS_PARAM_H 1++/* Define to 1 if you have the <sys/resource.h> header file. */+#define HAVE_SYS_RESOURCE_H 1++/* Define to 1 if you have the <sys/select.h> header file. */+#define HAVE_SYS_SELECT_H 1++/* Define to 1 if you have the <sys/stat.h> header file. */+#define HAVE_SYS_STAT_H 1++/* Define to 1 if you have the <sys/timeb.h> header file. */+#define HAVE_SYS_TIMEB_H 1++/* Define to 1 if you have the <sys/timerfd.h> header file. */+/* #undef HAVE_SYS_TIMERFD_H */++/* Define to 1 if you have the <sys/timers.h> header file. */+/* #undef HAVE_SYS_TIMERS_H */++/* Define to 1 if you have the <sys/times.h> header file. */+#define HAVE_SYS_TIMES_H 1++/* Define to 1 if you have the <sys/time.h> header file. */+#define HAVE_SYS_TIME_H 1++/* Define to 1 if you have the <sys/types.h> header file. */+#define HAVE_SYS_TYPES_H 1++/* Define to 1 if you have the <sys/utsname.h> header file. */+#define HAVE_SYS_UTSNAME_H 1++/* Define to 1 if you have the <sys/wait.h> header file. */+#define HAVE_SYS_WAIT_H 1++/* Define to 1 if you have the <termios.h> header file. */+#define HAVE_TERMIOS_H 1++/* Define to 1 if you have the `timer_settime' function. */+/* #undef HAVE_TIMER_SETTIME */++/* Define to 1 if you have the `times' function. */+#define HAVE_TIMES 1++/* Define to 1 if you have the <time.h> header file. */+#define HAVE_TIME_H 1++/* Define to 1 if you have the <unistd.h> header file. */+#define HAVE_UNISTD_H 1++/* Define to 1 if you have the <utime.h> header file. */+#define HAVE_UTIME_H 1++/* Define to 1 if you have the `vfork' function. */+#define HAVE_VFORK 1++/* Define to 1 if you have the <vfork.h> header file. */+/* #undef HAVE_VFORK_H */++/* Define to 1 if you have the <windows.h> header file. */+/* #undef HAVE_WINDOWS_H */++/* Define to 1 if you have the `WinExec' function. */+/* #undef HAVE_WINEXEC */++/* Define to 1 if you have the <winsock.h> header file. */+/* #undef HAVE_WINSOCK_H */++/* Define to 1 if `fork' works. */+#define HAVE_WORKING_FORK 1++/* Define to 1 if `vfork' works. */+#define HAVE_WORKING_VFORK 1++/* Define to 1 if C symbols have a leading underscore added by the compiler.+   */+#define LEADING_UNDERSCORE 1++/* Define 1 if we need to link code using pthreads with -lpthread */+#define NEED_PTHREAD_LIB 0++/* Define to the address where bug reports for this package should be sent. */+/* #undef PACKAGE_BUGREPORT */++/* Define to the full name of this package. */+/* #undef PACKAGE_NAME */++/* Define to the full name and version of this package. */+/* #undef PACKAGE_STRING */++/* Define to the one symbol short name of this package. */+/* #undef PACKAGE_TARNAME */++/* Define to the home page for this package. */+/* #undef PACKAGE_URL */++/* Define to the version of this package. */+/* #undef PACKAGE_VERSION */++/* Use mmap in the runtime linker */+#define RTS_LINKER_USE_MMAP 1++/* The size of `char', as computed by sizeof. */+#define SIZEOF_CHAR 1++/* The size of `double', as computed by sizeof. */+#define SIZEOF_DOUBLE 8++/* The size of `float', as computed by sizeof. */+#define SIZEOF_FLOAT 4++/* The size of `int', as computed by sizeof. */+#define SIZEOF_INT 4++/* The size of `int16_t', as computed by sizeof. */+#define SIZEOF_INT16_T 2++/* The size of `int32_t', as computed by sizeof. */+#define SIZEOF_INT32_T 4++/* The size of `int64_t', as computed by sizeof. */+#define SIZEOF_INT64_T 8++/* The size of `int8_t', as computed by sizeof. */+#define SIZEOF_INT8_T 1++/* The size of `long', as computed by sizeof. */+#define SIZEOF_LONG 8++/* The size of `long long', as computed by sizeof. */+#define SIZEOF_LONG_LONG 8++/* The size of `short', as computed by sizeof. */+#define SIZEOF_SHORT 2++/* The size of `uint16_t', as computed by sizeof. */+#define SIZEOF_UINT16_T 2++/* The size of `uint32_t', as computed by sizeof. */+#define SIZEOF_UINT32_T 4++/* The size of `uint64_t', as computed by sizeof. */+#define SIZEOF_UINT64_T 8++/* The size of `uint8_t', as computed by sizeof. */+#define SIZEOF_UINT8_T 1++/* The size of `unsigned char', as computed by sizeof. */+#define SIZEOF_UNSIGNED_CHAR 1++/* The size of `unsigned int', as computed by sizeof. */+#define SIZEOF_UNSIGNED_INT 4++/* The size of `unsigned long', as computed by sizeof. */+#define SIZEOF_UNSIGNED_LONG 8++/* The size of `unsigned long long', as computed by sizeof. */+#define SIZEOF_UNSIGNED_LONG_LONG 8++/* The size of `unsigned short', as computed by sizeof. */+#define SIZEOF_UNSIGNED_SHORT 2++/* The size of `void *', as computed by sizeof. */+#define SIZEOF_VOID_P 8++/* If using the C implementation of alloca, define if you know the+   direction of stack growth for your system; otherwise it will be+   automatically deduced at runtime.+	STACK_DIRECTION > 0 => grows toward higher addresses+	STACK_DIRECTION < 0 => grows toward lower addresses+	STACK_DIRECTION = 0 => direction of growth unknown */+/* #undef STACK_DIRECTION */++/* Define to 1 if you have the ANSI C header files. */+#define STDC_HEADERS 1++/* Define to 1 if you can safely include both <sys/time.h> and <time.h>. */+#define TIME_WITH_SYS_TIME 1++/* Enable single heap address space support */+#define USE_LARGE_ADDRESS_SPACE 1++/* Set to 1 to use libdw */+#define USE_LIBDW 0++/* Enable extensions on AIX 3, Interix.  */+#ifndef _ALL_SOURCE+# define _ALL_SOURCE 1+#endif+/* Enable GNU extensions on systems that have them.  */+#ifndef _GNU_SOURCE+# define _GNU_SOURCE 1+#endif+/* Enable threading extensions on Solaris.  */+#ifndef _POSIX_PTHREAD_SEMANTICS+# define _POSIX_PTHREAD_SEMANTICS 1+#endif+/* Enable extensions on HP NonStop.  */+#ifndef _TANDEM_SOURCE+# define _TANDEM_SOURCE 1+#endif+/* Enable general extensions on Solaris.  */+#ifndef __EXTENSIONS__+# define __EXTENSIONS__ 1+#endif+++/* Define to 1 if we can use timer_create(CLOCK_REALTIME,...) */+/* #undef USE_TIMER_CREATE */++/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most+   significant byte first (like Motorola and SPARC, unlike Intel). */+#if defined AC_APPLE_UNIVERSAL_BUILD+# if defined __BIG_ENDIAN__+#  define WORDS_BIGENDIAN 1+# endif+#else+# ifndef WORDS_BIGENDIAN+/* #  undef WORDS_BIGENDIAN */+# endif+#endif++/* Enable large inode numbers on Mac OS X 10.5.  */+#ifndef _DARWIN_USE_64_BIT_INODE+# define _DARWIN_USE_64_BIT_INODE 1+#endif++/* Number of bits in a file offset, on hosts where this is settable. */+/* #undef _FILE_OFFSET_BITS */++/* Define for large files, on AIX-style hosts. */+/* #undef _LARGE_FILES */++/* Define to 1 if on MINIX. */+/* #undef _MINIX */++/* Define to 2 if the system does not provide POSIX.1 features except with+   this defined. */+/* #undef _POSIX_1_SOURCE */++/* Define to 1 if you need to in order for `stat' and other things to work. */+/* #undef _POSIX_SOURCE */++/* ARM pre v6 */+/* #undef arm_HOST_ARCH_PRE_ARMv6 */++/* ARM pre v7 */+/* #undef arm_HOST_ARCH_PRE_ARMv7 */++/* Define to empty if `const' does not conform to ANSI C. */+/* #undef const */++/* Define to `int' if <sys/types.h> does not define. */+/* #undef pid_t */++/* The supported LLVM version number */+#define sUPPORTED_LLVM_VERSION (7,0)++/* Define to `unsigned int' if <sys/types.h> does not define. */+/* #undef size_t */++/* Define as `fork' if `vfork' does not work. */+/* #undef vfork */++#define TABLES_NEXT_TO_CODE 1++#define llvm_CC_FLAVOR 1++#define clang_CC_FLAVOR 1+#endif /* __GHCAUTOCONF_H__ */
+ ghc-lib/generated/ghcplatform.h view
@@ -0,0 +1,34 @@+#ifndef __GHCPLATFORM_H__+#define __GHCPLATFORM_H__++#define BuildPlatform_TYPE  x86_64_apple_darwin+#define HostPlatform_TYPE   x86_64_apple_darwin++#define x86_64_apple_darwin_BUILD 1+#define x86_64_apple_darwin_HOST 1++#define x86_64_BUILD_ARCH 1+#define x86_64_HOST_ARCH 1+#define BUILD_ARCH "x86_64"+#define HOST_ARCH "x86_64"++#define darwin_BUILD_OS 1+#define darwin_HOST_OS 1+#define BUILD_OS "darwin"+#define HOST_OS "darwin"++#define apple_BUILD_VENDOR 1+#define apple_HOST_VENDOR 1+#define BUILD_VENDOR "apple"+#define HOST_VENDOR "apple"++/* These TARGET macros are for backwards compatibility... DO NOT USE! */+#define TargetPlatform_TYPE x86_64_apple_darwin+#define x86_64_apple_darwin_TARGET 1+#define x86_64_TARGET_ARCH 1+#define TARGET_ARCH "x86_64"+#define darwin_TARGET_OS 1+#define TARGET_OS "darwin"+#define apple_TARGET_VENDOR 1++#endif /* __GHCPLATFORM_H__ */
+ ghc-lib/generated/ghcversion.h view
@@ -0,0 +1,18 @@+#ifndef __GHCVERSION_H__+#define __GHCVERSION_H__++#ifndef __GLASGOW_HASKELL__+# define __GLASGOW_HASKELL__ 809+#endif++#define __GLASGOW_HASKELL_PATCHLEVEL1__ 20190402++#define MIN_VERSION_GLASGOW_HASKELL(ma,mi,pl1,pl2) (\+   ((ma)*100+(mi)) <  __GLASGOW_HASKELL__ || \+   ((ma)*100+(mi)) == __GLASGOW_HASKELL__    \+          && (pl1) <  __GLASGOW_HASKELL_PATCHLEVEL1__ || \+   ((ma)*100+(mi)) == __GLASGOW_HASKELL__    \+          && (pl1) == __GLASGOW_HASKELL_PATCHLEVEL1__ \+          && (pl2) <= __GLASGOW_HASKELL_PATCHLEVEL2__ )++#endif /* __GHCVERSION_H__ */
+ ghc-lib/stage0/compiler/build/Lexer.hs view
@@ -0,0 +1,3465 @@+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-}+{-# LANGUAGE CPP,MagicHash #-}+{-# LINE 43 "compiler/parser/Lexer.x" #-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}++{-# OPTIONS_GHC -funbox-strict-fields #-}++module Lexer (+   Token(..), lexer, pragState, mkPState, mkPStatePure, PState(..),+   P(..), ParseResult(..), mkParserFlags, mkParserFlags', ParserFlags,+   getRealSrcLoc, getPState, withThisPackage,+   failLocMsgP, srcParseFail,+   getErrorMessages, getMessages,+   popContext, pushModuleContext, setLastToken, setSrcLoc,+   activeContext, nextIsEOF,+   getLexState, popLexState, pushLexState,+   ExtBits(..), getBit,+   addWarning, addError, addFatalError,+   lexTokenStream,+   addAnnotation,AddAnn,addAnnsAt,mkParensApiAnn,+   commentToAnnotation+  ) where++import GhcPrelude++-- base+import Control.Monad+import Control.Monad.Fail as MonadFail+import Data.Bits+import Data.Char+import Data.List+import Data.Maybe+import Data.Word++import EnumSet (EnumSet)+import qualified EnumSet++-- ghc-boot+import qualified GHC.LanguageExtensions as LangExt++-- bytestring+import Data.ByteString (ByteString)++-- containers+import Data.Map (Map)+import qualified Data.Map as Map++-- compiler/utils+import Bag+import Outputable+import StringBuffer+import FastString+import UniqFM+import Util             ( readRational, readHexRational )++-- compiler/main+import ErrUtils+import DynFlags++-- compiler/basicTypes+import SrcLoc+import Module+import BasicTypes     ( InlineSpec(..), RuleMatchInfo(..),+                        IntegralLit(..), FractionalLit(..),+                        SourceText(..) )++-- compiler/parser+import Ctype++import ApiAnnotation++#if __GLASGOW_HASKELL__ >= 603+#include "ghcconfig.h"+#elif defined(__GLASGOW_HASKELL__)+#include "config.h"+#endif+#if __GLASGOW_HASKELL__ >= 503+import Data.Array+import Data.Array.Base (unsafeAt)+#else+import Array+#endif+#if __GLASGOW_HASKELL__ >= 503+import GHC.Exts+#else+import GlaExts+#endif+alex_tab_size :: Int+alex_tab_size = 8+alex_base :: AlexAddr+alex_base = AlexA#+  "\x01\x00\x00\x00\x7b\x00\x00\x00\x84\x00\x00\x00\xa0\x00\x00\x00\xbc\x00\x00\x00\xc5\x00\x00\x00\xce\x00\x00\x00\xec\x00\x00\x00\x06\x01\x00\x00\x22\x01\x00\x00\x3f\x01\x00\x00\x7b\x01\x00\x00\xd4\xff\xff\xff\x61\x00\x00\x00\xd7\xff\xff\xff\xdb\xff\xff\xff\xa4\xff\xff\xff\xaa\xff\xff\xff\xf8\x01\x00\x00\x72\x02\x00\x00\xec\x02\x00\x00\x93\xff\xff\xff\x94\xff\xff\xff\x66\x03\x00\x00\x95\xff\xff\xff\xb2\xff\xff\xff\xe7\xff\xff\xff\xe8\xff\xff\xff\xe9\xff\xff\xff\xd1\x00\x00\x00\xae\xff\xff\xff\xab\xff\xff\xff\xb0\xff\xff\xff\x59\x01\x00\x00\xdc\x03\x00\x00\xfc\x01\x00\x00\xe6\x03\x00\x00\xb3\xff\xff\xff\xba\xff\xff\xff\xac\xff\xff\xff\x3d\x01\x00\x00\x7a\x01\x00\x00\x50\x02\x00\x00\xca\x02\x00\x00\x1f\x04\x00\x00\xfa\x03\x00\x00\x59\x04\x00\x00\x95\x01\x00\x00\x05\x02\x00\x00\xaf\xff\xff\xff\xb1\xff\xff\xff\xa4\x04\x00\x00\xe5\x04\x00\x00\x63\x02\x00\x00\x44\x03\x00\x00\xdd\x02\x00\x00\xfc\x04\x00\x00\x3d\x05\x00\x00\x57\x03\x00\x00\xc5\x04\x00\x00\x1d\x05\x00\x00\x59\x05\x00\x00\x63\x05\x00\x00\x79\x05\x00\x00\x83\x05\x00\x00\x99\x05\x00\x00\xa9\x05\x00\x00\xb3\x05\x00\x00\xbd\x05\x00\x00\xc9\x05\x00\x00\xd3\x05\x00\x00\xed\x05\x00\x00\x04\x06\x00\x00\x63\x00\x00\x00\x51\x00\x00\x00\x26\x06\x00\x00\x4b\x06\x00\x00\x62\x06\x00\x00\xc4\x03\x00\x00\x6c\x00\x00\x00\x84\x06\x00\x00\xbd\x06\x00\x00\x17\x07\x00\x00\x95\x07\x00\x00\x11\x08\x00\x00\x8d\x08\x00\x00\x09\x09\x00\x00\x85\x09\x00\x00\x01\x0a\x00\x00\xb9\x00\x00\x00\x7d\x0a\x00\x00\xfb\x0a\x00\x00\x12\x00\x00\x00\x16\x00\x00\x00\x2d\x01\x00\x00\x5e\x01\x00\x00\x00\x00\x00\x00\x79\x00\x00\x00\xfa\x01\x00\x00\xe0\x03\x00\x00\x67\x00\x00\x00\x9c\x00\x00\x00\x81\x00\x00\x00\x82\x00\x00\x00\x88\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x00\x00\x76\x0b\x00\x00\x9e\x0b\x00\x00\xe1\x0b\x00\x00\x09\x0c\x00\x00\x4c\x0c\x00\x00\x74\x0c\x00\x00\xb7\x0c\x00\x00\xe7\x04\x00\x00\x94\x07\x00\x00\x10\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x75\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf7\x0c\x00\x00\x71\x0d\x00\x00\xeb\x0d\x00\x00\x65\x0e\x00\x00\xdf\x0e\x00\x00\xa8\x00\x00\x00\xa9\x00\x00\x00\x5d\x0f\x00\x00\x9d\x00\x00\x00\xd7\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x10\x00\x00\x00\x00\x00\x00\xcf\x10\x00\x00\x49\x11\x00\x00\x00\x00\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc3\x11\x00\x00\x3d\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x97\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd7\x12\x00\x00\x51\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8b\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9f\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x00\x00\x07\x14\x00\x00\x81\x14\x00\x00\xfb\x14\x00\x00\x75\x15\x00\x00\xef\x15\x00\x00\x69\x16\x00\x00\xe3\x16\x00\x00\x5d\x17\x00\x00\xd7\x17\x00\x00\x51\x18\x00\x00\xcb\x18\x00\x00\x45\x19\x00\x00\xbf\x19\x00\x00\x39\x1a\x00\x00\xa1\x00\x00\x00\xbd\x00\x00\x00\xbe\x00\x00\x00\xbf\x00\x00\x00\xc1\x00\x00\x00\xc3\x00\x00\x00\x93\x1a\x00\x00\xb6\x1a\x00\x00\x12\x1b\x00\x00\x3a\x1b\x00\x00\x5d\x1b\x00\x00\x85\x1b\x00\x00\xc8\x1b\x00\x00\xed\x1b\x00\x00\x66\x1c\x00\x00\xdf\x1c\x00\x00\x58\x1d\x00\x00\xb4\x1d\x00\x00\x58\x0b\x00\x00\xc7\x1d\x00\x00\xdd\x00\x00\x00\xbb\x06\x00\x00\x10\x1e\x00\x00\xc9\x1a\x00\x00\x35\x1e\x00\x00\x20\x01\x00\x00\x71\x07\x00\x00\x7e\x1e\x00\x00\x49\x1c\x00\x00\xf2\x07\x00\x00\xc3\x1c\x00\x00\x6e\x08\x00\x00\xbf\x1e\x00\x00\xe4\x08\x00\x00\x00\x1f\x00\x00\x60\x09\x00\x00\xc4\x00\x00\x00\xc7\x00\x00\x00\xc8\x00\x00\x00\xc9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++alex_table :: AlexAddr+alex_table = AlexA#+  "\x00\x00\x64\x00\xc1\x00\xba\x00\x6d\x00\xcf\x00\x5e\x00\xa1\x00\x6e\x00\x77\x00\x60\x00\x80\x00\x5e\x00\x5e\x00\x5e\x00\x7d\x00\x8b\x00\x8c\x00\x8e\x00\x5d\x00\x15\x00\x16\x00\x18\x00\x32\x00\x19\x00\x31\x00\x1f\x00\x25\x00\x7a\x00\x11\x00\x26\x00\x10\x00\x79\x00\x5e\x00\xcf\x00\xf6\x00\xd0\x00\xd3\x00\xcf\x00\xcf\x00\xf5\x00\xaa\x00\xab\x00\xcf\x00\xcf\x00\xaf\x00\xcb\x00\xcf\x00\xcf\x00\xd6\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd4\x00\xb0\x00\xcf\x00\xcf\x00\xcf\x00\xd1\x00\xa2\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xad\x00\xcf\x00\xae\x00\xcf\x00\xbb\x00\xb1\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xb3\x00\xcd\x00\xb4\x00\xcf\x00\x5e\x00\xdc\x00\xdc\x00\xff\xff\x60\x00\x76\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x12\x00\xff\xff\xff\xff\x60\x00\x6e\x00\x5e\x00\x5e\x00\x5e\x00\xff\xff\xdd\x00\xdd\x00\xdd\x00\xdd\x00\xdd\x00\xdd\x00\xdd\x00\xdd\x00\x5e\x00\xd7\x00\xd7\x00\x78\x00\xff\xff\xff\xff\xff\xff\x64\x00\x20\x00\x5e\x00\x5e\x00\xff\xff\xff\xff\x0f\x00\x60\x00\x7c\x00\x5e\x00\x5e\x00\x5e\x00\x93\x00\x5c\x00\x4a\x00\x0f\x00\xff\xff\xff\xff\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x95\x00\x88\x00\x5e\x00\x5e\x00\x49\x00\x7e\x00\xc3\x00\x60\x00\x7c\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x4f\x00\x62\x00\x0f\x00\x60\x00\x7c\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x63\x00\x65\x00\x70\x00\x60\x00\xa7\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x91\x00\x8b\x00\x7e\x00\xc4\x00\xc5\x00\xc7\x00\x91\x00\xc5\x00\x5e\x00\xc8\x00\xef\x00\x7e\x00\x0f\x00\xf0\x00\xf1\x00\xf2\x00\xf4\x00\x5e\x00\x00\x00\x00\x00\x5e\x00\x0f\x00\x00\x00\x00\x00\x60\x00\x0c\x00\x5e\x00\x5e\x00\x5e\x00\x1e\x00\x0f\x00\x00\x00\x00\x00\x27\x00\x0c\x00\xe8\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x5f\x00\x5e\x00\xd7\x00\xd7\x00\x61\x00\xff\xff\x5f\x00\x5f\x00\x5f\x00\x00\x00\x00\x00\x3d\x00\x91\x00\x00\x00\x0f\x00\x00\x00\x7b\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x5f\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x5e\x00\x5e\x00\x5e\x00\x1d\x00\xa3\x00\x5e\x00\x87\x00\x00\x00\x91\x00\x3d\x00\x7b\x00\x5e\x00\x5e\x00\x5e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x7b\x00\x7f\x00\x5e\x00\xec\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x60\x00\x0c\x00\x5e\x00\x5e\x00\x5e\x00\x5e\x00\x00\x00\x0f\x00\xdc\x00\xdc\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x00\x00\x00\x00\x30\x00\x5e\x00\x00\x00\x00\x00\x1a\x00\x5f\x00\x30\x00\x30\x00\x30\x00\x0c\x00\xff\xff\x5f\x00\x5f\x00\x5f\x00\x0d\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x00\x00\x00\x00\x30\x00\x00\x00\x00\x00\xc2\x00\xc0\x00\x5f\x00\x4a\x00\x5e\x00\x86\x00\x00\x00\x00\x00\x60\x00\x80\x00\x5e\x00\x5e\x00\x5e\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2f\x00\x5e\x00\x28\x00\x0c\x00\x1c\x00\x00\x00\x2f\x00\x2f\x00\x2f\x00\xa9\x00\xab\x00\x00\x00\x00\x00\xaf\x00\x0e\x00\x00\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x00\x00\x2f\x00\xb0\x00\x5a\x00\x2a\x00\x00\x00\x0c\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xac\x00\x00\x00\xae\x00\x29\x00\xc0\x00\xb1\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xb2\x00\x00\x00\xb4\x00\x81\x00\x81\x00\x81\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x23\x00\x12\x00\x12\x00\x12\x00\x12\x00\x23\x00\x23\x00\x23\x00\x23\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x00\x30\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x59\x00\x00\x00\x23\x00\x8f\x00\x91\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\x00\x30\x00\x00\x00\x5b\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x91\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x83\x00\x83\x00\x83\x00\x91\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x13\x00\x13\x00\x13\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x37\x00\x00\x00\x13\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x84\x00\x84\x00\x84\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x00\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x8d\x00\x8d\x00\x8d\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x3c\x00\x00\x00\x17\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x00\x00\x00\x00\x00\x00\x36\x00\x00\x00\x00\x00\x00\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x00\x00\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x2f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2f\x00\x2f\x00\x2f\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x23\x00\x23\x00\x23\x00\xd8\x00\xd8\x00\xd8\x00\xd8\x00\xd8\x00\xd8\x00\xd8\x00\xd8\x00\x2f\x00\x00\x00\x00\x00\x00\x00\x59\x00\x00\x00\x00\x00\x90\x00\x91\x00\x00\x00\x23\x00\x00\x00\x00\x00\x1b\x00\x91\x00\x00\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x24\x00\x2c\x00\x2c\x00\x2c\x00\x4e\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x41\x00\x00\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x29\x00\x00\x00\x00\x00\x91\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x00\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x1d\x00\x2c\x00\x53\x00\x91\x00\x00\x00\x00\x00\x3d\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x00\x00\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x35\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x35\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\x00\x00\x00\x00\x6a\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\x3a\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x00\x00\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\x40\x00\x00\x00\x40\x00\x00\x00\x00\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\x00\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\x00\x00\x45\x00\x00\x00\x45\x00\x00\x00\x3f\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\x00\x00\x42\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x44\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\x00\x00\x47\x00\x00\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\x35\x00\x00\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\x00\x00\x00\x00\x00\x00\x48\x00\x00\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\x00\x00\x4c\x00\x00\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\x3a\x00\x00\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xb8\x00\xb6\x00\x00\x00\x4d\x00\x00\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\xd8\x00\xd8\x00\xd8\x00\xd8\x00\xd8\x00\xd8\x00\xd8\x00\xd8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb7\x00\xb5\x00\x4e\x00\xc9\x00\xb6\x00\x00\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xc9\x00\x00\x00\xc9\x00\xc9\x00\xc9\x00\xc9\x00\x00\x00\x00\x00\x00\x00\xc9\x00\xc9\x00\x00\x00\xc9\x00\xc9\x00\xc9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\x00\x00\x00\xc9\x00\xc9\x00\xc9\x00\xc9\x00\xc9\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\x00\x00\xc9\x00\x00\x00\xc9\x00\xb5\x00\x00\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\x00\x00\xc9\x00\xed\x00\xc9\x00\x53\x00\x53\x00\x53\x00\x00\x00\x00\x00\x00\x00\x53\x00\x00\x00\xff\xff\x00\x00\x00\x00\xdd\x00\xdd\x00\xdd\x00\xdd\x00\xdd\x00\xdd\x00\xdd\x00\xdd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\x00\x00\x00\x00\x00\x00\x00\x53\x00\x00\x00\x68\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x00\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x00\x00\x00\x00\x68\x00\x00\x00\x53\x00\x00\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x53\x00\x68\x00\xa0\x00\x54\x00\x54\x00\x54\x00\xf3\x00\x00\x00\x00\x00\x54\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\xe0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\x00\x00\x00\x00\x00\x00\x00\x54\x00\x00\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x00\x00\x00\x00\x69\x00\x00\x00\x54\x00\x00\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x69\x00\x9f\x00\x54\x00\x54\x00\x54\x00\xf3\x00\x00\x00\x00\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\xe2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x00\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x00\x00\x98\x00\x54\x00\x54\x00\x54\x00\x00\x00\x00\x00\x00\x00\x54\x00\x00\x00\x00\x00\x00\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\xe4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x00\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x00\x00\x97\x00\x54\x00\x54\x00\x54\x00\x00\x00\x00\x00\x00\x00\x54\x00\x00\x00\x00\x00\x00\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\xe6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x00\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x00\x00\x96\x00\x54\x00\x54\x00\x54\x00\x00\x00\x00\x00\x00\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x00\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x00\x00\x94\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5a\x00\x8a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5b\x00\x85\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\xff\xff\xe7\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x46\x00\x00\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\x42\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\x6c\x00\xff\xff\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x73\x00\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\x00\x00\x6c\x00\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x74\x00\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\x89\x00\x6c\x00\xff\xff\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x89\x00\x89\x00\x89\x00\x89\x00\x00\x00\x00\x00\x00\x00\x89\x00\x89\x00\x00\x00\x6f\x00\x89\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x89\x00\x89\x00\x89\x00\x89\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x75\x00\x89\x00\x00\x00\x89\x00\x89\x00\x89\x00\x89\x00\x00\x00\x00\x00\x00\x00\x89\x00\x89\x00\xcf\x00\x6f\x00\x89\x00\x89\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x89\x00\x89\x00\x89\x00\x89\x00\x89\x00\x89\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\xcf\x00\xcf\x00\x00\x00\x71\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x73\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\xcf\x00\xcf\x00\x00\x00\x71\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x81\x00\x81\x00\x81\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\x00\x00\x00\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x81\x00\x82\x00\x82\x00\x82\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x00\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x83\x00\x83\x00\x83\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x84\x00\x84\x00\x84\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x00\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5b\x00\x85\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x5b\x00\x82\x00\x82\x00\x82\x00\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x88\x00\x88\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x00\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x82\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5a\x00\x8a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x5a\x00\x8d\x00\x8d\x00\x8d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x00\x00\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x8d\x00\x83\x00\x83\x00\x83\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x13\x00\x13\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x83\x00\x84\x00\x84\x00\x84\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x00\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x9b\x00\x9b\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9b\x00\x00\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9c\x00\x9c\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x9c\x00\x00\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\xcf\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xa5\x00\xa5\x00\xa5\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\x00\x00\x00\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa6\x00\xa6\x00\xa6\x00\x00\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\x00\x00\x2c\x00\x54\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x00\x00\x54\x00\x54\x00\x54\x00\x56\x00\x58\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x57\x00\x54\x00\x54\x00\x54\x00\x55\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x54\x00\x00\x00\x92\x00\xb5\x00\xb5\x00\xb5\x00\x00\x00\x00\x00\x00\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc3\x00\x00\x00\x00\x00\x00\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\x00\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb5\x00\xb6\x00\xb6\x00\xb6\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb6\x00\xb7\x00\xb7\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc4\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x52\x00\x00\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb7\x00\xb8\x00\xb8\x00\xb8\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x00\x00\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xb8\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc5\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xbd\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xbd\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc5\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc5\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc5\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x46\x00\x00\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\xbc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xbd\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xbd\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc5\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x45\x00\x00\x00\x45\x00\x00\x00\x00\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc5\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbe\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc6\x00\x00\x00\x00\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\xbf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbe\x00\x00\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xba\x00\xc0\x00\xc0\x00\xc0\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x00\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc0\x00\xc1\x00\xc1\x00\xc1\x00\x00\x00\x00\x00\x00\x00\xc1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\xc1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x52\x00\x00\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x00\x00\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc1\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\x00\x00\x00\x00\x00\x00\xc9\x00\xc2\x00\x00\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc2\x00\xc9\x00\x00\x00\xc9\x00\xc9\x00\xc9\x00\xc9\x00\xca\x00\x00\x00\x00\x00\xc9\x00\xc9\x00\x00\x00\xc9\x00\xc9\x00\xc9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc9\x00\x00\x00\xc9\x00\xc9\x00\xc9\x00\xc9\x00\xc9\x00\x00\x00\x00\x00\x00\x00\xca\x00\x00\x00\xca\x00\xca\x00\xca\x00\xca\x00\x00\x00\x00\x00\x00\x00\xca\x00\xca\x00\x00\x00\xca\x00\xca\x00\xca\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xeb\x00\x00\x00\x00\x00\xc9\x00\xca\x00\xc9\x00\xca\x00\xca\x00\xca\x00\xca\x00\xca\x00\x41\x00\x00\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\xc9\x00\x00\x00\xc9\x00\xca\x00\x00\x00\xca\x00\x00\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\xca\x00\xcf\x00\xca\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\x72\x00\xcf\x00\xcf\x00\xdb\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\xcf\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\x2b\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\xa4\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\xcf\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\xcf\x00\x8e\x00\xcf\x00\xcf\x00\x99\x00\xcf\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xce\x00\x00\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x9a\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xa6\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\xa8\x00\xcf\x00\xcf\x00\x00\x00\xcc\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xa6\x00\x00\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa6\x00\xa5\x00\xcf\x00\xcf\x00\xcf\x00\xf3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\xdf\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x42\x00\x00\x00\xcf\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xa5\x00\x00\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\xa5\x00\x9c\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\xf3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\xe1\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x9e\x00\x3d\x00\xcf\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\x9c\x00\x00\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9c\x00\x9b\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xd2\x00\xcf\x00\xcf\x00\x00\x00\x9d\x00\x00\x00\xcf\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\xcf\x00\x9b\x00\xd4\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x9b\x00\x00\x00\xcf\x00\xd4\x00\xcf\x00\xd4\x00\xd4\x00\xd4\x00\xd4\x00\x00\x00\x00\x00\x00\x00\xd4\x00\xd4\x00\x00\x00\xd4\x00\xd4\x00\xd4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe7\x00\x00\x00\x00\x00\x00\x00\xd4\x00\x00\x00\xd4\x00\xd4\x00\xd4\x00\xd4\x00\xd4\x00\x46\x00\x00\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\xd5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\xd4\x00\x00\x00\xd4\x00\x00\x00\x00\x00\x00\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\xd4\x00\x00\x00\xd4\x00\xea\x00\x00\x00\x00\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x4c\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\x00\x00\xeb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x41\x00\x00\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\xda\x00\x4d\x00\x00\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\xd9\x00\x4a\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x00\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x47\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x4a\x00\x00\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xee\x00\x00\x00\x00\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x47\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x48\x00\x00\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\xde\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x00\x00\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\xe5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++alex_check :: AlexAddr+alex_check = AlexA#+  "\xff\xff\x2d\x00\x01\x00\x02\x00\x2d\x00\x04\x00\x05\x00\x06\x00\x2d\x00\x65\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x65\x00\x7d\x00\x7d\x00\x7d\x00\x61\x00\x2d\x00\x2d\x00\x2d\x00\x69\x00\x6d\x00\x69\x00\x67\x00\x61\x00\x0a\x00\x6e\x00\x72\x00\x6e\x00\x0a\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x05\x00\x30\x00\x31\x00\x0a\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x05\x00\x23\x00\x0a\x00\x0a\x00\x09\x00\x2d\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x20\x00\x30\x00\x31\x00\x23\x00\x0a\x00\x0a\x00\x0a\x00\x2d\x00\x6c\x00\x20\x00\x05\x00\x0a\x00\x0a\x00\x2d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x7c\x00\x21\x00\x5f\x00\x2d\x00\x0a\x00\x0a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x7c\x00\x23\x00\x20\x00\x05\x00\x5f\x00\x23\x00\x23\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x05\x00\x5f\x00\x2d\x00\x2d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x05\x00\x2d\x00\x2d\x00\x2d\x00\x09\x00\x23\x00\x0b\x00\x0c\x00\x0d\x00\x20\x00\x24\x00\x7d\x00\x23\x00\x23\x00\x23\x00\x23\x00\x2a\x00\x23\x00\x20\x00\x23\x00\x23\x00\x23\x00\x2d\x00\x23\x00\x23\x00\x23\x00\x23\x00\x20\x00\xff\xff\xff\xff\x05\x00\x2d\x00\xff\xff\xff\xff\x09\x00\x7b\x00\x0b\x00\x0c\x00\x0d\x00\x6c\x00\x2d\x00\xff\xff\xff\xff\x70\x00\x7b\x00\x23\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x05\x00\x20\x00\x30\x00\x31\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x45\x00\x5e\x00\xff\xff\x2d\x00\xff\xff\x7b\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x20\x00\x05\x00\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\x0b\x00\x0c\x00\x0d\x00\x5f\x00\x7c\x00\x05\x00\x2d\x00\xff\xff\x7c\x00\x65\x00\x7b\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x20\x00\x23\x00\x05\x00\xff\xff\xff\xff\xff\xff\x09\x00\x7b\x00\x0b\x00\x0c\x00\x0d\x00\x20\x00\xff\xff\x2d\x00\x30\x00\x31\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x05\x00\x20\x00\xff\xff\xff\xff\x23\x00\x05\x00\x0b\x00\x0c\x00\x0d\x00\x7b\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x01\x00\x02\x00\x20\x00\x5f\x00\x05\x00\x7b\x00\xff\xff\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x00\x20\x00\x5f\x00\x7b\x00\x23\x00\xff\xff\x0b\x00\x0c\x00\x0d\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\x2d\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x20\x00\x3b\x00\x22\x00\x5f\x00\xff\xff\x7b\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\x5d\x00\x5f\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\x7d\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\x05\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x20\x00\xff\xff\x20\x00\x23\x00\x24\x00\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\x20\x00\xff\xff\x22\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x5e\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\x7c\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x00\xff\xff\x2d\x00\xff\xff\x20\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x00\xff\xff\x2d\x00\xff\xff\x20\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0b\x00\x0c\x00\x0d\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x20\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\x2a\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x01\x00\x02\x00\x03\x00\x5f\x00\xff\xff\xff\xff\x07\x00\xff\xff\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\x5e\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x5f\x00\x01\x00\x02\x00\x7c\x00\xff\xff\xff\xff\x65\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\x50\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x24\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\x70\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\x5e\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x50\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x7c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x2b\x00\xff\xff\x2d\x00\xff\xff\x5f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x45\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x5f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x50\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x50\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x01\x00\x02\x00\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x01\x00\x02\x00\x5f\x00\x04\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x23\x00\x7e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\x0a\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x24\x00\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\x5e\x00\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7c\x00\x7c\x00\x01\x00\x02\x00\x03\x00\x23\x00\xff\xff\xff\xff\x07\x00\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x24\x00\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\x5e\x00\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7c\x00\x7c\x00\x01\x00\x02\x00\x03\x00\x23\x00\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x04\x00\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x45\x00\xff\xff\xff\xff\x2a\x00\x2b\x00\x04\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\x04\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\x3a\x00\x7e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\x04\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\x3a\x00\x7e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\x3a\x00\x7e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\x04\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\x04\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x04\x00\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\x7c\x00\xff\xff\x7e\x00\x5c\x00\xff\xff\x5e\x00\xff\xff\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\x04\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x04\x00\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\x29\x00\x2a\x00\x2b\x00\x04\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x3a\x00\x5e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\x7c\x00\x7d\x00\x7e\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x02\x00\xff\xff\x04\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\x3a\x00\x7e\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x02\x00\x7c\x00\x04\x00\x7e\x00\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x45\x00\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x02\x00\x7c\x00\x04\x00\x7e\x00\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\x45\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x02\x00\x7c\x00\x04\x00\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x04\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x42\x00\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\x62\x00\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x23\x00\xff\xff\xff\xff\x6f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x78\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x42\x00\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\x62\x00\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\x6f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x78\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++alex_deflt :: AlexAddr+alex_deflt = AlexA#+  "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x89\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\xff\xff\x89\x00\xff\xff\x89\x00\xff\xff\xff\xff\xff\xff\x89\x00\x66\x00\x67\x00\x68\x00\x69\x00\x68\x00\x6b\x00\x6b\x00\x67\x00\x67\x00\x6b\x00\x67\x00\x6b\x00\x67\x00\x66\x00\x66\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x89\x00\xff\xff\xff\xff\xff\xff\x89\x00\x89\x00\x89\x00\x89\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++alex_accept = listArray (0 :: Int, 246)+  [ AlexAccNone+  , AlexAcc 178+  , AlexAccNone+  , AlexAcc 177+  , AlexAcc 176+  , AlexAcc 175+  , AlexAcc 174+  , AlexAcc 173+  , AlexAcc 172+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccNone+  , AlexAccSkip+  , AlexAccSkip+  , AlexAcc 171+  , AlexAcc 170+  , AlexAccPred 169 ( isNormalComment )(AlexAccNone)+  , AlexAccPred 168 ( isNormalComment )(AlexAccNone)+  , AlexAccPred 167 ( isNormalComment )(AlexAccNone)+  , AlexAccPred 166 ( isNormalComment )(AlexAcc 165)+  , AlexAcc 164+  , AlexAcc 163+  , AlexAccPred 162 ( alexNotPred (ifExtension HaddockBit) )(AlexAccNone)+  , AlexAccPred 161 ( alexNotPred (ifExtension HaddockBit) )(AlexAcc 160)+  , AlexAccPred 159 ( alexNotPred (ifExtension HaddockBit) )(AlexAccPred 158 ( ifExtension HaddockBit )(AlexAccNone))+  , AlexAcc 157+  , AlexAccPred 156 ( atEOL )(AlexAccNone)+  , AlexAccPred 155 ( atEOL )(AlexAccNone)+  , AlexAccPred 154 ( atEOL )(AlexAccNone)+  , AlexAccPred 153 ( atEOL )(AlexAcc 152)+  , AlexAccPred 151 ( atEOL )(AlexAcc 150)+  , AlexAccPred 149 ( atEOL )(AlexAcc 148)+  , AlexAccPred 147 ( atEOL )(AlexAcc 146)+  , AlexAccPred 145 ( atEOL )(AlexAccNone)+  , AlexAccPred 144 ( atEOL )(AlexAccNone)+  , AlexAccPred 143 ( atEOL )(AlexAcc 142)+  , AlexAccSkip+  , AlexAccPred 141 (alexPrevCharMatches(\c -> c >= '\n' && c <= '\n' || False))(AlexAccNone)+  , AlexAccPred 140 (alexPrevCharMatches(\c -> c >= '\n' && c <= '\n' || False) `alexAndPred`  followedByDigit )(AlexAccNone)+  , AlexAccSkipPred (alexPrevCharMatches(\c -> c >= '\n' && c <= '\n' || False))(AlexAccNone)+  , AlexAccSkipPred (alexPrevCharMatches(\c -> c >= '\n' && c <= '\n' || False))(AlexAccNone)+  , AlexAccPred 139 ( notFollowedBy '-' )(AlexAccNone)+  , AlexAccSkip+  , AlexAccPred 138 (alexPrevCharMatches(\c -> c >= '\n' && c <= '\n' || False))(AlexAccNone)+  , AlexAccPred 137 (alexPrevCharMatches(\c -> c >= '\n' && c <= '\n' || False))(AlexAccNone)+  , AlexAccPred 136 ( notFollowedBySymbol )(AlexAccNone)+  , AlexAcc 135+  , AlexAccPred 134 ( known_pragma linePrags )(AlexAccNone)+  , AlexAccPred 133 ( known_pragma linePrags )(AlexAcc 132)+  , AlexAccPred 131 ( known_pragma linePrags )(AlexAccPred 130 ( known_pragma oneWordPrags )(AlexAccPred 129 ( known_pragma ignoredPrags )(AlexAccPred 128 ( known_pragma fileHeaderPrags )(AlexAccNone))))+  , AlexAccPred 127 ( known_pragma linePrags )(AlexAccPred 126 ( known_pragma oneWordPrags )(AlexAccPred 125 ( known_pragma ignoredPrags )(AlexAccPred 124 ( known_pragma fileHeaderPrags )(AlexAccNone))))+  , AlexAcc 123+  , AlexAcc 122+  , AlexAcc 121+  , AlexAcc 120+  , AlexAcc 119+  , AlexAcc 118+  , AlexAcc 117+  , AlexAcc 116+  , AlexAccPred 115 ( known_pragma twoWordPrags )(AlexAccNone)+  , AlexAcc 114+  , AlexAcc 113+  , AlexAcc 112+  , AlexAccPred 111 ( ifExtension HaddockBit )(AlexAccNone)+  , AlexAccPred 110 ( ifExtension ThQuotesBit )(AlexAccNone)+  , AlexAccPred 109 ( ifExtension ThQuotesBit )(AlexAccNone)+  , AlexAccPred 108 ( ifExtension ThQuotesBit )(AlexAccPred 107 ( ifExtension QqBit )(AlexAccNone))+  , AlexAccPred 106 ( ifExtension ThQuotesBit )(AlexAccNone)+  , AlexAccPred 105 ( ifExtension ThQuotesBit )(AlexAccPred 104 ( ifExtension QqBit )(AlexAccNone))+  , AlexAccPred 103 ( ifExtension ThQuotesBit )(AlexAccPred 102 ( ifExtension QqBit )(AlexAccNone))+  , AlexAccPred 101 ( ifExtension ThQuotesBit )(AlexAccPred 100 ( ifExtension QqBit )(AlexAccNone))+  , AlexAccPred 99 ( ifExtension ThQuotesBit )(AlexAccNone)+  , AlexAccPred 98 ( ifExtension ThQuotesBit )(AlexAccNone)+  , AlexAccPred 97 ( ifExtension ThBit )(AlexAccNone)+  , AlexAccPred 96 ( ifExtension ThBit )(AlexAccNone)+  , AlexAccPred 95 ( ifExtension ThBit )(AlexAccNone)+  , AlexAccPred 94 ( ifExtension ThBit )(AlexAccNone)+  , AlexAccPred 93 ( ifExtension QqBit )(AlexAccNone)+  , AlexAccPred 92 ( ifExtension QqBit )(AlexAccNone)+  , AlexAccPred 91 ( ifCurrentChar '⟦' `alexAndPred`+        ifExtension UnicodeSyntaxBit `alexAndPred`+        ifExtension ThQuotesBit )(AlexAccPred 90 ( ifCurrentChar '⟧' `alexAndPred`+        ifExtension UnicodeSyntaxBit `alexAndPred`+        ifExtension ThQuotesBit )(AlexAccPred 89 ( ifCurrentChar '⦇' `alexAndPred`+        ifExtension UnicodeSyntaxBit `alexAndPred`+        ifExtension ArrowsBit )(AlexAccPred 88 ( ifCurrentChar '⦈' `alexAndPred`+        ifExtension UnicodeSyntaxBit `alexAndPred`+        ifExtension ArrowsBit )(AlexAccNone))))+  , AlexAccPred 87 (alexPrevCharMatches(\c -> True && c < '\SOH' || c > '\ETX' && c < '\a' || c > '\a' && c < '\n' || c > '\n' && c < '\'' || c > '\'' && c < ')' || c > ')' && c < '0' || c > '9' && c < 'A' || c > 'Z' && c < '_' || c > '_' && c < 'a' || c > 'z' && True || False) `alexAndPred`  ifExtension TypeApplicationsBit `alexAndPred` notFollowedBySymbol )(AlexAcc 86)+  , AlexAccPred 85 ( ifExtension ArrowsBit `alexAndPred`+        notFollowedBySymbol )(AlexAccNone)+  , AlexAccPred 84 ( ifExtension ArrowsBit )(AlexAccNone)+  , AlexAccPred 83 ( ifExtension IpBit )(AlexAccNone)+  , AlexAccPred 82 ( ifExtension OverloadedLabelsBit )(AlexAccNone)+  , AlexAccPred 81 ( ifExtension UnboxedTuplesBit `alexOrPred`+           ifExtension UnboxedSumsBit )(AlexAccNone)+  , AlexAccPred 80 ( ifExtension UnboxedTuplesBit `alexOrPred`+           ifExtension UnboxedSumsBit )(AlexAccNone)+  , AlexAcc 79+  , AlexAcc 78+  , AlexAcc 77+  , AlexAcc 76+  , AlexAcc 75+  , AlexAcc 74+  , AlexAcc 73+  , AlexAcc 72+  , AlexAcc 71+  , AlexAcc 70+  , AlexAcc 69+  , AlexAcc 68+  , AlexAcc 67+  , AlexAcc 66+  , AlexAcc 65+  , AlexAcc 64+  , AlexAcc 63+  , AlexAcc 62+  , AlexAcc 61+  , AlexAcc 60+  , AlexAcc 59+  , AlexAcc 58+  , AlexAcc 57+  , AlexAcc 56+  , AlexAcc 55+  , AlexAcc 54+  , AlexAccPred 53 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAccPred 52 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAccPred 51 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAccPred 50 ( ifExtension MagicHashBit )(AlexAccPred 49 ( ifExtension MagicHashBit )(AlexAccNone))+  , AlexAccPred 48 ( ifExtension MagicHashBit )(AlexAccPred 47 ( ifExtension MagicHashBit )(AlexAccNone))+  , AlexAccPred 46 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAcc 45+  , AlexAcc 44+  , AlexAcc 43+  , AlexAcc 42+  , AlexAcc 41+  , AlexAcc 40+  , AlexAcc 39+  , AlexAcc 38+  , AlexAcc 37+  , AlexAcc 36+  , AlexAcc 35+  , AlexAcc 34+  , AlexAcc 33+  , AlexAcc 32+  , AlexAccPred 31 ( ifExtension BinaryLiteralsBit )(AlexAccNone)+  , AlexAcc 30+  , AlexAcc 29+  , AlexAccPred 28 ( ifExtension NegativeLiteralsBit )(AlexAccNone)+  , AlexAccPred 27 ( ifExtension NegativeLiteralsBit )(AlexAccNone)+  , AlexAccPred 26 ( ifExtension NegativeLiteralsBit `alexAndPred`+                                           ifExtension BinaryLiteralsBit )(AlexAccNone)+  , AlexAccPred 25 ( ifExtension NegativeLiteralsBit )(AlexAccNone)+  , AlexAccPred 24 ( ifExtension NegativeLiteralsBit )(AlexAccNone)+  , AlexAcc 23+  , AlexAcc 22+  , AlexAccPred 21 ( ifExtension NegativeLiteralsBit )(AlexAccNone)+  , AlexAccPred 20 ( ifExtension NegativeLiteralsBit )(AlexAccNone)+  , AlexAccPred 19 ( ifExtension HexFloatLiteralsBit )(AlexAccNone)+  , AlexAccPred 18 ( ifExtension HexFloatLiteralsBit )(AlexAccNone)+  , AlexAccPred 17 ( ifExtension HexFloatLiteralsBit `alexAndPred`+                                           ifExtension NegativeLiteralsBit )(AlexAccNone)+  , AlexAccPred 16 ( ifExtension HexFloatLiteralsBit `alexAndPred`+                                           ifExtension NegativeLiteralsBit )(AlexAccNone)+  , AlexAccPred 15 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAccPred 14 ( ifExtension MagicHashBit `alexAndPred`+                                           ifExtension BinaryLiteralsBit )(AlexAccNone)+  , AlexAccPred 13 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAccPred 12 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAccPred 11 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAccPred 10 ( ifExtension MagicHashBit `alexAndPred`+                                           ifExtension BinaryLiteralsBit )(AlexAccNone)+  , AlexAccPred 9 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAccPred 8 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAccPred 7 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAccPred 6 ( ifExtension MagicHashBit `alexAndPred`+                                           ifExtension BinaryLiteralsBit )(AlexAccNone)+  , AlexAccPred 5 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAccPred 4 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAccPred 3 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAccPred 2 ( ifExtension MagicHashBit )(AlexAccNone)+  , AlexAcc 1+  , AlexAcc 0+  ]++alex_actions = array (0 :: Int, 179)+  [ (178,alex_action_14)+  , (177,alex_action_20)+  , (176,alex_action_21)+  , (175,alex_action_19)+  , (174,alex_action_22)+  , (173,alex_action_26)+  , (172,alex_action_27)+  , (171,alex_action_1)+  , (170,alex_action_1)+  , (169,alex_action_2)+  , (168,alex_action_2)+  , (167,alex_action_2)+  , (166,alex_action_2)+  , (165,alex_action_27)+  , (164,alex_action_3)+  , (163,alex_action_4)+  , (162,alex_action_5)+  , (161,alex_action_5)+  , (160,alex_action_27)+  , (159,alex_action_5)+  , (158,alex_action_38)+  , (157,alex_action_6)+  , (156,alex_action_7)+  , (155,alex_action_7)+  , (154,alex_action_7)+  , (153,alex_action_7)+  , (152,alex_action_27)+  , (151,alex_action_7)+  , (150,alex_action_27)+  , (149,alex_action_7)+  , (148,alex_action_85)+  , (147,alex_action_7)+  , (146,alex_action_85)+  , (145,alex_action_8)+  , (144,alex_action_8)+  , (143,alex_action_8)+  , (142,alex_action_27)+  , (141,alex_action_10)+  , (140,alex_action_11)+  , (139,alex_action_15)+  , (138,alex_action_17)+  , (137,alex_action_17)+  , (136,alex_action_18)+  , (135,alex_action_23)+  , (134,alex_action_24)+  , (133,alex_action_24)+  , (132,alex_action_27)+  , (131,alex_action_24)+  , (130,alex_action_32)+  , (129,alex_action_33)+  , (128,alex_action_35)+  , (127,alex_action_24)+  , (126,alex_action_32)+  , (125,alex_action_33)+  , (124,alex_action_36)+  , (123,alex_action_25)+  , (122,alex_action_27)+  , (121,alex_action_27)+  , (120,alex_action_27)+  , (119,alex_action_27)+  , (118,alex_action_28)+  , (117,alex_action_29)+  , (116,alex_action_30)+  , (115,alex_action_31)+  , (114,alex_action_34)+  , (113,alex_action_37)+  , (112,alex_action_37)+  , (111,alex_action_39)+  , (110,alex_action_40)+  , (109,alex_action_41)+  , (108,alex_action_42)+  , (107,alex_action_53)+  , (106,alex_action_43)+  , (105,alex_action_44)+  , (104,alex_action_53)+  , (103,alex_action_45)+  , (102,alex_action_53)+  , (101,alex_action_46)+  , (100,alex_action_53)+  , (99,alex_action_47)+  , (98,alex_action_48)+  , (97,alex_action_49)+  , (96,alex_action_50)+  , (95,alex_action_51)+  , (94,alex_action_52)+  , (93,alex_action_53)+  , (92,alex_action_54)+  , (91,alex_action_55)+  , (90,alex_action_56)+  , (89,alex_action_60)+  , (88,alex_action_61)+  , (87,alex_action_57)+  , (86,alex_action_85)+  , (85,alex_action_58)+  , (84,alex_action_59)+  , (83,alex_action_62)+  , (82,alex_action_63)+  , (81,alex_action_64)+  , (80,alex_action_65)+  , (79,alex_action_66)+  , (78,alex_action_66)+  , (77,alex_action_67)+  , (76,alex_action_68)+  , (75,alex_action_68)+  , (74,alex_action_69)+  , (73,alex_action_70)+  , (72,alex_action_71)+  , (71,alex_action_72)+  , (70,alex_action_73)+  , (69,alex_action_73)+  , (68,alex_action_74)+  , (67,alex_action_75)+  , (66,alex_action_75)+  , (65,alex_action_76)+  , (64,alex_action_76)+  , (63,alex_action_77)+  , (62,alex_action_77)+  , (61,alex_action_77)+  , (60,alex_action_77)+  , (59,alex_action_77)+  , (58,alex_action_77)+  , (57,alex_action_77)+  , (56,alex_action_77)+  , (55,alex_action_78)+  , (54,alex_action_78)+  , (53,alex_action_79)+  , (52,alex_action_80)+  , (51,alex_action_81)+  , (50,alex_action_81)+  , (49,alex_action_111)+  , (48,alex_action_81)+  , (47,alex_action_112)+  , (46,alex_action_82)+  , (45,alex_action_83)+  , (44,alex_action_84)+  , (43,alex_action_85)+  , (42,alex_action_85)+  , (41,alex_action_85)+  , (40,alex_action_85)+  , (39,alex_action_85)+  , (38,alex_action_85)+  , (37,alex_action_85)+  , (36,alex_action_85)+  , (35,alex_action_85)+  , (34,alex_action_86)+  , (33,alex_action_87)+  , (32,alex_action_87)+  , (31,alex_action_88)+  , (30,alex_action_89)+  , (29,alex_action_90)+  , (28,alex_action_91)+  , (27,alex_action_91)+  , (26,alex_action_92)+  , (25,alex_action_93)+  , (24,alex_action_94)+  , (23,alex_action_95)+  , (22,alex_action_95)+  , (21,alex_action_96)+  , (20,alex_action_96)+  , (19,alex_action_97)+  , (18,alex_action_97)+  , (17,alex_action_98)+  , (16,alex_action_98)+  , (15,alex_action_99)+  , (14,alex_action_100)+  , (13,alex_action_101)+  , (12,alex_action_102)+  , (11,alex_action_103)+  , (10,alex_action_104)+  , (9,alex_action_105)+  , (8,alex_action_106)+  , (7,alex_action_107)+  , (6,alex_action_108)+  , (5,alex_action_109)+  , (4,alex_action_110)+  , (3,alex_action_111)+  , (2,alex_action_112)+  , (1,alex_action_113)+  , (0,alex_action_114)+  ]++{-# LINE 578 "compiler/parser/Lexer.x" #-}+++-- -----------------------------------------------------------------------------+-- The token type++data Token+  = ITas                        -- Haskell keywords+  | ITcase+  | ITclass+  | ITdata+  | ITdefault+  | ITderiving+  | ITdo+  | ITelse+  | IThiding+  | ITforeign+  | ITif+  | ITimport+  | ITin+  | ITinfix+  | ITinfixl+  | ITinfixr+  | ITinstance+  | ITlet+  | ITmodule+  | ITnewtype+  | ITof+  | ITqualified+  | ITthen+  | ITtype+  | ITwhere++  | ITforall            IsUnicodeSyntax -- GHC extension keywords+  | ITexport+  | ITlabel+  | ITdynamic+  | ITsafe+  | ITinterruptible+  | ITunsafe+  | ITstdcallconv+  | ITccallconv+  | ITcapiconv+  | ITprimcallconv+  | ITjavascriptcallconv+  | ITmdo+  | ITfamily+  | ITrole+  | ITgroup+  | ITby+  | ITusing+  | ITpattern+  | ITstatic+  | ITstock+  | ITanyclass+  | ITvia++  -- Backpack tokens+  | ITunit+  | ITsignature+  | ITdependency+  | ITrequires++  -- Pragmas, see  note [Pragma source text] in BasicTypes+  | ITinline_prag       SourceText InlineSpec RuleMatchInfo+  | ITspec_prag         SourceText                -- SPECIALISE+  | ITspec_inline_prag  SourceText Bool    -- SPECIALISE INLINE (or NOINLINE)+  | ITsource_prag       SourceText+  | ITrules_prag        SourceText+  | ITwarning_prag      SourceText+  | ITdeprecated_prag   SourceText+  | ITline_prag         SourceText  -- not usually produced, see 'UsePosPragsBit'+  | ITcolumn_prag       SourceText  -- not usually produced, see 'UsePosPragsBit'+  | ITscc_prag          SourceText+  | ITgenerated_prag    SourceText+  | ITcore_prag         SourceText         -- hdaume: core annotations+  | ITunpack_prag       SourceText+  | ITnounpack_prag     SourceText+  | ITann_prag          SourceText+  | ITcomplete_prag     SourceText+  | ITclose_prag+  | IToptions_prag String+  | ITinclude_prag String+  | ITlanguage_prag+  | ITminimal_prag      SourceText+  | IToverlappable_prag SourceText  -- instance overlap mode+  | IToverlapping_prag  SourceText  -- instance overlap mode+  | IToverlaps_prag     SourceText  -- instance overlap mode+  | ITincoherent_prag   SourceText  -- instance overlap mode+  | ITctype             SourceText+  | ITcomment_line_prag         -- See Note [Nested comment line pragmas]++  | ITdotdot                    -- reserved symbols+  | ITcolon+  | ITdcolon            IsUnicodeSyntax+  | ITequal+  | ITlam+  | ITlcase+  | ITvbar+  | ITlarrow            IsUnicodeSyntax+  | ITrarrow            IsUnicodeSyntax+  | ITat+  | ITtilde+  | ITdarrow            IsUnicodeSyntax+  | ITminus+  | ITbang+  | ITstar              IsUnicodeSyntax+  | ITdot++  | ITbiglam                    -- GHC-extension symbols++  | ITocurly                    -- special symbols+  | ITccurly+  | ITvocurly+  | ITvccurly+  | ITobrack+  | ITopabrack                  -- [:, for parallel arrays with -XParallelArrays+  | ITcpabrack                  -- :], for parallel arrays with -XParallelArrays+  | ITcbrack+  | IToparen+  | ITcparen+  | IToubxparen+  | ITcubxparen+  | ITsemi+  | ITcomma+  | ITunderscore+  | ITbackquote+  | ITsimpleQuote               --  '++  | ITvarid   FastString        -- identifiers+  | ITconid   FastString+  | ITvarsym  FastString+  | ITconsym  FastString+  | ITqvarid  (FastString,FastString)+  | ITqconid  (FastString,FastString)+  | ITqvarsym (FastString,FastString)+  | ITqconsym (FastString,FastString)++  | ITdupipvarid   FastString   -- GHC extension: implicit param: ?x+  | ITlabelvarid   FastString   -- Overloaded label: #x++  | ITchar     SourceText Char       -- Note [Literal source text] in BasicTypes+  | ITstring   SourceText FastString -- Note [Literal source text] in BasicTypes+  | ITinteger  IntegralLit           -- Note [Literal source text] in BasicTypes+  | ITrational FractionalLit++  | ITprimchar   SourceText Char     -- Note [Literal source text] in BasicTypes+  | ITprimstring SourceText ByteString -- Note [Literal source text] @BasicTypes+  | ITprimint    SourceText Integer  -- Note [Literal source text] in BasicTypes+  | ITprimword   SourceText Integer  -- Note [Literal source text] in BasicTypes+  | ITprimfloat  FractionalLit+  | ITprimdouble FractionalLit++  -- Template Haskell extension tokens+  | ITopenExpQuote HasE IsUnicodeSyntax --  [| or [e|+  | ITopenPatQuote                      --  [p|+  | ITopenDecQuote                      --  [d|+  | ITopenTypQuote                      --  [t|+  | ITcloseQuote IsUnicodeSyntax        --  |]+  | ITopenTExpQuote HasE                --  [|| or [e||+  | ITcloseTExpQuote                    --  ||]+  | ITidEscape   FastString             --  $x+  | ITparenEscape                       --  $(+  | ITidTyEscape   FastString           --  $$x+  | ITparenTyEscape                     --  $$(+  | ITtyQuote                           --  ''+  | ITquasiQuote (FastString,FastString,RealSrcSpan)+    -- ITquasiQuote(quoter, quote, loc)+    -- represents a quasi-quote of the form+    -- [quoter| quote |]+  | ITqQuasiQuote (FastString,FastString,FastString,RealSrcSpan)+    -- ITqQuasiQuote(Qual, quoter, quote, loc)+    -- represents a qualified quasi-quote of the form+    -- [Qual.quoter| quote |]++  -- Arrow notation extension+  | ITproc+  | ITrec+  | IToparenbar  IsUnicodeSyntax -- ^ @(|@+  | ITcparenbar  IsUnicodeSyntax -- ^ @|)@+  | ITlarrowtail IsUnicodeSyntax -- ^ @-<@+  | ITrarrowtail IsUnicodeSyntax -- ^ @>-@+  | ITLarrowtail IsUnicodeSyntax -- ^ @-<<@+  | ITRarrowtail IsUnicodeSyntax -- ^ @>>-@++  -- | Type application '@' (lexed differently than as-pattern '@',+  -- due to checking for preceding whitespace)+  | ITtypeApp+++  | ITunknown String             -- ^ Used when the lexer can't make sense of it+  | ITeof                        -- ^ end of file token++  -- Documentation annotations+  | ITdocCommentNext  String     -- ^ something beginning @-- |@+  | ITdocCommentPrev  String     -- ^ something beginning @-- ^@+  | ITdocCommentNamed String     -- ^ something beginning @-- $@+  | ITdocSection      Int String -- ^ a section heading+  | ITdocOptions      String     -- ^ doc options (prune, ignore-exports, etc)+  | ITlineComment     String     -- ^ comment starting by "--"+  | ITblockComment    String     -- ^ comment in {- -}++  deriving Show++instance Outputable Token where+  ppr x = text (show x)+++-- the bitmap provided as the third component indicates whether the+-- corresponding extension keyword is valid under the extension options+-- provided to the compiler; if the extension corresponding to *any* of the+-- bits set in the bitmap is enabled, the keyword is valid (this setup+-- facilitates using a keyword in two different extensions that can be+-- activated independently)+--+reservedWordsFM :: UniqFM (Token, ExtsBitmap)+reservedWordsFM = listToUFM $+    map (\(x, y, z) -> (mkFastString x, (y, z)))+        [( "_",              ITunderscore,    0 ),+         ( "as",             ITas,            0 ),+         ( "case",           ITcase,          0 ),+         ( "class",          ITclass,         0 ),+         ( "data",           ITdata,          0 ),+         ( "default",        ITdefault,       0 ),+         ( "deriving",       ITderiving,      0 ),+         ( "do",             ITdo,            0 ),+         ( "else",           ITelse,          0 ),+         ( "hiding",         IThiding,        0 ),+         ( "if",             ITif,            0 ),+         ( "import",         ITimport,        0 ),+         ( "in",             ITin,            0 ),+         ( "infix",          ITinfix,         0 ),+         ( "infixl",         ITinfixl,        0 ),+         ( "infixr",         ITinfixr,        0 ),+         ( "instance",       ITinstance,      0 ),+         ( "let",            ITlet,           0 ),+         ( "module",         ITmodule,        0 ),+         ( "newtype",        ITnewtype,       0 ),+         ( "of",             ITof,            0 ),+         ( "qualified",      ITqualified,     0 ),+         ( "then",           ITthen,          0 ),+         ( "type",           ITtype,          0 ),+         ( "where",          ITwhere,         0 ),++         ( "forall",         ITforall NormalSyntax, 0),+         ( "mdo",            ITmdo,           xbit RecursiveDoBit),+             -- See Note [Lexing type pseudo-keywords]+         ( "family",         ITfamily,        0 ),+         ( "role",           ITrole,          0 ),+         ( "pattern",        ITpattern,       xbit PatternSynonymsBit),+         ( "static",         ITstatic,        xbit StaticPointersBit ),+         ( "stock",          ITstock,         0 ),+         ( "anyclass",       ITanyclass,      0 ),+         ( "via",            ITvia,           0 ),+         ( "group",          ITgroup,         xbit TransformComprehensionsBit),+         ( "by",             ITby,            xbit TransformComprehensionsBit),+         ( "using",          ITusing,         xbit TransformComprehensionsBit),++         ( "foreign",        ITforeign,       xbit FfiBit),+         ( "export",         ITexport,        xbit FfiBit),+         ( "label",          ITlabel,         xbit FfiBit),+         ( "dynamic",        ITdynamic,       xbit FfiBit),+         ( "safe",           ITsafe,          xbit FfiBit .|.+                                              xbit SafeHaskellBit),+         ( "interruptible",  ITinterruptible, xbit InterruptibleFfiBit),+         ( "unsafe",         ITunsafe,        xbit FfiBit),+         ( "stdcall",        ITstdcallconv,   xbit FfiBit),+         ( "ccall",          ITccallconv,     xbit FfiBit),+         ( "capi",           ITcapiconv,      xbit CApiFfiBit),+         ( "prim",           ITprimcallconv,  xbit FfiBit),+         ( "javascript",     ITjavascriptcallconv, xbit FfiBit),++         ( "unit",           ITunit,          0 ),+         ( "dependency",     ITdependency,       0 ),+         ( "signature",      ITsignature,     0 ),++         ( "rec",            ITrec,           xbit ArrowsBit .|.+                                              xbit RecursiveDoBit),+         ( "proc",           ITproc,          xbit ArrowsBit)+     ]++{-----------------------------------+Note [Lexing type pseudo-keywords]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++One might think that we wish to treat 'family' and 'role' as regular old+varids whenever -XTypeFamilies and -XRoleAnnotations are off, respectively.+But, there is no need to do so. These pseudo-keywords are not stolen syntax:+they are only used after the keyword 'type' at the top-level, where varids are+not allowed. Furthermore, checks further downstream (TcTyClsDecls) ensure that+type families and role annotations are never declared without their extensions+on. In fact, by unconditionally lexing these pseudo-keywords as special, we+can get better error messages.++Also, note that these are included in the `varid` production in the parser --+a key detail to make all this work.+-------------------------------------}++reservedSymsFM :: UniqFM (Token, IsUnicodeSyntax, ExtsBitmap)+reservedSymsFM = listToUFM $+    map (\ (x,w,y,z) -> (mkFastString x,(w,y,z)))+      [ ("..",  ITdotdot,                   NormalSyntax,  0 )+        -- (:) is a reserved op, meaning only list cons+       ,(":",   ITcolon,                    NormalSyntax,  0 )+       ,("::",  ITdcolon NormalSyntax,      NormalSyntax,  0 )+       ,("=",   ITequal,                    NormalSyntax,  0 )+       ,("\\",  ITlam,                      NormalSyntax,  0 )+       ,("|",   ITvbar,                     NormalSyntax,  0 )+       ,("<-",  ITlarrow NormalSyntax,      NormalSyntax,  0 )+       ,("->",  ITrarrow NormalSyntax,      NormalSyntax,  0 )+       ,("@",   ITat,                       NormalSyntax,  0 )+       ,("~",   ITtilde,                    NormalSyntax,  0 )+       ,("=>",  ITdarrow NormalSyntax,      NormalSyntax,  0 )+       ,("-",   ITminus,                    NormalSyntax,  0 )+       ,("!",   ITbang,                     NormalSyntax,  0 )++       ,("*",   ITstar NormalSyntax,        NormalSyntax,  xbit StarIsTypeBit)++        -- For 'forall a . t'+       ,(".",   ITdot,                      NormalSyntax,  0 )++       ,("-<",  ITlarrowtail NormalSyntax,  NormalSyntax,  xbit ArrowsBit)+       ,(">-",  ITrarrowtail NormalSyntax,  NormalSyntax,  xbit ArrowsBit)+       ,("-<<", ITLarrowtail NormalSyntax,  NormalSyntax,  xbit ArrowsBit)+       ,(">>-", ITRarrowtail NormalSyntax,  NormalSyntax,  xbit ArrowsBit)++       ,("∷",   ITdcolon UnicodeSyntax,     UnicodeSyntax, 0 )+       ,("⇒",   ITdarrow UnicodeSyntax,     UnicodeSyntax, 0 )+       ,("∀",   ITforall UnicodeSyntax,     UnicodeSyntax, 0 )+       ,("→",   ITrarrow UnicodeSyntax,     UnicodeSyntax, 0 )+       ,("←",   ITlarrow UnicodeSyntax,     UnicodeSyntax, 0 )++       ,("⤙",   ITlarrowtail UnicodeSyntax, UnicodeSyntax, xbit ArrowsBit)+       ,("⤚",   ITrarrowtail UnicodeSyntax, UnicodeSyntax, xbit ArrowsBit)+       ,("⤛",   ITLarrowtail UnicodeSyntax, UnicodeSyntax, xbit ArrowsBit)+       ,("⤜",   ITRarrowtail UnicodeSyntax, UnicodeSyntax, xbit ArrowsBit)++       ,("★",   ITstar UnicodeSyntax,       UnicodeSyntax, xbit StarIsTypeBit)++        -- ToDo: ideally, → and ∷ should be "specials", so that they cannot+        -- form part of a large operator.  This would let us have a better+        -- syntax for kinds: ɑ∷*→* would be a legal kind signature. (maybe).+       ]++-- -----------------------------------------------------------------------------+-- Lexer actions++type Action = RealSrcSpan -> StringBuffer -> Int -> P (RealLocated Token)++special :: Token -> Action+special tok span _buf _len = return (L span tok)++token, layout_token :: Token -> Action+token t span _buf _len = return (L span t)+layout_token t span _buf _len = pushLexState layout >> return (L span t)++idtoken :: (StringBuffer -> Int -> Token) -> Action+idtoken f span buf len = return (L span $! (f buf len))++skip_one_varid :: (FastString -> Token) -> Action+skip_one_varid f span buf len+  = return (L span $! f (lexemeToFastString (stepOn buf) (len-1)))++skip_two_varid :: (FastString -> Token) -> Action+skip_two_varid f span buf len+  = return (L span $! f (lexemeToFastString (stepOn (stepOn buf)) (len-2)))++strtoken :: (String -> Token) -> Action+strtoken f span buf len =+  return (L span $! (f $! lexemeToString buf len))++begin :: Int -> Action+begin code _span _str _len = do pushLexState code; lexToken++pop :: Action+pop _span _buf _len = do _ <- popLexState+                         lexToken+-- See Note [Nested comment line pragmas]+failLinePrag1 :: Action+failLinePrag1 span _buf _len = do+  b <- getBit InNestedCommentBit+  if b then return (L span ITcomment_line_prag)+       else lexError "lexical error in pragma"++-- See Note [Nested comment line pragmas]+popLinePrag1 :: Action+popLinePrag1 span _buf _len = do+  b <- getBit InNestedCommentBit+  if b then return (L span ITcomment_line_prag) else do+    _ <- popLexState+    lexToken++hopefully_open_brace :: Action+hopefully_open_brace span buf len+ = do relaxed <- getBit RelaxedLayoutBit+      ctx <- getContext+      (AI l _) <- getInput+      let offset = srcLocCol l+          isOK = relaxed ||+                 case ctx of+                 Layout prev_off _ : _ -> prev_off < offset+                 _                     -> True+      if isOK then pop_and open_brace span buf len+              else addFatalError (RealSrcSpan span) (text "Missing block")++pop_and :: Action -> Action+pop_and act span buf len = do _ <- popLexState+                              act span buf len++{-# INLINE nextCharIs #-}+nextCharIs :: StringBuffer -> (Char -> Bool) -> Bool+nextCharIs buf p = not (atEnd buf) && p (currentChar buf)++{-# INLINE nextCharIsNot #-}+nextCharIsNot :: StringBuffer -> (Char -> Bool) -> Bool+nextCharIsNot buf p = not (nextCharIs buf p)++notFollowedBy :: Char -> AlexAccPred ExtsBitmap+notFollowedBy char _ _ _ (AI _ buf)+  = nextCharIsNot buf (== char)++notFollowedBySymbol :: AlexAccPred ExtsBitmap+notFollowedBySymbol _ _ _ (AI _ buf)+  = nextCharIsNot buf (`elem` "!#$%&*+./<=>?@\\^|-~")++followedByDigit :: AlexAccPred ExtsBitmap+followedByDigit _ _ _ (AI _ buf)+  = afterOptionalSpace buf (\b -> nextCharIs b (`elem` ['0'..'9']))++ifCurrentChar :: Char -> AlexAccPred ExtsBitmap+ifCurrentChar char _ (AI _ buf) _ _+  = nextCharIs buf (== char)++-- We must reject doc comments as being ordinary comments everywhere.+-- In some cases the doc comment will be selected as the lexeme due to+-- maximal munch, but not always, because the nested comment rule is+-- valid in all states, but the doc-comment rules are only valid in+-- the non-layout states.+isNormalComment :: AlexAccPred ExtsBitmap+isNormalComment bits _ _ (AI _ buf)+  | HaddockBit `xtest` bits = notFollowedByDocOrPragma+  | otherwise               = nextCharIsNot buf (== '#')+  where+    notFollowedByDocOrPragma+       = afterOptionalSpace buf (\b -> nextCharIsNot b (`elem` "|^*$#"))++afterOptionalSpace :: StringBuffer -> (StringBuffer -> Bool) -> Bool+afterOptionalSpace buf p+    = if nextCharIs buf (== ' ')+      then p (snd (nextChar buf))+      else p buf++atEOL :: AlexAccPred ExtsBitmap+atEOL _ _ _ (AI _ buf) = atEnd buf || currentChar buf == '\n'++ifExtension :: ExtBits -> AlexAccPred ExtsBitmap+ifExtension extBits bits _ _ _ = extBits `xtest` bits++alexNotPred p userState in1 len in2+  = not (p userState in1 len in2)++alexOrPred p1 p2 userState in1 len in2+  = p1 userState in1 len in2 || p2 userState in1 len in2++multiline_doc_comment :: Action+multiline_doc_comment span buf _len = withLexedDocType (worker "")+  where+    worker commentAcc input docType checkNextLine = case alexGetChar' input of+      Just ('\n', input')+        | checkNextLine -> case checkIfCommentLine input' of+          Just input -> worker ('\n':commentAcc) input docType checkNextLine+          Nothing -> docCommentEnd input commentAcc docType buf span+        | otherwise -> docCommentEnd input commentAcc docType buf span+      Just (c, input) -> worker (c:commentAcc) input docType checkNextLine+      Nothing -> docCommentEnd input commentAcc docType buf span++    -- Check if the next line of input belongs to this doc comment as well.+    -- A doc comment continues onto the next line when the following+    -- conditions are met:+    --   * The line starts with "--"+    --   * The line doesn't start with "---".+    --   * The line doesn't start with "-- $", because that would be the+    --     start of a /new/ named haddock chunk (#10398).+    checkIfCommentLine :: AlexInput -> Maybe AlexInput+    checkIfCommentLine input = check (dropNonNewlineSpace input)+      where+        check input = do+          ('-', input) <- alexGetChar' input+          ('-', input) <- alexGetChar' input+          (c, after_c) <- alexGetChar' input+          case c of+            '-' -> Nothing+            ' ' -> case alexGetChar' after_c of+                     Just ('$', _) -> Nothing+                     _ -> Just input+            _   -> Just input++        dropNonNewlineSpace input = case alexGetChar' input of+          Just (c, input')+            | isSpace c && c /= '\n' -> dropNonNewlineSpace input'+            | otherwise -> input+          Nothing -> input++lineCommentToken :: Action+lineCommentToken span buf len = do+  b <- getBit RawTokenStreamBit+  if b then strtoken ITlineComment span buf len else lexToken++{-+  nested comments require traversing by hand, they can't be parsed+  using regular expressions.+-}+nested_comment :: P (RealLocated Token) -> Action+nested_comment cont span buf len = do+  input <- getInput+  go (reverse $ lexemeToString buf len) (1::Int) input+  where+    go commentAcc 0 input = do+      setInput input+      b <- getBit RawTokenStreamBit+      if b+        then docCommentEnd input commentAcc ITblockComment buf span+        else cont+    go commentAcc n input = case alexGetChar' input of+      Nothing -> errBrace input span+      Just ('-',input) -> case alexGetChar' input of+        Nothing  -> errBrace input span+        Just ('\125',input) -> go ('\125':'-':commentAcc) (n-1) input -- '}'+        Just (_,_)          -> go ('-':commentAcc) n input+      Just ('\123',input) -> case alexGetChar' input of  -- '{' char+        Nothing  -> errBrace input span+        Just ('-',input) -> go ('-':'\123':commentAcc) (n+1) input+        Just (_,_)       -> go ('\123':commentAcc) n input+      -- See Note [Nested comment line pragmas]+      Just ('\n',input) -> case alexGetChar' input of+        Nothing  -> errBrace input span+        Just ('#',_) -> do (parsedAcc,input) <- parseNestedPragma input+                           go (parsedAcc ++ '\n':commentAcc) n input+        Just (_,_)   -> go ('\n':commentAcc) n input+      Just (c,input) -> go (c:commentAcc) n input++nested_doc_comment :: Action+nested_doc_comment span buf _len = withLexedDocType (go "")+  where+    go commentAcc input docType _ = case alexGetChar' input of+      Nothing -> errBrace input span+      Just ('-',input) -> case alexGetChar' input of+        Nothing -> errBrace input span+        Just ('\125',input) ->+          docCommentEnd input commentAcc docType buf span+        Just (_,_) -> go ('-':commentAcc) input docType False+      Just ('\123', input) -> case alexGetChar' input of+        Nothing  -> errBrace input span+        Just ('-',input) -> do+          setInput input+          let cont = do input <- getInput; go commentAcc input docType False+          nested_comment cont span buf _len+        Just (_,_) -> go ('\123':commentAcc) input docType False+      -- See Note [Nested comment line pragmas]+      Just ('\n',input) -> case alexGetChar' input of+        Nothing  -> errBrace input span+        Just ('#',_) -> do (parsedAcc,input) <- parseNestedPragma input+                           go (parsedAcc ++ '\n':commentAcc) input docType False+        Just (_,_)   -> go ('\n':commentAcc) input docType False+      Just (c,input) -> go (c:commentAcc) input docType False++-- See Note [Nested comment line pragmas]+parseNestedPragma :: AlexInput -> P (String,AlexInput)+parseNestedPragma input@(AI _ buf) = do+  origInput <- getInput+  setInput input+  setExts (.|. xbit InNestedCommentBit)+  pushLexState bol+  lt <- lexToken+  _ <- popLexState+  setExts (.&. complement (xbit InNestedCommentBit))+  postInput@(AI _ postBuf) <- getInput+  setInput origInput+  case unRealSrcSpan lt of+    ITcomment_line_prag -> do+      let bytes = byteDiff buf postBuf+          diff  = lexemeToString buf bytes+      return (reverse diff, postInput)+    lt' -> panic ("parseNestedPragma: unexpected token" ++ (show lt'))++{-+Note [Nested comment line pragmas]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We used to ignore cpp-preprocessor-generated #line pragmas if they were inside+nested comments.++Now, when parsing a nested comment, if we encounter a line starting with '#' we+call parseNestedPragma, which executes the following:+1. Save the current lexer input (loc, buf) for later+2. Set the current lexer input to the beginning of the line starting with '#'+3. Turn the 'InNestedComment' extension on+4. Push the 'bol' lexer state+5. Lex a token. Due to (2), (3), and (4), this should always lex a single line+   or less and return the ITcomment_line_prag token. This may set source line+   and file location if a #line pragma is successfully parsed+6. Restore lexer input and state to what they were before we did all this+7. Return control to the function parsing a nested comment, informing it of+   what the lexer parsed++Regarding (5) above:+Every exit from the 'bol' lexer state (do_bol, popLinePrag1, failLinePrag1)+checks if the 'InNestedComment' extension is set. If it is, that function will+return control to parseNestedPragma by returning the ITcomment_line_prag token.++See #314 for more background on the bug this fixes.+-}++withLexedDocType :: (AlexInput -> (String -> Token) -> Bool -> P (RealLocated Token))+                 -> P (RealLocated Token)+withLexedDocType lexDocComment = do+  input@(AI _ buf) <- getInput+  case prevChar buf ' ' of+    -- The `Bool` argument to lexDocComment signals whether or not the next+    -- line of input might also belong to this doc comment.+    '|' -> lexDocComment input ITdocCommentNext True+    '^' -> lexDocComment input ITdocCommentPrev True+    '$' -> lexDocComment input ITdocCommentNamed True+    '*' -> lexDocSection 1 input+    _ -> panic "withLexedDocType: Bad doc type"+ where+    lexDocSection n input = case alexGetChar' input of+      Just ('*', input) -> lexDocSection (n+1) input+      Just (_,   _)     -> lexDocComment input (ITdocSection n) False+      Nothing -> do setInput input; lexToken -- eof reached, lex it normally++-- RULES pragmas turn on the forall and '.' keywords, and we turn them+-- off again at the end of the pragma.+rulePrag :: Action+rulePrag span buf len = do+  setExts (.|. xbit InRulePragBit)+  let !src = lexemeToString buf len+  return (L span (ITrules_prag (SourceText src)))++-- When 'UsePosPragsBit' is not set, it is expected that we emit a token instead+-- of updating the position in 'PState'+linePrag :: Action+linePrag span buf len = do+  usePosPrags <- getBit UsePosPragsBit+  if usePosPrags+    then begin line_prag2 span buf len+    else let !src = lexemeToString buf len+         in return (L span (ITline_prag (SourceText src)))++-- When 'UsePosPragsBit' is not set, it is expected that we emit a token instead+-- of updating the position in 'PState'+columnPrag :: Action+columnPrag span buf len = do+  usePosPrags <- getBit UsePosPragsBit+  let !src = lexemeToString buf len+  if usePosPrags+    then begin column_prag span buf len+    else let !src = lexemeToString buf len+         in return (L span (ITcolumn_prag (SourceText src)))++endPrag :: Action+endPrag span _buf _len = do+  setExts (.&. complement (xbit InRulePragBit))+  return (L span ITclose_prag)++-- docCommentEnd+-------------------------------------------------------------------------------+-- This function is quite tricky. We can't just return a new token, we also+-- need to update the state of the parser. Why? Because the token is longer+-- than what was lexed by Alex, and the lexToken function doesn't know this, so+-- it writes the wrong token length to the parser state. This function is+-- called afterwards, so it can just update the state.++docCommentEnd :: AlexInput -> String -> (String -> Token) -> StringBuffer ->+                 RealSrcSpan -> P (RealLocated Token)+docCommentEnd input commentAcc docType buf span = do+  setInput input+  let (AI loc nextBuf) = input+      comment = reverse commentAcc+      span' = mkRealSrcSpan (realSrcSpanStart span) loc+      last_len = byteDiff buf nextBuf++  span `seq` setLastToken span' last_len+  return (L span' (docType comment))++errBrace :: AlexInput -> RealSrcSpan -> P a+errBrace (AI end _) span = failLocMsgP (realSrcSpanStart span) end "unterminated `{-'"++open_brace, close_brace :: Action+open_brace span _str _len = do+  ctx <- getContext+  setContext (NoLayout:ctx)+  return (L span ITocurly)+close_brace span _str _len = do+  popContext+  return (L span ITccurly)++qvarid, qconid :: StringBuffer -> Int -> Token+qvarid buf len = ITqvarid $! splitQualName buf len False+qconid buf len = ITqconid $! splitQualName buf len False++splitQualName :: StringBuffer -> Int -> Bool -> (FastString,FastString)+-- takes a StringBuffer and a length, and returns the module name+-- and identifier parts of a qualified name.  Splits at the *last* dot,+-- because of hierarchical module names.+splitQualName orig_buf len parens = split orig_buf orig_buf+  where+    split buf dot_buf+        | orig_buf `byteDiff` buf >= len  = done dot_buf+        | c == '.'                        = found_dot buf'+        | otherwise                       = split buf' dot_buf+      where+       (c,buf') = nextChar buf++    -- careful, we might get names like M....+    -- so, if the character after the dot is not upper-case, this is+    -- the end of the qualifier part.+    found_dot buf -- buf points after the '.'+        | isUpper c    = split buf' buf+        | otherwise    = done buf+      where+       (c,buf') = nextChar buf++    done dot_buf =+        (lexemeToFastString orig_buf (qual_size - 1),+         if parens -- Prelude.(+)+            then lexemeToFastString (stepOn dot_buf) (len - qual_size - 2)+            else lexemeToFastString dot_buf (len - qual_size))+      where+        qual_size = orig_buf `byteDiff` dot_buf++varid :: Action+varid span buf len =+  case lookupUFM reservedWordsFM fs of+    Just (ITcase, _) -> do+      lastTk <- getLastTk+      keyword <- case lastTk of+        Just ITlam -> do+          lambdaCase <- getBit LambdaCaseBit+          unless lambdaCase $ do+            pState <- getPState+            addError (RealSrcSpan (last_loc pState)) $ text+                     "Illegal lambda-case (use LambdaCase)"+          return ITlcase+        _ -> return ITcase+      maybe_layout keyword+      return $ L span keyword+    Just (keyword, 0) -> do+      maybe_layout keyword+      return $ L span keyword+    Just (keyword, i) -> do+      exts <- getExts+      if exts .&. i /= 0+        then do+          maybe_layout keyword+          return $ L span keyword+        else+          return $ L span $ ITvarid fs+    Nothing ->+      return $ L span $ ITvarid fs+  where+    !fs = lexemeToFastString buf len++conid :: StringBuffer -> Int -> Token+conid buf len = ITconid $! lexemeToFastString buf len++qvarsym, qconsym :: StringBuffer -> Int -> Token+qvarsym buf len = ITqvarsym $! splitQualName buf len False+qconsym buf len = ITqconsym $! splitQualName buf len False++varsym, consym :: Action+varsym = sym ITvarsym+consym = sym ITconsym++sym :: (FastString -> Token) -> Action+sym con span buf len =+  case lookupUFM reservedSymsFM fs of+    Just (keyword, NormalSyntax, 0) ->+      return $ L span keyword+    Just (keyword, NormalSyntax, i) -> do+      exts <- getExts+      if exts .&. i /= 0+        then return $ L span keyword+        else return $ L span (con fs)+    Just (keyword, UnicodeSyntax, 0) -> do+      exts <- getExts+      if xtest UnicodeSyntaxBit exts+        then return $ L span keyword+        else return $ L span (con fs)+    Just (keyword, UnicodeSyntax, i) -> do+      exts <- getExts+      if exts .&. i /= 0 && xtest UnicodeSyntaxBit exts+        then return $ L span keyword+        else return $ L span (con fs)+    Nothing ->+      return $ L span $! con fs+  where+    !fs = lexemeToFastString buf len++-- Variations on the integral numeric literal.+tok_integral :: (SourceText -> Integer -> Token)+             -> (Integer -> Integer)+             -> Int -> Int+             -> (Integer, (Char -> Int))+             -> Action+tok_integral itint transint transbuf translen (radix,char_to_int) span buf len = do+  numericUnderscores <- getBit NumericUnderscoresBit  -- #14473+  let src = lexemeToString buf len+  when ((not numericUnderscores) && ('_' `elem` src)) $ do+    pState <- getPState+    addError (RealSrcSpan (last_loc pState)) $ text+             "Use NumericUnderscores to allow underscores in integer literals"+  return $ L span $ itint (SourceText src)+       $! transint $ parseUnsignedInteger+       (offsetBytes transbuf buf) (subtract translen len) radix char_to_int++tok_num :: (Integer -> Integer)+        -> Int -> Int+        -> (Integer, (Char->Int)) -> Action+tok_num = tok_integral $ \case+    st@(SourceText ('-':_)) -> itint st (const True)+    st@(SourceText _)       -> itint st (const False)+    st@NoSourceText         -> itint st (< 0)+  where+    itint :: SourceText -> (Integer -> Bool) -> Integer -> Token+    itint !st is_negative !val = ITinteger ((IL st $! is_negative val) val)++tok_primint :: (Integer -> Integer)+            -> Int -> Int+            -> (Integer, (Char->Int)) -> Action+tok_primint = tok_integral ITprimint+++tok_primword :: Int -> Int+             -> (Integer, (Char->Int)) -> Action+tok_primword = tok_integral ITprimword positive+positive, negative :: (Integer -> Integer)+positive = id+negative = negate+decimal, octal, hexadecimal :: (Integer, Char -> Int)+decimal = (10,octDecDigit)+binary = (2,octDecDigit)+octal = (8,octDecDigit)+hexadecimal = (16,hexDigit)++-- readRational can understand negative rationals, exponents, everything.+tok_frac :: Int -> (String -> Token) -> Action+tok_frac drop f span buf len = do+  numericUnderscores <- getBit NumericUnderscoresBit  -- #14473+  let src = lexemeToString buf (len-drop)+  when ((not numericUnderscores) && ('_' `elem` src)) $ do+    pState <- getPState+    addError (RealSrcSpan (last_loc pState)) $ text+             "Use NumericUnderscores to allow underscores in floating literals"+  return (L span $! (f $! src))++tok_float, tok_primfloat, tok_primdouble :: String -> Token+tok_float        str = ITrational   $! readFractionalLit str+tok_hex_float    str = ITrational   $! readHexFractionalLit str+tok_primfloat    str = ITprimfloat  $! readFractionalLit str+tok_primdouble   str = ITprimdouble $! readFractionalLit str++readFractionalLit :: String -> FractionalLit+readFractionalLit str = ((FL $! (SourceText str)) $! is_neg) $! readRational str+                        where is_neg = case str of ('-':_) -> True+                                                   _       -> False+readHexFractionalLit :: String -> FractionalLit+readHexFractionalLit str =+  FL { fl_text  = SourceText str+     , fl_neg   = case str of+                    '-' : _ -> True+                    _       -> False+     , fl_value = readHexRational str+     }++-- -----------------------------------------------------------------------------+-- Layout processing++-- we're at the first token on a line, insert layout tokens if necessary+do_bol :: Action+do_bol span _str _len = do+        -- See Note [Nested comment line pragmas]+        b <- getBit InNestedCommentBit+        if b then return (L span ITcomment_line_prag) else do+          (pos, gen_semic) <- getOffside+          case pos of+              LT -> do+                  --trace "layout: inserting '}'" $ do+                  popContext+                  -- do NOT pop the lex state, we might have a ';' to insert+                  return (L span ITvccurly)+              EQ | gen_semic -> do+                  --trace "layout: inserting ';'" $ do+                  _ <- popLexState+                  return (L span ITsemi)+              _ -> do+                  _ <- popLexState+                  lexToken++-- certain keywords put us in the "layout" state, where we might+-- add an opening curly brace.+maybe_layout :: Token -> P ()+maybe_layout t = do -- If the alternative layout rule is enabled then+                    -- we never create an implicit layout context here.+                    -- Layout is handled XXX instead.+                    -- The code for closing implicit contexts, or+                    -- inserting implicit semi-colons, is therefore+                    -- irrelevant as it only applies in an implicit+                    -- context.+                    alr <- getBit AlternativeLayoutRuleBit+                    unless alr $ f t+    where f ITdo    = pushLexState layout_do+          f ITmdo   = pushLexState layout_do+          f ITof    = pushLexState layout+          f ITlcase = pushLexState layout+          f ITlet   = pushLexState layout+          f ITwhere = pushLexState layout+          f ITrec   = pushLexState layout+          f ITif    = pushLexState layout_if+          f _       = return ()++-- Pushing a new implicit layout context.  If the indentation of the+-- next token is not greater than the previous layout context, then+-- Haskell 98 says that the new layout context should be empty; that is+-- the lexer must generate {}.+--+-- We are slightly more lenient than this: when the new context is started+-- by a 'do', then we allow the new context to be at the same indentation as+-- the previous context.  This is what the 'strict' argument is for.+new_layout_context :: Bool -> Bool -> Token -> Action+new_layout_context strict gen_semic tok span _buf len = do+    _ <- popLexState+    (AI l _) <- getInput+    let offset = srcLocCol l - len+    ctx <- getContext+    nondecreasing <- getBit NondecreasingIndentationBit+    let strict' = strict || not nondecreasing+    case ctx of+        Layout prev_off _ : _  |+           (strict'     && prev_off >= offset  ||+            not strict' && prev_off > offset) -> do+                -- token is indented to the left of the previous context.+                -- we must generate a {} sequence now.+                pushLexState layout_left+                return (L span tok)+        _ -> do setContext (Layout offset gen_semic : ctx)+                return (L span tok)++do_layout_left :: Action+do_layout_left span _buf _len = do+    _ <- popLexState+    pushLexState bol  -- we must be at the start of a line+    return (L span ITvccurly)++-- -----------------------------------------------------------------------------+-- LINE pragmas++setLineAndFile :: Int -> Action+setLineAndFile code span buf len = do+  let src = lexemeToString buf (len - 1)  -- drop trailing quotation mark+      linenumLen = length $ head $ words src+      linenum = parseUnsignedInteger buf linenumLen 10 octDecDigit+      file = mkFastString $ go $ drop 1 $ dropWhile (/= '"') src+          -- skip everything through first quotation mark to get to the filename+        where go ('\\':c:cs) = c : go cs+              go (c:cs)      = c : go cs+              go []          = []+              -- decode escapes in the filename.  e.g. on Windows+              -- when our filenames have backslashes in, gcc seems to+              -- escape the backslashes.  One symptom of not doing this+              -- is that filenames in error messages look a bit strange:+              --   C:\\foo\bar.hs+              -- only the first backslash is doubled, because we apply+              -- System.FilePath.normalise before printing out+              -- filenames and it does not remove duplicate+              -- backslashes after the drive letter (should it?).+  setAlrLastLoc $ alrInitialLoc file+  setSrcLoc (mkRealSrcLoc file (fromIntegral linenum - 1) (srcSpanEndCol span))+      -- subtract one: the line number refers to the *following* line+  addSrcFile file+  _ <- popLexState+  pushLexState code+  lexToken++setColumn :: Action+setColumn span buf len = do+  let column =+        case reads (lexemeToString buf len) of+          [(column, _)] -> column+          _ -> error "setColumn: expected integer" -- shouldn't happen+  setSrcLoc (mkRealSrcLoc (srcSpanFile span) (srcSpanEndLine span)+                          (fromIntegral (column :: Integer)))+  _ <- popLexState+  lexToken++alrInitialLoc :: FastString -> RealSrcSpan+alrInitialLoc file = mkRealSrcSpan loc loc+    where -- This is a hack to ensure that the first line in a file+          -- looks like it is after the initial location:+          loc = mkRealSrcLoc file (-1) (-1)++-- -----------------------------------------------------------------------------+-- Options, includes and language pragmas.++lex_string_prag :: (String -> Token) -> Action+lex_string_prag mkTok span _buf _len+    = do input <- getInput+         start <- getRealSrcLoc+         tok <- go [] input+         end <- getRealSrcLoc+         return (L (mkRealSrcSpan start end) tok)+    where go acc input+              = if isString input "#-}"+                   then do setInput input+                           return (mkTok (reverse acc))+                   else case alexGetChar input of+                          Just (c,i) -> go (c:acc) i+                          Nothing -> err input+          isString _ [] = True+          isString i (x:xs)+              = case alexGetChar i of+                  Just (c,i') | c == x    -> isString i' xs+                  _other -> False+          err (AI end _) = failLocMsgP (realSrcSpanStart span) end "unterminated options pragma"+++-- -----------------------------------------------------------------------------+-- Strings & Chars++-- This stuff is horrible.  I hates it.++lex_string_tok :: Action+lex_string_tok span buf _len = do+  tok <- lex_string ""+  (AI end bufEnd) <- getInput+  let+    tok' = case tok of+            ITprimstring _ bs -> ITprimstring (SourceText src) bs+            ITstring _ s -> ITstring (SourceText src) s+            _ -> panic "lex_string_tok"+    src = lexemeToString buf (cur bufEnd - cur buf)+  return (L (mkRealSrcSpan (realSrcSpanStart span) end) tok')++lex_string :: String -> P Token+lex_string s = do+  i <- getInput+  case alexGetChar' i of+    Nothing -> lit_error i++    Just ('"',i)  -> do+        setInput i+        let s' = reverse s+        magicHash <- getBit MagicHashBit+        if magicHash+          then do+            i <- getInput+            case alexGetChar' i of+              Just ('#',i) -> do+                setInput i+                when (any (> '\xFF') s') $ do+                  pState <- getPState+                  addError (RealSrcSpan (last_loc pState)) $ text+                     "primitive string literal must contain only characters <= \'\\xFF\'"+                return (ITprimstring (SourceText s') (unsafeMkByteString s'))+              _other ->+                return (ITstring (SourceText s') (mkFastString s'))+          else+                return (ITstring (SourceText s') (mkFastString s'))++    Just ('\\',i)+        | Just ('&',i) <- next -> do+                setInput i; lex_string s+        | Just (c,i) <- next, c <= '\x7f' && is_space c -> do+                           -- is_space only works for <= '\x7f' (#3751, #5425)+                setInput i; lex_stringgap s+        where next = alexGetChar' i++    Just (c, i1) -> do+        case c of+          '\\' -> do setInput i1; c' <- lex_escape; lex_string (c':s)+          c | isAny c -> do setInput i1; lex_string (c:s)+          _other -> lit_error i++lex_stringgap :: String -> P Token+lex_stringgap s = do+  i <- getInput+  c <- getCharOrFail i+  case c of+    '\\' -> lex_string s+    c | c <= '\x7f' && is_space c -> lex_stringgap s+                           -- is_space only works for <= '\x7f' (#3751, #5425)+    _other -> lit_error i+++lex_char_tok :: Action+-- Here we are basically parsing character literals, such as 'x' or '\n'+-- but we additionally spot 'x and ''T, returning ITsimpleQuote and+-- ITtyQuote respectively, but WITHOUT CONSUMING the x or T part+-- (the parser does that).+-- So we have to do two characters of lookahead: when we see 'x we need to+-- see if there's a trailing quote+lex_char_tok span buf _len = do        -- We've seen '+   i1 <- getInput       -- Look ahead to first character+   let loc = realSrcSpanStart span+   case alexGetChar' i1 of+        Nothing -> lit_error  i1++        Just ('\'', i2@(AI end2 _)) -> do       -- We've seen ''+                   setInput i2+                   return (L (mkRealSrcSpan loc end2)  ITtyQuote)++        Just ('\\', i2@(AI _end2 _)) -> do      -- We've seen 'backslash+                  setInput i2+                  lit_ch <- lex_escape+                  i3 <- getInput+                  mc <- getCharOrFail i3 -- Trailing quote+                  if mc == '\'' then finish_char_tok buf loc lit_ch+                                else lit_error i3++        Just (c, i2@(AI _end2 _))+                | not (isAny c) -> lit_error i1+                | otherwise ->++                -- We've seen 'x, where x is a valid character+                --  (i.e. not newline etc) but not a quote or backslash+           case alexGetChar' i2 of      -- Look ahead one more character+                Just ('\'', i3) -> do   -- We've seen 'x'+                        setInput i3+                        finish_char_tok buf loc c+                _other -> do            -- We've seen 'x not followed by quote+                                        -- (including the possibility of EOF)+                                        -- Just parse the quote only+                        let (AI end _) = i1+                        return (L (mkRealSrcSpan loc end) ITsimpleQuote)++finish_char_tok :: StringBuffer -> RealSrcLoc -> Char -> P (RealLocated Token)+finish_char_tok buf loc ch  -- We've already seen the closing quote+                        -- Just need to check for trailing #+  = do  magicHash <- getBit MagicHashBit+        i@(AI end bufEnd) <- getInput+        let src = lexemeToString buf (cur bufEnd - cur buf)+        if magicHash then do+            case alexGetChar' i of+              Just ('#',i@(AI end _)) -> do+                setInput i+                return (L (mkRealSrcSpan loc end)+                          (ITprimchar (SourceText src) ch))+              _other ->+                return (L (mkRealSrcSpan loc end)+                          (ITchar (SourceText src) ch))+            else do+              return (L (mkRealSrcSpan loc end) (ITchar (SourceText src) ch))++isAny :: Char -> Bool+isAny c | c > '\x7f' = isPrint c+        | otherwise  = is_any c++lex_escape :: P Char+lex_escape = do+  i0 <- getInput+  c <- getCharOrFail i0+  case c of+        'a'   -> return '\a'+        'b'   -> return '\b'+        'f'   -> return '\f'+        'n'   -> return '\n'+        'r'   -> return '\r'+        't'   -> return '\t'+        'v'   -> return '\v'+        '\\'  -> return '\\'+        '"'   -> return '\"'+        '\''  -> return '\''+        '^'   -> do i1 <- getInput+                    c <- getCharOrFail i1+                    if c >= '@' && c <= '_'+                        then return (chr (ord c - ord '@'))+                        else lit_error i1++        'x'   -> readNum is_hexdigit 16 hexDigit+        'o'   -> readNum is_octdigit  8 octDecDigit+        x | is_decdigit x -> readNum2 is_decdigit 10 octDecDigit (octDecDigit x)++        c1 ->  do+           i <- getInput+           case alexGetChar' i of+            Nothing -> lit_error i0+            Just (c2,i2) ->+              case alexGetChar' i2 of+                Nothing -> do lit_error i0+                Just (c3,i3) ->+                   let str = [c1,c2,c3] in+                   case [ (c,rest) | (p,c) <- silly_escape_chars,+                                     Just rest <- [stripPrefix p str] ] of+                          (escape_char,[]):_ -> do+                                setInput i3+                                return escape_char+                          (escape_char,_:_):_ -> do+                                setInput i2+                                return escape_char+                          [] -> lit_error i0++readNum :: (Char -> Bool) -> Int -> (Char -> Int) -> P Char+readNum is_digit base conv = do+  i <- getInput+  c <- getCharOrFail i+  if is_digit c+        then readNum2 is_digit base conv (conv c)+        else lit_error i++readNum2 :: (Char -> Bool) -> Int -> (Char -> Int) -> Int -> P Char+readNum2 is_digit base conv i = do+  input <- getInput+  read i input+  where read i input = do+          case alexGetChar' input of+            Just (c,input') | is_digit c -> do+               let i' = i*base + conv c+               if i' > 0x10ffff+                  then setInput input >> lexError "numeric escape sequence out of range"+                  else read i' input'+            _other -> do+              setInput input; return (chr i)+++silly_escape_chars :: [(String, Char)]+silly_escape_chars = [+        ("NUL", '\NUL'),+        ("SOH", '\SOH'),+        ("STX", '\STX'),+        ("ETX", '\ETX'),+        ("EOT", '\EOT'),+        ("ENQ", '\ENQ'),+        ("ACK", '\ACK'),+        ("BEL", '\BEL'),+        ("BS", '\BS'),+        ("HT", '\HT'),+        ("LF", '\LF'),+        ("VT", '\VT'),+        ("FF", '\FF'),+        ("CR", '\CR'),+        ("SO", '\SO'),+        ("SI", '\SI'),+        ("DLE", '\DLE'),+        ("DC1", '\DC1'),+        ("DC2", '\DC2'),+        ("DC3", '\DC3'),+        ("DC4", '\DC4'),+        ("NAK", '\NAK'),+        ("SYN", '\SYN'),+        ("ETB", '\ETB'),+        ("CAN", '\CAN'),+        ("EM", '\EM'),+        ("SUB", '\SUB'),+        ("ESC", '\ESC'),+        ("FS", '\FS'),+        ("GS", '\GS'),+        ("RS", '\RS'),+        ("US", '\US'),+        ("SP", '\SP'),+        ("DEL", '\DEL')+        ]++-- before calling lit_error, ensure that the current input is pointing to+-- the position of the error in the buffer.  This is so that we can report+-- a correct location to the user, but also so we can detect UTF-8 decoding+-- errors if they occur.+lit_error :: AlexInput -> P a+lit_error i = do setInput i; lexError "lexical error in string/character literal"++getCharOrFail :: AlexInput -> P Char+getCharOrFail i =  do+  case alexGetChar' i of+        Nothing -> lexError "unexpected end-of-file in string/character literal"+        Just (c,i)  -> do setInput i; return c++-- -----------------------------------------------------------------------------+-- QuasiQuote++lex_qquasiquote_tok :: Action+lex_qquasiquote_tok span buf len = do+  let (qual, quoter) = splitQualName (stepOn buf) (len - 2) False+  quoteStart <- getRealSrcLoc+  quote <- lex_quasiquote quoteStart ""+  end <- getRealSrcLoc+  return (L (mkRealSrcSpan (realSrcSpanStart span) end)+           (ITqQuasiQuote (qual,+                           quoter,+                           mkFastString (reverse quote),+                           mkRealSrcSpan quoteStart end)))++lex_quasiquote_tok :: Action+lex_quasiquote_tok span buf len = do+  let quoter = tail (lexemeToString buf (len - 1))+                -- 'tail' drops the initial '[',+                -- while the -1 drops the trailing '|'+  quoteStart <- getRealSrcLoc+  quote <- lex_quasiquote quoteStart ""+  end <- getRealSrcLoc+  return (L (mkRealSrcSpan (realSrcSpanStart span) end)+           (ITquasiQuote (mkFastString quoter,+                          mkFastString (reverse quote),+                          mkRealSrcSpan quoteStart end)))++lex_quasiquote :: RealSrcLoc -> String -> P String+lex_quasiquote start s = do+  i <- getInput+  case alexGetChar' i of+    Nothing -> quasiquote_error start++    -- NB: The string "|]" terminates the quasiquote,+    -- with absolutely no escaping. See the extensive+    -- discussion on #5348 for why there is no+    -- escape handling.+    Just ('|',i)+        | Just (']',i) <- alexGetChar' i+        -> do { setInput i; return s }++    Just (c, i) -> do+         setInput i; lex_quasiquote start (c : s)++quasiquote_error :: RealSrcLoc -> P a+quasiquote_error start = do+  (AI end buf) <- getInput+  reportLexError start end buf "unterminated quasiquotation"++-- -----------------------------------------------------------------------------+-- Warnings++warnTab :: Action+warnTab srcspan _buf _len = do+    addTabWarning srcspan+    lexToken++warnThen :: WarningFlag -> SDoc -> Action -> Action+warnThen option warning action srcspan buf len = do+    addWarning option (RealSrcSpan srcspan) warning+    action srcspan buf len++-- -----------------------------------------------------------------------------+-- The Parse Monad++-- | Do we want to generate ';' layout tokens? In some cases we just want to+-- generate '}', e.g. in MultiWayIf we don't need ';'s because '|' separates+-- alternatives (unlike a `case` expression where we need ';' to as a separator+-- between alternatives).+type GenSemic = Bool++generateSemic, dontGenerateSemic :: GenSemic+generateSemic     = True+dontGenerateSemic = False++data LayoutContext+  = NoLayout+  | Layout !Int !GenSemic+  deriving Show++-- | The result of running a parser.+data ParseResult a+  = POk      -- ^ The parser has consumed a (possibly empty) prefix+             --   of the input and produced a result. Use 'getMessages'+             --   to check for accumulated warnings and non-fatal errors.+      PState -- ^ The resulting parsing state. Can be used to resume parsing.+      a      -- ^ The resulting value.+  | PFailed  -- ^ The parser has consumed a (possibly empty) prefix+             --   of the input and failed.+      PState -- ^ The parsing state right before failure, including the fatal+             --   parse error. 'getMessages' and 'getErrorMessages' must return+             --   a non-empty bag of errors.++-- | Test whether a 'WarningFlag' is set+warnopt :: WarningFlag -> ParserFlags -> Bool+warnopt f options = f `EnumSet.member` pWarningFlags options++-- | The subset of the 'DynFlags' used by the parser.+-- See 'mkParserFlags' or 'mkParserFlags'' for ways to construct this.+data ParserFlags = ParserFlags {+    pWarningFlags   :: EnumSet WarningFlag+  , pThisPackage    :: UnitId      -- ^ key of package currently being compiled+  , pExtsBitmap     :: !ExtsBitmap -- ^ bitmap of permitted extensions+  }++data PState = PState {+        buffer     :: StringBuffer,+        options    :: ParserFlags,+        -- This needs to take DynFlags as an argument until+        -- we have a fix for #10143+        messages   :: DynFlags -> Messages,+        tab_first  :: Maybe RealSrcSpan, -- pos of first tab warning in the file+        tab_count  :: !Int,              -- number of tab warnings in the file+        last_tk    :: Maybe Token,+        last_loc   :: RealSrcSpan, -- pos of previous token+        last_len   :: !Int,        -- len of previous token+        loc        :: RealSrcLoc,  -- current loc (end of prev token + 1)+        context    :: [LayoutContext],+        lex_state  :: [Int],+        srcfiles   :: [FastString],+        -- Used in the alternative layout rule:+        -- These tokens are the next ones to be sent out. They are+        -- just blindly emitted, without the rule looking at them again:+        alr_pending_implicit_tokens :: [RealLocated Token],+        -- This is the next token to be considered or, if it is Nothing,+        -- we need to get the next token from the input stream:+        alr_next_token :: Maybe (RealLocated Token),+        -- This is what we consider to be the location of the last token+        -- emitted:+        alr_last_loc :: RealSrcSpan,+        -- The stack of layout contexts:+        alr_context :: [ALRContext],+        -- Are we expecting a '{'? If it's Just, then the ALRLayout tells+        -- us what sort of layout the '{' will open:+        alr_expecting_ocurly :: Maybe ALRLayout,+        -- Have we just had the '}' for a let block? If so, than an 'in'+        -- token doesn't need to close anything:+        alr_justClosedExplicitLetBlock :: Bool,++        -- The next three are used to implement Annotations giving the+        -- locations of 'noise' tokens in the source, so that users of+        -- the GHC API can do source to source conversions.+        -- See note [Api annotations] in ApiAnnotation.hs+        annotations :: [(ApiAnnKey,[SrcSpan])],+        comment_q :: [Located AnnotationComment],+        annotations_comments :: [(SrcSpan,[Located AnnotationComment])]+     }+        -- last_loc and last_len are used when generating error messages,+        -- and in pushCurrentContext only.  Sigh, if only Happy passed the+        -- current token to happyError, we could at least get rid of last_len.+        -- Getting rid of last_loc would require finding another way to+        -- implement pushCurrentContext (which is only called from one place).++data ALRContext = ALRNoLayout Bool{- does it contain commas? -}+                              Bool{- is it a 'let' block? -}+                | ALRLayout ALRLayout Int+data ALRLayout = ALRLayoutLet+               | ALRLayoutWhere+               | ALRLayoutOf+               | ALRLayoutDo++-- | The parsing monad, isomorphic to @StateT PState Maybe@.+newtype P a = P { unP :: PState -> ParseResult a }++instance Functor P where+  fmap = liftM++instance Applicative P where+  pure = returnP+  (<*>) = ap++instance Monad P where+  (>>=) = thenP+#if !MIN_VERSION_base(4,13,0)+  fail = MonadFail.fail+#endif++instance MonadFail.MonadFail P where+  fail = failMsgP++returnP :: a -> P a+returnP a = a `seq` (P $ \s -> POk s a)++thenP :: P a -> (a -> P b) -> P b+(P m) `thenP` k = P $ \ s ->+        case m s of+                POk s1 a         -> (unP (k a)) s1+                PFailed s1 -> PFailed s1++failMsgP :: String -> P a+failMsgP msg = do+  pState <- getPState+  addFatalError (RealSrcSpan (last_loc pState)) (text msg)++failLocMsgP :: RealSrcLoc -> RealSrcLoc -> String -> P a+failLocMsgP loc1 loc2 str =+  addFatalError (RealSrcSpan (mkRealSrcSpan loc1 loc2)) (text str)++getPState :: P PState+getPState = P $ \s -> POk s s++withThisPackage :: (UnitId -> a) -> P a+withThisPackage f = P $ \s@(PState{options = o}) -> POk s (f (pThisPackage o))++getExts :: P ExtsBitmap+getExts = P $ \s -> POk s (pExtsBitmap . options $ s)++setExts :: (ExtsBitmap -> ExtsBitmap) -> P ()+setExts f = P $ \s -> POk s {+  options =+    let p = options s+    in  p { pExtsBitmap = f (pExtsBitmap p) }+  } ()++setSrcLoc :: RealSrcLoc -> P ()+setSrcLoc new_loc = P $ \s -> POk s{loc=new_loc} ()++getRealSrcLoc :: P RealSrcLoc+getRealSrcLoc = P $ \s@(PState{ loc=loc }) -> POk s loc++addSrcFile :: FastString -> P ()+addSrcFile f = P $ \s -> POk s{ srcfiles = f : srcfiles s } ()++setLastToken :: RealSrcSpan -> Int -> P ()+setLastToken loc len = P $ \s -> POk s {+  last_loc=loc,+  last_len=len+  } ()++setLastTk :: Token -> P ()+setLastTk tk = P $ \s -> POk s { last_tk = Just tk } ()++getLastTk :: P (Maybe Token)+getLastTk = P $ \s@(PState { last_tk = last_tk }) -> POk s last_tk++data AlexInput = AI RealSrcLoc StringBuffer++{-+Note [Unicode in Alex]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Although newer versions of Alex support unicode, this grammar is processed with+the old style '--latin1' behaviour. This means that when implementing the+functions++    alexGetByte       :: AlexInput -> Maybe (Word8,AlexInput)+    alexInputPrevChar :: AlexInput -> Char++which Alex uses to take apart our 'AlexInput', we must++  * return a latin1 character in the 'Word8' that 'alexGetByte' expects+  * return a latin1 character in 'alexInputPrevChar'.++We handle this in 'adjustChar' by squishing entire classes of unicode+characters into single bytes.+-}++{-# INLINE adjustChar #-}+adjustChar :: Char -> Word8+adjustChar c = fromIntegral $ ord adj_c+  where non_graphic     = '\x00'+        upper           = '\x01'+        lower           = '\x02'+        digit           = '\x03'+        symbol          = '\x04'+        space           = '\x05'+        other_graphic   = '\x06'+        uniidchar       = '\x07'++        adj_c+          | c <= '\x07' = non_graphic+          | c <= '\x7f' = c+          -- Alex doesn't handle Unicode, so when Unicode+          -- character is encountered we output these values+          -- with the actual character value hidden in the state.+          | otherwise =+                -- NB: The logic behind these definitions is also reflected+                -- in basicTypes/Lexeme.hs+                -- Any changes here should likely be reflected there.++                case generalCategory c of+                  UppercaseLetter       -> upper+                  LowercaseLetter       -> lower+                  TitlecaseLetter       -> upper+                  ModifierLetter        -> uniidchar -- see #10196+                  OtherLetter           -> lower -- see #1103+                  NonSpacingMark        -> uniidchar -- see #7650+                  SpacingCombiningMark  -> other_graphic+                  EnclosingMark         -> other_graphic+                  DecimalNumber         -> digit+                  LetterNumber          -> other_graphic+                  OtherNumber           -> digit -- see #4373+                  ConnectorPunctuation  -> symbol+                  DashPunctuation       -> symbol+                  OpenPunctuation       -> other_graphic+                  ClosePunctuation      -> other_graphic+                  InitialQuote          -> other_graphic+                  FinalQuote            -> other_graphic+                  OtherPunctuation      -> symbol+                  MathSymbol            -> symbol+                  CurrencySymbol        -> symbol+                  ModifierSymbol        -> symbol+                  OtherSymbol           -> symbol+                  Space                 -> space+                  _other                -> non_graphic++-- Getting the previous 'Char' isn't enough here - we need to convert it into+-- the same format that 'alexGetByte' would have produced.+--+-- See Note [Unicode in Alex] and #13986.+alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (AI _ buf) = chr (fromIntegral (adjustChar pc))+  where pc = prevChar buf '\n'++-- backwards compatibility for Alex 2.x+alexGetChar :: AlexInput -> Maybe (Char,AlexInput)+alexGetChar inp = case alexGetByte inp of+                    Nothing    -> Nothing+                    Just (b,i) -> c `seq` Just (c,i)+                       where c = chr $ fromIntegral b++-- See Note [Unicode in Alex]+alexGetByte :: AlexInput -> Maybe (Word8,AlexInput)+alexGetByte (AI loc s)+  | atEnd s   = Nothing+  | otherwise = byte `seq` loc' `seq` s' `seq`+                --trace (show (ord c)) $+                Just (byte, (AI loc' s'))+  where (c,s') = nextChar s+        loc'   = advanceSrcLoc loc c+        byte   = adjustChar c++-- This version does not squash unicode characters, it is used when+-- lexing strings.+alexGetChar' :: AlexInput -> Maybe (Char,AlexInput)+alexGetChar' (AI loc s)+  | atEnd s   = Nothing+  | otherwise = c `seq` loc' `seq` s' `seq`+                --trace (show (ord c)) $+                Just (c, (AI loc' s'))+  where (c,s') = nextChar s+        loc'   = advanceSrcLoc loc c++getInput :: P AlexInput+getInput = P $ \s@PState{ loc=l, buffer=b } -> POk s (AI l b)++setInput :: AlexInput -> P ()+setInput (AI l b) = P $ \s -> POk s{ loc=l, buffer=b } ()++nextIsEOF :: P Bool+nextIsEOF = do+  AI _ s <- getInput+  return $ atEnd s++pushLexState :: Int -> P ()+pushLexState ls = P $ \s@PState{ lex_state=l } -> POk s{lex_state=ls:l} ()++popLexState :: P Int+popLexState = P $ \s@PState{ lex_state=ls:l } -> POk s{ lex_state=l } ls++getLexState :: P Int+getLexState = P $ \s@PState{ lex_state=ls:_ } -> POk s ls++popNextToken :: P (Maybe (RealLocated Token))+popNextToken+    = P $ \s@PState{ alr_next_token = m } ->+              POk (s {alr_next_token = Nothing}) m++activeContext :: P Bool+activeContext = do+  ctxt <- getALRContext+  expc <- getAlrExpectingOCurly+  impt <- implicitTokenPending+  case (ctxt,expc) of+    ([],Nothing) -> return impt+    _other       -> return True++setAlrLastLoc :: RealSrcSpan -> P ()+setAlrLastLoc l = P $ \s -> POk (s {alr_last_loc = l}) ()++getAlrLastLoc :: P RealSrcSpan+getAlrLastLoc = P $ \s@(PState {alr_last_loc = l}) -> POk s l++getALRContext :: P [ALRContext]+getALRContext = P $ \s@(PState {alr_context = cs}) -> POk s cs++setALRContext :: [ALRContext] -> P ()+setALRContext cs = P $ \s -> POk (s {alr_context = cs}) ()++getJustClosedExplicitLetBlock :: P Bool+getJustClosedExplicitLetBlock+ = P $ \s@(PState {alr_justClosedExplicitLetBlock = b}) -> POk s b++setJustClosedExplicitLetBlock :: Bool -> P ()+setJustClosedExplicitLetBlock b+ = P $ \s -> POk (s {alr_justClosedExplicitLetBlock = b}) ()++setNextToken :: RealLocated Token -> P ()+setNextToken t = P $ \s -> POk (s {alr_next_token = Just t}) ()++implicitTokenPending :: P Bool+implicitTokenPending+    = P $ \s@PState{ alr_pending_implicit_tokens = ts } ->+              case ts of+              [] -> POk s False+              _  -> POk s True++popPendingImplicitToken :: P (Maybe (RealLocated Token))+popPendingImplicitToken+    = P $ \s@PState{ alr_pending_implicit_tokens = ts } ->+              case ts of+              [] -> POk s Nothing+              (t : ts') -> POk (s {alr_pending_implicit_tokens = ts'}) (Just t)++setPendingImplicitTokens :: [RealLocated Token] -> P ()+setPendingImplicitTokens ts = P $ \s -> POk (s {alr_pending_implicit_tokens = ts}) ()++getAlrExpectingOCurly :: P (Maybe ALRLayout)+getAlrExpectingOCurly = P $ \s@(PState {alr_expecting_ocurly = b}) -> POk s b++setAlrExpectingOCurly :: Maybe ALRLayout -> P ()+setAlrExpectingOCurly b = P $ \s -> POk (s {alr_expecting_ocurly = b}) ()++-- | For reasons of efficiency, boolean parsing flags (eg, language extensions+-- or whether we are currently in a @RULE@ pragma) are represented by a bitmap+-- stored in a @Word64@.+type ExtsBitmap = Word64++-- | Check if a given flag is currently set in the bitmap.+getBit :: ExtBits -> P Bool+getBit ext = P $ \s -> let b =  ext `xtest` pExtsBitmap (options s)+                       in b `seq` POk s b++xbit :: ExtBits -> ExtsBitmap+xbit = bit . fromEnum++xtest :: ExtBits -> ExtsBitmap -> Bool+xtest ext xmap = testBit xmap (fromEnum ext)++-- | Various boolean flags, mostly language extensions, that impact lexing and+-- parsing. Note that a handful of these can change during lexing/parsing.+data ExtBits+  -- Flags that are constant once parsing starts+  = FfiBit+  | InterruptibleFfiBit+  | CApiFfiBit+  | ArrowsBit+  | ThBit+  | ThQuotesBit+  | IpBit+  | OverloadedLabelsBit -- #x overloaded labels+  | ExplicitForallBit -- the 'forall' keyword+  | BangPatBit -- Tells the parser to understand bang-patterns+               -- (doesn't affect the lexer)+  | PatternSynonymsBit -- pattern synonyms+  | HaddockBit-- Lex and parse Haddock comments+  | MagicHashBit -- "#" in both functions and operators+  | RecursiveDoBit -- mdo+  | UnicodeSyntaxBit -- the forall symbol, arrow symbols, etc+  | UnboxedTuplesBit -- (# and #)+  | UnboxedSumsBit -- (# and #)+  | DatatypeContextsBit+  | MonadComprehensionsBit+  | TransformComprehensionsBit+  | QqBit -- enable quasiquoting+  | RawTokenStreamBit -- producing a token stream with all comments included+  | AlternativeLayoutRuleBit+  | ALRTransitionalBit+  | RelaxedLayoutBit+  | NondecreasingIndentationBit+  | SafeHaskellBit+  | TraditionalRecordSyntaxBit+  | ExplicitNamespacesBit+  | LambdaCaseBit+  | BinaryLiteralsBit+  | NegativeLiteralsBit+  | HexFloatLiteralsBit+  | TypeApplicationsBit+  | StaticPointersBit+  | NumericUnderscoresBit+  | StarIsTypeBit+  | BlockArgumentsBit+  | NPlusKPatternsBit+  | DoAndIfThenElseBit+  | MultiWayIfBit+  | GadtSyntaxBit++  -- Flags that are updated once parsing starts+  | InRulePragBit+  | InNestedCommentBit -- See Note [Nested comment line pragmas]+  | UsePosPragsBit+    -- ^ If this is enabled, '{-# LINE ... -#}' and '{-# COLUMN ... #-}'+    -- update the internal position. Otherwise, those pragmas are lexed as+    -- tokens of their own.+  deriving Enum++++++-- PState for parsing options pragmas+--+pragState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState+pragState dynflags buf loc = (mkPState dynflags buf loc) {+                                 lex_state = [bol, option_prags, 0]+                             }++{-# INLINE mkParserFlags' #-}+mkParserFlags'+  :: EnumSet WarningFlag        -- ^ warnings flags enabled+  -> EnumSet LangExt.Extension  -- ^ permitted language extensions enabled+  -> UnitId                     -- ^ key of package currently being compiled+  -> Bool                       -- ^ are safe imports on?+  -> Bool                       -- ^ keeping Haddock comment tokens+  -> Bool                       -- ^ keep regular comment tokens++  -> Bool+  -- ^ If this is enabled, '{-# LINE ... -#}' and '{-# COLUMN ... #-}' update+  -- the internal position kept by the parser. Otherwise, those pragmas are+  -- lexed as 'ITline_prag' and 'ITcolumn_prag' tokens.++  -> ParserFlags+-- ^ Given exactly the information needed, set up the 'ParserFlags'+mkParserFlags' warningFlags extensionFlags thisPackage+  safeImports isHaddock rawTokStream usePosPrags =+    ParserFlags {+      pWarningFlags = warningFlags+    , pThisPackage = thisPackage+    , pExtsBitmap = safeHaskellBit .|. langExtBits .|. optBits+    }+  where+    safeHaskellBit = SafeHaskellBit `setBitIf` safeImports+    langExtBits =+          FfiBit                      `xoptBit` LangExt.ForeignFunctionInterface+      .|. InterruptibleFfiBit         `xoptBit` LangExt.InterruptibleFFI+      .|. CApiFfiBit                  `xoptBit` LangExt.CApiFFI+      .|. ArrowsBit                   `xoptBit` LangExt.Arrows+      .|. ThBit                       `xoptBit` LangExt.TemplateHaskell+      .|. ThQuotesBit                 `xoptBit` LangExt.TemplateHaskellQuotes+      .|. QqBit                       `xoptBit` LangExt.QuasiQuotes+      .|. IpBit                       `xoptBit` LangExt.ImplicitParams+      .|. OverloadedLabelsBit         `xoptBit` LangExt.OverloadedLabels+      .|. ExplicitForallBit           `xoptBit` LangExt.ExplicitForAll+      .|. BangPatBit                  `xoptBit` LangExt.BangPatterns+      .|. MagicHashBit                `xoptBit` LangExt.MagicHash+      .|. RecursiveDoBit              `xoptBit` LangExt.RecursiveDo+      .|. UnicodeSyntaxBit            `xoptBit` LangExt.UnicodeSyntax+      .|. UnboxedTuplesBit            `xoptBit` LangExt.UnboxedTuples+      .|. UnboxedSumsBit              `xoptBit` LangExt.UnboxedSums+      .|. DatatypeContextsBit         `xoptBit` LangExt.DatatypeContexts+      .|. TransformComprehensionsBit  `xoptBit` LangExt.TransformListComp+      .|. MonadComprehensionsBit      `xoptBit` LangExt.MonadComprehensions+      .|. AlternativeLayoutRuleBit    `xoptBit` LangExt.AlternativeLayoutRule+      .|. ALRTransitionalBit          `xoptBit` LangExt.AlternativeLayoutRuleTransitional+      .|. RelaxedLayoutBit            `xoptBit` LangExt.RelaxedLayout+      .|. NondecreasingIndentationBit `xoptBit` LangExt.NondecreasingIndentation+      .|. TraditionalRecordSyntaxBit  `xoptBit` LangExt.TraditionalRecordSyntax+      .|. ExplicitNamespacesBit       `xoptBit` LangExt.ExplicitNamespaces+      .|. LambdaCaseBit               `xoptBit` LangExt.LambdaCase+      .|. BinaryLiteralsBit           `xoptBit` LangExt.BinaryLiterals+      .|. NegativeLiteralsBit         `xoptBit` LangExt.NegativeLiterals+      .|. HexFloatLiteralsBit         `xoptBit` LangExt.HexFloatLiterals+      .|. PatternSynonymsBit          `xoptBit` LangExt.PatternSynonyms+      .|. TypeApplicationsBit         `xoptBit` LangExt.TypeApplications+      .|. StaticPointersBit           `xoptBit` LangExt.StaticPointers+      .|. NumericUnderscoresBit       `xoptBit` LangExt.NumericUnderscores+      .|. StarIsTypeBit               `xoptBit` LangExt.StarIsType+      .|. BlockArgumentsBit           `xoptBit` LangExt.BlockArguments+      .|. NPlusKPatternsBit           `xoptBit` LangExt.NPlusKPatterns+      .|. DoAndIfThenElseBit          `xoptBit` LangExt.DoAndIfThenElse+      .|. MultiWayIfBit               `xoptBit` LangExt.MultiWayIf+      .|. GadtSyntaxBit               `xoptBit` LangExt.GADTSyntax+    optBits =+          HaddockBit        `setBitIf` isHaddock+      .|. RawTokenStreamBit `setBitIf` rawTokStream+      .|. UsePosPragsBit    `setBitIf` usePosPrags++    xoptBit bit ext = bit `setBitIf` EnumSet.member ext extensionFlags++    setBitIf :: ExtBits -> Bool -> ExtsBitmap+    b `setBitIf` cond | cond      = xbit b+                      | otherwise = 0++-- | Extracts the flag information needed for parsing+mkParserFlags :: DynFlags -> ParserFlags+mkParserFlags =+  mkParserFlags'+    <$> DynFlags.warningFlags+    <*> DynFlags.extensionFlags+    <*> DynFlags.thisPackage+    <*> safeImportsOn+    <*> gopt Opt_Haddock+    <*> gopt Opt_KeepRawTokenStream+    <*> const True++-- | Creates a parse state from a 'DynFlags' value+mkPState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState+mkPState flags = mkPStatePure (mkParserFlags flags)++-- | Creates a parse state from a 'ParserFlags' value+mkPStatePure :: ParserFlags -> StringBuffer -> RealSrcLoc -> PState+mkPStatePure options buf loc =+  PState {+      buffer        = buf,+      options       = options,+      messages      = const emptyMessages,+      tab_first     = Nothing,+      tab_count     = 0,+      last_tk       = Nothing,+      last_loc      = mkRealSrcSpan loc loc,+      last_len      = 0,+      loc           = loc,+      context       = [],+      lex_state     = [bol, 0],+      srcfiles      = [],+      alr_pending_implicit_tokens = [],+      alr_next_token = Nothing,+      alr_last_loc = alrInitialLoc (fsLit "<no file>"),+      alr_context = [],+      alr_expecting_ocurly = Nothing,+      alr_justClosedExplicitLetBlock = False,+      annotations = [],+      comment_q = [],+      annotations_comments = []+    }++-- | Add a non-fatal error. Use this when the parser can produce a result+--   despite the error.+--+--   For example, when GHC encounters a @forall@ in a type,+--   but @-XExplicitForAll@ is disabled, the parser constructs @ForAllTy@+--   as if @-XExplicitForAll@ was enabled, adding a non-fatal error to+--   the accumulator.+--+--   Control flow wise, non-fatal errors act like warnings: they are added+--   to the accumulator and parsing continues. This allows GHC to report+--   more than one parse error per file.+--+addError :: SrcSpan -> SDoc -> P ()+addError srcspan msg+ = P $ \s@PState{messages=m} ->+       let+           m' d =+               let (ws, es) = m d+                   errormsg = mkErrMsg d srcspan alwaysQualify msg+                   es' = es `snocBag` errormsg+               in (ws, es')+       in POk s{messages=m'} ()++-- | Add a fatal error. This will be the last error reported by the parser, and+--   the parser will not produce any result, ending in a 'PFailed' state.+addFatalError :: SrcSpan -> SDoc -> P a+addFatalError span msg =+  addError span msg >> P PFailed++-- | Add a warning to the accumulator.+--   Use 'getMessages' to get the accumulated warnings.+addWarning :: WarningFlag -> SrcSpan -> SDoc -> P ()+addWarning option srcspan warning+ = P $ \s@PState{messages=m, options=o} ->+       let+           m' d =+               let (ws, es) = m d+                   warning' = makeIntoWarning (Reason option) $+                      mkWarnMsg d srcspan alwaysQualify warning+                   ws' = if warnopt option o then ws `snocBag` warning' else ws+               in (ws', es)+       in POk s{messages=m'} ()++addTabWarning :: RealSrcSpan -> P ()+addTabWarning srcspan+ = P $ \s@PState{tab_first=tf, tab_count=tc, options=o} ->+       let tf' = if isJust tf then tf else Just srcspan+           tc' = tc + 1+           s' = if warnopt Opt_WarnTabs o+                then s{tab_first = tf', tab_count = tc'}+                else s+       in POk s' ()++mkTabWarning :: PState -> DynFlags -> Maybe ErrMsg+mkTabWarning PState{tab_first=tf, tab_count=tc} d =+  let middle = if tc == 1+        then text ""+        else text ", and in" <+> speakNOf (tc - 1) (text "further location")+      message = text "Tab character found here"+                <> middle+                <> text "."+                $+$ text "Please use spaces instead."+  in fmap (\s -> makeIntoWarning (Reason Opt_WarnTabs) $+                 mkWarnMsg d (RealSrcSpan s) alwaysQualify message) tf++-- | Get a bag of the errors that have been accumulated so far.+--   Does not take -Werror into account.+getErrorMessages :: PState -> DynFlags -> ErrorMessages+getErrorMessages PState{messages=m} d =+  let (_, es) = m d in es++-- | Get the warnings and errors accumulated so far.+--   Does not take -Werror into account.+getMessages :: PState -> DynFlags -> Messages+getMessages p@PState{messages=m} d =+  let (ws, es) = m d+      tabwarning = mkTabWarning p d+      ws' = maybe ws (`consBag` ws) tabwarning+  in (ws', es)++getContext :: P [LayoutContext]+getContext = P $ \s@PState{context=ctx} -> POk s ctx++setContext :: [LayoutContext] -> P ()+setContext ctx = P $ \s -> POk s{context=ctx} ()++popContext :: P ()+popContext = P $ \ s@(PState{ buffer = buf, options = o, context = ctx,+                              last_len = len, last_loc = last_loc }) ->+  case ctx of+        (_:tl) ->+          POk s{ context = tl } ()+        []     ->+          unP (addFatalError (RealSrcSpan last_loc) (srcParseErr o buf len)) s++-- Push a new layout context at the indentation of the last token read.+pushCurrentContext :: GenSemic -> P ()+pushCurrentContext gen_semic = P $ \ s@PState{ last_loc=loc, context=ctx } ->+    POk s{context = Layout (srcSpanStartCol loc) gen_semic : ctx} ()++-- This is only used at the outer level of a module when the 'module' keyword is+-- missing.+pushModuleContext :: P ()+pushModuleContext = pushCurrentContext generateSemic++getOffside :: P (Ordering, Bool)+getOffside = P $ \s@PState{last_loc=loc, context=stk} ->+                let offs = srcSpanStartCol loc in+                let ord = case stk of+                            Layout n gen_semic : _ ->+                              --trace ("layout: " ++ show n ++ ", offs: " ++ show offs) $+                              (compare offs n, gen_semic)+                            _ ->+                              (GT, dontGenerateSemic)+                in POk s ord++-- ---------------------------------------------------------------------------+-- Construct a parse error++srcParseErr+  :: ParserFlags+  -> StringBuffer       -- current buffer (placed just after the last token)+  -> Int                -- length of the previous token+  -> MsgDoc+srcParseErr options buf len+  = if null token+         then text "parse error (possibly incorrect indentation or mismatched brackets)"+         else text "parse error on input" <+> quotes (text token)+              $$ ppWhen (not th_enabled && token == "$") -- #7396+                        (text "Perhaps you intended to use TemplateHaskell")+              $$ ppWhen (token == "<-")+                        (if mdoInLast100+                           then text "Perhaps you intended to use RecursiveDo"+                           else text "Perhaps this statement should be within a 'do' block?")+              $$ ppWhen (token == "=" && doInLast100) -- #15849+                        (text "Perhaps you need a 'let' in a 'do' block?"+                         $$ text "e.g. 'let x = 5' instead of 'x = 5'")+              $$ ppWhen (not ps_enabled && pattern == "pattern ") -- #12429+                        (text "Perhaps you intended to use PatternSynonyms")+  where token = lexemeToString (offsetBytes (-len) buf) len+        pattern = decodePrevNChars 8 buf+        last100 = decodePrevNChars 100 buf+        doInLast100 = "do" `isInfixOf` last100+        mdoInLast100 = "mdo" `isInfixOf` last100+        th_enabled = ThBit `xtest` pExtsBitmap options+        ps_enabled = PatternSynonymsBit `xtest` pExtsBitmap options++-- Report a parse failure, giving the span of the previous token as+-- the location of the error.  This is the entry point for errors+-- detected during parsing.+srcParseFail :: P a+srcParseFail = P $ \s@PState{ buffer = buf, options = o, last_len = len,+                            last_loc = last_loc } ->+    unP (addFatalError (RealSrcSpan last_loc) (srcParseErr o buf len)) s++-- A lexical error is reported at a particular position in the source file,+-- not over a token range.+lexError :: String -> P a+lexError str = do+  loc <- getRealSrcLoc+  (AI end buf) <- getInput+  reportLexError loc end buf str++-- -----------------------------------------------------------------------------+-- This is the top-level function: called from the parser each time a+-- new token is to be read from the input.++lexer :: Bool -> (Located Token -> P a) -> P a+lexer queueComments cont = do+  alr <- getBit AlternativeLayoutRuleBit+  let lexTokenFun = if alr then lexTokenAlr else lexToken+  (L span tok) <- lexTokenFun+  --trace ("token: " ++ show tok) $ do++  case tok of+    ITeof -> addAnnotationOnly noSrcSpan AnnEofPos (RealSrcSpan span)+    _ -> return ()++  if (queueComments && isDocComment tok)+    then queueComment (L (RealSrcSpan span) tok)+    else return ()++  if (queueComments && isComment tok)+    then queueComment (L (RealSrcSpan span) tok) >> lexer queueComments cont+    else cont (L (RealSrcSpan span) tok)++lexTokenAlr :: P (RealLocated Token)+lexTokenAlr = do mPending <- popPendingImplicitToken+                 t <- case mPending of+                      Nothing ->+                          do mNext <- popNextToken+                             t <- case mNext of+                                  Nothing -> lexToken+                                  Just next -> return next+                             alternativeLayoutRuleToken t+                      Just t ->+                          return t+                 setAlrLastLoc (getRealSrcSpan t)+                 case unRealSrcSpan t of+                     ITwhere -> setAlrExpectingOCurly (Just ALRLayoutWhere)+                     ITlet   -> setAlrExpectingOCurly (Just ALRLayoutLet)+                     ITof    -> setAlrExpectingOCurly (Just ALRLayoutOf)+                     ITlcase -> setAlrExpectingOCurly (Just ALRLayoutOf)+                     ITdo    -> setAlrExpectingOCurly (Just ALRLayoutDo)+                     ITmdo   -> setAlrExpectingOCurly (Just ALRLayoutDo)+                     ITrec   -> setAlrExpectingOCurly (Just ALRLayoutDo)+                     _       -> return ()+                 return t++alternativeLayoutRuleToken :: RealLocated Token -> P (RealLocated Token)+alternativeLayoutRuleToken t+    = do context <- getALRContext+         lastLoc <- getAlrLastLoc+         mExpectingOCurly <- getAlrExpectingOCurly+         transitional <- getBit ALRTransitionalBit+         justClosedExplicitLetBlock <- getJustClosedExplicitLetBlock+         setJustClosedExplicitLetBlock False+         let thisLoc = getRealSrcSpan t+             thisCol = srcSpanStartCol thisLoc+             newLine = srcSpanStartLine thisLoc > srcSpanEndLine lastLoc+         case (unRealSrcSpan t, context, mExpectingOCurly) of+             -- This case handles a GHC extension to the original H98+             -- layout rule...+             (ITocurly, _, Just alrLayout) ->+                 do setAlrExpectingOCurly Nothing+                    let isLet = case alrLayout of+                                ALRLayoutLet -> True+                                _ -> False+                    setALRContext (ALRNoLayout (containsCommas ITocurly) isLet : context)+                    return t+             -- ...and makes this case unnecessary+             {-+             -- I think our implicit open-curly handling is slightly+             -- different to John's, in how it interacts with newlines+             -- and "in"+             (ITocurly, _, Just _) ->+                 do setAlrExpectingOCurly Nothing+                    setNextToken t+                    lexTokenAlr+             -}+             (_, ALRLayout _ col : _ls, Just expectingOCurly)+              | (thisCol > col) ||+                (thisCol == col &&+                 isNonDecreasingIndentation expectingOCurly) ->+                 do setAlrExpectingOCurly Nothing+                    setALRContext (ALRLayout expectingOCurly thisCol : context)+                    setNextToken t+                    return (L thisLoc ITvocurly)+              | otherwise ->+                 do setAlrExpectingOCurly Nothing+                    setPendingImplicitTokens [L lastLoc ITvccurly]+                    setNextToken t+                    return (L lastLoc ITvocurly)+             (_, _, Just expectingOCurly) ->+                 do setAlrExpectingOCurly Nothing+                    setALRContext (ALRLayout expectingOCurly thisCol : context)+                    setNextToken t+                    return (L thisLoc ITvocurly)+             -- We do the [] cases earlier than in the spec, as we+             -- have an actual EOF token+             (ITeof, ALRLayout _ _ : ls, _) ->+                 do setALRContext ls+                    setNextToken t+                    return (L thisLoc ITvccurly)+             (ITeof, _, _) ->+                 return t+             -- the other ITeof case omitted; general case below covers it+             (ITin, _, _)+              | justClosedExplicitLetBlock ->+                 return t+             (ITin, ALRLayout ALRLayoutLet _ : ls, _)+              | newLine ->+                 do setPendingImplicitTokens [t]+                    setALRContext ls+                    return (L thisLoc ITvccurly)+             -- This next case is to handle a transitional issue:+             (ITwhere, ALRLayout _ col : ls, _)+              | newLine && thisCol == col && transitional ->+                 do addWarning Opt_WarnAlternativeLayoutRuleTransitional+                               (RealSrcSpan thisLoc)+                               (transitionalAlternativeLayoutWarning+                                    "`where' clause at the same depth as implicit layout block")+                    setALRContext ls+                    setNextToken t+                    -- Note that we use lastLoc, as we may need to close+                    -- more layouts, or give a semicolon+                    return (L lastLoc ITvccurly)+             -- This next case is to handle a transitional issue:+             (ITvbar, ALRLayout _ col : ls, _)+              | newLine && thisCol == col && transitional ->+                 do addWarning Opt_WarnAlternativeLayoutRuleTransitional+                               (RealSrcSpan thisLoc)+                               (transitionalAlternativeLayoutWarning+                                    "`|' at the same depth as implicit layout block")+                    setALRContext ls+                    setNextToken t+                    -- Note that we use lastLoc, as we may need to close+                    -- more layouts, or give a semicolon+                    return (L lastLoc ITvccurly)+             (_, ALRLayout _ col : ls, _)+              | newLine && thisCol == col ->+                 do setNextToken t+                    let loc = realSrcSpanStart thisLoc+                        zeroWidthLoc = mkRealSrcSpan loc loc+                    return (L zeroWidthLoc ITsemi)+              | newLine && thisCol < col ->+                 do setALRContext ls+                    setNextToken t+                    -- Note that we use lastLoc, as we may need to close+                    -- more layouts, or give a semicolon+                    return (L lastLoc ITvccurly)+             -- We need to handle close before open, as 'then' is both+             -- an open and a close+             (u, _, _)+              | isALRclose u ->+                 case context of+                 ALRLayout _ _ : ls ->+                     do setALRContext ls+                        setNextToken t+                        return (L thisLoc ITvccurly)+                 ALRNoLayout _ isLet : ls ->+                     do let ls' = if isALRopen u+                                     then ALRNoLayout (containsCommas u) False : ls+                                     else ls+                        setALRContext ls'+                        when isLet $ setJustClosedExplicitLetBlock True+                        return t+                 [] ->+                     do let ls = if isALRopen u+                                    then [ALRNoLayout (containsCommas u) False]+                                    else []+                        setALRContext ls+                        -- XXX This is an error in John's code, but+                        -- it looks reachable to me at first glance+                        return t+             (u, _, _)+              | isALRopen u ->+                 do setALRContext (ALRNoLayout (containsCommas u) False : context)+                    return t+             (ITin, ALRLayout ALRLayoutLet _ : ls, _) ->+                 do setALRContext ls+                    setPendingImplicitTokens [t]+                    return (L thisLoc ITvccurly)+             (ITin, ALRLayout _ _ : ls, _) ->+                 do setALRContext ls+                    setNextToken t+                    return (L thisLoc ITvccurly)+             -- the other ITin case omitted; general case below covers it+             (ITcomma, ALRLayout _ _ : ls, _)+              | topNoLayoutContainsCommas ls ->+                 do setALRContext ls+                    setNextToken t+                    return (L thisLoc ITvccurly)+             (ITwhere, ALRLayout ALRLayoutDo _ : ls, _) ->+                 do setALRContext ls+                    setPendingImplicitTokens [t]+                    return (L thisLoc ITvccurly)+             -- the other ITwhere case omitted; general case below covers it+             (_, _, _) -> return t++transitionalAlternativeLayoutWarning :: String -> SDoc+transitionalAlternativeLayoutWarning msg+    = text "transitional layout will not be accepted in the future:"+   $$ text msg++isALRopen :: Token -> Bool+isALRopen ITcase          = True+isALRopen ITif            = True+isALRopen ITthen          = True+isALRopen IToparen        = True+isALRopen ITobrack        = True+isALRopen ITocurly        = True+-- GHC Extensions:+isALRopen IToubxparen     = True+isALRopen ITparenEscape   = True+isALRopen ITparenTyEscape = True+isALRopen _               = False++isALRclose :: Token -> Bool+isALRclose ITof     = True+isALRclose ITthen   = True+isALRclose ITelse   = True+isALRclose ITcparen = True+isALRclose ITcbrack = True+isALRclose ITccurly = True+-- GHC Extensions:+isALRclose ITcubxparen = True+isALRclose _        = False++isNonDecreasingIndentation :: ALRLayout -> Bool+isNonDecreasingIndentation ALRLayoutDo = True+isNonDecreasingIndentation _           = False++containsCommas :: Token -> Bool+containsCommas IToparen = True+containsCommas ITobrack = True+-- John doesn't have {} as containing commas, but records contain them,+-- which caused a problem parsing Cabal's Distribution.Simple.InstallDirs+-- (defaultInstallDirs).+containsCommas ITocurly = True+-- GHC Extensions:+containsCommas IToubxparen = True+containsCommas _        = False++topNoLayoutContainsCommas :: [ALRContext] -> Bool+topNoLayoutContainsCommas [] = False+topNoLayoutContainsCommas (ALRLayout _ _ : ls) = topNoLayoutContainsCommas ls+topNoLayoutContainsCommas (ALRNoLayout b _ : _) = b++lexToken :: P (RealLocated Token)+lexToken = do+  inp@(AI loc1 buf) <- getInput+  sc <- getLexState+  exts <- getExts+  case alexScanUser exts inp sc of+    AlexEOF -> do+        let span = mkRealSrcSpan loc1 loc1+        setLastToken span 0+        return (L span ITeof)+    AlexError (AI loc2 buf) ->+        reportLexError loc1 loc2 buf "lexical error"+    AlexSkip inp2 _ -> do+        setInput inp2+        lexToken+    AlexToken inp2@(AI end buf2) _ t -> do+        setInput inp2+        let span = mkRealSrcSpan loc1 end+        let bytes = byteDiff buf buf2+        span `seq` setLastToken span bytes+        lt <- t span buf bytes+        case unRealSrcSpan lt of+          ITlineComment _  -> return lt+          ITblockComment _ -> return lt+          lt' -> do+            setLastTk lt'+            return lt++reportLexError :: RealSrcLoc -> RealSrcLoc -> StringBuffer -> [Char] -> P a+reportLexError loc1 loc2 buf str+  | atEnd buf = failLocMsgP loc1 loc2 (str ++ " at end of input")+  | otherwise =+  let c = fst (nextChar buf)+  in if c == '\0' -- decoding errors are mapped to '\0', see utf8DecodeChar#+     then failLocMsgP loc2 loc2 (str ++ " (UTF-8 decoding error)")+     else failLocMsgP loc1 loc2 (str ++ " at character " ++ show c)++lexTokenStream :: StringBuffer -> RealSrcLoc -> DynFlags -> ParseResult [Located Token]+lexTokenStream buf loc dflags = unP go initState{ options = opts' }+    where dflags' = gopt_set (gopt_unset dflags Opt_Haddock) Opt_KeepRawTokenStream+          initState@PState{ options = opts } = mkPState dflags' buf loc+          opts' = opts{ pExtsBitmap = complement (xbit UsePosPragsBit) .&. pExtsBitmap opts }+          go = do+            ltok <- lexer False return+            case ltok of+              L _ ITeof -> return []+              _ -> liftM (ltok:) go++linePrags = Map.singleton "line" linePrag++fileHeaderPrags = Map.fromList([("options", lex_string_prag IToptions_prag),+                                 ("options_ghc", lex_string_prag IToptions_prag),+                                 ("options_haddock", lex_string_prag ITdocOptions),+                                 ("language", token ITlanguage_prag),+                                 ("include", lex_string_prag ITinclude_prag)])++ignoredPrags = Map.fromList (map ignored pragmas)+               where ignored opt = (opt, nested_comment lexToken)+                     impls = ["hugs", "nhc98", "jhc", "yhc", "catch", "derive"]+                     options_pragmas = map ("options_" ++) impls+                     -- CFILES is a hugs-only thing.+                     pragmas = options_pragmas ++ ["cfiles", "contract"]++oneWordPrags = Map.fromList [+     ("rules", rulePrag),+     ("inline",+         strtoken (\s -> (ITinline_prag (SourceText s) Inline FunLike))),+     ("inlinable",+         strtoken (\s -> (ITinline_prag (SourceText s) Inlinable FunLike))),+     ("inlineable",+         strtoken (\s -> (ITinline_prag (SourceText s) Inlinable FunLike))),+                                    -- Spelling variant+     ("notinline",+         strtoken (\s -> (ITinline_prag (SourceText s) NoInline FunLike))),+     ("specialize", strtoken (\s -> ITspec_prag (SourceText s))),+     ("source", strtoken (\s -> ITsource_prag (SourceText s))),+     ("warning", strtoken (\s -> ITwarning_prag (SourceText s))),+     ("deprecated", strtoken (\s -> ITdeprecated_prag (SourceText s))),+     ("scc", strtoken (\s -> ITscc_prag (SourceText s))),+     ("generated", strtoken (\s -> ITgenerated_prag (SourceText s))),+     ("core", strtoken (\s -> ITcore_prag (SourceText s))),+     ("unpack", strtoken (\s -> ITunpack_prag (SourceText s))),+     ("nounpack", strtoken (\s -> ITnounpack_prag (SourceText s))),+     ("ann", strtoken (\s -> ITann_prag (SourceText s))),+     ("minimal", strtoken (\s -> ITminimal_prag (SourceText s))),+     ("overlaps", strtoken (\s -> IToverlaps_prag (SourceText s))),+     ("overlappable", strtoken (\s -> IToverlappable_prag (SourceText s))),+     ("overlapping", strtoken (\s -> IToverlapping_prag (SourceText s))),+     ("incoherent", strtoken (\s -> ITincoherent_prag (SourceText s))),+     ("ctype", strtoken (\s -> ITctype (SourceText s))),+     ("complete", strtoken (\s -> ITcomplete_prag (SourceText s))),+     ("column", columnPrag)+     ]++twoWordPrags = Map.fromList [+     ("inline conlike",+         strtoken (\s -> (ITinline_prag (SourceText s) Inline ConLike))),+     ("notinline conlike",+         strtoken (\s -> (ITinline_prag (SourceText s) NoInline ConLike))),+     ("specialize inline",+         strtoken (\s -> (ITspec_inline_prag (SourceText s) True))),+     ("specialize notinline",+         strtoken (\s -> (ITspec_inline_prag (SourceText s) False)))+     ]++dispatch_pragmas :: Map String Action -> Action+dispatch_pragmas prags span buf len = case Map.lookup (clean_pragma (lexemeToString buf len)) prags of+                                       Just found -> found span buf len+                                       Nothing -> lexError "unknown pragma"++known_pragma :: Map String Action -> AlexAccPred ExtsBitmap+known_pragma prags _ (AI _ startbuf) _ (AI _ curbuf)+ = isKnown && nextCharIsNot curbuf pragmaNameChar+    where l = lexemeToString startbuf (byteDiff startbuf curbuf)+          isKnown = isJust $ Map.lookup (clean_pragma l) prags+          pragmaNameChar c = isAlphaNum c || c == '_'++clean_pragma :: String -> String+clean_pragma prag = canon_ws (map toLower (unprefix prag))+                    where unprefix prag' = case stripPrefix "{-#" prag' of+                                             Just rest -> rest+                                             Nothing -> prag'+                          canonical prag' = case prag' of+                                              "noinline" -> "notinline"+                                              "specialise" -> "specialize"+                                              "constructorlike" -> "conlike"+                                              _ -> prag'+                          canon_ws s = unwords (map canonical (words s))++++{-+%************************************************************************+%*                                                                      *+        Helper functions for generating annotations in the parser+%*                                                                      *+%************************************************************************+-}++-- | Encapsulated call to addAnnotation, requiring only the SrcSpan of+--   the AST construct the annotation belongs to; together with the+--   AnnKeywordId, this is the key of the annotation map.+--+--   This type is useful for places in the parser where it is not yet+--   known what SrcSpan an annotation should be added to.  The most+--   common situation is when we are parsing a list: the annotations+--   need to be associated with the AST element that *contains* the+--   list, not the list itself.  'AddAnn' lets us defer adding the+--   annotations until we finish parsing the list and are now parsing+--   the enclosing element; we then apply the 'AddAnn' to associate+--   the annotations.  Another common situation is where a common fragment of+--   the AST has been factored out but there is no separate AST node for+--   this fragment (this occurs in class and data declarations). In this+--   case, the annotation belongs to the parent data declaration.+--+--   The usual way an 'AddAnn' is created is using the 'mj' ("make jump")+--   function, and then it can be discharged using the 'ams' function.+type AddAnn = SrcSpan -> P ()++addAnnotation :: SrcSpan          -- SrcSpan of enclosing AST construct+              -> AnnKeywordId     -- The first two parameters are the key+              -> SrcSpan          -- The location of the keyword itself+              -> P ()+addAnnotation l a v = do+  addAnnotationOnly l a v+  allocateComments l++addAnnotationOnly :: SrcSpan -> AnnKeywordId -> SrcSpan -> P ()+addAnnotationOnly l a v = P $ \s -> POk s {+  annotations = ((l,a), [v]) : annotations s+  } ()++-- |Given a location and a list of AddAnn, apply them all to the location.+addAnnsAt :: SrcSpan -> [AddAnn] -> P ()+addAnnsAt loc anns = mapM_ (\a -> a loc) anns++-- |Given a 'SrcSpan' that surrounds a 'HsPar' or 'HsParTy', generate+-- 'AddAnn' values for the opening and closing bordering on the start+-- and end of the span+mkParensApiAnn :: SrcSpan -> [AddAnn]+mkParensApiAnn (UnhelpfulSpan _)  = []+mkParensApiAnn s@(RealSrcSpan ss) = [mj AnnOpenP lo,mj AnnCloseP lc]+  where+    mj a l = (\s -> addAnnotation s a l)+    f = srcSpanFile ss+    sl = srcSpanStartLine ss+    sc = srcSpanStartCol ss+    el = srcSpanEndLine ss+    ec = srcSpanEndCol ss+    lo = mkSrcSpan (srcSpanStart s)         (mkSrcLoc f sl (sc+1))+    lc = mkSrcSpan (mkSrcLoc f el (ec - 1)) (srcSpanEnd s)++queueComment :: Located Token -> P()+queueComment c = P $ \s -> POk s {+  comment_q = commentToAnnotation c : comment_q s+  } ()++-- | Go through the @comment_q@ in @PState@ and remove all comments+-- that belong within the given span+allocateComments :: SrcSpan -> P ()+allocateComments ss = P $ \s ->+  let+    (before,rest)  = break (\(L l _) -> isSubspanOf l ss) (comment_q s)+    (middle,after) = break (\(L l _) -> not (isSubspanOf l ss)) rest+    comment_q' = before ++ after+    newAnns = if null middle then []+                             else [(ss,middle)]+  in+    POk s {+       comment_q = comment_q'+     , annotations_comments = newAnns ++ (annotations_comments s)+     } ()++commentToAnnotation :: Located Token -> Located AnnotationComment+commentToAnnotation (L l (ITdocCommentNext s))  = L l (AnnDocCommentNext s)+commentToAnnotation (L l (ITdocCommentPrev s))  = L l (AnnDocCommentPrev s)+commentToAnnotation (L l (ITdocCommentNamed s)) = L l (AnnDocCommentNamed s)+commentToAnnotation (L l (ITdocSection n s))    = L l (AnnDocSection n s)+commentToAnnotation (L l (ITdocOptions s))      = L l (AnnDocOptions s)+commentToAnnotation (L l (ITlineComment s))     = L l (AnnLineComment s)+commentToAnnotation (L l (ITblockComment s))    = L l (AnnBlockComment s)+commentToAnnotation _                           = panic "commentToAnnotation"++-- ---------------------------------------------------------------------++isComment :: Token -> Bool+isComment (ITlineComment     _)   = True+isComment (ITblockComment    _)   = True+isComment _ = False++isDocComment :: Token -> Bool+isDocComment (ITdocCommentNext  _)   = True+isDocComment (ITdocCommentPrev  _)   = True+isDocComment (ITdocCommentNamed _)   = True+isDocComment (ITdocSection      _ _) = True+isDocComment (ITdocOptions      _)   = True+isDocComment _ = False+++bol,column_prag,layout,layout_do,layout_if,layout_left,line_prag1,line_prag1a,line_prag2,line_prag2a,option_prags :: Int+bol = 1+column_prag = 2+layout = 3+layout_do = 4+layout_if = 5+layout_left = 6+line_prag1 = 7+line_prag1a = 8+line_prag2 = 9+line_prag2a = 10+option_prags = 11+alex_action_1 =  warnTab +alex_action_2 =  nested_comment lexToken +alex_action_3 =  lineCommentToken +alex_action_4 =  lineCommentToken +alex_action_5 =  lineCommentToken +alex_action_6 =  lineCommentToken +alex_action_7 =  lineCommentToken +alex_action_8 =  lineCommentToken +alex_action_10 =  begin line_prag1 +alex_action_11 =  begin line_prag1 +alex_action_14 =  do_bol +alex_action_15 =  hopefully_open_brace +alex_action_17 =  begin line_prag1 +alex_action_18 =  new_layout_context True dontGenerateSemic ITvbar +alex_action_19 =  pop +alex_action_20 =  new_layout_context True  generateSemic ITvocurly +alex_action_21 =  new_layout_context False generateSemic ITvocurly +alex_action_22 =  do_layout_left +alex_action_23 =  begin bol +alex_action_24 =  dispatch_pragmas linePrags +alex_action_25 =  setLineAndFile line_prag1a +alex_action_26 =  failLinePrag1 +alex_action_27 =  popLinePrag1 +alex_action_28 =  setLineAndFile line_prag2a +alex_action_29 =  pop +alex_action_30 =  setColumn +alex_action_31 =  dispatch_pragmas twoWordPrags +alex_action_32 =  dispatch_pragmas oneWordPrags +alex_action_33 =  dispatch_pragmas ignoredPrags +alex_action_34 =  endPrag +alex_action_35 =  dispatch_pragmas fileHeaderPrags +alex_action_36 =  nested_comment lexToken +alex_action_37 =  warnThen Opt_WarnUnrecognisedPragmas (text "Unrecognised pragma")+                    (nested_comment lexToken) +alex_action_38 =  multiline_doc_comment +alex_action_39 =  nested_doc_comment +alex_action_40 =  token (ITopenExpQuote NoE NormalSyntax) +alex_action_41 =  token (ITopenTExpQuote NoE) +alex_action_42 =  token (ITopenExpQuote HasE NormalSyntax) +alex_action_43 =  token (ITopenTExpQuote HasE) +alex_action_44 =  token ITopenPatQuote +alex_action_45 =  layout_token ITopenDecQuote +alex_action_46 =  token ITopenTypQuote +alex_action_47 =  token (ITcloseQuote NormalSyntax) +alex_action_48 =  token ITcloseTExpQuote +alex_action_49 =  skip_one_varid ITidEscape +alex_action_50 =  skip_two_varid ITidTyEscape +alex_action_51 =  token ITparenEscape +alex_action_52 =  token ITparenTyEscape +alex_action_53 =  lex_quasiquote_tok +alex_action_54 =  lex_qquasiquote_tok +alex_action_55 =  token (ITopenExpQuote NoE UnicodeSyntax) +alex_action_56 =  token (ITcloseQuote UnicodeSyntax) +alex_action_57 =  token ITtypeApp +alex_action_58 =  special (IToparenbar NormalSyntax) +alex_action_59 =  special (ITcparenbar NormalSyntax) +alex_action_60 =  special (IToparenbar UnicodeSyntax) +alex_action_61 =  special (ITcparenbar UnicodeSyntax) +alex_action_62 =  skip_one_varid ITdupipvarid +alex_action_63 =  skip_one_varid ITlabelvarid +alex_action_64 =  token IToubxparen +alex_action_65 =  token ITcubxparen +alex_action_66 =  special IToparen +alex_action_67 =  special ITcparen +alex_action_68 =  special ITobrack +alex_action_69 =  special ITcbrack +alex_action_70 =  special ITcomma +alex_action_71 =  special ITsemi +alex_action_72 =  special ITbackquote +alex_action_73 =  open_brace +alex_action_74 =  close_brace +alex_action_75 =  idtoken qvarid +alex_action_76 =  idtoken qconid +alex_action_77 =  varid +alex_action_78 =  idtoken conid +alex_action_79 =  idtoken qvarid +alex_action_80 =  idtoken qconid +alex_action_81 =  varid +alex_action_82 =  idtoken conid +alex_action_83 =  idtoken qvarsym +alex_action_84 =  idtoken qconsym +alex_action_85 =  varsym +alex_action_86 =  consym +alex_action_87 =  tok_num positive 0 0 decimal +alex_action_88 =  tok_num positive 2 2 binary +alex_action_89 =  tok_num positive 2 2 octal +alex_action_90 =  tok_num positive 2 2 hexadecimal +alex_action_91 =  tok_num negative 1 1 decimal +alex_action_92 =  tok_num negative 3 3 binary +alex_action_93 =  tok_num negative 3 3 octal +alex_action_94 =  tok_num negative 3 3 hexadecimal +alex_action_95 =  tok_frac 0 tok_float +alex_action_96 =  tok_frac 0 tok_float +alex_action_97 =  tok_frac 0 tok_hex_float +alex_action_98 =  tok_frac 0 tok_hex_float +alex_action_99 =  tok_primint positive 0 1 decimal +alex_action_100 =  tok_primint positive 2 3 binary +alex_action_101 =  tok_primint positive 2 3 octal +alex_action_102 =  tok_primint positive 2 3 hexadecimal +alex_action_103 =  tok_primint negative 1 2 decimal +alex_action_104 =  tok_primint negative 3 4 binary +alex_action_105 =  tok_primint negative 3 4 octal +alex_action_106 =  tok_primint negative 3 4 hexadecimal +alex_action_107 =  tok_primword 0 2 decimal +alex_action_108 =  tok_primword 2 4 binary +alex_action_109 =  tok_primword 2 4 octal +alex_action_110 =  tok_primword 2 4 hexadecimal +alex_action_111 =  tok_frac 1 tok_primfloat +alex_action_112 =  tok_frac 2 tok_primdouble +alex_action_113 =  lex_char_tok +alex_action_114 =  lex_string_tok +{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++++++++++++++++++-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.+#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif++++++++++++++++++++data AlexAddr = AlexA# Addr#+-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.+#if __GLASGOW_HASKELL__ < 503+uncheckedShiftL# = shiftL#+#endif++{-# INLINE alexIndexInt16OffAddr #-}+alexIndexInt16OffAddr (AlexA# arr) off =+#ifdef WORDS_BIGENDIAN+  narrow16Int# i+  where+        i    = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+        high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+        low  = int2Word# (ord# (indexCharOffAddr# arr off'))+        off' = off *# 2#+#else+  indexInt16OffAddr# arr off+#endif++++++{-# INLINE alexIndexInt32OffAddr #-}+alexIndexInt32OffAddr (AlexA# arr) off =+#ifdef WORDS_BIGENDIAN+  narrow32Int# i+  where+   i    = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`+                     (b2 `uncheckedShiftL#` 16#) `or#`+                     (b1 `uncheckedShiftL#` 8#) `or#` b0)+   b3   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))+   b2   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))+   b1   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+   b0   = int2Word# (ord# (indexCharOffAddr# arr off'))+   off' = off *# 4#+#else+  indexInt32OffAddr# arr off+#endif+++++++#if __GLASGOW_HASKELL__ < 503+quickIndex arr i = arr ! i+#else+-- GHC >= 503, unsafeAt is available from Data.Array.Base.+quickIndex = unsafeAt+#endif+++++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+  = AlexEOF+  | AlexError  !AlexInput+  | AlexSkip   !AlexInput !Int+  | AlexToken  !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> AlexReturn a+alexScan input__ (I# (sc))+  = alexScanUser undefined input__ (I# (sc))++alexScanUser user__ input__ (I# (sc))+  = case alex_scan_tkn user__ input__ 0# input__ sc AlexNone of+  (AlexNone, input__') ->+    case alexGetByte input__ of+      Nothing ->++++                                   AlexEOF+      Just _ ->++++                                   AlexError input__'++  (AlexLastSkip input__'' len, _) ->++++    AlexSkip input__'' len++  (AlexLastAcc k input__''' len, _) ->++++    AlexToken input__''' len (alex_actions ! k)+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user__ orig_input len input__ s last_acc =+  input__ `seq` -- strict in the input+  let+  new_acc = (check_accs (alex_accept `quickIndex` (I# (s))))+  in+  new_acc `seq`+  case alexGetByte input__ of+     Nothing -> (new_acc, input__)+     Just (c, new_input) ->++++      case fromIntegral c of { (I# (ord_c)) ->+        let+                base   = alexIndexInt32OffAddr alex_base s+                offset = (base +# ord_c)+                check  = alexIndexInt16OffAddr alex_check offset++                new_s = if GTE(offset,0#) && EQ(check,ord_c)+                          then alexIndexInt16OffAddr alex_table offset+                          else alexIndexInt16OffAddr alex_deflt s+        in+        case new_s of+            -1# -> (new_acc, input__)+                -- on an error, we want to keep the input *before* the+                -- character that failed, not after.+            _ -> alex_scan_tkn user__ orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len)+                                                -- note that the length is increased ONLY if this is the 1st byte in a char encoding)+                        new_input new_s new_acc+      }+  where+        check_accs (AlexAccNone) = last_acc+        check_accs (AlexAcc a  ) = AlexLastAcc a input__ (I# (len))+        check_accs (AlexAccSkip) = AlexLastSkip  input__ (I# (len))++        check_accs (AlexAccPred a predx rest)+           | predx user__ orig_input (I# (len)) input__+           = AlexLastAcc a input__ (I# (len))+           | otherwise+           = check_accs rest+        check_accs (AlexAccSkipPred predx rest)+           | predx user__ orig_input (I# (len)) input__+           = AlexLastSkip input__ (I# (len))+           | otherwise+           = check_accs rest+++data AlexLastAcc+  = AlexNone+  | AlexLastAcc !Int !AlexInput !Int+  | AlexLastSkip     !AlexInput !Int++data AlexAcc user+  = AlexAccNone+  | AlexAcc Int+  | AlexAccSkip++  | AlexAccPred Int (AlexAccPred user) (AlexAcc user)+  | AlexAccSkipPred (AlexAccPred user) (AlexAcc user)++type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool++-- -----------------------------------------------------------------------------+-- Predicates on a rule++alexAndPred p1 p2 user__ in1 len in2+  = p1 user__ in1 len in2 && p2 user__ in1 len in2++--alexPrevCharIsPred :: Char -> AlexAccPred _+alexPrevCharIs c _ input__ _ _ = c == alexInputPrevChar input__++alexPrevCharMatches f _ input__ _ _ = f (alexInputPrevChar input__)++--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _+alexPrevCharIsOneOf arr _ input__ _ _ = arr ! alexInputPrevChar input__++--alexRightContext :: Int -> AlexAccPred _+alexRightContext (I# (sc)) user__ _ _ input__ =+     case alex_scan_tkn user__ input__ 0# input__ sc AlexNone of+          (AlexNone, _) -> False+          _ -> True+        -- TODO: there's no need to find the longest+        -- match when checking the right context, just+        -- the first match will do.+
+ ghc-lib/stage0/compiler/build/Parser.hs view
@@ -0,0 +1,10061 @@+{-# OPTIONS_GHC -w #-}+{-# OPTIONS -XMagicHash -XBangPatterns -XTypeSynonymInstances -XFlexibleInstances -cpp #-}+#if __GLASGOW_HASKELL__ >= 710+{-# OPTIONS_GHC -XPartialTypeSignatures #-}+#endif+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | This module provides the generated Happy parser for Haskell. It exports+-- a number of parsers which may be used in any library that uses the GHC API.+-- A common usage pattern is to initialize the parser state with a given string+-- and then parse that string:+--+-- @+--     runParser :: DynFlags -> String -> P a -> ParseResult a+--     runParser flags str parser = unP parser parseState+--     where+--       filename = "\<interactive\>"+--       location = mkRealSrcLoc (mkFastString filename) 1 1+--       buffer = stringToStringBuffer str+--       parseState = mkPState flags buffer location+-- @+module Parser (parseModule, parseSignature, parseImport, parseStatement, parseBackpack,+               parseDeclaration, parseExpression, parsePattern,+               parseTypeSignature,+               parseStmt, parseIdentifier,+               parseType, parseHeader) where++-- base+import Control.Monad    ( unless, liftM, when, (<=<) )+import GHC.Exts+import Data.Char+import Control.Monad    ( mplus )+import Control.Applicative ((<$))++-- compiler/hsSyn+import HsSyn++-- compiler/main+import HscTypes         ( IsBootInterface, WarningTxt(..) )+import DynFlags+import BkpSyn+import PackageConfig++-- compiler/utils+import OrdList+import BooleanFormula   ( BooleanFormula(..), LBooleanFormula(..), mkTrue )+import FastString+import Maybes           ( isJust, orElse )+import Outputable++-- compiler/basicTypes+import RdrName+import OccName          ( varName, dataName, tcClsName, tvName, startsWithUnderscore )+import DataCon          ( DataCon, dataConName )+import SrcLoc+import Module+import BasicTypes++-- compiler/types+import Type             ( funTyCon )+import Kind             ( Kind )+import Class            ( FunDep )++-- compiler/parser+import RdrHsSyn+import Lexer+import HaddockUtils+import ApiAnnotation++-- compiler/typecheck+import TcEvidence       ( emptyTcEvBinds )++-- compiler/prelude+import ForeignCall+import TysPrim          ( eqPrimTyCon )+import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon,+                          unboxedUnitTyCon, unboxedUnitDataCon,+                          listTyCon_RDR, consDataCon_RDR, eqTyCon_RDR )++-- compiler/utils+import Util             ( looksLikePackageName, fstOf3, sndOf3, thdOf3 )+import GhcPrelude+import qualified Data.Array as Happy_Data_Array+import qualified Data.Bits as Bits+import qualified GHC.Exts as Happy_GHC_Exts+import Control.Applicative(Applicative(..))+import Control.Monad (ap)++-- parser produced by Happy Version 1.19.9++data HappyAbsSyn +	= HappyTerminal ((Located Token))+	| HappyErrorToken Int+	| HappyAbsSyn16 (Located RdrName)+	| HappyAbsSyn17 ([LHsUnit PackageName])+	| HappyAbsSyn18 (OrdList (LHsUnit PackageName))+	| HappyAbsSyn19 (LHsUnit PackageName)+	| HappyAbsSyn20 (LHsUnitId PackageName)+	| HappyAbsSyn21 (OrdList (LHsModuleSubst PackageName))+	| HappyAbsSyn22 (LHsModuleSubst PackageName)+	| HappyAbsSyn23 (LHsModuleId PackageName)+	| HappyAbsSyn24 (Located PackageName)+	| HappyAbsSyn25 (Located FastString)+	| HappyAbsSyn27 (Maybe [LRenaming])+	| HappyAbsSyn28 (OrdList LRenaming)+	| HappyAbsSyn29 (LRenaming)+	| HappyAbsSyn30 (OrdList (LHsUnitDecl PackageName))+	| HappyAbsSyn32 (LHsUnitDecl PackageName)+	| HappyAbsSyn33 (Located (HsModule GhcPs))+	| HappyAbsSyn35 (Maybe LHsDocString)+	| HappyAbsSyn36 (())+	| HappyAbsSyn38 (Maybe (Located WarningTxt))+	| HappyAbsSyn39 (([AddAnn]+             ,([LImportDecl GhcPs], [LHsDecl GhcPs])))+	| HappyAbsSyn42 (([LImportDecl GhcPs], [LHsDecl GhcPs]))+	| HappyAbsSyn44 ([LImportDecl GhcPs])+	| HappyAbsSyn48 ((Maybe (Located [LIE GhcPs])))+	| HappyAbsSyn49 (OrdList (LIE GhcPs))+	| HappyAbsSyn54 (Located ([AddAnn],ImpExpSubSpec))+	| HappyAbsSyn55 (([AddAnn], [Located ImpExpQcSpec]))+	| HappyAbsSyn57 (Located ([AddAnn], Located ImpExpQcSpec))+	| HappyAbsSyn58 (Located ImpExpQcSpec)+	| HappyAbsSyn60 ([AddAnn])+	| HappyAbsSyn64 (LImportDecl GhcPs)+	| HappyAbsSyn65 ((([AddAnn],SourceText),IsBootInterface))+	| HappyAbsSyn66 (([AddAnn],Bool))+	| HappyAbsSyn67 (([AddAnn],Maybe StringLiteral))+	| HappyAbsSyn69 (([AddAnn],Located (Maybe (Located ModuleName))))+	| HappyAbsSyn70 (Located (Maybe (Bool, Located [LIE GhcPs])))+	| HappyAbsSyn71 (Located (Bool, Located [LIE GhcPs]))+	| HappyAbsSyn72 (Located (SourceText,Int))+	| HappyAbsSyn73 (Located FixityDirection)+	| HappyAbsSyn74 (Located (OrdList (Located RdrName)))+	| HappyAbsSyn75 (OrdList (LHsDecl GhcPs))+	| HappyAbsSyn77 (LHsDecl GhcPs)+	| HappyAbsSyn78 (LTyClDecl GhcPs)+	| HappyAbsSyn80 (LInstDecl GhcPs)+	| HappyAbsSyn81 (Maybe (Located OverlapMode))+	| HappyAbsSyn82 (LDerivStrategy GhcPs)+	| HappyAbsSyn84 (Maybe (LDerivStrategy GhcPs))+	| HappyAbsSyn85 (Located ([AddAnn], Maybe (LInjectivityAnn GhcPs)))+	| HappyAbsSyn86 (LInjectivityAnn GhcPs)+	| HappyAbsSyn87 (Located [Located RdrName])+	| HappyAbsSyn88 (Located ([AddAnn],FamilyInfo GhcPs))+	| HappyAbsSyn89 (Located ([AddAnn],Maybe [LTyFamInstEqn GhcPs]))+	| HappyAbsSyn90 (Located [LTyFamInstEqn GhcPs])+	| HappyAbsSyn91 (Located ([AddAnn],TyFamInstEqn GhcPs))+	| HappyAbsSyn96 (Located (AddAnn, NewOrData))+	| HappyAbsSyn97 (Located ([AddAnn], Maybe (LHsKind GhcPs)))+	| HappyAbsSyn98 (Located ([AddAnn], LFamilyResultSig GhcPs))+	| HappyAbsSyn100 (Located ([AddAnn], ( LFamilyResultSig GhcPs+                                            , Maybe (LInjectivityAnn GhcPs))))+	| HappyAbsSyn101 (Located (Maybe (LHsContext GhcPs), LHsType GhcPs))+	| HappyAbsSyn102 (Located ([AddAnn],(Maybe (LHsContext GhcPs), Maybe [LHsTyVarBndr GhcPs], LHsType GhcPs)))+	| HappyAbsSyn103 (Maybe (Located CType))+	| HappyAbsSyn104 (LDerivDecl GhcPs)+	| HappyAbsSyn105 (LRoleAnnotDecl GhcPs)+	| HappyAbsSyn106 (Located [Located (Maybe FastString)])+	| HappyAbsSyn108 (Located (Maybe FastString))+	| HappyAbsSyn110 ((Located RdrName, HsPatSynDetails (Located RdrName), [AddAnn]))+	| HappyAbsSyn111 ([Located RdrName])+	| HappyAbsSyn112 ([RecordPatSynField (Located RdrName)])+	| HappyAbsSyn113 (Located ([AddAnn]+                         , Located (OrdList (LHsDecl GhcPs))))+	| HappyAbsSyn114 (LSig GhcPs)+	| HappyAbsSyn116 (Located ([AddAnn],OrdList (LHsDecl GhcPs)))+	| HappyAbsSyn117 (Located ([AddAnn]+                     , OrdList (LHsDecl GhcPs)))+	| HappyAbsSyn118 (Located ([AddAnn]+                       ,(OrdList (LHsDecl GhcPs))))+	| HappyAbsSyn119 (Located (OrdList (LHsDecl GhcPs)))+	| HappyAbsSyn122 (Located ([AddAnn]+                        , OrdList (LHsDecl GhcPs)))+	| HappyAbsSyn124 (Located ([AddAnn],Located (OrdList (LHsDecl GhcPs))))+	| HappyAbsSyn125 (Located ([AddAnn],Located (HsLocalBinds GhcPs)))+	| HappyAbsSyn127 (OrdList (LRuleDecl GhcPs))+	| HappyAbsSyn128 (LRuleDecl GhcPs)+	| HappyAbsSyn129 (([AddAnn],Maybe Activation))+	| HappyAbsSyn130 (([AddAnn]+                              ,Activation))+	| HappyAbsSyn131 (([AddAnn], Maybe [LHsTyVarBndr GhcPs], [LRuleBndr GhcPs]))+	| HappyAbsSyn132 ([LRuleTyTmVar])+	| HappyAbsSyn133 (LRuleTyTmVar)+	| HappyAbsSyn134 (OrdList (LWarnDecl GhcPs))+	| HappyAbsSyn138 (Located ([AddAnn],[Located StringLiteral]))+	| HappyAbsSyn139 (Located (OrdList (Located StringLiteral)))+	| HappyAbsSyn141 (Located ([AddAnn],HsDecl GhcPs))+	| HappyAbsSyn142 (Located CCallConv)+	| HappyAbsSyn143 (Located Safety)+	| HappyAbsSyn144 (Located ([AddAnn]+                    ,(Located StringLiteral, Located RdrName, LHsSigType GhcPs)))+	| HappyAbsSyn145 (([AddAnn], Maybe (LHsType GhcPs)))+	| HappyAbsSyn146 (([AddAnn], Maybe (Located RdrName)))+	| HappyAbsSyn147 (LHsType GhcPs)+	| HappyAbsSyn150 ((OrdList (LHsSigType GhcPs)))+	| HappyAbsSyn151 (Located ([AddAnn], SourceText, SrcUnpackedness))+	| HappyAbsSyn152 ((AddAnn, ForallVisFlag))+	| HappyAbsSyn157 (LHsContext GhcPs)+	| HappyAbsSyn162 (Located [Located TyEl])+	| HappyAbsSyn163 (Located TyEl)+	| HappyAbsSyn165 ([Located TyEl])+	| HappyAbsSyn168 (LHsSigType GhcPs)+	| HappyAbsSyn169 ([LHsSigType GhcPs])+	| HappyAbsSyn170 ([LHsType GhcPs])+	| HappyAbsSyn173 ([LHsTyVarBndr GhcPs])+	| HappyAbsSyn174 (LHsTyVarBndr GhcPs)+	| HappyAbsSyn175 (Located ([AddAnn],[Located (FunDep (Located RdrName))]))+	| HappyAbsSyn176 (Located [Located (FunDep (Located RdrName))])+	| HappyAbsSyn177 (Located (FunDep (Located RdrName)))+	| HappyAbsSyn179 (LHsKind GhcPs)+	| HappyAbsSyn180 (Located ([AddAnn]+                          ,[LConDecl GhcPs]))+	| HappyAbsSyn181 (Located [LConDecl GhcPs])+	| HappyAbsSyn182 (LConDecl GhcPs)+	| HappyAbsSyn184 (Located ([AddAnn],[LConDecl GhcPs]))+	| HappyAbsSyn187 (Located ([AddAnn], Maybe [LHsTyVarBndr GhcPs]))+	| HappyAbsSyn188 (Located (Located RdrName, HsConDeclDetails GhcPs, Maybe LHsDocString))+	| HappyAbsSyn189 ([LConDeclField GhcPs])+	| HappyAbsSyn191 (LConDeclField GhcPs)+	| HappyAbsSyn192 (HsDeriving GhcPs)+	| HappyAbsSyn194 (LHsDerivingClause GhcPs)+	| HappyAbsSyn195 (Located [LHsSigType GhcPs])+	| HappyAbsSyn197 (LDocDecl)+	| HappyAbsSyn200 (Located ([AddAnn],GRHSs GhcPs (LHsExpr GhcPs)))+	| HappyAbsSyn201 (Located [LGRHS GhcPs (LHsExpr GhcPs)])+	| HappyAbsSyn202 (LGRHS GhcPs (LHsExpr GhcPs))+	| HappyAbsSyn205 (([AddAnn],Activation))+	| HappyAbsSyn206 (Located (HsSplice GhcPs))+	| HappyAbsSyn207 (ExpCmdP)+	| HappyAbsSyn209 (LHsExpr GhcPs)+	| HappyAbsSyn212 (([Located Token],Bool))+	| HappyAbsSyn213 (Located (([AddAnn],SourceText),StringLiteral))+	| HappyAbsSyn214 (Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,Int))),+                         ((SourceText,SourceText),(SourceText,SourceText))+                       ))+	| HappyAbsSyn222 ([LHsCmdTop GhcPs])+	| HappyAbsSyn223 (LHsCmdTop GhcPs)+	| HappyAbsSyn224 (([AddAnn],[LHsDecl GhcPs]))+	| HappyAbsSyn225 ([LHsDecl GhcPs])+	| HappyAbsSyn227 (([AddAnn],SumOrTuple))+	| HappyAbsSyn228 ((SrcSpan,[LHsTupArg GhcPs]))+	| HappyAbsSyn229 ([LHsTupArg GhcPs])+	| HappyAbsSyn230 (([AddAnn],HsExpr GhcPs))+	| HappyAbsSyn231 (Located [LHsExpr GhcPs])+	| HappyAbsSyn232 (Located [LStmt GhcPs (LHsExpr GhcPs)])+	| HappyAbsSyn233 (Located [[LStmt GhcPs (LHsExpr GhcPs)]])+	| HappyAbsSyn235 (Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs)))+	| HappyAbsSyn238 (forall b. ExpCmdI b => PV (Located ([AddAnn],[LMatch GhcPs (Located (b GhcPs))])))+	| HappyAbsSyn241 (forall b. ExpCmdI b => PV (LMatch GhcPs (Located (b GhcPs))))+	| HappyAbsSyn242 (forall b. ExpCmdI b => PV (Located ([AddAnn],GRHSs GhcPs (Located (b GhcPs)))))+	| HappyAbsSyn243 (forall b. ExpCmdI b => PV (Located [LGRHS GhcPs (Located (b GhcPs))]))+	| HappyAbsSyn245 (Located ([AddAnn],[LGRHS GhcPs (LHsExpr GhcPs)]))+	| HappyAbsSyn246 (forall b. ExpCmdI b => PV (LGRHS GhcPs (Located (b GhcPs))))+	| HappyAbsSyn247 (LPat GhcPs)+	| HappyAbsSyn250 ([LPat GhcPs])+	| HappyAbsSyn251 (forall b. ExpCmdI b => PV (Located ([AddAnn],[LStmt GhcPs (Located (b GhcPs))])))+	| HappyAbsSyn253 (Maybe (LStmt GhcPs (LHsExpr GhcPs)))+	| HappyAbsSyn254 (LStmt GhcPs (LHsExpr GhcPs))+	| HappyAbsSyn255 (forall b. ExpCmdI b => PV (LStmt GhcPs (Located (b GhcPs))))+	| HappyAbsSyn257 (([AddAnn],([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)))+	| HappyAbsSyn259 (LHsRecField GhcPs (LHsExpr GhcPs))+	| HappyAbsSyn260 (Located [LIPBind GhcPs])+	| HappyAbsSyn261 (LIPBind GhcPs)+	| HappyAbsSyn262 (Located HsIPName)+	| HappyAbsSyn264 (LBooleanFormula (Located RdrName))+	| HappyAbsSyn267 ([LBooleanFormula (Located RdrName)])+	| HappyAbsSyn276 (Located DataCon)+	| HappyAbsSyn315 (Located (HsLit GhcPs))+	| HappyAbsSyn317 (Located ModuleName)+	| HappyAbsSyn318 (([SrcSpan],Int))+	| HappyAbsSyn321 (LHsDocString)+	| HappyAbsSyn323 (Located (String, HsDocString))+	| HappyAbsSyn324 (Located (Int, HsDocString))++happyExpList :: HappyAddr+happyExpList = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc7\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x7f\xf3\x55\xff\xff\xe5\xff\x7e\x06\x41\xd0\x00\x88\x0a\x67\xfe\xff\x5f\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x73\x11\xfd\xff\xe5\xff\x1c\x04\x41\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc7\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x08\xc0\x21\x88\x82\xfe\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x21\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x81\x88\x02\x47\x30\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x98\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd4\xe1\x88\xc3\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\xc6\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x08\xc0\x21\x88\x82\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\xd4\x21\x00\x41\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x51\x80\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\x85\x1f\x00\x00\x40\x10\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\x85\x1f\x00\x00\x40\x10\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\x85\x1f\x00\x00\xc0\x90\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\x85\x1f\x00\x00\x40\x10\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x00\x00\x40\x10\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\x85\x1f\x00\x00\x40\x10\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x48\xd0\x21\x98\x8a\xff\xff\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x48\xd1\x21\x88\xcb\xff\xff\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x48\xd1\x21\x88\xce\xff\xff\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x88\x02\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\xc0\x21\x00\x80\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x02\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x88\x02\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x02\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x48\xd1\x21\x88\xcb\xff\xff\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\x85\x1f\x00\x00\x40\x10\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\xc0\x21\x00\x80\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x80\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x81\x10\xfc\xfe\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x88\x02\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x88\x02\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x88\x02\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x52\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x88\x02\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\x85\x1f\x00\x00\x40\x10\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\x85\x1f\x00\x00\x40\x10\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\x85\x1f\x00\x00\x40\x10\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\xc0\x21\x00\x41\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x80\x00\x40\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x80\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x41\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x14\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\xc0\x3f\x00\x80\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x48\xd0\x21\x88\xca\xff\xff\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x48\xd1\x21\x88\x8a\xff\xff\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x00\x00\x40\x10\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x08\xc0\x21\x88\x43\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x73\x11\xfd\xff\xe5\xff\x1c\x04\x41\xd0\x00\x88\x0a\x67\xfe\xff\x5f\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x73\x11\xfd\xff\xe5\xff\x1c\x04\x41\xd0\x00\x88\x0a\x67\xfe\xff\x5f\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\xd4\x21\x00\x80\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\xd4\x20\x00\x41\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\xc0\x21\x00\x80\x98\x01\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\xc0\x21\x00\x41\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x48\xd0\x21\x88\xca\xff\xff\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x01\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\x85\x1f\x00\x00\x40\x90\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\x85\x1f\x00\x00\x40\x10\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc7\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc7\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\x85\x1f\x00\x00\x40\x10\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x04\x00\x00\x80\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x81\x88\x02\x47\x30\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\xc3\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x88\x02\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\x1c\xf8\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x06\x10\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x21\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\xd0\x00\x89\x2a\x67\xfe\x1f\x5e\x7f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\xd0\x00\x8c\x2a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\x85\x1f\x00\x00\x40\x90\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x48\xd0\x21\x88\x8a\xff\xff\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x31\xfd\xff\xc5\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x48\xd0\x21\x88\x8a\xff\xff\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x48\xd0\x21\x88\xca\xff\xff\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x88\x1a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x7f\xf3\x55\xff\xff\xe5\xff\x7e\x06\x41\xd0\x00\x88\x0a\x67\xfe\xff\x5f\x7f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x40\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\xc0\x21\x00\x80\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x88\x02\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x88\x02\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x02\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x02\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\xc0\x21\x00\x80\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x48\xd0\x21\x88\x8a\xff\xff\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\xd0\x20\x00\x00\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x88\x02\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x88\x02\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x88\x02\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\x85\x1f\x00\x00\x40\x10\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x7f\xf3\x55\xff\xff\xe5\xff\x7e\x06\x41\xd0\x00\x88\x0a\x67\xfe\xff\x5f\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x04\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x73\x11\xfd\xff\xe5\xff\x1c\x04\x41\xd0\x00\x88\x0a\x67\xfe\xff\x5f\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\xd4\x21\x00\x80\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\xd0\x00\x88\x2a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc7\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x48\xd0\x21\x88\x8a\xff\xff\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x04\x00\x00\x80\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\x1c\xf8\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x31\xfd\xff\xc5\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x31\xfd\xff\xc5\x1f\x1c\x00\x40\xd0\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x80\x01\x00\x00\x00\x00\x00\x80\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x5b\x73\x51\xfd\xff\xe5\xff\x1c\x04\x41\xd0\x00\x88\x0a\x67\xfe\xff\x5f\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x5b\x73\x51\xfd\xff\xe5\xff\x1c\x04\x41\xd0\x00\x88\x0a\x67\xfe\xff\x5f\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x4b\x73\x55\xfd\xff\xe5\xff\x1c\x04\x41\xd0\x00\x88\x0a\x67\xfe\xff\x5f\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x4b\x73\x55\xfd\xff\xe5\xff\x1c\x04\x41\xd0\x00\x88\x0a\x67\xfe\xff\x5f\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\xc0\x21\x00\x80\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x73\x11\xfd\xff\xe5\xff\x1c\x04\x41\xd0\x00\x88\x0a\x67\xfe\xff\x5f\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x73\x11\xfd\xff\xe5\xff\x1c\x04\x41\xd0\x00\x88\x0a\x67\xfe\xff\x5f\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x81\x10\xfd\xfa\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x02\x04\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x02\x04\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x83\xdf\x31\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\x1c\xf8\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x06\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x52\xfd\xfe\xa4\x1f\x00\x00\x00\x00\x00\x80\x40\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x02\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\xd0\x21\x00\x00\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\x1c\xf8\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x06\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x40\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x5b\x73\x51\xfd\xff\xe5\xff\x1c\x04\x41\xd0\x00\x88\x0a\x67\xfe\xff\x5f\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\xc0\x21\x00\x80\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x4b\x73\x55\xfd\xff\xe5\xff\x1c\x04\x41\xd0\x00\x88\x0a\x67\xfe\xff\x5f\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x0c\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x0c\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfd\xfe\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x02\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x33\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x02\x04\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x20\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x40\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x43\x03\x11\xfd\xff\xc5\x1f\x1c\x00\x40\x50\x00\x88\x0a\x67\xfe\x1f\x5e\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x41\x10\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x50\xfd\xfe\x84\x1f\x00\x00\x04\x00\x00\x80\x00\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x40\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd4\xe1\x88\xc3\xdf\x33\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfd\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\xfc\xf8\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x01\x10\xfc\xf8\x84\x1f\x80\x01\x08\xd0\xe1\x88\x82\xdf\x31\x40\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x10\x1c\xf8\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x0e\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x50\xfd\xfe\x84\x1f\x00\x00\x04\x00\x00\x80\x00\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x01\x52\xfd\xfe\xa4\x1f\x00\x00\x00\x00\x00\x80\x00\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++{-# NOINLINE happyExpListPerState #-}+happyExpListPerState st =+    token_strs_expected+  where token_strs = ["error","%dummy","%start_parseModule","%start_parseSignature","%start_parseImport","%start_parseStatement","%start_parseDeclaration","%start_parseExpression","%start_parsePattern","%start_parseTypeSignature","%start_parseStmt","%start_parseIdentifier","%start_parseType","%start_parseBackpack","%start_parseHeader","identifier","backpack","units","unit","unitid","msubsts","msubst","moduleid","pkgname","litpkgname_segment","litpkgname","mayberns","rns","rn","unitbody","unitdecls","unitdecl","signature","module","maybedocheader","missing_module_keyword","implicit_top","maybemodwarning","body","body2","top","top1","header","header_body","header_body2","header_top","header_top_importdecls","maybeexports","exportlist","exportlist1","expdoclist","exp_doc","export","export_subspec","qcnames","qcnames1","qcname_ext_w_wildcard","qcname_ext","qcname","semis1","semis","importdecls","importdecls_semi","importdecl","maybe_src","maybe_safe","maybe_pkg","optqualified","maybeas","maybeimpspec","impspec","prec","infix","ops","topdecls","topdecls_semi","topdecl","cl_decl","ty_decl","inst_decl","overlap_pragma","deriv_strategy_no_via","deriv_strategy_via","deriv_standalone_strategy","opt_injective_info","injectivity_cond","inj_varids","where_type_family","ty_fam_inst_eqn_list","ty_fam_inst_eqns","ty_fam_inst_eqn","at_decl_cls","opt_family","opt_instance","at_decl_inst","data_or_newtype","opt_kind_sig","opt_datafam_kind_sig","opt_tyfam_kind_sig","opt_at_kind_inj_sig","tycl_hdr","tycl_hdr_inst","capi_ctype","stand_alone_deriving","role_annot","maybe_roles","roles","role","pattern_synonym_decl","pattern_synonym_lhs","vars0","cvars1","where_decls","pattern_synonym_sig","decl_cls","decls_cls","decllist_cls","where_cls","decl_inst","decls_inst","decllist_inst","where_inst","decls","decllist","binds","wherebinds","rules","rule","rule_activation","rule_explicit_activation","rule_foralls","rule_vars","rule_var","warnings","warning","deprecations","deprecation","strings","stringlist","annotation","fdecl","callconv","safety","fspec","opt_sig","opt_tyconsig","sigtype","sigtypedoc","sig_vars","sigtypes1","unpackedness","forall_vis_flag","ktype","ktypedoc","ctype","ctypedoc","context","constr_context","type","typedoc","constr_btype","constr_tyapps","constr_tyapp","btype","tyapps","tyapp","atype","inst_type","deriv_types","comma_types0","comma_types1","bar_types2","tv_bndrs","tv_bndr","fds","fds1","fd","varids0","kind","gadt_constrlist","gadt_constrs","gadt_constr_with_doc","gadt_constr","constrs","constrs1","constr","forall","constr_stuff","fielddecls","fielddecls1","fielddecl","maybe_derivings","derivings","deriving","deriv_clause_types","docdecl","docdecld","decl_no_th","decl","rhs","gdrhs","gdrh","sigdecl","activation","explicit_activation","quasiquote","exp","infixexp","infixexp_top","exp10_top","exp10","optSemi","scc_annot","hpc_annot","fexp","aexp","aexp1","aexp2","splice_exp","splice_untyped","splice_typed","cmdargs","acmd","cvtopbody","cvtopdecls0","texp","tup_exprs","commas_tup_tail","tup_tail","list","lexps","flattenedpquals","pquals","squals","transformqual","guardquals","guardquals1","altslist","alts","alts1","alt","alt_rhs","ralt","gdpats","ifgdpats","gdpat","pat","bindpat","apat","apats","stmtlist","stmts","maybe_stmt","e_stmt","stmt","qual","fbinds","fbinds1","fbind","dbinds","dbind","ipvar","overloaded_label","name_boolformula_opt","name_boolformula","name_boolformula_and","name_boolformula_and_list","name_boolformula_atom","namelist","name_var","qcon_nowiredlist","qcon","gen_qcon","con","con_list","sysdcon_nolist","sysdcon","conop","qconop","gtycon","ntgtycon","oqtycon","oqtycon_no_varcon","qtyconop","qtycon","qtycondoc","tycon","qtyconsym","tyconsym","op","varop","qop","qopm","hole_op","qvarop","qvaropm","tyvar","tyvarop","tyvarid","var","qvar","qvarid","varid","qvarsym","qvarsym_no_minus","qvarsym1","varsym","varsym_no_minus","special_id","special_sym","qconid","conid","qconsym","consym","literal","close","modid","commas","bars0","bars","docnext","docprev","docnamed","docsection","moduleheader","maybe_docprev","maybe_docnext","'_'","'as'","'case'","'class'","'data'","'default'","'deriving'","'do'","'else'","'hiding'","'if'","'import'","'in'","'infix'","'infixl'","'infixr'","'instance'","'let'","'module'","'newtype'","'of'","'qualified'","'then'","'type'","'where'","'forall'","'foreign'","'export'","'label'","'dynamic'","'safe'","'interruptible'","'unsafe'","'mdo'","'family'","'role'","'stdcall'","'ccall'","'capi'","'prim'","'javascript'","'proc'","'rec'","'group'","'by'","'using'","'pattern'","'static'","'stock'","'anyclass'","'via'","'unit'","'signature'","'dependency'","'{-# INLINE'","'{-# SPECIALISE'","'{-# SPECIALISE_INLINE'","'{-# SOURCE'","'{-# RULES'","'{-# CORE'","'{-# SCC'","'{-# GENERATED'","'{-# DEPRECATED'","'{-# WARNING'","'{-# UNPACK'","'{-# NOUNPACK'","'{-# ANN'","'{-# MINIMAL'","'{-# CTYPE'","'{-# OVERLAPPING'","'{-# OVERLAPPABLE'","'{-# OVERLAPS'","'{-# INCOHERENT'","'{-# COMPLETE'","'#-}'","'..'","':'","'::'","'='","'\\\\'","'lcase'","'|'","'<-'","'->'","'@'","'~'","'=>'","'-'","'!'","'*'","'-<'","'>-'","'-<<'","'>>-'","'.'","TYPEAPP","'{'","'}'","vocurly","vccurly","'['","']'","'[:'","':]'","'('","')'","'(#'","'#)'","'(|'","'|)'","';'","','","'`'","SIMPLEQUOTE","VARID","CONID","VARSYM","CONSYM","QVARID","QCONID","QVARSYM","QCONSYM","IPDUPVARID","LABELVARID","CHAR","STRING","INTEGER","RATIONAL","PRIMCHAR","PRIMSTRING","PRIMINTEGER","PRIMWORD","PRIMFLOAT","PRIMDOUBLE","DOCNEXT","DOCPREV","DOCNAMED","DOCSECTION","'[|'","'[p|'","'[t|'","'[d|'","'|]'","'[||'","'||]'","TH_ID_SPLICE","'$('","TH_ID_TY_SPLICE","'$$('","TH_TY_QUOTE","TH_QUASIQUOTE","TH_QQUASIQUOTE","%eof"]+        bit_start = st * 480+        bit_end = (st + 1) * 480+        read_bit = readArrayBit happyExpList+        bits = map read_bit [bit_start..bit_end - 1]+        bits_indexed = zip bits [0..479]+        token_strs_expected = concatMap f bits_indexed+        f (False, _) = []+        f (True, nr) = [token_strs !! nr]++happyActOffsets :: HappyAddr+happyActOffsets = HappyA# "\x43\x00\x20\x00\xc8\x00\xfa\x24\x4a\x1a\x1a\x2c\x22\x29\x32\x23\xfa\x24\xa9\x43\x7a\x39\x7c\x00\x52\x00\xa9\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x04\x00\x00\x00\x00\xc0\x01\x00\x00\xe4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x94\x00\x05\x01\x05\x01\x00\x00\xbc\x00\x13\x01\x0f\x01\x00\x00\x15\x02\xe9\x41\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x4a\x00\x00\x00\x00\x00\x00\x5d\x01\x7c\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\x42\x11\x00\x84\x34\x07\x33\x86\x33\x43\x46\x0e\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x2c\x00\x00\x00\x00\x3f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x01\x32\x09\x31\x03\xa9\x45\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xac\x01\x98\x0a\x00\x00\x00\x00\x1a\x2c\x1a\x2c\x12\x2f\x00\x00\xb8\x01\x00\x00\x00\x00\x00\x00\x00\x00\xf4\x01\xb7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x02\x00\x00\x00\x00\x1a\x2c\x9d\x00\x92\x25\xcd\x01\xc5\x02\x72\x31\xc5\x02\x72\x31\x02\x02\x33\x02\x14\x02\x7a\x2e\x72\x31\xaa\x2f\x72\x31\xd2\x20\xda\x1d\x72\x1e\x80\x32\x13\x45\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x2c\x1a\x2c\x7a\x39\x70\x04\x1a\x2c\x00\x00\x1a\x2c\xdf\x45\x40\x02\x00\x00\x2e\x02\xb4\x0b\x00\x00\x67\x02\xa5\x02\x00\x00\x00\x00\x00\x00\x0d\x05\xb5\x03\xa0\x02\x4d\x00\xa0\x02\xa9\x46\x8b\x48\xb5\x03\x0a\x1f\x00\x00\xbf\x02\x72\x31\xbf\x02\xbf\x02\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x0a\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x41\x43\x03\xb4\x02\x8b\x02\xf4\x05\x00\x00\x03\x35\x7f\x00\xc6\x48\xf1\x02\xf3\x48\xf3\x48\x5e\x48\x72\x31\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x02\x00\x00\xf0\x02\x56\x03\x00\x03\x67\x03\x0c\x03\x95\x03\x00\x00\x00\x00\x00\x00\x69\x03\x92\x03\x5c\x00\x55\x03\x55\x03\xb7\x03\xbb\x03\x55\x02\x72\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x72\x31\xb6\x03\xe6\x03\x2e\x00\x00\x00\x3c\x00\xd9\x03\xcf\x00\x00\x00\x3c\x00\xd2\x00\x00\x00\x01\x04\xee\x03\xc3\x49\x2b\x04\x76\x01\xd5\x02\x00\x00\x9d\x05\x9d\x05\x21\x04\x2a\x04\x72\x3d\xe9\x41\x42\x02\x7a\x39\x3c\x04\x3f\x04\x4a\x04\x6d\x04\x00\x00\x81\x04\x00\x00\x00\x00\x00\x00\xe9\x41\x7a\x39\xe9\x41\x88\x04\x68\x04\x00\x00\x55\x02\x00\x00\xe2\x2d\x00\x00\x00\x00\x82\x35\x73\x44\xe9\x41\x7d\x04\x4d\x04\x00\x00\x8c\x04\x98\x0a\xb6\x01\x8f\x04\x00\x00\x1a\x2c\x00\x00\x00\x00\x00\x00\x94\x04\x97\x04\xa6\x04\xaf\x04\xa2\x1f\x6a\x21\x00\x00\xaa\x2f\x00\x00\x00\x00\x73\x44\x73\x04\xd1\x04\xd7\x04\x00\x00\xda\x04\x00\x00\xb9\x04\x00\x00\xd6\x46\x2c\x00\xa9\x46\x00\x00\x1f\x01\xa9\x46\x7a\x39\xa9\x46\x00\x00\x3c\x05\x42\x1d\x42\x1d\x09\x4a\x01\x36\xc4\x04\x00\x00\x00\x00\x00\x00\x00\x00\xd5\x04\xb7\x05\xf8\x03\xe6\x04\xc5\x04\xd9\x04\x00\x00\x00\x00\xf7\x04\x50\x04\x06\x05\x00\x00\x00\x00\x94\x09\x00\x00\x00\x00\x1d\x01\x12\x05\x00\x00\x00\x00\x3a\x20\x00\x00\x2f\x05\x80\x01\x3a\x05\x44\x05\x00\x00\x00\x00\x42\x30\x00\x00\x00\x00\xda\x30\x2c\x05\x72\x31\x4f\x05\x89\x05\x96\x05\x9f\x05\x00\x00\x00\x00\x2a\x26\x2a\x26\xb5\x05\x00\x00\xe1\x05\x93\x05\x2e\x01\x00\x00\x00\x00\xba\x29\xbc\x05\x00\x00\xfd\x05\x72\x31\x1a\x2c\x70\x46\x00\x00\x68\x42\x00\x00\x00\x00\x1a\x2c\x7a\x39\x1a\x2c\x1a\x2c\x1a\x2c\x1a\x2c\xac\x05\xba\x05\x57\x04\xce\x05\xe7\x05\x39\x02\x05\x06\x22\x06\x25\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x39\x05\x34\x0c\x46\xcf\x05\xd2\x05\x45\x00\xff\x05\x2d\x06\xbf\x04\x00\x00\x84\x02\x33\x06\x8c\x02\x36\x06\x00\x00\x71\x01\x00\x00\xc4\x05\x00\x00\x0b\x00\x00\x00\x09\x4a\x00\x00\x7b\x45\x00\x00\x00\x00\xb7\x02\xbd\x4a\x00\x00\x26\x32\xe9\x41\x00\x00\x7a\x39\x7a\x39\x7a\x39\xee\x00\x00\x00\x19\x43\xad\x00\x00\x00\x35\x06\x00\x00\xd2\x04\xd2\x04\x50\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\xac\x06\x00\x00\x00\x00\x00\x00\x00\x00\x9f\x06\xbc\x06\x98\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa6\x06\x00\x00\x7a\x39\x00\x00\x00\x00\x87\x01\x00\x00\xae\x02\x85\x06\x00\x00\x00\x00\x7a\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x39\x00\x00\x00\x00\x00\x00\x7a\x39\x7a\x39\x00\x00\x00\x00\x90\x06\x93\x06\x9d\x06\x9e\x06\xa2\x06\xa3\x06\xaa\x06\xaf\x06\xb0\x06\xbb\x06\xbe\x06\xb9\x06\xc9\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\x06\x00\x00\xc7\x06\xf6\x06\x00\x00\x00\x00\x00\x00\x2c\x05\x44\x00\xf4\x06\xd6\x06\x00\x00\x00\x00\x00\x00\x32\x07\x00\x00\x1a\x2c\x1a\x2c\x7b\x01\x00\x00\x1d\x02\x1a\x2c\x00\x00\x00\x00\xfd\x06\x00\x00\x00\x00\x62\x24\xb2\x19\xda\x30\xf7\x06\xca\x23\x00\x00\x1a\x2c\xc2\x26\xca\x23\x00\x00\xe0\x06\x00\x00\x00\x00\x00\x00\x02\x22\xff\x06\x00\x00\xf9\x31\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x1a\x5c\x00\xf0\x06\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x06\x00\x00\xe6\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x96\x49\x00\x00\x00\x00\x02\x07\x00\x00\x6e\x01\x0c\x07\xe9\x41\xbd\x4a\x94\x01\xa9\x01\x00\x00\x00\x00\x66\x0e\x9a\x22\xc6\x01\x00\x00\x0d\x07\x95\x02\x9d\x02\x12\x07\x00\x00\x13\x07\x11\x07\xea\x06\x04\x07\x1d\x07\x00\x00\x22\x07\x06\x07\x07\x07\x2e\x49\x2e\x49\x00\x00\x23\x07\x54\x03\xb5\x03\x03\x07\x05\x07\x2d\x07\x00\x00\x10\x07\x0b\x05\x00\x00\x00\x00\x1a\x2c\xca\x23\x32\x00\xf1\x3d\x1c\x00\x00\x00\x1e\x07\x63\x01\x34\x07\xbd\x4a\x00\x00\x00\x00\x4e\x00\x00\x00\x1a\x2c\xba\x29\xe9\x41\x68\x07\x00\x00\x35\x07\x1c\x07\x00\x00\xf4\x05\x00\x00\x00\x00\x00\x00\x00\x00\x70\x07\x4f\x00\x38\x06\x90\x02\x00\x00\x3e\x07\xbd\x4a\x01\x36\xb4\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x42\x6a\x0b\x1a\x07\x01\x36\x00\x00\x6a\x0b\x09\x4a\x52\x2a\x52\x2a\x75\x07\x00\x00\x5a\x01\x00\x00\x14\x07\x00\x00\x19\x07\x00\x00\x00\x00\x5b\x49\x5b\x49\x00\x00\x00\x00\x5b\x49\x72\x31\x45\x07\x46\x07\x00\x00\x00\x00\x7d\x07\x00\x00\x9f\x03\x9f\x03\x00\x00\x00\x00\x00\x00\x8c\x07\x00\x00\x2a\x07\x00\x00\x4a\x1a\x31\x07\x3c\x00\x3c\x00\x31\x07\x1f\x07\x00\x00\x00\x00\x00\x00\x50\x07\x00\x00\x00\x00\x00\x00\x8d\x02\x00\x00\x00\x00\x25\x01\x38\x07\x1a\x2c\x36\x4a\x86\x07\x00\x00\x3f\x07\x36\x07\x00\x00\x00\x00\x3d\x07\x00\x00\xec\x42\x00\x00\x55\x07\x61\x07\x69\x07\x72\x07\x63\x4a\x00\x00\x00\x00\x73\x07\x63\x07\x7a\x39\x53\x07\x7a\x39\xbd\x4a\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x05\x7a\x39\x00\x00\x00\x00\x7a\x39\x54\x07\x00\x00\x8c\x47\x00\x00\x57\x05\x00\x00\x76\x07\xaa\x07\x00\x00\x00\x00\x6e\x05\xb7\x02\xe9\x41\x77\x07\x80\x36\x80\x36\xad\x07\xc0\x07\x79\x07\x7a\x39\x1c\x00\x7a\x07\x00\x00\xea\x4a\x00\x00\x7f\x07\x00\x00\x00\x00\x80\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x39\x00\x00\x66\x07\x7a\x39\x00\x00\x00\x00\x00\x00\x59\x07\x00\x00\x42\x1d\x1a\x2c\x00\x00\x00\x00\xff\x36\x63\x4a\xb7\x02\x81\x07\xe9\x41\xff\x36\xff\x36\xc4\x04\x00\x00\x00\x00\x6b\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x6b\x01\x00\x00\x00\x00\xb2\x2c\x00\x00\x00\x00\x4a\x2d\x00\x00\x5c\x00\x6c\x07\x00\x00\x83\x05\x00\x00\x5a\x27\x7b\x07\x00\x00\x58\x07\x00\x00\x00\x00\xf2\x27\x00\x00\x00\x00\x00\x00\x4a\x2d\xea\x2a\x4a\x2d\x00\x00\x00\x00\xca\x23\x70\x46\x00\x00\x00\x00\x00\x00\x7a\x39\x00\x00\x00\x00\x8d\x07\x00\x00\x85\x07\x84\x07\x5f\x07\x7a\x39\x00\x00\x7a\x39\x3c\x09\x8a\x05\x00\x00\x87\x07\x87\x07\xc7\x07\x00\x05\xdb\x07\x00\x00\x2a\x00\x2a\x00\x00\x00\x8b\x07\x71\x07\x00\x00\x7e\x07\x00\x00\x00\x00\x8e\x07\x00\x00\x00\x00\x00\x00\x00\x00\x97\x07\x00\x00\xa2\x07\x00\x00\x00\x00\x00\x00\xe3\x07\xb5\x07\x4a\x2d\x82\x2b\x00\x00\x00\x00\xdf\x07\xc1\x04\x8a\x28\x8a\x28\x4a\x2d\x9e\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\x36\xff\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc3\x07\xa3\x07\xc9\x07\x00\x00\xcb\x07\x00\x00\xb9\x07\xe9\x41\x02\x08\x15\x08\x00\x00\x99\x07\x00\x00\x21\x08\x00\x00\x1c\x04\x21\x08\xf1\x05\xff\x36\x27\x03\x7e\x37\x00\x00\x00\x00\x4a\x2d\x00\x00\xe2\x1a\xe2\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x1b\x7a\x1b\x00\x00\x00\x00\x00\x00\x0e\x08\x26\x32\x00\x00\xe9\x41\x7a\x39\xdd\x07\xfd\x37\x00\x00\x00\x00\x63\x4a\x00\x00\x00\x00\x0b\x06\xcd\x07\x90\x4a\x00\x00\x6a\x0b\x2d\x03\x00\x00\x00\x00\xcf\x07\x00\x00\xb3\x07\x00\x00\xd2\x04\x00\x00\x14\x08\xee\x07\xf0\x07\x24\x08\xd0\x07\x00\x00\x40\x06\x00\x00\x00\x00\x40\x06\x3f\x08\x00\x00\x00\x00\x4a\x2d\xf4\x07\x00\x00\x2d\x08\x42\x1d\x42\x1d\x00\x00\x00\x00\xfd\x37\x00\x00\xf9\x07\x00\x00\xf5\x07\x00\x00\x54\x06\x00\x00\x60\x00\x00\x00\xd4\x01\x00\x00\x00\x00\x39\x08\xcf\x02\x00\x00\x26\x32\x00\x00\x00\x00\xe6\x01\x00\x00\x28\x08\x4a\x2d\x7c\x38\xd9\x02\x00\x00\x00\x00\x00\x00\x23\x05\x23\x05\x00\x00\x77\x02\x19\x08\xc5\x07\x00\x00\x00\x00\x00\x00\x00\x00\xf9\x39\x00\x00\x24\x00\x00\x00\x34\x08\x00\x00\x48\x08\x00\x00\xe9\x41\x00\x00\x00\x00\x78\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x2d\x4a\x2d\x4a\x2d\x00\x00\x00\x00\x00\x00\xd4\x07\x4b\x08\x00\x00\x00\x00\x00\x00\x00\x00\xef\x01\x00\x00\xe1\x01\x46\x43\xe7\x02\x60\x06\xeb\x07\x00\x00\xa0\x44\x00\x05\x00\x00\x00\x00\x00\x00\x60\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\xed\x07\x00\x00\x00\x00\x00\x00\x00\x00\xd2\x04\xc9\x02\x4c\x04\x22\x04\x00\x05\x00\x00\x00\x00\x00\x00\x69\x00\xf3\x07\xf2\x07\x73\x43\xd2\x04\xd2\x04\x00\x00\x4a\x2d\x0c\x08\x00\x00\x00\x00\x2f\x08\x00\x00\x0b\x08\x00\x00\x00\x00\x70\x3e\xea\x4a\x13\x08\xfa\x07\x3d\x00\xff\x07\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\xfc\x07\x00\x00\x1e\x08\x00\x08\x11\x08\x00\x00\x12\x1c\x00\x00\x58\x04\xef\x3e\xe9\x41\xae\x0e\xe9\x41\x00\x00\x00\x00\x00\x00\xaa\x1c\xef\x3e\x00\x00\x00\x00\x6e\x3f\x29\x08\x00\x00\xf7\x3a\x76\x3b\x26\x32\xf5\x3b\x00\x00\x2f\x02\xf3\x02\x90\x4a\xf5\x3b\x00\x00\x4b\x00\xd2\x04\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x12\x08\x00\x00\x00\x00\x00\x00\x0f\x08\x00\x05\x0d\x08\x16\x08\x00\x00\x00\x00\x00\x00\x26\x32\x00\x00\x41\x02\x00\x00\x5c\x00\xfb\x02\x17\x08\x6e\x3f\x1c\x00\x00\x00\x00\x00\x2c\x08\xfb\x38\xb8\x04\x00\x00\x00\x00\xf5\x3b\x74\x3c\x00\x00\x00\x00\xb5\x03\xfb\x38\x23\x05\x00\x00\x00\x00\xed\x3f\xf7\x07\x23\x08\x30\x08\x00\x00\xf3\x3c\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x41\x4a\x2d\x07\x08\x00\x00\x54\x00\x54\x00\x00\x00\xd2\x04\x00\x00\xd2\x04\x00\x00\x00\x00\x1f\x08\x22\x08\x27\x08\x2a\x08\x00\x00\xda\x02\x00\x00\x00\x00\x00\x00\x41\x45\x18\x08\x00\x00\x00\x00\x00\x05\x2b\x08\x1a\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x03\x00\x00\x89\x08\xeb\x02\x00\x00\x25\x00\x2e\x08\x2e\x08\x47\x08\x00\x00\x00\x00\x00\x00\x6c\x40\x00\x00\x33\x08\x00\x00\x00\x00\x00\x00\x00\x00\x41\x08\x49\x08\x07\x33\x00\x00\x00\x00\xea\x4a\x00\x00\x00\x00\x83\x08\x9a\x08\x1c\x00\x00\x00\x00\x00\xeb\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x08\x00\x05\x00\x00\x00\x00\x3e\x08\x00\x00\x00\x00\x91\x08\xa7\x08\x00\x00\xa7\x08\x6f\x08\x26\x32\x00\x00\x6a\x41\x00\x00\x00\x00\xa8\x08\xa9\x08\x6c\x19\xd2\x04\x00\x00\xd2\x04\xd2\x04\x00\x00\xd2\x04\x41\x45\x00\x00\x00\x00\xd9\x44\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x08\x78\x08\x00\x00\xd2\x04\x64\x06\x64\x06\x00\x00\x00\x00\x00\x00\xc6\x08\x00\x00\x00\x00\x00\x00\x00\x00\x59\x08\xd2\x04\x00\x00\x00\x00\x00\x00\x00\x00"#++happyGotoOffsets :: HappyAddr+happyGotoOffsets = HappyA# "\x05\x00\xfe\xff\xa0\x08\xb9\x4e\x48\x01\x4d\x53\x75\x52\xf2\x06\x01\x4f\x01\x00\x60\x12\x8d\x00\x07\x00\xf6\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x04\x00\x00\x00\x00\x00\x00\x75\x01\x00\x00\x00\x00\x00\x00\x79\x01\x00\x00\x00\x00\x41\x05\x80\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\xff\x53\x01\x7d\x12\x83\x0e\x63\x0e\xd6\x00\x17\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x95\x53\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\xa4\x07\xcd\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x0c\x00\x00\x00\x00\xdd\x53\x25\x54\xd2\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x54\xec\x07\x0d\x51\x53\x05\xf6\x07\xbe\x14\xf8\x07\xaa\x15\x00\x00\x00\x00\x00\x00\xfa\x11\xc7\x34\xe6\x12\x46\x35\xb9\x4a\x5f\x46\x45\x47\xe6\x07\x49\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x54\x4d\x5c\x12\x13\x06\x08\xfd\x54\x00\x00\x45\x55\xfc\x05\xaa\x08\x00\x00\x00\x00\xa7\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x05\xa7\x02\xf1\x04\x40\x05\x66\x05\xd3\x03\x66\x0b\xdf\x02\xd2\x46\x00\x00\x00\x00\xc5\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x01\x00\x00\x00\x00\x00\x00\x00\x00\x74\x07\x00\x00\x00\x00\xae\x05\x9f\x08\x00\x00\x2d\x16\x67\x08\x8c\x00\xe8\x05\x96\x04\x73\x02\x46\x03\x44\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x08\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x00\x00\x00\xc1\x01\x00\x00\x5a\x02\xbc\x07\xc2\x07\xc6\x07\xb7\x08\x00\x00\xa4\x04\xc3\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x37\xe1\x07\x93\x04\x00\x00\x00\x00\x7a\x08\x00\x00\x00\x00\x00\x00\x7e\x08\x00\x00\x00\x00\xf6\x05\x00\x00\xc6\xff\x00\x00\x6f\xff\x2d\x04\x00\x00\x74\x08\x7d\x08\x00\x00\x00\x00\x18\x01\x8f\x16\x19\x03\xc9\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xac\x16\x88\x10\xc9\x16\x5d\x08\x00\x00\x00\x00\xef\x04\x00\x00\x02\x09\x00\x00\x00\x00\x6a\x08\xcd\x02\xaf\x07\xa6\x08\x00\x00\x00\x00\x00\x00\x2f\x0f\x98\xff\x00\x00\x00\x00\x95\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x4b\x03\x4c\x00\x00\xe6\x12\x00\x00\x00\x00\x61\x03\x00\x00\x84\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9a\x05\x00\x00\xf6\x03\x00\x00\x00\x00\x30\x04\x5e\x0f\xbb\x04\x00\x00\x00\x00\xfa\x02\x42\x03\x7e\x00\x09\x09\xc9\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x01\xd9\x07\x00\x00\x00\x00\x00\x00\x1d\x00\x28\x00\x00\x00\x0b\x11\x00\x00\x00\x00\x00\x00\x04\x04\x3a\x08\x00\x00\x98\xff\x00\x00\x00\x00\x00\x00\x27\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x38\x00\x00\x00\x00\x89\x09\x31\x08\xbf\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x49\x4f\x91\x4f\x00\x00\x00\x00\x00\x00\x45\x08\x80\xff\x00\x00\x00\x00\xde\x4f\xec\x05\x00\x00\x00\x00\xbd\x39\x8d\x55\xdb\x01\x00\x00\xba\xff\x00\x00\x00\x00\x69\x5d\x6b\x10\xd5\x55\x1d\x56\x65\x56\xad\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x10\xbf\x0d\xdd\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x02\x00\x00\xac\x00\x00\x00\x30\x03\x00\x00\x00\x00\x82\x08\x1b\x00\x00\x00\x59\x02\xe6\x16\x00\x00\x24\x15\x41\x15\x2f\x13\x00\x00\x00\x00\x16\x00\xe0\x07\x00\x00\x9a\x02\x00\x00\xe7\x07\xea\x07\x05\x09\x00\x00\x00\x00\x06\x09\x00\x00\x00\x00\xed\x08\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd6\x15\x00\x00\x00\x00\x00\x00\x00\x00\x79\x04\x00\x00\x00\x00\x00\x00\x3a\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x11\x00\x00\x00\x00\x00\x00\x74\x11\x91\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x08\x3b\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf5\x56\x3d\x57\xfb\x07\x00\x00\x00\x00\x85\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x50\x6f\x4a\xc9\x33\x00\x00\x71\x4c\x00\x00\xcd\x57\x29\x4e\xdf\x4c\x00\x00\x89\xff\x00\x00\x00\x00\x00\x00\x95\x4b\x00\x00\x00\x00\x33\x07\x00\x00\x00\x00\x00\x00\x00\x00\x90\x01\x08\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdd\x02\x00\x00\x00\x00\x00\x00\x00\x00\x01\x08\x00\x00\x9e\x18\xa5\x00\x00\x00\x10\x08\x00\x00\x00\x00\x77\x01\x00\x00\x1b\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x07\x8e\x0b\x00\x00\x00\x00\xf6\x04\x4f\x03\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x0b\x11\x00\x00\x00\x00\x69\x5d\x4d\x4d\x00\x00\x09\x08\xc1\xff\x00\x00\x00\x00\x03\x08\x00\x00\x1b\x01\x00\x00\x00\x00\x04\x00\x00\x00\x15\x58\x78\x50\x48\x17\xb9\x08\xa7\x05\xd3\x08\x00\x00\x00\x00\xe5\x08\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x08\x01\x06\x9b\x05\xdf\x08\x00\x00\x00\x00\x5c\x01\xe2\x0b\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc4\xff\xce\x02\x1c\x08\x26\x09\x00\x00\xd5\xff\xe8\xff\xbd\x52\x05\x53\xc4\x08\x00\x00\x00\x00\x00\x00\xc8\x08\x00\x00\xc2\x08\x00\x00\x00\x00\xd6\x01\x13\x0c\x00\x00\x00\x00\x97\x00\x3c\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x09\x00\x00\x2a\x09\x2b\x09\x00\x00\x00\x00\x00\x00\x17\x03\x00\x00\x16\x09\x00\x00\x90\x01\x23\x09\xce\x08\xcf\x08\x2c\x09\x17\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdd\x5c\xd8\xff\xea\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3e\x03\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x13\x0a\x09\x69\x13\xbd\xff\x00\x00\xfa\x08\x00\x00\x00\x00\x00\x00\x00\x00\xee\x08\x7b\x0f\x00\x00\x00\x00\xfe\x13\x00\x00\x00\x00\xf7\x02\x00\x00\xf6\x08\x00\x00\x00\x00\xf8\x08\x00\x00\x00\x00\x5d\x06\xd4\x08\x65\x17\x00\x00\x8b\x0b\xa8\x0b\xc3\x08\xc2\x05\x00\x00\x1b\x14\xe4\xff\x00\x00\x00\x00\x7d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x98\x0f\x00\x00\x00\x00\xb5\x0f\x00\x00\x00\x00\x00\x00\xe3\x05\x00\x00\xb1\x06\x5d\x58\x00\x00\x00\x00\x52\x09\x94\x03\xe2\x08\x00\x00\x82\x17\x78\x0c\x95\x0c\xc9\x05\x00\x00\x00\x00\x3f\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x58\x00\x00\x00\x00\xed\x58\x00\x00\x40\x08\x00\x00\x00\x00\x31\x05\x00\x00\xc5\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x51\x00\x00\x00\x00\x00\x00\x35\x59\xe5\x51\x7d\x59\x00\x00\x00\x00\xbb\x4d\x17\x02\x00\x00\x00\x00\x00\x00\x26\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x04\xf3\x15\x00\x00\x38\x14\x22\x00\x67\x09\x00\x00\x58\x09\x5c\x09\x00\x00\x15\x00\x00\x00\x00\x00\xfb\xff\xfd\xff\x00\x00\x00\x00\x47\x04\x00\x00\xd4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x09\x9b\x08\xc5\x59\x2d\x52\x00\x00\x00\x00\x00\x00\x00\x00\x71\x4e\x9d\x51\x0d\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x0c\xcf\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9f\x17\xdc\x08\xcd\x05\x00\x00\xc5\xff\x00\x00\xd0\x08\x00\x00\xfc\xff\xd0\x05\x00\x00\x65\x0d\x00\x00\xc5\x0b\x00\x00\x00\x00\x55\x5a\x00\x00\xd8\x03\x20\x04\x00\x00\xe7\x08\x3c\x06\x00\x00\x00\x00\x00\x00\x1b\x02\x63\x02\x00\x00\x00\x00\x00\x00\x46\x09\xc3\xff\x00\x00\x01\x18\x55\x14\x00\x00\xf1\x09\x00\x00\x00\x00\xf4\xff\x00\x00\x00\x00\x00\x00\x00\x00\xed\xff\x00\x00\x6c\x03\x0b\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7b\x09\x00\x00\x00\x00\x7c\x09\x5f\x09\x00\x00\x00\x00\x9d\x5a\x00\x00\x00\x00\x00\x00\xaf\x05\x30\x06\x00\x00\x00\x00\x0e\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4e\x09\x00\x00\x41\x09\x00\x00\x6e\x08\x00\x00\x00\x00\x53\x09\x00\x00\x00\x00\xf7\x02\x00\x00\x00\x00\x77\x08\x00\x00\x57\x09\x25\x5d\x13\x06\x00\x00\x00\x00\x00\x00\x00\x00\x37\x01\x5c\x02\x00\x00\x54\x01\x62\x09\x7c\x08\x00\x00\x00\x00\x00\x00\x00\x00\x78\x0d\x00\x00\x83\x03\x00\x00\xfb\x08\x00\x00\xd6\x05\x00\x00\x9e\x0d\x00\x00\x00\x00\x4e\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe5\x5a\x2d\x5b\x75\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x08\x00\x00\x00\x00\x26\x00\x00\x00\x8d\x09\x00\x00\x00\x00\x55\x00\xe3\xff\x00\x00\x00\x00\x00\x00\x98\x09\x00\x00\x58\x02\xa8\x02\x00\x00\x27\x00\x8f\x09\x00\x00\x00\x00\x00\x00\x00\x00\x8a\x08\xc3\x03\xec\x01\x13\x05\x2b\x00\x00\x00\x00\x00\x00\x00\x03\x00\xad\x09\x00\x00\x29\x00\x8c\x08\x92\x08\x00\x00\xbd\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa6\x0a\x8f\x01\x00\x00\x00\x00\x8f\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x96\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x05\x00\x00\x6a\x09\x7b\x06\x1e\x18\x0b\x11\x3b\x18\x00\x00\x00\x00\x00\x00\xab\x04\x15\x07\x00\x00\x00\x00\x20\x08\x6c\x09\x00\x00\x27\x04\x0f\x05\xda\xff\xea\x14\x00\x00\x99\x08\x00\x00\x34\x00\x10\x16\x00\x00\xb2\x06\xa3\x08\x00\x00\xfe\x01\x0a\x02\x00\x00\xa5\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4e\x02\x00\x00\xab\x08\x00\x00\xac\x08\x00\x00\x00\x00\x44\x08\x06\x00\x00\x00\x00\x00\x74\x09\x3a\x0a\x7e\x09\x00\x00\x00\x00\x07\x15\x43\x12\x00\x00\x00\x00\x1a\x01\xd9\x0a\x69\x02\x00\x00\x00\x00\x8b\x0d\x49\x04\x00\x00\x00\x00\x00\x00\xb9\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x58\x18\x05\x5c\x00\x00\x00\x00\xbd\x09\xbe\x09\x00\x00\xff\xff\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x02\x00\x00\x00\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x09\xbb\x09\x00\x00\x00\x00\x00\x00\x00\x00\xec\x0a\x00\x00\xb0\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x0e\x00\x00\x00\x00\x71\x00\x00\x00\x00\x00\x38\x09\xd9\x05\x0e\x00\x00\x00\x00\x00\x57\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x09\x0a\x06\x00\x00\x4e\x06\x00\x00\xd6\xff\x00\x00\xb9\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\xb3\x08\x00\x00\x02\x00\xb6\x08\x00\x00\xf5\xff\x5f\x00\x00\x00\x00\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x08\xd3\x09\xd4\x09\x00\x00\x00\x00\x00\x00\x92\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x08\x00\x00\x00\x00\x00\x00\x00\x00"#++happyAdjustOffset :: Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int#+happyAdjustOffset off = off++happyDefActions :: HappyAddr+happyDefActions = HappyA# "\xbf\xff\xc0\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\xfd\x00\x00\x00\x00\xbe\xff\xbf\xff\x00\x00\xf2\xff\x0d\xfd\x0a\xfd\x07\xfd\xf7\xfc\xf5\xfc\xf6\xfc\x03\xfd\xf4\xfc\xf3\xfc\xf2\xfc\x05\xfd\x04\xfd\x06\xfd\x02\xfd\x01\xfd\xf1\xfc\xf0\xfc\xef\xfc\xee\xfc\xed\xfc\xec\xfc\xeb\xfc\xea\xfc\xe9\xfc\xe8\xfc\xe6\xfc\xe7\xfc\x00\x00\x08\xfd\x09\xfd\x00\x00\x8a\xff\x00\x00\xb0\xff\xc1\xff\x8a\xff\xc5\xfc\x00\x00\x00\x00\x00\x00\x7d\xfe\x00\x00\xa1\xfe\x00\x00\x9a\xfe\x93\xfe\x86\xfe\x85\xfe\x83\xfe\x71\xfe\x70\xfe\x00\x00\x7c\xfe\x44\xfd\x81\xfe\x3f\xfd\x35\xfd\x38\xfd\x2f\xfd\x7b\xfe\x80\xfe\x16\xfd\x13\xfd\x68\xfe\x5d\xfe\x11\xfd\x10\xfd\x12\xfd\x00\x00\x00\x00\x2c\xfd\x28\xfd\x2b\xfd\x2a\xfd\x7a\xfe\x29\xfd\x00\x00\xc1\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\xfd\x32\xfd\x2d\xfd\x2e\xfd\x36\xfd\x30\xfd\x31\xfd\x6b\xfd\x69\xfe\x6a\xfe\xcc\xfd\x00\x00\x11\xfe\x10\xfe\x00\x00\xf1\xff\x5a\xfd\x4d\xfd\x59\xfd\xef\xff\xf0\xff\x1a\xfd\xff\xfc\x00\xfd\xfb\xfc\xf8\xfc\x58\xfd\xe2\xfc\x49\xfd\xdf\xfc\xdc\xfc\xfa\xfc\xe5\xfc\xe3\xfc\xe4\xfc\x00\x00\x00\x00\x00\x00\x00\x00\xe0\xfc\xf9\xfc\xdd\xfc\xe1\xfc\xfc\xfc\xde\xfc\xd0\xfd\x78\xfd\x0a\xfe\x01\xfe\x09\xfe\x00\x00\x00\x00\x02\xfe\xf7\xfd\xeb\xfd\xe9\xfd\xdb\xfd\xce\xfd\xcd\xfd\x00\x00\x00\x00\x7e\xfd\x7b\xfd\xe6\xfd\xe5\xfd\xe7\xfd\xe8\xfd\xe4\xfd\xdc\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\xfd\xdb\xfc\xda\xfc\xe3\xfd\xe2\xfd\xd7\xfc\xd6\xfc\xd9\xfc\xd8\xfc\xd5\xfc\xd4\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfd\x00\x00\xd6\xfd\x77\xff\x1e\xfe\x00\x00\x00\x00\x07\xfe\x00\x00\x0a\xfd\x75\xff\x74\xff\x73\xff\x00\x00\x00\x00\x15\xfe\x15\xfe\x15\xfe\x00\x00\x68\xfd\x00\x00\x00\x00\x8c\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x6d\xff\x6c\xff\x6b\xff\x15\xff\x6a\xff\x69\xff\x2a\xfe\x63\xff\x29\xfe\x32\xfe\x62\xff\x2d\xfe\x61\xff\x31\xfe\x30\xfe\x2f\xfe\x2e\xfe\x00\x00\x29\xff\x00\x00\x49\xff\x52\xff\x28\xff\x00\x00\x00\x00\x00\x00\xdc\xfe\xc6\xfe\xcb\xfe\x00\x00\x00\x00\xc9\xfc\xc8\xfc\xc7\xfc\xc6\xfc\x00\x00\x7c\xfd\x00\x00\x84\xff\x00\x00\x00\x00\x00\x00\x00\x00\x8a\xff\xc2\xff\x8a\xff\x00\x00\x87\xff\x00\x00\x00\x00\x00\x00\x82\xff\x00\x00\x00\x00\x00\x00\x5d\xfd\x54\xfd\x5e\xfd\x0f\xfd\x56\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xcc\xfe\x00\x00\x60\xfd\x00\x00\xc7\xfe\x00\x00\x00\x00\xdd\xfe\xda\xfe\x00\x00\x53\xfd\x00\x00\x00\x00\x00\x00\x67\xff\x00\x00\x00\x00\x00\x00\x93\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\xff\x00\x00\x4b\xff\x4d\xff\x4c\xff\x00\x00\x63\xfe\x00\x00\x5a\xfe\x00\x00\x1c\xff\x00\x00\x20\xfd\x00\x00\x1f\xfd\x21\xfd\x00\x00\x00\x00\x00\x00\x15\xff\x00\x00\x8b\xfd\xc1\xfd\x0a\xfe\x00\x00\x00\x00\x1d\xfd\x00\x00\x1c\xfd\x1e\xfd\x18\xfd\xfd\xfc\x00\x00\xfe\xfc\x49\xfd\x00\x00\x00\x00\xca\xfc\xfa\xfc\x51\xfd\xce\xfc\x00\x00\x53\xfd\xad\xfe\x00\x00\x69\xfd\x67\xfd\x65\xfd\x64\xfd\x61\xfd\x00\x00\x00\x00\x00\x00\x14\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xe4\xfe\x00\x00\xe7\xfe\xe7\xfe\x00\x00\x00\x00\x00\x00\x76\xff\xd7\xfd\x47\xfd\xd8\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6e\xff\x6e\xff\x00\x00\x00\x00\x00\x00\xd9\xfd\xda\xfd\x00\x00\xc7\xfd\xe8\xfd\x00\x00\x00\x00\xfd\xfc\xfe\xfc\x00\x00\x4f\xfd\x00\x00\xb5\xfd\x00\x00\xb4\xfd\x4c\xfd\x89\xfd\x05\xfe\xf5\xfd\x88\xfd\x85\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf8\xfd\x7a\xfd\x7f\xfd\x7f\xfd\x00\x00\xed\xfd\x77\xfd\xfe\xfd\x00\x00\xf0\xfd\x90\xfd\x00\x00\x00\x00\xee\xfd\x00\x00\x00\x00\x00\x00\x75\xfd\xfa\xfd\x00\x00\x04\xfe\x00\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\xfe\x5c\xfd\x5b\xfd\x7f\xfe\x7e\xfe\x6c\xfe\x23\xfd\x63\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x62\xfe\x00\x00\x00\x00\x00\x00\x76\xfe\x00\x00\x38\xfd\x00\x00\x00\x00\x78\xfe\x00\x00\x40\xfd\x00\x00\x40\xfe\x3e\xfe\xc2\xfc\x00\x00\x82\xfe\x00\x00\xa4\xfe\xa5\xfe\x00\x00\x5d\xfe\x5c\xfe\x00\x00\x00\x00\x84\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xe8\xff\x00\x00\x00\x00\xad\xff\x87\xff\xac\xff\x00\x00\x00\x00\xbb\xff\xd1\xfc\xd0\xfc\xbb\xff\xab\xff\xa9\xff\xaa\xff\x8b\xff\xec\xff\xd2\xfc\xd3\xfc\xe9\xff\x00\x00\xd8\xff\xdc\xff\xd9\xff\xdb\xff\xda\xff\xdd\xff\xeb\xff\x53\xfe\xa0\xfe\x9c\xfe\x92\xfe\x9b\xfe\x00\x00\x5e\xfe\x00\x00\xa2\xfe\xa3\xfe\x00\x00\xa8\xfe\x00\x00\x00\x00\x79\xfe\x73\xfe\x00\x00\x41\xfd\x43\xfd\xcf\xfc\x3e\xfd\x72\xfe\x00\x00\x42\xfd\x74\xfe\x75\xfe\x00\x00\x00\x00\x15\xfd\x37\xfd\x00\x00\x00\x00\x00\x00\x2c\xfd\x2b\xfd\x2a\xfd\x7a\xfe\x29\xfd\x2d\xfd\x2e\xfd\x31\xfd\x62\xfe\x00\x00\x64\xfe\xcb\xfd\xed\xff\xee\xff\x50\xfd\x57\xfd\x0b\xfd\x4e\xfd\x48\xfd\x19\xfd\x0b\xfe\x0c\xfe\x0d\xfe\x0e\xfe\x0f\xfe\xab\xfe\x08\xfe\xf9\xfd\x00\x00\x76\xfd\x73\xfd\x70\xfd\x72\xfd\x79\xfd\xf6\xfd\x00\x00\x00\x00\x00\x00\xa1\xfd\x9f\xfd\x91\xfd\x8e\xfd\x00\x00\xff\xfd\x00\x00\x00\x00\x00\x00\x80\xfd\x00\x00\x00\x00\xfd\xfd\xfc\xfd\x00\x00\x87\xfd\xf2\xfd\x00\x00\x00\x00\x85\xfd\x00\x00\x00\x00\xdd\xfd\xb3\xfd\x00\x00\x00\x00\x0c\xfd\xb7\xfd\xbb\xfd\xde\xfd\xbd\xfd\xb6\xfd\xbc\xfd\xdf\xfd\x00\x00\xd5\xfd\xd2\xfd\xd3\xfd\xc2\xfd\xc3\xfd\x00\x00\x00\x00\xd1\xfd\xd4\xfd\xc9\xfd\x45\xfd\x00\x00\x46\xfd\x1f\xfe\x26\xfd\x71\xff\x27\xfd\x4b\xfd\x25\xfd\x24\xfd\x00\x00\x21\xfe\xaa\xfe\x00\x00\x96\xfe\x91\xfe\x00\x00\x00\x00\x5d\xfe\x00\x00\x00\x00\x28\xfe\xe8\xfe\xaf\xfe\x27\xfe\x00\x00\x6d\xfd\xe6\xfd\x00\x00\x00\x00\x00\x00\x67\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\xfc\xcb\xfc\x0c\xfd\xbf\xfd\xe0\xfd\xe1\xfd\xc0\xfd\x00\x00\x00\x00\x00\x00\x27\xff\xae\xfe\x00\x00\x91\xfe\x00\x00\x5d\xfe\x06\xfe\x2b\xfe\xe0\xfe\x23\xfe\x00\x00\x00\x00\x00\x00\xf5\xfe\x55\xfe\x25\xff\x00\x00\x4e\xff\x52\xff\x53\xff\x54\xff\x56\xff\x55\xff\xeb\xfe\x12\xff\x00\x00\x23\xff\x59\xff\x00\x00\x5d\xfe\x00\x00\x00\x00\xb9\xfe\xb8\xfe\xb7\xfe\xb6\xfe\xb5\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x09\xff\x06\xff\x00\x00\x00\x00\x00\x00\xd3\xfe\xd9\xfe\x00\x00\x64\xff\xde\xfe\xc5\xfe\xc0\xfe\xc4\xfe\x66\xff\xc8\xfe\x00\x00\xca\xfe\x65\xff\xcd\xfe\x00\x00\x00\x00\x00\x00\x2c\xfe\x85\xff\x7e\xff\x83\xff\xbb\xff\xbb\xff\xb7\xff\xb6\xff\xb3\xff\x6e\xff\xb8\xff\x89\xff\xb4\xff\xb5\xff\xa7\xff\x00\x00\x00\x00\xa7\xff\x80\xff\x7f\xff\xbf\xfe\xbd\xfe\x00\x00\xce\xfe\x5f\xfd\xc9\xfe\x00\x00\xc1\xfe\xdf\xfe\x00\x00\x00\x00\x00\x00\xd1\xfe\x0b\xff\x0c\xff\x00\x00\x04\xff\x05\xff\x00\xff\x00\x00\x08\xff\x00\x00\xbb\xfe\x00\x00\xb3\xfe\xb2\xfe\xb4\xfe\x00\x00\xba\xfe\x5f\xff\x9f\xfe\x00\x00\x00\x00\x48\xff\x00\x00\x00\x00\x13\xff\x11\xff\x10\xff\x0d\xff\x0e\xff\x5a\xff\x00\x00\x00\x00\x68\xff\x5b\xff\x00\x00\x59\xfe\x57\xfe\x00\x00\x60\xff\x00\x00\x1d\xff\x00\x00\xe0\xfe\x25\xfe\x24\xfe\x00\x00\x00\x00\x00\x00\x90\xfe\x00\x00\x00\x00\x50\xfe\x3c\xfe\x00\x00\x00\x00\x27\xff\x00\x00\x18\xff\x5d\xfe\x16\xff\x00\x00\xbe\xfd\xba\xfd\xcd\xfc\x1b\xfd\x17\xfd\x52\xfd\xac\xfe\x1d\xfe\x66\xfd\x63\xfd\x55\xfd\x62\xfd\x1a\xfe\x00\x00\x13\xfe\x00\x00\x00\x00\x17\xfe\x1c\xfe\xe3\xfe\x6e\xfd\xe6\xfe\xe9\xfe\x00\x00\xe2\xfe\xe5\xfe\x00\x00\x00\x00\x00\x00\x8f\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xc5\xfd\xc4\xfd\x70\xff\xc6\xfd\xc8\xfd\xcf\xfd\xb9\xfd\xb8\xfd\xc1\xfd\xad\xfd\xaf\xfd\xac\xfd\xaa\xfd\xa7\xfd\xa6\xfd\x00\x00\xb1\xfd\xae\xfd\x00\x00\x86\xfd\x00\x00\x9a\xfd\x96\xfd\x00\x00\x9b\xfd\x00\x00\x00\x00\x9c\xfd\x00\x00\x03\xfe\x84\xfd\x81\xfd\x83\xfd\xec\xfd\xf3\xfd\x00\x00\x00\x00\x00\x00\x8f\xfd\xef\xfd\x00\x00\x00\x00\xea\xfd\x6d\xfe\x0e\xfd\x00\x00\x22\xfd\x61\xfe\x60\xfe\x5f\xfe\x00\x00\x00\x00\xc3\xfc\x00\x00\x9d\xfe\x00\x00\x00\x00\x00\x00\xea\xff\xa7\xff\xa7\xff\x00\x00\xa0\xff\x00\x00\xe7\xff\xc0\xff\xc0\xff\xd7\xff\x00\x00\xc3\xfc\xc4\xfc\xc1\xfc\x6b\xfe\x77\xfe\x00\x00\x74\xfd\x71\xfd\x8d\xfd\xa0\xfd\xfe\xfd\x82\xfd\x00\x00\x9e\xfd\x99\xfd\x95\xfd\xe0\xfe\x92\xfd\x00\x00\x97\xfd\x9d\xfd\xf4\xfd\xa5\xfd\xec\xfc\x00\x00\x00\x00\xb2\xfd\x6f\xff\x8c\xff\x72\xff\x98\xfe\x8e\xfe\x97\xfe\x00\x00\x00\x00\xa9\xfe\x20\xfe\x6c\xfd\xea\xfe\x6f\xfd\x00\x00\xa7\xfe\x00\x00\x12\xfe\x00\x00\x17\xff\x00\x00\x00\x00\x50\xfe\x3c\xfe\x26\xff\xc1\xfc\x5d\xff\x3b\xfe\x39\xfe\x00\x00\x3c\xfe\x00\x00\x00\x00\x97\xfe\x00\x00\xe1\xfe\x26\xfe\x00\x00\xf6\xfe\xf9\xfe\xf9\xfe\x54\xfe\x55\xfe\x55\xfe\x24\xff\x14\xff\xec\xfe\xef\xfe\xef\xfe\x0f\xff\x21\xff\x22\xff\x43\xff\x00\x00\x38\xff\x00\x00\x00\x00\x00\x00\x00\x00\xbc\xfe\x4a\xfd\x00\x00\x07\xff\x0a\xff\x00\x00\x00\x00\xd1\xfe\xd0\xfe\x00\x00\x00\x00\xd8\xfe\xd6\xfe\x00\x00\xc3\xfe\x00\x00\xbe\xfe\x00\x00\x81\xff\x00\x00\x00\x00\x00\x00\x00\x00\x88\xff\x8d\xff\x00\x00\xbd\xff\xbc\xff\x00\x00\x7c\xff\xc2\xfe\xd7\xfe\x00\x00\x00\x00\xd2\xfe\xd4\xfe\xe7\xfe\xe7\xfe\x03\xff\xb0\xfe\x00\x00\x9e\xfe\x00\x00\x47\xff\x00\x00\x5e\xff\x00\x00\xf4\xfe\x15\xff\xf0\xfe\x00\x00\xf3\xfe\x29\xff\x30\xff\x00\x00\x58\xfe\x56\xfe\xff\xfe\xfa\xfe\x00\x00\xfe\xfe\x32\xff\x00\x00\x00\x00\x00\x00\x22\xfe\x99\xfe\x8d\xfe\x4d\xfe\x4d\xfe\x5c\xff\x00\x00\x38\xfe\x34\xfd\x35\xfe\x4f\xff\x51\xff\x50\xff\x00\x00\x3a\xfe\x49\xfe\x47\xfe\x43\xfe\x58\xff\x3c\xfe\x19\xff\x00\x00\x18\xfe\x19\xfe\x00\x00\x8c\xfe\xb0\xfd\xa9\xfd\xa8\xfd\xab\xfd\x00\x00\x00\x00\x00\x00\x98\xfd\x93\xfd\x94\xfd\x00\x00\x00\x00\x6e\xfe\x3f\xfe\x3d\xfe\x5b\xfe\x00\x00\xcb\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\xff\xa2\xff\xa0\xff\x9d\xff\x9e\xff\x9f\xff\x00\x00\xb1\xff\x8a\xff\x8a\xff\xa1\xff\xa0\xff\x99\xff\x91\xff\x8e\xff\x3d\xfd\x8f\xff\x00\x00\x00\x00\x00\x00\x00\x00\xa0\xff\xa8\xff\xb2\xff\xcf\xff\xcc\xff\xd6\xff\xe6\xff\xe6\xfc\x00\x00\x00\x00\xce\xff\x00\x00\x00\x00\xa4\xfd\xa3\xfd\x00\x00\xa6\xfe\x00\x00\x1a\xff\x57\xff\x00\x00\x5d\xfe\x00\x00\x66\xfe\x91\xfe\x00\x00\x34\xfe\x33\xfd\x36\xfe\x37\xfe\x00\x00\x4e\xfe\x4b\xfe\x00\x00\x00\x00\x00\x00\xf8\xfe\xfb\xfe\x34\xff\x20\xff\x00\x00\x00\x00\x00\x00\x00\x00\x31\xff\xf7\xfe\xee\xfe\xf1\xfe\x00\x00\x2f\xff\xed\xfe\x00\x00\x15\xff\x42\xff\x3a\xff\x3a\xff\x00\x00\x00\x00\xb1\xfe\x00\x00\x00\x00\xd1\xfe\x00\x00\xdb\xfe\x7a\xff\x00\x00\xc4\xff\x8a\xff\x8a\xff\xc3\xff\x00\x00\x00\x00\x7d\xff\x86\xff\x7b\xff\x00\x00\xa0\xff\x00\x00\x00\x00\x02\xff\x01\xff\x39\xff\x46\xff\x44\xff\x00\x00\x3b\xff\x00\x00\x00\x00\x00\x00\x00\x00\x27\xff\x2e\xff\xf2\xfe\x25\xff\x00\x00\x20\xff\x33\xff\x36\xff\x00\x00\x00\x00\xfc\xfe\x52\xfe\x00\x00\x00\x00\x4d\xfe\x51\xfe\x33\xfe\x00\x00\xc3\xfc\x00\x00\x00\x00\x94\xfe\x42\xfe\x8a\xfe\x88\xfe\x45\xfe\x87\xfe\x00\x00\x00\x00\x00\x00\xf1\xfd\xc7\xff\xc8\xff\xc5\xff\x00\x00\xc6\xff\x00\x00\xcd\xff\xa6\xff\x00\x00\x00\x00\x00\x00\x00\x00\x9a\xff\x00\x00\x90\xff\x9b\xff\x9c\xff\x97\xff\xa3\xff\xae\xff\xaf\xff\xa0\xff\x00\x00\x96\xff\x94\xff\x93\xff\x92\xff\x3c\xfd\x3b\xfd\x39\xfd\x3a\xfd\x00\x00\xd2\xff\xd0\xff\x00\x00\xe2\xff\x00\x00\xa7\xff\xa7\xff\x00\x00\xa2\xfd\x1b\xff\x89\xfe\x00\x00\x44\xfe\xc1\xfc\x65\xfe\x4f\xfe\x4a\xfe\x4c\xfe\x00\x00\x7b\xfe\x00\x00\x1f\xff\x35\xff\x00\x00\xfd\xfe\x37\xff\x50\xfe\x3c\xfe\x27\xff\x3f\xff\x41\xff\x3c\xff\x3e\xff\x40\xff\x45\xff\xd5\xfe\xcf\xfe\x00\x00\xa0\xff\xba\xff\xb9\xff\x00\x00\x79\xff\x3d\xff\x50\xfe\x3c\xfe\x2d\xff\x3c\xfe\x7b\xfe\x00\x00\x48\xfe\x42\xfe\x46\xfe\xfb\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xe5\xff\xe3\xff\x00\x00\xd5\xff\xd3\xff\x00\x00\x98\xff\xa4\xff\xa2\xff\x95\xff\xd4\xff\xd1\xff\xe4\xff\x00\x00\x00\x00\xe1\xff\x00\x00\x00\x00\x00\x00\x1e\xff\x2b\xff\x2c\xff\x3c\xfe\x78\xff\x2a\xff\xc9\xff\xca\xff\x00\x00\x00\x00\xe0\xff\xde\xff\xdf\xff"#++happyCheck :: HappyAddr+happyCheck = HappyA# "\xff\xff\x00\x00\x0d\x00\x3a\x00\x05\x00\x06\x00\x23\x00\x24\x00\x06\x00\x46\x00\x0f\x00\x10\x00\x0f\x00\x10\x00\x13\x00\x11\x00\x13\x00\x13\x00\x51\x00\x10\x00\x0c\x00\x0d\x00\x13\x00\x12\x00\x13\x00\x14\x00\x13\x00\x14\x00\x46\x00\x18\x00\x08\x00\x09\x00\x0a\x00\x47\x00\x1b\x00\x04\x00\x1d\x00\x5f\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x04\x00\x09\x00\x0a\x00\x04\x00\x08\x00\x09\x00\x0a\x00\x08\x00\x09\x00\x0a\x00\x5f\x00\x51\x00\x21\x00\x22\x00\x23\x00\x24\x00\x21\x00\x22\x00\x23\x00\x24\x00\x42\x00\x21\x00\x22\x00\x23\x00\x24\x00\x7f\x00\x80\x00\x22\x00\x23\x00\x24\x00\x60\x00\x97\x00\x23\x00\x24\x00\x74\x00\x75\x00\x23\x00\x24\x00\x01\x00\x97\x00\x9d\x00\x9e\x00\x60\x00\x0a\x00\x13\x00\x51\x00\x3b\x00\x3c\x00\xaa\x00\x9e\x00\x00\x00\xd4\x00\x11\x00\x51\x00\x36\x00\x74\x00\x75\x00\x3b\x00\x3c\x00\x13\x00\xe6\x00\x19\x00\x11\x00\xa8\x00\x4e\x00\x4f\x00\xd4\x00\x19\x00\xa9\x00\xaa\x00\xbe\x00\x11\x00\x6e\x00\x62\x00\x4f\x00\x06\x01\x52\x00\x4b\x00\xbe\x00\x4b\x00\x25\x00\x70\x00\x13\x00\x4b\x00\xcc\x00\x2a\x00\x2b\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xcc\x00\x35\x00\x29\x00\x2a\x00\x2b\x00\x0c\x00\xa8\x00\x4c\x00\x01\x00\x3f\x00\x40\x00\x54\x00\x87\x00\x3f\x00\x40\x00\x54\x00\x52\x00\x52\x00\x87\x00\x2a\x01\x75\x00\x1c\x00\x45\x00\x6f\x00\x35\x00\x36\x00\x52\x00\x65\x00\x15\x00\x87\x00\x61\x00\x45\x00\x62\x00\x87\x00\x74\x00\x75\x00\x7e\x00\x87\x00\x2c\x01\x00\x00\xa8\x00\xb3\x00\x7e\x00\x87\x00\x65\x00\x61\x00\x69\x00\x70\x00\xa8\x00\x2e\x01\x9d\x00\x9e\x00\x7e\x00\x09\x01\x0a\x01\x69\x00\xba\x00\x0d\x01\x64\x00\x0f\x01\x73\x00\x09\x01\x0a\x01\x88\x00\x2e\x01\x0d\x01\x30\x01\x0f\x01\x87\x00\x19\x01\x80\x00\x1b\x01\x19\x01\x06\x01\x1b\x01\x80\x00\x19\x00\x19\x01\x0c\x00\x1b\x01\x19\x01\x25\x01\x1b\x01\x87\x00\x25\x01\x12\x01\x13\x01\x61\x00\x1b\x01\x25\x01\x1c\x01\x31\x01\x25\x01\x1f\x01\x00\x00\x1f\x01\x2d\x00\x37\x01\x25\x01\x25\x01\x5e\x00\x25\x01\x23\x01\x24\x01\xd1\x00\x26\x01\x87\x00\x1b\x01\x31\x01\x2a\x01\x1f\x01\x1b\x01\x31\x01\x1f\x01\x37\x01\xd1\x00\x25\x01\x25\x01\x37\x01\x25\x01\x61\x00\x25\x01\x63\x00\x00\x01\x01\x01\x85\x00\x1c\x01\x04\x01\x05\x01\x1f\x01\x07\x01\x0d\x01\x0e\x01\x0f\x01\x1f\x01\x25\x01\x77\x00\x9e\x00\x1c\x01\x64\x00\x25\x01\x1f\x01\x31\x01\x31\x01\x33\x01\x34\x01\x17\x01\x25\x01\x4b\x00\x37\x01\x6f\x00\x4b\x00\x1d\x01\x1e\x01\x1f\x01\x20\x01\x2d\x01\x22\x01\x23\x01\x24\x01\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2d\x01\x99\x00\x00\x00\x2d\x01\x35\x01\x85\x00\x35\x01\x35\x01\x19\x01\x2d\x01\x1b\x01\x31\x01\x35\x01\x34\x00\x35\x01\x25\x01\x35\x01\x37\x01\x6f\x00\x31\x01\x25\x01\x6f\x00\x9d\x00\x9e\x00\x25\x01\x37\x01\x31\x01\x25\x01\x33\x01\x34\x01\x31\x01\x25\x01\x33\x01\x34\x01\x25\x01\x31\x01\x62\x00\x33\x01\x34\x01\x1f\x01\x31\x01\x99\x00\x33\x01\x34\x01\x31\x01\x25\x01\x33\x01\x34\x01\x31\x01\x6f\x00\x33\x01\x34\x01\x0b\x01\x4e\x00\x0d\x01\x4b\x00\x0f\x01\x0b\x01\x57\x00\x0d\x01\x1c\x01\x0f\x01\x0b\x01\x1f\x01\x0d\x01\x1c\x01\x0f\x01\x52\x00\x1f\x01\x25\x01\x1d\x01\x1e\x01\x1f\x01\x56\x00\x25\x01\x1d\x01\x1e\x01\x1f\x01\x25\x01\x00\x00\x1d\x01\x1e\x01\x1f\x01\x25\x01\x52\x00\x39\x00\xae\x00\xaf\x00\x25\x01\x3d\x00\x3e\x00\x3f\x00\x40\x00\x6c\x00\x19\x01\x66\x00\x1b\x01\x70\x00\x02\x01\x03\x01\x04\x01\x05\x01\x64\x00\x1e\x00\xfd\x00\xfe\x00\x25\x01\x1e\x00\x50\x00\x02\x01\x1c\x01\x04\x01\x05\x01\x1f\x01\x7f\x00\x87\x00\x58\x00\x59\x00\x2d\x00\x25\x01\x7f\x00\x5d\x00\x2d\x00\x8f\x00\x4b\x00\x00\x00\x62\x00\x1f\x01\x94\x00\x95\x00\x96\x00\x97\x00\x56\x00\x25\x01\x4f\x00\x1c\x01\x28\x01\x52\x00\x1f\x01\x54\x00\x9d\x00\x9e\x00\x57\x00\x4e\x00\x25\x01\x52\x00\x19\x01\x28\x01\x1b\x01\xa7\x00\x54\x00\x4d\x00\x7c\x00\x57\x00\x00\x00\x4b\x00\x1c\x01\x39\x00\x25\x01\x1f\x01\x4c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x25\x01\x52\x00\x13\x00\x00\x00\x4e\x00\xbe\x00\x66\x00\x99\x00\x7f\x00\x19\x00\x70\x00\xa5\x00\xa6\x00\xa7\x00\x64\x00\x50\x00\x70\x00\x4e\x00\x0d\x01\xcc\x00\x0f\x01\x00\x00\x71\x00\x58\x00\x59\x00\x6f\x00\x88\x00\x76\x00\x5d\x00\x2d\x00\x00\x00\x70\x00\x1b\x01\x62\x00\x66\x00\x13\x00\x35\x00\x88\x00\x70\x00\x81\x00\x9d\x00\x9e\x00\x25\x01\xb4\x00\xb5\x00\xb6\x00\x53\x00\xad\x00\xae\x00\xaf\x00\xbb\x00\x70\x00\x31\x01\xbe\x00\xb3\x00\x52\x00\xc1\x00\xc2\x00\x37\x01\x7c\x00\x64\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x35\x00\x19\x00\x6f\x00\x61\x00\x9d\x00\x9e\x00\x02\x01\x03\x01\x04\x01\x05\x01\x6a\x00\x09\x01\x0a\x01\x19\x00\x0c\x01\x0d\x01\x70\x00\x0f\x01\x10\x01\x11\x01\x64\x00\x2d\x00\x9d\x00\x9e\x00\x61\x00\x00\x00\x63\x00\x19\x01\x1a\x01\x1b\x01\x19\x01\x6f\x00\x1b\x01\x2d\x00\x64\x00\x02\x01\x03\x01\x04\x01\x05\x01\x25\x01\xf6\x00\xf7\x00\x25\x01\x00\x00\x28\x01\x6f\x00\xb4\x00\xb5\x00\xb6\x00\x53\x00\x00\x01\x01\x01\x64\x00\xbb\x00\x04\x01\x05\x01\xbe\x00\x79\x00\x99\x00\xc1\x00\xc2\x00\x64\x00\x39\x00\x6f\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x6f\x00\x28\x01\x55\x00\x0d\x01\x0e\x01\x0f\x01\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x31\x01\x54\x00\x4f\x00\x50\x00\x57\x00\x25\x01\x37\x01\x27\x01\x28\x01\x10\x01\x11\x01\x2b\x01\x1a\x00\x19\x01\x1e\x00\x1b\x01\x5d\x00\x31\x01\x32\x01\x33\x01\x34\x01\x62\x00\x07\x01\x62\x00\x7e\x00\x25\x01\x67\x00\x68\x00\x31\x01\x2d\x00\xf6\x00\xf7\x00\x2e\x00\x2f\x00\x37\x01\x14\x01\x6f\x00\x16\x01\x17\x01\x2e\x01\x00\x01\x01\x01\x7e\x00\x64\x00\x04\x01\x05\x01\x19\x01\x20\x01\x1b\x01\x22\x01\x23\x01\x24\x01\x39\x00\x26\x01\x6f\x00\x14\x00\x29\x01\x2a\x01\x25\x01\x6a\x00\x4f\x00\x64\x00\x73\x00\x52\x00\x19\x01\x70\x00\x1b\x01\x69\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x6f\x00\x7e\x00\x4f\x00\x50\x00\x25\x01\x25\x01\x74\x00\x27\x01\x28\x01\x1f\x00\x78\x00\x2b\x01\x31\x00\x32\x00\x33\x00\x7f\x00\x5d\x00\x31\x01\x32\x01\x33\x01\x34\x01\x62\x00\x1e\x00\x99\x00\x2e\x00\x2f\x00\x67\x00\x68\x00\xf1\x00\xf2\x00\xf3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xfd\x00\xfe\x00\x2d\x00\xbb\x00\x70\x00\x02\x01\xbe\x00\x04\x01\x05\x01\xc1\x00\xc2\x00\x4e\x00\x4f\x00\x69\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x76\x00\x77\x00\x74\x00\x00\x01\x01\x01\x6a\x00\x78\x00\x04\x01\x05\x01\x1c\x01\x66\x00\x70\x00\x1f\x01\x6a\x00\x62\x00\x1d\x01\x1e\x01\x1f\x01\x25\x01\x70\x00\x70\x00\x28\x01\x62\x00\x25\x01\xa5\x00\xa6\x00\xa7\x00\x6f\x00\x65\x00\x58\x00\x59\x00\x5a\x00\xf2\x00\xf3\x00\x54\x00\x6f\x00\x5f\x00\xa5\x00\xa6\x00\xa7\x00\xf6\x00\xf7\x00\x27\x01\x28\x01\x70\x00\x5f\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x01\x01\x01\x69\x00\xbb\x00\x04\x01\x05\x01\xbe\x00\x4d\x00\x75\x00\xc1\x00\xc2\x00\x61\x00\x4d\x00\x63\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x62\x00\x69\x00\x39\x00\x1d\x01\x1e\x01\x1f\x01\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x62\x00\x25\x01\x74\x00\x6f\x00\x6a\x00\x25\x01\x78\x00\x27\x01\x28\x01\x6a\x00\x70\x00\x2b\x01\x30\x00\x6f\x00\x62\x00\x70\x00\x76\x00\x31\x01\x32\x01\x33\x01\x34\x01\x76\x00\x66\x00\x3b\x00\x3c\x00\x7a\x00\x62\x00\x6f\x00\x5d\x00\x99\x00\xf6\x00\xf7\x00\x70\x00\x62\x00\x62\x00\x02\x01\x03\x01\x04\x01\x05\x01\x6f\x00\x00\x01\x01\x01\x6b\x00\x23\x00\x04\x01\x05\x01\x1b\x01\x6f\x00\x02\x01\x03\x01\x04\x01\x05\x01\x7e\x00\xfd\x00\xfe\x00\x19\x01\x25\x01\x1b\x01\x02\x01\x4f\x00\x04\x01\x05\x01\x52\x00\x4d\x00\x39\x00\x4f\x00\x6a\x00\x25\x01\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x70\x00\x28\x01\x58\x00\x59\x00\x5a\x00\x25\x01\x99\x00\x27\x01\x28\x01\x5f\x00\x31\x01\x2b\x01\x1c\x01\x3a\x00\x28\x01\x1f\x01\x37\x01\x31\x01\x32\x01\x33\x01\x34\x01\x25\x01\x99\x00\x31\x01\x28\x01\x35\x00\x6c\x00\x71\x00\x5d\x00\x37\x01\x70\x00\x75\x00\x76\x00\x62\x00\x99\x00\x79\x00\x7a\x00\x13\x00\x02\x01\x03\x01\x04\x01\x05\x01\x6b\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x29\x01\x2a\x01\x31\x01\xbb\x00\x02\x00\x2e\x01\xbe\x00\x65\x00\x37\x01\xc1\x00\xc2\x00\x69\x00\x0a\x00\x6b\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x74\x00\x74\x00\x16\x00\x62\x00\x78\x00\x78\x00\x1a\x00\x28\x01\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x1f\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x3f\x00\x40\x00\x2c\x00\x02\x01\x03\x01\x04\x01\x05\x01\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x1e\x01\x1f\x01\x1f\x01\xf4\x00\xf5\x00\xf6\x00\xf7\x00\x25\x01\x25\x01\x27\x01\x28\x01\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x01\x01\x01\x1f\x01\xbb\x00\x04\x01\x05\x01\xbe\x00\x6f\x00\x25\x01\xc1\x00\xc2\x00\x28\x01\x4b\x00\x28\x01\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x19\x01\x39\x00\x1b\x01\x1d\x01\x1e\x01\x1f\x01\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x65\x00\x25\x01\x25\x01\x69\x00\x69\x00\x25\x01\x6b\x00\x27\x01\x28\x01\x0a\x01\x4c\x00\x2b\x01\x0d\x01\x73\x00\x0f\x01\x74\x00\x74\x00\x31\x01\x32\x01\x33\x01\x34\x01\xff\x00\x14\x00\x01\x01\x7e\x00\x4d\x00\x04\x01\x5d\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\x62\x00\x63\x00\x64\x00\x4f\x00\x58\x00\x59\x00\x5a\x00\x53\x00\x00\x01\x01\x01\xfe\x00\x5f\x00\x04\x01\x05\x01\x02\x01\x70\x00\x04\x01\x05\x01\x1c\x01\x31\x00\x32\x00\x1f\x01\x6a\x00\x02\x01\x03\x01\x04\x01\x05\x01\x25\x01\x70\x00\x27\x01\x28\x01\x39\x00\x1c\x01\x75\x00\x76\x00\x1f\x01\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x1c\x01\x25\x01\x6c\x00\x1f\x01\x65\x00\x25\x01\x70\x00\x27\x01\x28\x01\x25\x01\x4c\x00\x2b\x01\x28\x01\x4d\x00\x4f\x00\x4a\x00\x4b\x00\x31\x01\x32\x01\x33\x01\x34\x01\x28\x01\x56\x00\x4e\x00\x58\x00\x59\x00\x5a\x00\x5d\x00\x54\x00\x1e\x01\x1f\x01\x5f\x00\x62\x00\x63\x00\x64\x00\x69\x00\x25\x01\x4b\x00\x27\x01\x28\x01\x4b\x00\x1f\x01\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x74\x00\x25\x01\x11\x00\xbb\x00\x78\x00\x4b\x00\xbe\x00\x75\x00\x76\x00\xc1\x00\xc2\x00\x79\x00\x7a\x00\x4d\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x4e\x00\x4f\x00\x58\x00\x59\x00\x5a\x00\x58\x00\x59\x00\x5a\x00\x87\x00\x5f\x00\x1c\x01\x65\x00\x5f\x00\x1f\x01\x31\x01\x69\x00\x8f\x00\x6b\x00\x4b\x00\x25\x01\x37\x01\x94\x00\x95\x00\x96\x00\x97\x00\x57\x00\x74\x00\x71\x00\x45\x00\x6c\x00\x78\x00\x75\x00\x76\x00\x70\x00\x75\x00\x79\x00\x7a\x00\x7e\x00\x79\x00\x0a\x01\xf6\x00\xf7\x00\x0d\x01\x61\x00\x0f\x01\x63\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x01\x01\x01\x52\x00\xbb\x00\x04\x01\x05\x01\xbe\x00\x8f\x00\x54\x00\xc1\x00\xc2\x00\x70\x00\x39\x00\xbe\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x2d\x00\x2e\x00\x1d\x01\x1e\x01\x1f\x01\xcc\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x25\x01\x6a\x00\x4f\x00\x50\x00\x1f\x01\x25\x01\x6a\x00\x27\x01\x28\x01\x6a\x00\x25\x01\x2b\x01\x27\x01\x28\x01\x4e\x00\x4f\x00\x5d\x00\x31\x01\x32\x01\x33\x01\x34\x01\x62\x00\x78\x00\x79\x00\x6a\x00\x4d\x00\x67\x00\x1d\x01\x1e\x01\x1f\x01\xf6\x00\xf7\x00\x54\x00\x6a\x00\x56\x00\x25\x01\x58\x00\x59\x00\x5a\x00\x4e\x00\x00\x01\x01\x01\x4b\x00\x5f\x00\x04\x01\x05\x01\x22\x01\x23\x01\x24\x01\x70\x00\x26\x01\x6c\x00\x52\x00\x29\x01\x2a\x01\x70\x00\x09\x01\x0a\x01\x2e\x01\x0c\x01\x0d\x01\x71\x00\x0f\x01\x10\x01\x11\x01\x75\x00\x76\x00\x66\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x19\x01\x1a\x01\x1b\x01\x02\x00\x03\x00\x25\x01\x74\x00\x27\x01\x28\x01\x0d\x00\x78\x00\x2b\x01\x25\x01\x1d\x01\x1e\x01\x1f\x01\x6a\x00\x31\x01\x32\x01\x33\x01\x34\x01\x25\x01\x91\x00\x2a\x01\x4d\x00\x4a\x00\x4b\x00\x2e\x01\xb8\x00\xb9\x00\xba\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x58\x00\x59\x00\x5a\x00\xbb\x00\x39\x00\x8f\x00\xbe\x00\x5f\x00\x32\x01\xc1\x00\xc2\x00\x61\x00\x36\x01\x63\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x32\x01\x4c\x00\x32\x01\x71\x00\x36\x01\x6c\x00\x36\x01\x75\x00\x76\x00\x02\x00\x03\x00\x79\x00\x7a\x00\x8f\x00\x87\x00\x65\x00\x89\x00\x8a\x00\x5d\x00\x69\x00\x61\x00\x6b\x00\x63\x00\x62\x00\x63\x00\x6f\x00\xfd\x00\xfe\x00\x8f\x00\x87\x00\x74\x00\x02\x01\x6a\x00\x04\x01\x05\x01\x23\x01\x24\x01\x8f\x00\x26\x01\x66\x00\xf6\x00\xf7\x00\x94\x00\x95\x00\x96\x00\x97\x00\xb8\x00\xb9\x00\xba\x00\x87\x00\x00\x01\x01\x01\xbc\x00\xbd\x00\x04\x01\x05\x01\x61\x00\x1c\x01\x63\x00\x70\x00\x1f\x01\x23\x01\x24\x01\x61\x00\x26\x01\x63\x00\x25\x01\x87\x00\x2a\x01\x28\x01\x6c\x00\x6d\x00\x2e\x01\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x96\x00\x97\x00\xbe\x00\x7f\x00\x61\x00\x25\x01\x63\x00\x27\x01\x28\x01\x4b\x00\x52\x00\x2b\x01\x54\x00\x1d\x01\x1e\x01\x1f\x01\xcc\x00\x31\x01\x32\x01\x33\x01\x34\x01\x25\x01\x4b\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x6c\x00\x6d\x00\x39\x00\xbb\x00\x4b\x00\x61\x00\xbe\x00\x63\x00\x0d\x00\xc1\x00\xc2\x00\x43\x00\x44\x00\xbe\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xbc\x00\xbd\x00\x08\x01\x09\x01\x0a\x01\xcc\x00\x6f\x00\x0d\x01\x4d\x00\x0f\x01\x22\x01\x23\x01\x24\x01\x54\x00\x26\x01\x54\x00\x5d\x00\x56\x00\x52\x00\x58\x00\x59\x00\x62\x00\x15\x00\xe2\x00\xe3\x00\xe4\x00\x5f\x00\xe6\x00\x09\x01\x0a\x01\x6b\x00\x0c\x01\x0d\x01\x71\x00\x0f\x01\x10\x01\x11\x01\x6a\x00\xbc\x00\xbd\x00\xf6\x00\xf7\x00\x62\x00\x70\x00\x19\x01\x1a\x01\x1b\x01\x71\x00\x75\x00\x76\x00\x00\x01\x01\x01\x79\x00\x7a\x00\x04\x01\x05\x01\x25\x01\x22\x01\x23\x01\x24\x01\x6a\x00\x26\x01\x46\x00\x47\x00\x48\x00\x49\x00\x09\x01\x0a\x01\x71\x00\x0c\x01\x0d\x01\x71\x00\x0f\x01\x10\x01\x11\x01\xa0\x00\xa1\x00\xa2\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x19\x01\x1a\x01\x1b\x01\x6a\x00\x61\x00\x25\x01\x63\x00\x27\x01\x28\x01\x6f\x00\x70\x00\x2b\x01\x25\x01\x5a\x00\x5b\x00\x5c\x00\x4b\x00\x31\x01\x32\x01\x33\x01\x34\x01\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x71\x00\x72\x00\x39\x00\xbb\x00\x6c\x00\x61\x00\xbe\x00\x63\x00\x6a\x00\xc1\x00\xc2\x00\xb0\x00\xb1\x00\xb2\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb0\x00\xb1\x00\xb2\x00\xb0\x00\xb1\x00\xb2\x00\x2f\x01\x30\x01\x4d\x00\xb0\x00\xb1\x00\xb2\x00\xb0\x00\xb1\x00\xb2\x00\x6a\x00\x5d\x00\x56\x00\x6a\x00\x58\x00\x59\x00\x62\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\x5f\x00\xfe\x00\x6c\x00\x87\x00\x6b\x00\x02\x01\x6a\x00\x04\x01\x05\x01\x6a\x00\x61\x00\x8f\x00\x63\x00\x6f\x00\xf6\x00\xf7\x00\x94\x00\x95\x00\x96\x00\x97\x00\x10\x01\x11\x01\x75\x00\x76\x00\x00\x01\x01\x01\x79\x00\x7a\x00\x04\x01\x05\x01\x61\x00\x1c\x01\x63\x00\x0c\x00\x1f\x01\xb0\x00\xb1\x00\xb2\x00\x23\x01\x24\x01\x25\x01\x26\x01\x61\x00\x28\x01\x63\x00\x2a\x01\x61\x00\x4b\x00\x63\x00\x2e\x01\x6c\x00\x6d\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x06\x01\xe4\x00\xbe\x00\xe6\x00\x34\x00\x25\x01\x19\x00\x27\x01\x28\x01\xf5\x00\xf6\x00\x2b\x01\x12\x01\x13\x01\xa1\x00\xa2\x00\xcc\x00\x31\x01\x32\x01\x33\x01\x34\x01\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x36\x00\x37\x00\x39\x00\xbb\x00\x23\x01\x24\x01\xbe\x00\x26\x01\x58\x00\xc1\x00\xc2\x00\x2a\x01\x4e\x00\x70\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xb0\x00\xb1\x00\xb2\x00\x71\x00\x87\x00\x70\x00\x08\x01\x09\x01\x0a\x01\x6a\x00\x6a\x00\x0d\x01\x8f\x00\x0f\x01\x6a\x00\x6a\x00\x5d\x00\x94\x00\x95\x00\x96\x00\x97\x00\x62\x00\x6a\x00\x19\x01\xff\x00\x1b\x01\x01\x01\x6a\x00\x6a\x00\x04\x01\x09\x01\x0a\x01\x07\x01\x0c\x01\x0d\x01\x25\x01\x0f\x01\x10\x01\x11\x01\x6a\x00\xf6\x00\xf7\x00\x6a\x00\x70\x00\x13\x01\x39\x00\x19\x01\x1a\x01\x1b\x01\x66\x00\x00\x01\x01\x01\x62\x00\x1c\x01\x04\x01\x05\x01\x1f\x01\x70\x00\x25\x01\xbe\x00\x23\x01\x24\x01\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\xb0\x00\xb1\x00\xb2\x00\x4f\x00\x70\x00\xcc\x00\x54\x00\x17\x00\x4d\x00\x54\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x70\x00\x52\x00\x62\x00\x6a\x00\x62\x00\x25\x01\x70\x00\x27\x01\x28\x01\x57\x00\x4e\x00\x2b\x01\x4f\x00\x4b\x00\x4b\x00\x4e\x00\x4b\x00\x31\x01\x32\x01\x33\x01\x34\x01\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x7f\x00\x66\x00\x4e\x00\xbb\x00\x4b\x00\x4b\x00\xbe\x00\x6a\x00\x6a\x00\xc1\x00\xc2\x00\x71\x00\x57\x00\x71\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x52\x00\x70\x00\x19\x00\x4e\x00\x4e\x00\x09\x01\x0a\x01\x6a\x00\x0c\x01\x0d\x01\x19\x00\x0f\x01\x10\x01\x11\x01\x4f\x00\x74\x00\x1a\x00\x4b\x00\x4b\x00\x7e\x00\x16\x00\x19\x01\x1a\x01\x1b\x01\x7e\x00\x0c\x00\x6f\x00\x69\x00\x4b\x00\x87\x00\x7e\x00\x66\x00\x19\x00\x25\x01\x62\x00\x4b\x00\x4e\x00\x8f\x00\x52\x00\x70\x00\xf6\x00\xf7\x00\x94\x00\x95\x00\x96\x00\x97\x00\xbb\x00\x71\x00\x4e\x00\xbe\x00\x00\x01\x01\x01\xc1\x00\xc2\x00\x04\x01\x05\x01\x4e\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x4e\x00\x4e\x00\x5f\x00\x19\x00\x70\x00\x4f\x00\x19\x00\x07\x00\x4f\x00\x55\x00\x4b\x00\x54\x00\x66\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x57\x00\x52\x00\xbe\x00\x7b\x00\x54\x00\x25\x01\x7f\x00\x27\x01\x28\x01\x6f\x00\x6f\x00\x2b\x01\x62\x00\x87\x00\x52\x00\x19\x00\xcc\x00\x31\x01\x32\x01\x33\x01\x34\x01\x8f\x00\x88\x00\xf6\x00\xf7\x00\x66\x00\x94\x00\x95\x00\x96\x00\x97\x00\x6a\x00\x69\x00\xbe\x00\x00\x01\x01\x01\x19\x00\x6a\x00\x04\x01\x05\x01\x6a\x00\x88\x00\x58\x00\x87\x00\x19\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x8d\x00\xcf\x00\x8f\x00\x55\x00\x87\x00\x6f\x00\x52\x00\x94\x00\x95\x00\x96\x00\x97\x00\x2d\x00\x6f\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x4f\x00\x70\x00\x4b\x00\xbe\x00\x4b\x00\x25\x01\x5f\x00\x27\x01\x28\x01\x19\x00\x07\x00\x2b\x01\x09\x01\x0a\x01\x87\x00\x0c\x01\x0d\x01\xcc\x00\x0f\x01\x10\x01\x11\x01\x19\x00\x07\x00\xf6\x00\xf7\x00\x4e\x00\x5f\x00\x19\x00\x19\x01\x1a\x01\x1b\x01\x7e\x00\xbe\x00\x00\x01\x01\x01\x66\x00\x87\x00\x04\x01\x05\x01\x4b\x00\x25\x01\x4b\x00\x8d\x00\x19\x00\x8f\x00\x6f\x00\xcc\x00\x02\x00\x4e\x00\x94\x00\x95\x00\x96\x00\x97\x00\x1a\x00\x4f\x00\x54\x00\x11\x00\x23\x00\x33\x00\x88\x00\x1a\x00\x07\x00\x1d\x01\x1e\x01\x1f\x01\x7f\x00\x09\x00\x6a\x00\x69\x00\x65\x00\x25\x01\x4d\x00\x27\x01\x28\x01\x69\x00\x2e\x00\x2b\x01\x56\x00\x09\x01\x0a\x01\x57\x00\x0c\x01\x0d\x01\x52\x00\x0f\x01\x10\x01\x11\x01\x6a\x00\x70\x00\x6f\x00\x4e\x00\xbe\x00\x45\x00\x6f\x00\x19\x01\x1a\x01\x1b\x01\x62\x00\x62\x00\x5f\x00\x56\x00\x6a\x00\x69\x00\x62\x00\x4e\x00\xcc\x00\x25\x01\x09\x01\x0a\x01\x88\x00\x0c\x01\x0d\x01\x5f\x00\x0f\x01\x10\x01\x11\x01\x7f\x00\x57\x00\x70\x00\x6a\x00\x70\x00\x02\x00\x6a\x00\x19\x01\x1a\x01\x1b\x01\x87\x00\x6a\x00\x4b\x00\x52\x00\x6a\x00\x6a\x00\x8d\x00\x69\x00\x8f\x00\x25\x01\x56\x00\x52\x00\x19\x00\x94\x00\x95\x00\x96\x00\x97\x00\x07\x00\xfb\x00\xfc\x00\xbe\x00\xfe\x00\x6a\x00\x87\x00\x6a\x00\x02\x01\x19\x00\x04\x01\x05\x01\x8d\x00\x07\x00\x8f\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x94\x00\x95\x00\x96\x00\x97\x00\x09\x01\x0a\x01\x87\x00\x0c\x01\x0d\x01\x4e\x00\x0f\x01\x10\x01\x11\x01\x19\x00\x19\x00\x1c\x01\x75\x00\x4d\x00\x1f\x01\xbe\x00\x19\x01\x1a\x01\x1b\x01\x87\x00\x25\x01\x07\x00\x75\x00\x28\x01\x30\x00\x8d\x00\x2e\x01\x8f\x00\x25\x01\xcc\x00\xd0\x00\xeb\x00\x94\x00\x95\x00\x96\x00\x97\x00\xf6\x00\xf7\x00\xbe\x00\x57\x00\x41\x00\xeb\x00\x38\x00\xeb\x00\x7d\x00\x31\x00\x00\x01\x01\x01\x2c\x01\x32\x00\x04\x01\x05\x01\xcc\x00\x83\x00\x84\x00\x2d\x01\x0f\x01\x87\x00\x7e\x00\x2d\x01\x7a\x00\x8b\x00\x8c\x00\x8d\x00\x7a\x00\x8f\x00\x90\x00\x7e\x00\x9f\x00\x57\x00\x94\x00\x95\x00\x96\x00\x97\x00\xbe\x00\x1d\x01\x1e\x01\x1f\x01\x82\x00\x2e\x01\xce\x00\xc4\x00\x88\x00\x25\x01\x2c\x01\x27\x01\x28\x01\xde\x00\xcc\x00\x2b\x01\x09\x01\x0a\x01\x2d\x01\x0c\x01\x0d\x01\x2d\x01\x0f\x01\x10\x01\x11\x01\x16\x00\x16\x00\x30\x00\x03\x00\x66\x00\xde\x00\xe6\x00\x19\x01\x1a\x01\x1b\x01\x52\x00\x41\x00\x2c\x01\xbe\x00\x09\x01\x0a\x01\x6a\x00\x0c\x01\x0d\x01\x25\x01\x0f\x01\x10\x01\x11\x01\x53\x00\x32\x01\x2c\x01\x32\x01\xcc\x00\x73\x00\x70\x00\x19\x01\x1a\x01\x1b\x01\x2c\x01\x7b\x00\x02\x00\x34\x00\x16\x00\x16\x00\x2c\x00\x20\x00\x28\x01\x25\x01\x0a\x00\x2c\x01\x7a\x00\x7a\x00\x33\x00\x61\x00\x20\x00\x09\x01\x0a\x01\x45\x00\x0c\x01\x0d\x01\x16\x00\x0f\x01\x10\x01\x11\x01\x5c\x00\x69\x00\x1c\x00\x1d\x00\x1e\x00\x65\x00\x88\x00\x19\x01\x1a\x01\x1b\x01\xf6\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x6e\x00\xa4\x00\x2c\x00\x25\x01\x88\x00\x2c\x00\x2c\x01\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x09\x01\x0a\x01\x0e\x00\x0c\x01\x0d\x01\x20\x00\x0f\x01\x10\x01\x11\x01\x20\x00\x6e\x00\xc4\x00\x4d\x00\xa4\x00\xe6\x00\xb2\x00\x19\x01\x1a\x01\x1b\x01\x54\x00\x2d\x01\x56\x00\xa2\x00\x58\x00\x59\x00\x5a\x00\x84\x00\x48\x00\x25\x01\x87\x00\x5f\x00\x17\x00\x17\x00\x35\x00\x8c\x00\x8d\x00\x49\x00\x57\x00\x90\x00\x2c\x01\x31\x01\x6a\x00\x94\x00\x95\x00\x96\x00\x97\x00\x4e\x00\x70\x00\x2c\x01\x4d\x00\x43\x00\xab\x00\x75\x00\x76\x00\x1c\x00\x84\x00\x79\x00\x7a\x00\x87\x00\x32\x01\x73\x00\x74\x00\x2c\x01\x8c\x00\x8d\x00\x1c\x00\x26\x00\x90\x00\x2d\x01\x0b\x00\x2d\x01\x94\x00\x95\x00\x96\x00\x97\x00\x54\x00\x2d\x01\xbe\x00\x32\x01\x2c\x01\x57\x00\xc2\x00\x2c\x01\x52\x00\xbe\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x2d\x01\x2c\x01\x54\x00\x16\x00\x16\x00\xcc\x00\x84\x00\x2c\x01\x2c\x01\x87\x00\x20\x00\x20\x00\xa4\x00\xa4\x00\x8c\x00\x8d\x00\x2d\x01\x4d\x00\x90\x00\x2d\x01\xbe\x00\x2d\x01\x94\x00\x95\x00\x96\x00\x97\x00\x17\x00\x17\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xcc\x00\x5f\x00\x2d\x01\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xf6\x00\xff\xff\xff\xff\x00\x01\x01\x01\x70\x00\xff\xff\x04\x01\x05\x01\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\x79\x00\x7a\x00\xff\xff\xbe\x00\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xcc\x00\x1d\x01\x1e\x01\x1f\x01\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\x31\x01\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xf6\x00\x00\x01\x01\x01\x25\x01\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x31\x01\xff\xff\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\x25\x01\xff\xff\x27\x01\x28\x01\xe9\x00\xea\x00\xff\xff\x84\x00\xff\xff\x25\x01\x87\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8c\x00\x8d\x00\xf6\x00\xf7\x00\x90\x00\xff\xff\x31\x01\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\xff\xff\x84\x00\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8c\x00\x8d\x00\xff\xff\xff\xff\x90\x00\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xbe\x00\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\xcc\x00\x84\x00\xff\xff\xff\xff\x87\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x8c\x00\x8d\x00\xff\xff\x5f\x00\x90\x00\xff\xff\xbe\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\x79\x00\x7a\x00\x4d\x00\x4e\x00\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xbe\x00\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xcc\x00\xff\xff\xff\xff\x71\x00\x19\x01\x1a\x01\x1b\x01\x75\x00\x76\x00\xff\xff\xff\xff\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\x31\x01\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xf6\x00\xff\xff\xff\xff\x25\x01\x8e\x00\xff\xff\xff\xff\x91\x00\x92\x00\x93\x00\xff\xff\xff\xff\x96\x00\x97\x00\xff\xff\x31\x01\x87\x00\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\x93\x00\xff\xff\xff\xff\x96\x00\x97\x00\xff\xff\xac\x00\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x84\x00\xff\xff\x25\x01\x87\x00\xff\xff\xff\xff\xff\xff\xbe\x00\x8c\x00\x8d\x00\xff\xff\xff\xff\x90\x00\xff\xff\x31\x01\x02\x00\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xcc\x00\x87\x00\x0a\x00\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\x16\x00\xff\xff\x96\x00\x97\x00\x1a\x00\xcc\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xbe\x00\xac\x00\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\x25\x01\xff\xff\xff\xff\xff\xff\xf6\x00\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\x32\x01\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x25\x01\xff\xff\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\x32\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\x25\x01\xff\xff\xff\xff\x4d\x00\x4e\x00\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\x31\x01\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\x25\x01\x87\x00\x5f\x00\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\xff\xff\x8f\x00\x90\x00\xff\xff\xff\xff\x32\x01\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\x79\x00\x7a\x00\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\xff\xff\x8f\x00\x90\x00\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\xff\xff\x8f\x00\x90\x00\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xff\xff\xfe\x00\xff\xff\xbe\x00\xff\xff\x02\x01\x87\x00\x04\x01\x05\x01\x8a\x00\xff\xff\x8c\x00\x8d\x00\xff\xff\xff\xff\x90\x00\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\x1c\x01\xbe\x00\xff\xff\x1f\x01\xff\xff\xf9\x00\xfa\x00\xfb\x00\xfc\x00\x25\x01\xfe\x00\xff\xff\x28\x01\xff\xff\x02\x01\xcc\x00\x04\x01\x05\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\x1c\x01\xff\xff\xff\xff\x1f\x01\xcc\x00\xff\xff\x25\x01\x09\x01\x0a\x01\x25\x01\x0c\x01\x0d\x01\x28\x01\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\x31\x01\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\x31\x01\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\x31\x01\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8c\x00\x8d\x00\xff\xff\x25\x01\x90\x00\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xfd\x00\xfe\x00\xff\xff\x31\x01\xff\xff\x02\x01\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8c\x00\x8d\x00\xff\xff\xff\xff\x90\x00\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x1c\x01\xff\xff\xff\xff\x1f\x01\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\x25\x01\x87\x00\xff\xff\x28\x01\xff\xff\xff\xff\x8c\x00\x8d\x00\xff\xff\xff\xff\x90\x00\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\x07\x01\x8c\x00\x8d\x00\xff\xff\xff\xff\x90\x00\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\x14\x01\xff\xff\x16\x01\x17\x01\xff\xff\xff\xff\xff\xff\xf6\x00\xff\xff\xbe\x00\xff\xff\xff\xff\x20\x01\xff\xff\x22\x01\x23\x01\x24\x01\xff\xff\x26\x01\xff\xff\xff\xff\x29\x01\x2a\x01\xcc\x00\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\x31\x01\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\x31\x01\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\x31\x01\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8c\x00\x8d\x00\xff\xff\x25\x01\x90\x00\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x87\x00\x31\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x90\x00\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\x99\x00\x87\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x90\x00\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xbe\x00\x99\x00\x87\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xff\xff\xcc\x00\x94\x00\x95\x00\x96\x00\x97\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x87\x00\xff\xff\x89\x00\xbe\x00\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xcc\x00\xff\xff\xff\xff\xff\xff\xf6\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\x19\x01\x1a\x01\x1b\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\x25\x01\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\x09\x01\x0a\x01\x31\x01\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\x25\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\x09\x01\x0a\x01\x31\x01\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\x25\x01\xff\xff\xff\xff\x4d\x00\x4e\x00\xf6\x00\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\x31\x01\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\x25\x01\xff\xff\x5f\x00\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x19\x01\x1a\x01\x1b\x01\x75\x00\x76\x00\xff\xff\xff\xff\x79\x00\x7a\x00\xff\xff\x23\x01\x24\x01\x25\x01\x26\x01\xff\xff\xff\xff\x29\x01\x2a\x01\x87\x00\xff\xff\x89\x00\x2e\x01\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\x4d\x00\x4e\x00\xff\xff\x9b\x00\x9c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x87\x00\xff\xff\x89\x00\x5f\x00\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\xbe\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\x87\x00\xff\xff\x89\x00\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x83\x00\xff\xff\xff\xff\xcc\x00\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xf6\x00\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xcc\x00\xff\xff\xff\xff\xff\xff\xf6\x00\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\x25\x01\xff\xff\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\x2e\x01\x0f\x01\x10\x01\x11\x01\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x01\xff\xff\xff\xff\x2e\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\x14\x01\xff\xff\x16\x01\x17\x01\xf6\x00\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\x20\x01\xff\xff\x22\x01\x23\x01\x24\x01\xff\xff\x26\x01\x25\x01\xff\xff\x29\x01\x2a\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\x2e\x01\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x83\x00\x19\x01\x1a\x01\x1b\x01\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\x25\x01\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x83\x00\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x83\x00\xbe\x00\xff\xff\x86\x00\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x01\xff\xff\x83\x00\xbe\x00\xff\xff\x86\x00\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\x14\x01\x8f\x00\x16\x01\x17\x01\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x20\x01\xff\xff\x22\x01\x23\x01\x24\x01\xf6\x00\x26\x01\xbe\x00\xff\xff\x29\x01\x2a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\x83\x00\xff\xff\xff\xff\x86\x00\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\x25\x01\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x83\x00\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\x89\x00\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x9a\x00\x9b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\x89\x00\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x9a\x00\x9b\x00\xff\xff\xff\xff\xff\xff\xf6\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\x87\x00\xff\xff\x89\x00\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\x25\x01\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\x9b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x89\x00\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\x9b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\x89\x00\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\xff\xff\x07\x01\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\x89\x00\xff\xff\x8b\x00\xff\xff\x8d\x00\x14\x01\x8f\x00\x16\x01\x17\x01\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x20\x01\x9b\x00\x22\x01\x23\x01\x24\x01\xf6\x00\x26\x01\xbe\x00\xff\xff\x29\x01\x2a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\x87\x00\xff\xff\x89\x00\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\x25\x01\xff\xff\xbe\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\x9b\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\x87\x00\xff\xff\x89\x00\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9e\x00\xff\xff\xe9\x00\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\x89\x00\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xf6\x00\xf7\x00\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\x89\x00\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xf6\x00\xff\xff\xbe\x00\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\x87\x00\xff\xff\x89\x00\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\x25\x01\xff\xff\xbe\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xa3\x00\x87\x00\xff\xff\x89\x00\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xf6\x00\xf7\x00\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xf6\x00\xff\xff\xbe\x00\x25\x01\xa3\x00\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\x25\x01\xff\xff\xbe\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xa3\x00\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xa3\x00\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xf6\x00\xf7\x00\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xbe\x00\xff\xff\xa3\x00\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xf6\x00\xff\xff\xbe\x00\x25\x01\xa3\x00\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\x87\x00\xff\xff\x89\x00\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\x25\x01\xff\xff\xbe\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xa3\x00\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xf6\x00\xf7\x00\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xf6\x00\xff\xff\xbe\x00\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\x25\x01\xff\xff\xbe\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x8d\x00\xff\xff\x8f\x00\xf6\x00\xf7\x00\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xf6\x00\xff\xff\xbe\x00\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\x8f\x00\x0f\x01\x10\x01\x11\x01\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\x8f\x00\x0f\x01\x10\x01\x11\x01\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\x25\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\x8f\x00\x0f\x01\x10\x01\x11\x01\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\x8f\x00\x0f\x01\x10\x01\x11\x01\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\x25\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\x8f\x00\x0f\x01\x10\x01\x11\x01\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\x8f\x00\x0f\x01\x10\x01\x11\x01\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\x25\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\x87\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8f\x00\xff\xff\xff\xff\xcc\x00\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\x87\x00\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\x94\x00\x95\x00\x96\x00\x97\x00\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xff\xff\xff\xff\xff\xff\x25\x01\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xcc\x00\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\x19\x01\x1a\x01\x1b\x01\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\x09\x01\x0a\x01\xff\xff\x0c\x01\x0d\x01\xff\xff\x0f\x01\x10\x01\x11\x01\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x19\x01\x1a\x01\x1b\x01\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\x73\x00\x74\x00\x75\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\x7e\x00\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\x6f\x00\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\x43\x00\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\x06\x00\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\x06\x00\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\x14\x00\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x6a\x00\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\x6c\x00\x6d\x00\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x6a\x00\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x6a\x00\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\x6c\x00\x6d\x00\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\x4e\x00\x4f\x00\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x62\x00\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\x6f\x00\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\x6f\x00\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\x17\x00\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\xff\xff\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\x51\x00\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\xff\xff\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x60\x00\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x60\x00\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\xff\xff\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\xff\xff\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\x01\x00\x02\x00\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\x0a\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x02\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\x01\x00\x02\x00\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\x0a\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\x73\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\xff\xff\x01\x00\x02\x00\xff\xff\x8b\x00\x8c\x00\x8d\x00\x8e\x00\xff\xff\x90\x00\x0a\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x54\x00\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x6a\x00\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\x6c\x00\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x6a\x00\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xe9\x00\xea\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x1d\x01\x1e\x01\x1f\x01\x65\x00\x66\x00\xff\xff\xff\xff\x69\x00\x25\x01\x6b\x00\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x1d\x01\x1e\x01\x1f\x01\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x25\x01\x6b\x00\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x0a\x00\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x1d\x01\x1e\x01\x1f\x01\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x25\x01\x6b\x00\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x0a\x00\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x1d\x01\x1e\x01\x1f\x01\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x25\x01\x6b\x00\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x0a\x00\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x1d\x01\x1e\x01\x1f\x01\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x25\x01\x6b\x00\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x0a\x00\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x1d\x01\x1e\x01\x1f\x01\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x25\x01\x6b\x00\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x0a\x00\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x1d\x01\x1e\x01\x1f\x01\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x25\x01\x6b\x00\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x1d\x01\x1e\x01\x1f\x01\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x25\x01\x6b\x00\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x0a\x00\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x1d\x01\x1e\x01\x1f\x01\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x25\x01\x6b\x00\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x6a\x00\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x0a\x00\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x1d\x01\x1e\x01\x1f\x01\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x25\x01\x6b\x00\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xbe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\x4c\x00\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\x1d\x01\x1e\x01\x1f\x01\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x25\x01\x6b\x00\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x88\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x88\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x87\x00\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x88\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x88\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x16\x00\xff\xff\x97\x00\x98\x00\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x02\x00\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\x0a\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\x73\x00\xff\xff\xff\xff\x97\x00\x98\x00\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\x7e\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x02\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x02\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\x73\x00\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7e\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x02\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7e\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\x7e\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\x02\x00\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\x71\x00\xff\xff\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\x01\x00\x02\x00\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\x71\x00\xff\xff\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\x78\x00\xff\xff\x7a\x00\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x02\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\xff\xff\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\x13\x00\xff\xff\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x2f\x00\x69\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x02\x00\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x69\x00\x02\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\x0a\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x02\x00\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x69\x00\x02\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\x0a\x00\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x65\x00\x02\x00\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x02\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\x77\x00\x78\x00\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\x65\x00\x02\x00\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x02\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\x78\x00\x4c\x00\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x02\x00\x69\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\xff\xff\xff\xff\x73\x00\xff\xff\xff\xff\xff\xff\x77\x00\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\xbe\x00\xbf\x00\xc0\x00\x77\x00\xc2\x00\xc3\x00\x4d\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\x58\x00\x59\x00\x5a\x00\xd2\x00\xd3\x00\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x6a\x00\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\x07\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x01\x16\x01\xff\xff\x18\x01\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\x21\x01\x22\x01\x23\x01\x24\x01\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\x2e\x01\x02\x00\x30\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\x0a\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\x16\x00\xff\xff\xd2\x00\xd3\x00\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\x07\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x54\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x01\x16\x01\xff\xff\x18\x01\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\x21\x01\x22\x01\x23\x01\x24\x01\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2b\x01\xff\xff\x73\x00\x2e\x01\xff\xff\x30\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xd2\x00\xd3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\x07\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x01\x16\x01\xff\xff\x18\x01\xff\xff\xff\xff\x02\x00\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\x21\x01\x22\x01\x0a\x00\x24\x01\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2b\x01\x13\x00\xff\xff\x2e\x01\x16\x00\x30\x01\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x02\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x02\x00\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x65\x00\xff\xff\x2c\x00\xff\xff\x69\x00\x02\x00\x6b\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x02\x00\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x65\x00\xff\xff\x2c\x00\xff\xff\x69\x00\x02\x00\x6b\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\x02\x00\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x65\x00\xff\xff\x2c\x00\xff\xff\x69\x00\x02\x00\x6b\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\x0a\x00\xff\xff\xff\xff\x53\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\x61\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x70\x00\xff\xff\x2c\x00\x73\x00\xff\xff\x02\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x02\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\x73\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x02\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\x73\x00\x1a\x00\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x02\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\x73\x00\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x02\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\xff\xff\x73\x00\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\xff\xff\xff\xff\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xbf\x00\xc0\x00\x73\x00\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdf\x00\xe0\x00\xe1\x00\xff\xff\xff\xff\x69\x00\xff\xff\xff\xff\xe7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xd2\x00\x1d\x01\x1e\x01\x1f\x01\xd6\x00\xd7\x00\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\x2c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\x07\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x01\x16\x01\xff\xff\x18\x01\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\x21\x01\x22\x01\xff\xff\x24\x01\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2b\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xd2\x00\xff\xff\xff\xff\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\x07\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x01\x16\x01\xff\xff\x18\x01\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\x21\x01\x22\x01\xff\xff\x24\x01\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2b\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xd2\x00\xff\xff\xff\xff\xd5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\x07\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x01\x16\x01\xff\xff\x18\x01\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\x21\x01\x22\x01\xff\xff\x24\x01\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2b\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xd2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\x07\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x01\x16\x01\xff\xff\x18\x01\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\x21\x01\x22\x01\xff\xff\x24\x01\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2b\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xd2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\x07\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x01\x16\x01\xff\xff\x18\x01\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\x21\x01\x22\x01\xff\xff\x24\x01\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2b\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xd2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\x07\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x01\x16\x01\xff\xff\x18\x01\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\x21\x01\x22\x01\xff\xff\x24\x01\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2b\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xd2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\x07\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x01\x16\x01\xff\xff\x18\x01\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\x21\x01\x22\x01\xff\xff\x24\x01\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2b\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xd2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\x07\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x01\x16\x01\xff\xff\x18\x01\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\x21\x01\x22\x01\xff\xff\x24\x01\x25\x01\x26\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2b\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xe8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf0\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xd9\x00\xda\x00\xdb\x00\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xe8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf0\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xe8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xee\x00\xef\x00\xf0\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xe8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xed\x00\xff\xff\xef\x00\xf0\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xe8\x00\xff\xff\xff\xff\xff\xff\xec\x00\xff\xff\xff\xff\xef\x00\xf0\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xe8\x00\xff\xff\xff\xff\xff\xff\xec\x00\xff\xff\xff\xff\xef\x00\xf0\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xdc\x00\xdd\x00\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xe8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf0\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xdf\x00\xe0\x00\xe1\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xe7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xdc\x00\xdd\x00\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xe8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf0\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xdf\x00\xe0\x00\xe1\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xe7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xe4\x00\xe5\x00\xe6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xe8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xef\x00\xf0\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xe8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf0\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xe8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf0\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xe1\x00\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xe7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xe7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xe7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xe7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xbf\x00\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xff\xff\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xff\xff\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xff\xff\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xbe\x00\xff\xff\xc0\x00\xff\xff\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xbe\x00\xff\xff\x04\x01\x05\x01\xc2\x00\xc3\x00\xff\xff\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x01\x01\xff\xff\xff\xff\x04\x01\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x01\x1e\x01\x1f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\xff\xff\x27\x01\x28\x01\xff\xff\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++happyTable :: HappyAddr+happyTable = HappyA# "\x00\x00\x70\x00\x83\x05\x8f\x02\x41\x05\x42\x05\x9b\x04\x93\x04\x85\x05\x4a\x04\x8e\x04\x8b\x04\x8a\x04\x8b\x04\x8c\x04\x0d\x01\x8c\x04\x0e\x01\x59\x03\x25\x05\x3e\x05\x3f\x05\x8c\x04\x0f\x01\x10\x01\x11\x01\x2d\x00\x2e\x00\x8c\x05\x12\x01\x10\x02\x11\x02\x12\x02\xf8\x04\x2f\x00\x87\x05\x30\x00\xf0\x02\x88\x05\xac\x04\x11\x02\x12\x02\xab\x04\x11\x02\xc8\x03\x21\x05\xac\x04\x11\x02\x12\x02\xac\x04\x11\x02\x12\x02\x2b\x03\xfa\x03\x90\x04\x91\x04\x92\x04\x93\x04\x64\x05\x91\x04\x92\x04\x93\x04\x66\x04\x68\x05\x91\x04\x92\x04\x93\x04\x2f\x03\x30\x03\x80\x05\x81\x05\x93\x04\x29\x03\xee\x01\x31\x05\x93\x04\x25\x04\x26\x04\x26\x05\x93\x04\x42\x03\x54\x02\xf2\x01\xf3\x01\x45\x04\xf2\x04\xc0\xff\x59\x05\x85\x02\x86\x02\x71\x05\x16\x04\x0e\x02\x8c\x03\x7a\x01\x6b\x05\x8e\x04\x41\x04\x26\x04\x85\x02\x86\x02\xc0\xff\x61\x02\x54\x03\x55\x01\x5a\x03\x5d\x03\xc1\xfc\x7d\x02\xbb\xff\x6f\x04\x70\x04\x40\x00\xdb\x04\x51\x03\x41\xfe\x78\x05\xed\x02\xc1\xfc\xb2\x02\x40\x00\x02\x03\x9c\x04\xc1\xfc\xc0\xff\x62\x03\x41\x00\x9d\x04\x9e\x04\x35\x05\x36\x05\x37\x05\x38\x05\x9e\x04\x41\x00\xc0\xff\x82\x05\x38\x05\x9e\x04\x36\x01\xfb\x03\xe5\x03\x34\x00\x16\x03\x17\x03\x83\x03\x06\x01\x16\x03\x17\x03\xc5\x02\xb8\x01\x33\x02\x06\x01\x93\x02\x79\x05\x37\x01\x56\x01\x03\x03\xc0\xff\x8e\x04\xd3\x02\xfc\x02\x35\x00\x06\x01\x14\x01\x56\x01\xac\x03\x34\x00\xf4\x04\x26\x04\xb3\x02\x06\x01\x62\x02\x0e\x02\x5a\x05\x67\x04\x63\x03\x34\x00\x78\x01\x33\x00\xf3\x04\x34\x02\x6c\x05\x7e\x02\x1e\x02\xf3\x01\xfd\x02\x43\x00\x44\x00\xbb\xff\x52\x03\x46\x00\x0f\x02\x47\x00\x43\x03\x43\x00\x44\x00\x07\x01\x7e\x02\x46\x00\x7f\x02\x47\x00\x34\x00\x4a\x00\x36\x03\x4c\x00\xf4\x01\x90\x02\x4c\x00\x1f\x04\x16\x01\x4a\x00\x0d\x01\x4c\x00\xf4\x01\x4d\x00\x4c\x00\x34\x00\x4d\x00\x91\x02\x92\x02\x37\x00\x4b\x04\x4d\x00\x31\x03\xec\x01\x4d\x00\x20\x01\xff\xff\xf1\x02\x15\x01\x71\x04\x4d\x00\x11\x00\x2f\x01\x11\x00\xd7\x01\x7a\x00\x88\x02\x7b\x00\x34\x00\x4b\x04\xec\x01\x93\x02\xf1\x02\xf9\x04\xec\x01\x27\x04\x5b\x03\x87\x02\x11\x00\x4d\x00\x71\x04\x11\x00\xaf\x01\x4d\x00\xb0\x01\x71\x00\x72\x00\x9f\x02\x2a\x03\x73\x00\x74\x00\x20\x01\x75\x00\x68\x04\x69\x04\x47\x00\x27\x04\x11\x00\x1d\x03\x51\x05\x2a\x03\x0f\x02\x11\x00\x20\x01\x94\x04\xec\x01\x95\x04\x96\x04\x76\x00\x11\x00\xfe\x02\x5b\x03\x10\x02\xf9\x02\x0e\x00\x0f\x00\x10\x00\x77\x00\x40\x05\x78\x00\x79\x00\x7a\x00\x11\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x43\x05\xff\xff\x0e\x02\x43\x05\x31\x00\x22\x02\x31\x00\x31\x00\xf4\x01\x40\x05\x4c\x00\xec\x01\x31\x00\xfe\x01\x31\x00\x13\x02\x31\x00\x5b\x03\xff\x02\xec\x01\x4d\x00\xfa\x02\x7f\x03\xf3\x01\x13\x02\x5b\x03\x94\x04\x13\x02\x95\x04\x96\x04\x94\x04\x13\x02\x95\x04\x96\x04\x13\x02\x94\x04\x18\x02\x95\x04\x96\x04\x27\x04\x94\x04\xff\xff\x95\x04\x96\x04\x94\x04\x11\x00\x95\x04\x96\x04\x94\x04\x10\x02\x95\x04\x96\x04\x9f\x04\xfb\x01\xa0\x04\xe2\x02\x47\x00\x9f\x04\xfa\x01\xa0\x04\x31\x03\x47\x00\x9f\x04\x20\x01\xa0\x04\x31\x03\x47\x00\x67\x01\x20\x01\x11\x00\xa1\x04\x0f\x00\x10\x00\xaf\x02\x11\x00\xa1\x04\x0f\x00\x10\x00\x11\x00\x0e\x02\xa1\x04\x0f\x00\x10\x00\x11\x00\xb8\x01\xce\x00\x87\x04\xeb\x01\x11\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\x81\x02\xf4\x01\x2c\x04\x4c\x00\x6a\x01\x30\x01\x31\x01\x73\x00\x1e\x01\x0f\x02\x01\x02\x27\x01\x28\x01\x4d\x00\xff\x01\xe9\x00\x1d\x01\x23\x02\x73\x00\x1e\x01\x20\x01\xb0\x02\x37\x00\xea\x00\xeb\x00\x00\x02\x11\x00\x2d\x04\xec\x00\x00\x02\xe3\x02\xf2\x01\x0e\x02\xcf\x00\x32\x01\x38\x01\x3d\x00\x3e\x00\x3f\x00\x24\x03\x11\x00\x93\xfe\x1f\x01\x21\x01\x93\xfe\x20\x01\x58\x03\x54\x03\xf3\x01\x95\xfe\xf7\x01\x11\x00\xe3\x03\xf4\x01\x21\x01\x4c\x00\x50\x05\x83\x03\x81\x00\xed\x00\x95\xfe\x0e\x02\xf1\x01\x23\x02\xce\x00\x4d\x00\x20\x01\x77\x02\x87\x03\xe6\x00\xe7\x00\xe8\x00\x11\x00\x78\x02\x03\x02\x0e\x02\xbb\x03\x40\x00\x28\x02\xff\xff\x25\x03\x14\x01\xe4\x03\xc9\x04\xc5\x04\xc6\x04\x0f\x02\xe9\x00\x29\x02\x7e\x03\xdb\x01\x41\x00\x47\x00\x0e\x02\xef\x02\xea\x00\xeb\x00\xa5\x03\x07\x01\x8c\x00\xec\x00\x15\x01\x0e\x02\x79\x02\xdc\x01\xcf\x00\xa1\x01\xaf\x04\x04\x02\x07\x01\x7f\x03\x4c\x01\x39\x03\xf3\x01\x4d\x00\xee\x00\xef\x00\xf0\x00\x8a\xfd\xe9\x01\xea\x01\xeb\x01\xf1\x00\x7f\x03\xec\x01\x8f\x00\xc3\x04\x67\x01\xf2\x00\xd2\x00\xed\x01\xed\x00\x0f\x02\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\xb0\x04\xed\x04\x7a\x03\xbe\x01\xf8\x03\xf3\x01\x6b\x01\xc7\x04\x73\x00\x1e\x01\xc3\x02\x43\x00\x44\x00\xec\x04\x45\x00\x46\x00\x6a\x01\x47\x00\x48\x00\x49\x00\x0f\x02\x15\x01\x13\x05\xf3\x01\x7e\x01\x0e\x02\x7f\x01\x4a\x00\x4b\x00\x4c\x00\xf4\x01\x78\x03\x4c\x00\x15\x01\x0f\x02\x6b\x01\xc7\x04\x73\x00\x1e\x01\x4d\x00\xa1\x00\xa2\x00\x4d\x00\x0e\x02\x21\x01\xd6\x04\xee\x00\xef\x00\xf0\x00\xbd\x01\xa3\x00\x72\x00\x0f\x02\xf1\x00\x73\x00\x74\x00\x8f\x00\x1f\x03\xff\xff\xf2\x00\xd2\x00\x0f\x02\xce\x00\xcc\x04\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\xab\x04\x21\x01\xbc\x01\x68\x04\x69\x04\x47\x00\xd3\x00\xa4\x00\x0f\x00\xd4\x00\xec\x01\xf9\x01\x4e\x04\x4f\x04\x95\xfe\x11\x00\xc8\x04\x7c\x00\x7d\x00\x8d\x02\x49\x00\xa5\x00\x0d\x03\xf4\x01\x33\x05\x4c\x00\xec\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xcf\x00\x4d\x01\xa4\x03\xac\x01\x4d\x00\x50\x04\x55\x04\xec\x01\x00\x02\xa1\x00\xa2\x00\x0e\x03\x0f\x03\xed\x01\x4e\x01\xa5\x03\x4f\x01\x50\x01\xe4\x01\xa3\x00\x72\x00\xa9\x01\x0f\x02\x73\x00\x74\x00\xf4\x01\x77\x00\x4c\x00\x78\x00\x79\x00\x7a\x00\xce\x00\x7b\x00\x7a\x03\x44\x01\x7e\x00\x7f\x00\x4d\x00\x48\x02\xd2\x02\x0f\x02\xaa\x01\xd3\x02\xf4\x01\x2c\x02\x4c\x00\xe1\x02\xd3\x00\xa4\x00\x0f\x00\xd4\x00\x5f\x05\xab\x01\x4e\x04\x4f\x04\x4d\x00\x11\x00\x64\x00\x7c\x00\x7d\x00\x08\x02\x67\x00\xa5\x00\x45\x01\x46\x01\x47\x01\x83\x01\xec\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xcf\x00\x32\x05\xff\xff\x09\x02\x0a\x02\x50\x04\x51\x04\x55\x02\x56\x02\x57\x02\xee\x00\xef\x00\xa1\x02\x52\x04\x2b\x01\x28\x01\x00\x02\xf1\x00\x80\x01\x1d\x01\x8f\x00\x73\x00\x1e\x01\xa3\x02\xd2\x00\x3d\x03\x3e\x03\x6e\x04\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa4\x02\x9b\x00\x9c\x00\x25\x01\x26\x01\x64\x00\x2b\x05\x72\x00\x2e\x02\x67\x00\x73\x00\x74\x00\x1f\x01\x2e\x04\x2f\x02\x20\x01\x2b\x02\x79\x03\x58\x02\x0f\x00\x10\x00\x11\x00\x2c\x02\x2f\x04\x21\x01\x77\x03\x11\x00\xc4\x04\xc5\x04\xc6\x04\x7a\x03\x78\x01\x82\x00\x83\x00\x84\x00\xd0\x03\x57\x02\x21\x02\x78\x03\x85\x00\x4e\x05\xc5\x04\xc6\x04\xa1\x00\xa2\x00\x7c\x00\x7d\x00\x0f\xfd\x22\x02\xee\x00\xef\x00\xa1\x02\x52\x04\xa3\x00\x72\x00\x48\x01\xf1\x00\x73\x00\x74\x00\x8f\x00\x81\x00\x8b\x00\xa3\x02\xd2\x00\xaf\x01\x81\x00\xb0\x01\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa4\x02\x9b\x00\x9c\x00\xd5\x04\xe1\x02\xce\x00\x58\x02\x0f\x00\x10\x00\xd3\x00\xa4\x00\x0f\x00\xd4\x00\xcb\x04\x11\x00\x64\x00\xd6\x04\x69\x01\x11\x00\x67\x00\x7c\x00\x7d\x00\x69\x01\x6a\x01\xa5\x00\x11\x03\xcc\x04\xaa\x04\x6a\x01\x8c\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x8c\x00\x7a\x05\x12\x03\x13\x03\x8f\x00\xf6\x04\xab\x04\xec\x00\xff\xff\xa1\x00\xa2\x00\x7b\x05\xcf\x00\x5e\x05\x6b\x01\xc7\x04\x73\x00\x1e\x01\x7a\x03\xa3\x00\x72\x00\xa8\x02\x49\x01\x73\x00\x74\x00\x61\x05\x5f\x05\x6b\x01\xc7\x04\x73\x00\x1e\x01\x2f\x01\x27\x01\x28\x01\x1d\x02\x4d\x00\x4c\x00\x1d\x01\x9b\xfe\x73\x00\x1e\x01\x9b\xfe\x81\x00\xce\x00\x40\x04\x7d\x05\x4d\x00\xd3\x00\xa4\x00\x0f\x00\xd4\x00\x7e\x05\x21\x01\x82\x00\x83\x00\x84\x00\x11\x00\xff\xff\x7c\x00\x7d\x00\x85\x00\xec\x01\xa5\x00\x1f\x01\x1b\x01\x21\x01\x20\x01\xc8\x04\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x11\x00\xff\xff\xec\x01\x21\x01\x19\x01\x9c\x01\x53\x01\xec\x00\xc8\x04\x6a\x01\x8b\x00\x8c\x00\xcf\x00\xff\xff\x8e\x00\x8f\x00\x18\x01\x6b\x01\x31\x01\x73\x00\x1e\x01\xa0\x02\xee\x00\xef\x00\xa1\x02\xa2\x02\xcc\x01\x7f\x00\xec\x01\xf1\x00\x13\x00\xcd\x01\x8f\x00\x87\x01\x25\x02\xa3\x02\xd2\x00\x88\x01\x14\x00\x89\x01\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa4\x02\x9b\x00\x9c\x00\x64\x00\x06\x02\x15\x00\x11\x03\x67\x00\x07\x02\x16\x00\x21\x01\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x0a\x03\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x16\x03\x17\x03\x24\x00\x6b\x01\x6c\x01\x73\x00\x1e\x01\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xc8\x01\x10\x00\x2e\x03\xa9\x02\xa6\x02\xa7\x02\xa2\x00\x11\x00\x11\x00\xc9\x01\x7d\x00\xee\x00\xef\x00\xa1\x02\xa2\x02\xa3\x00\x72\x00\x36\x02\xf1\x00\x73\x00\x74\x00\x8f\x00\x0c\x02\x11\x00\xa3\x02\xd2\x00\x2d\x03\x08\x03\x21\x01\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa4\x02\x9b\x00\x9c\x00\x0d\x04\xce\x00\x4c\x00\x0e\x00\x0f\x00\x10\x00\xd3\x00\xa4\x00\x0f\x00\xd4\x00\x86\x00\x11\x00\x4d\x00\x25\x02\x34\x01\x11\x00\x88\x00\x7c\x00\x7d\x00\xdf\x02\x58\x04\xa5\x00\x46\x00\x2c\x00\x47\x00\x8a\x00\x64\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xd1\x01\x6b\x04\xd2\x01\x36\x03\x81\x00\xd3\x01\xec\x00\xa5\x02\xa6\x02\xa7\x02\xa2\x00\xcf\x00\x59\x04\x5f\x04\xf4\x02\x82\x00\x83\x00\x84\x00\xf5\x02\xa3\x00\x72\x00\x1c\x01\x85\x00\x73\x00\x74\x00\x1d\x01\x00\x03\x73\x00\x1e\x01\xd6\x01\x6c\x04\x6d\x04\x20\x01\x69\x01\x6b\x01\x68\x03\x73\x00\x1e\x01\x11\x00\x6a\x01\x7c\x00\x7d\x00\xce\x00\x1d\x04\x8b\x00\x8c\x00\x20\x01\xd3\x00\xa4\x00\x0f\x00\xd4\x00\x1f\x01\x11\x00\x8d\x02\x20\x01\xf8\x02\x11\x00\x6a\x01\x7c\x00\x7d\x00\x11\x00\x58\x04\xa5\x00\x21\x01\x28\x05\xe6\x02\xfd\x04\xfb\x04\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x21\x01\x29\x05\xf0\x02\x82\x00\x83\x00\x84\x00\xec\x00\xf9\x01\xbb\x02\x10\x00\x85\x00\xcf\x00\x59\x04\x5a\x04\x6e\x04\x11\x00\xde\x02\xc9\x01\x7d\x00\xdd\x02\x40\x04\xee\x00\xef\x00\xa1\x02\x5b\x04\x64\x00\x11\x00\xda\x02\xf1\x00\x67\x00\xdc\x02\x8f\x00\x8b\x00\x2a\x05\xa3\x02\xd2\x00\x8e\x00\x2b\x05\x81\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa4\x02\x9b\x00\x9c\x00\x09\x05\x0a\x05\x82\x00\x83\x00\x84\x00\x82\x00\x83\x00\x84\x00\x37\x00\x85\x00\xed\x03\x86\x00\x85\x00\x20\x01\xec\x01\x2d\x05\xe3\x02\x88\x00\xdb\x02\x11\x00\xbc\x04\x38\x01\x3d\x00\x3e\x00\x3f\x00\xd4\x02\x8a\x00\x53\x01\x56\x01\x4b\x02\x8d\x00\x8b\x00\x8c\x00\x2c\x02\x8b\x00\x8e\x00\x8f\x00\xc6\x02\x8e\x00\x2d\x05\xa1\x00\xa2\x00\x46\x00\x8d\x01\x47\x00\x8e\x01\xee\x00\xef\x00\xa1\x02\x5b\x04\xa3\x00\x72\x00\xd6\x02\xf1\x00\x73\x00\x74\x00\x8f\x00\x84\x02\xc5\x02\xa3\x02\xd2\x00\xbb\x02\xce\x00\x40\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa4\x02\x9b\x00\x9c\x00\x7f\x04\x80\x04\x74\x01\x0f\x00\x10\x00\x41\x00\xd3\x00\xa4\x00\x0f\x00\xd4\x00\x11\x00\xc2\x02\x4e\x04\x4f\x04\x36\x02\x11\x00\x4a\x02\x7c\x00\x7d\x00\xc0\x02\x11\x00\xa5\x00\xc9\x01\x7d\x00\x09\x05\x57\x05\xec\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xcf\x00\x29\x01\x2a\x01\xfb\xfc\x81\x00\x02\x05\xb0\x02\x0f\x00\x10\x00\xa1\x00\xa2\x00\x95\x02\x49\x02\x96\x02\x11\x00\x82\x00\x83\x00\x84\x00\xba\x02\xa3\x00\x72\x00\xb8\x02\x85\x00\x73\x00\x74\x00\xcb\x01\x9c\x01\x7a\x00\xb6\x02\x7b\x00\x30\x02\xb7\x02\xcc\x01\x7f\x00\x2c\x02\x43\x00\x44\x00\xcd\x01\x45\x00\x46\x00\x97\x02\x47\x00\x48\x00\x49\x00\x8b\x00\x8c\x00\xe9\x01\xd3\x00\xa4\x00\x0f\x00\xd4\x00\x4a\x00\x4b\x00\x4c\x00\xfe\x01\xfc\x01\x11\x00\x06\x02\x7c\x00\x7d\x00\x66\x02\x07\x02\xa5\x00\x4d\x00\xad\x02\x0f\x00\x10\x00\x8c\x02\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x11\x00\x8b\x02\xb4\x02\x81\x00\xfa\x04\xfb\x04\xcd\x01\x06\x03\xcf\x02\xd0\x02\xee\x00\xef\x00\xa1\x02\x52\x04\x82\x00\x83\x00\x84\x00\xf1\x00\xce\x00\x8a\x02\x8f\x00\x85\x00\xcb\x03\xa3\x02\xd2\x00\x7e\x01\xcc\x03\x7f\x01\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa4\x02\x9b\x00\x9c\x00\xcb\x03\x58\x04\xcb\x03\x53\x01\x88\x04\x7d\x02\x4c\x05\x8b\x00\x8c\x00\xfb\x01\xfc\x01\x8e\x00\x8f\x00\x85\x02\x06\x01\x86\x00\x08\x01\x09\x01\xec\x00\x34\x01\x71\x02\x88\x00\x72\x02\xcf\x00\x0a\x05\xc1\xfc\x2b\x01\x28\x01\x83\x02\x37\x00\x8a\x00\x1d\x01\x7a\x02\x73\x00\x1e\x01\x38\x02\x7a\x00\xe3\x02\x7b\x00\x76\x02\xa1\x00\xa2\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\xce\x02\xcf\x02\xd0\x02\x06\x01\xa3\x00\x72\x00\x7a\x01\x76\x01\x73\x00\x74\x00\x14\x04\x1f\x01\x15\x04\x75\x02\x20\x01\x38\x02\x7a\x00\x0c\x04\x7b\x00\x0d\x04\x11\x00\x37\x00\xb4\x02\x21\x01\x7b\x01\xb2\x01\xcd\x01\xe8\x02\xe9\x02\xea\x02\xeb\x02\xec\x02\xd3\x00\xa4\x00\x0f\x00\xd4\x00\xf7\x01\x3f\x00\x40\x00\x6e\x02\x7e\x01\x11\x00\x7f\x01\x7c\x00\x7d\x00\x6d\x02\xb8\x01\xa5\x00\xdd\x03\xaa\x02\x0f\x00\x10\x00\x41\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x11\x00\x6c\x02\xee\x00\xef\x00\xa1\x02\x5b\x04\x7b\x01\x7c\x01\xce\x00\xf1\x00\x6b\x02\xc7\x03\x8f\x00\xc8\x03\x66\x02\xa3\x02\xd2\x00\x41\x01\x42\x01\x40\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa4\x02\x9b\x00\x9c\x00\x78\x01\x76\x01\x69\x03\x84\x01\x44\x00\x41\x00\x65\x02\x46\x00\x56\x00\x47\x00\xcb\x01\x9c\x01\x7a\x00\x67\x02\x7b\x00\xe6\x01\xec\x00\x57\x00\xb8\x01\x58\x00\x59\x00\xcf\x00\x5d\x02\xd9\x03\xda\x03\xdb\x03\x5b\x00\xb6\x01\x43\x00\x44\x00\xe2\x04\x45\x00\x46\x00\x4d\x02\x47\x00\x48\x00\x49\x00\x8f\x02\x75\x01\x76\x01\xa1\x00\xa2\x00\x27\x02\x6a\x01\x4a\x00\x4b\x00\x4c\x00\x4c\x02\x65\x00\x66\x00\xa3\x00\x72\x00\x68\x00\x69\x00\x73\x00\x74\x00\x4d\x00\xcb\x01\x9c\x01\x7a\x00\x4a\x02\x7b\x00\x3e\x01\x3f\x01\x40\x01\x41\x01\x43\x00\x44\x00\x36\x02\x45\x00\x46\x00\x35\x02\x47\x00\x48\x00\x49\x00\x49\x03\x4a\x03\x4b\x03\xd3\x00\xa4\x00\x0f\x00\xd4\x00\x4a\x00\x4b\x00\x4c\x00\x49\x02\x64\x04\x11\x00\x65\x04\x7c\x00\x7d\x00\x2c\x01\x2d\x01\xa5\x00\x4d\x00\x3e\x03\x3f\x03\x40\x03\xcc\x04\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xee\x00\xef\x00\xa1\x02\xa2\x02\xf5\x02\xf6\x02\xce\x00\xf1\x00\x32\x02\x44\x04\x8f\x00\x45\x04\x47\x02\xa3\x02\xd2\x00\xfe\x03\xff\x03\x00\x04\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa4\x02\x9b\x00\x9c\x00\x72\x04\xff\x03\x00\x04\x65\x04\xff\x03\x00\x04\x64\x03\x65\x03\x56\x00\xb9\x04\xff\x03\x00\x04\x6d\x05\xff\x03\x00\x04\x46\x02\xec\x00\x57\x00\x45\x02\x58\x00\x59\x00\xcf\x00\xb3\x02\x6f\x01\x70\x01\x71\x01\x5b\x00\x72\x01\x31\x02\x37\x00\xe1\x04\x1d\x01\x2d\x02\x73\x00\x1e\x01\x2a\x02\xea\x04\xcd\x04\xeb\x04\x0c\x02\xa1\x00\xa2\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\x8d\x02\x49\x00\x65\x00\x66\x00\xa3\x00\x72\x00\x68\x00\x69\x00\x73\x00\x74\x00\xdd\x04\x1f\x01\xde\x04\x0d\x01\x20\x01\x8e\x05\xff\x03\x00\x04\x38\x02\x7a\x00\x11\x00\x7b\x00\x9a\x04\x21\x01\x9b\x04\xb4\x02\xea\x04\x06\x05\xeb\x04\xcd\x01\x7b\x01\x07\x04\xd3\x00\xa4\x00\x0f\x00\xd4\x00\x90\x02\x5d\x02\x40\x00\xb6\x01\xfe\x01\x11\x00\xbf\x03\x7c\x00\x7d\x00\xf1\x03\xf2\x03\xa5\x00\xe7\x03\x92\x02\x56\x04\x4b\x03\x41\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xee\x00\xef\x00\xa1\x02\xa2\x02\xef\x04\xf0\x04\xce\x00\xf1\x00\xd7\x01\x7a\x00\x8f\x00\x7b\x00\xbe\x03\xa3\x02\xd2\x00\x93\x02\xbd\x03\xba\x03\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa4\x02\x9b\x00\x9c\x00\x8d\x05\xff\x03\x00\x04\xb4\x03\x37\x00\xb3\x03\x83\x01\x84\x01\x44\x00\xb2\x03\xdc\xfc\x46\x00\xe3\x02\x47\x00\xfa\xfc\xe5\xfc\xec\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\xcf\x00\xe3\xfc\x85\x01\xd1\x01\x4c\x00\xd2\x01\xe4\xfc\xf9\xfc\xd3\x01\x43\x00\x44\x00\xd4\x01\x45\x00\x46\x00\x4d\x00\x47\x00\x48\x00\x49\x00\xdd\xfc\xa1\x00\xa2\x00\xde\xfc\x34\x02\xd5\x01\xce\x00\x4a\x00\x4b\x00\x4c\x00\xb1\x03\xa3\x00\x72\x00\xb0\x03\xd6\x01\x73\x00\x74\x00\x20\x01\xaf\x03\x4d\x00\x40\x00\xd7\x01\x7a\x00\x11\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x91\x05\xff\x03\x00\x04\xae\x03\xaa\x03\x41\x00\xab\x03\xa9\x03\xa2\x03\x98\x03\xd3\x00\xa4\x00\x0f\x00\xd4\x00\x6a\x01\xbf\x02\x86\x03\x2d\x02\xcf\x00\x11\x00\x85\x03\x7c\x00\x7d\x00\x84\x03\x82\x03\xa5\x00\x7b\x03\x76\x03\x75\x03\x74\x03\x01\x05\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xee\x00\xef\x00\xa1\x02\xf0\x03\x73\x03\x72\x03\x71\x03\xf1\x00\x70\x03\x6b\x03\x8f\x00\x6f\x03\x6e\x03\xa3\x02\xd2\x00\x68\x03\x59\x03\x67\x03\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa4\x02\x9b\x00\x9c\x00\x67\x01\x0e\xfd\x4e\x03\x56\x03\x49\x03\x43\x00\x44\x00\x47\x03\x45\x00\x46\x00\x45\x03\x47\x00\x48\x00\x49\x00\x3b\x03\x8a\x00\x27\x03\x1c\x03\x1b\x03\x2f\x01\x1a\x03\x4a\x00\x4b\x00\x4c\x00\x22\x03\x0d\x01\xe7\x03\xc4\x03\x30\x04\x37\x00\x32\x04\x2b\x04\x25\x04\x4d\x00\x23\x04\x6a\x05\x1f\x04\xe3\x02\x1a\x04\x22\x04\xa1\x00\xa2\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\xd0\x00\x21\x04\x05\xfd\x8f\x00\xa3\x00\x72\x00\xd1\x00\xd2\x00\x73\x00\x74\x00\x04\xfd\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x06\xfd\x1d\x04\x1c\x04\x54\x03\x10\x04\x0a\x04\x04\x04\x02\x04\xfe\x03\x49\x01\xf8\x03\x05\x04\xf6\x03\xd3\x00\xa4\x00\x0f\x00\xd4\x00\xfa\x03\xbf\x02\x40\x00\x6a\x00\xec\x03\x11\x00\xd7\x03\x7c\x00\x7d\x00\xe7\x03\xde\x03\xa5\x00\xd8\x03\x37\x00\x33\x02\x98\x04\x41\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xe3\x02\x07\x01\xa1\x00\xa2\x00\xce\x03\x38\x01\x3d\x00\x3e\x00\x3f\x00\xcf\x03\xc4\x03\x8f\x00\xa3\x00\x72\x00\x90\x04\x8a\x04\x73\x00\x74\x00\x87\x04\x07\x01\x85\x04\x37\x00\x54\x03\x88\x03\x9a\x00\x9b\x00\x9c\x00\x4a\x01\x89\x03\x4b\x01\xc7\x02\x06\x01\x65\x02\xb8\x01\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x81\x04\x38\x04\xd3\x00\xa4\x00\x0f\x00\xd4\x00\x7b\x03\x79\x04\x78\x04\x40\x00\x77\x04\x11\x00\x76\x04\x7c\x00\x7d\x00\x04\x04\x02\x04\xa5\x00\x43\x00\x44\x00\x06\x01\x45\x00\x46\x00\x41\x00\x47\x00\x48\x00\x49\x00\x4e\x04\x02\x04\xa1\x00\xa2\x00\x48\x04\x43\x04\x3c\x04\x4a\x00\x4b\x00\x4c\x00\x3e\x04\x40\x00\xa3\x00\x72\x00\x3f\x04\x37\x00\x73\x00\x74\x00\x3b\x04\x4d\x00\x3a\x04\x4a\x01\x39\x04\x4b\x01\x38\x04\x41\x00\xe8\x04\xe5\x04\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xe4\x04\xe0\x04\xdf\x04\xd8\x04\xd3\x04\x47\x01\x07\x01\xbc\x04\x02\x04\x95\x01\x0f\x00\x10\x00\xb3\x04\xb2\x04\xa8\x04\x31\x05\x23\x05\x11\x00\x1e\x05\x7c\x00\x7d\x00\x25\x05\x1d\x05\xa5\x00\x5d\x03\x43\x00\x44\x00\x1c\x05\x45\x00\x46\x00\x13\x05\x47\x00\x48\x00\x49\x00\x11\x05\x12\x05\x0f\x05\x0e\x05\x40\x00\x56\x01\x0d\x05\x4a\x00\x4b\x00\x4c\x00\x0c\x05\x67\x05\x63\x05\x00\x05\x64\x05\x66\x05\x5d\x05\x49\x03\x41\x00\x4d\x00\x43\x00\x44\x00\x07\x01\x45\x00\x46\x00\x4c\x05\x47\x00\x48\x00\x49\x00\x47\x05\x4b\x05\x35\x05\x3e\x05\x7f\x05\x7c\x05\x3d\x05\x4a\x00\x4b\x00\x4c\x00\x37\x00\x3c\x05\x75\x05\x71\x05\x3b\x05\x80\x05\x5e\x03\xc4\x03\x5f\x03\x4d\x00\x5b\x05\x5c\xfe\x04\x04\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x02\x04\x6c\x03\x71\x01\x8f\x00\x72\x01\x6a\x05\x37\x00\x91\x05\x1d\x01\x04\x04\x73\x00\x1e\x01\x5e\x03\x02\x04\x5f\x03\x94\x01\x9a\x00\x9b\x00\x9c\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x43\x00\x44\x00\x06\x01\x45\x00\x46\x00\xbd\x03\x47\x00\x48\x00\x49\x00\x8c\x05\x8b\x05\x1f\x01\x97\x05\x96\x05\x20\x01\x40\x00\x4a\x00\x4b\x00\x4c\x00\x37\x00\x11\x00\x02\x04\x99\x05\x21\x01\x0b\x01\x5e\x03\xca\x01\x5f\x03\x4d\x00\x41\x00\x8b\x01\xb9\x01\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xa1\x00\xa2\x00\x40\x00\x53\x01\x3c\x01\xb1\x01\x81\x01\xad\x01\x34\x01\x19\x01\xa3\x00\x72\x00\x0c\x03\x08\x03\x73\x00\x74\x00\x41\x00\xc8\x02\x97\x02\x0b\x03\x03\x03\x37\x00\xec\x02\x0a\x03\x00\x03\x52\x02\x98\x02\xc9\x02\xfa\x02\x3b\x00\x9a\x02\xe6\x02\xd4\x02\xc6\x02\xca\x02\x3d\x00\x3e\x00\x3f\x00\x40\x00\x95\x01\x0f\x00\x10\x00\xb8\x02\xe0\x01\x81\x02\x63\x02\x1f\x02\x11\x00\x0c\x02\x7c\x00\x7d\x00\x6f\x02\x41\x00\xa5\x00\x43\x00\x44\x00\x07\x02\x45\x00\x46\x00\x04\x02\x47\x00\x48\x00\x49\x00\xc1\x03\xc0\x03\x11\x03\xbf\x03\x4c\x03\xac\x03\x61\x02\x4a\x00\x4b\x00\x4c\x00\x47\x03\x45\x03\xa5\x03\x40\x00\x43\x00\x44\x00\x43\x03\x45\x00\x46\x00\x4d\x00\x47\x00\x48\x00\x49\x00\x3b\x03\x56\x03\x86\x03\x56\x03\x41\x00\x25\x03\x22\x03\x4a\x00\x4b\x00\x4c\x00\x7c\x03\x20\x03\x13\x00\x18\x03\x17\x03\x14\x03\x36\x04\x35\x04\x2d\x03\x4d\x00\x14\x00\x7b\x03\x34\x04\x33\x04\x30\x04\x23\x04\x32\x04\x43\x00\x44\x00\x18\x04\x45\x00\x46\x00\x15\x00\x47\x00\x48\x00\x49\x00\x15\x04\x12\x04\x17\x00\x18\x00\x19\x00\x0a\x04\x06\x04\x4a\x00\x4b\x00\x4c\x00\xcb\x02\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x08\x04\x02\x04\x24\x00\x4d\x00\xec\x03\xe5\x03\xde\x03\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x43\x00\x44\x00\xc5\x03\x45\x00\x46\x00\xc4\x03\x47\x00\x48\x00\x49\x00\xc2\x03\x83\x04\x85\x04\x81\x00\x73\x04\x61\x02\x6e\x04\x4a\x00\x4b\x00\x4c\x00\xcf\x01\x3c\x04\xd0\x01\x57\x04\x82\x00\x83\x00\x84\x00\x97\x02\x4c\x04\x4d\x00\x37\x00\x85\x00\xeb\x04\xe8\x04\xe6\x04\x98\x02\x99\x02\xdb\x04\xd9\x04\x9a\x02\xd8\x04\x9d\x02\x69\x01\x9b\x02\x3d\x00\x3e\x00\x3f\x00\xd6\x04\x6a\x01\xd3\x04\xd1\x04\xc2\x04\xba\x04\x8b\x00\x8c\x00\xa8\x04\x2c\x03\x8e\x00\x8f\x00\x37\x00\xc1\x04\x15\x02\x16\x02\xb0\x04\x98\x02\x99\x02\x98\x04\x2f\x05\x9a\x02\x2e\x05\x23\x05\x20\x05\x9b\x02\x3d\x00\x3e\x00\x3f\x00\x07\x05\x1f\x05\x8f\x00\x56\x03\x0f\x05\xff\x04\xcd\x02\xf6\x04\x58\x05\x40\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\xee\x04\x67\x05\x55\x05\x45\x05\x44\x05\x41\x00\xee\x03\x60\x05\x5f\x05\x37\x00\x76\x05\x75\x05\x6e\x05\x8f\x05\x98\x02\x99\x02\x86\x05\x81\x00\x9a\x02\x84\x05\x40\x00\x94\x05\x9b\x02\x3d\x00\x3e\x00\x3f\x00\x93\x05\x92\x05\x82\x00\x83\x00\x84\x00\x00\x00\x00\x00\x00\x00\x41\x00\x85\x00\x97\x05\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\x01\x9c\x02\x00\x00\x00\x00\xa3\x00\x72\x00\x6a\x01\x00\x00\x73\x00\x74\x00\x00\x00\x8b\x00\x8c\x00\x00\x00\x00\x00\x8e\x00\x8f\x00\x00\x00\x40\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x9c\x02\x00\x00\x41\x00\xa4\x00\x0f\x00\x10\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x9d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x9c\x02\x91\x01\x72\x00\x4d\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\xa4\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x02\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x92\x01\x0f\x00\x10\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x72\x02\x73\x02\x00\x00\x46\x04\x00\x00\x4d\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x98\x02\x99\x02\xa1\x00\xa2\x00\x9a\x02\x00\x00\x9d\x02\x00\x00\x9b\x02\x3d\x00\x3e\x00\x3f\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x00\x00\xe0\x04\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x98\x02\x99\x02\x00\x00\x00\x00\x9a\x02\x00\x00\x00\x00\x00\x00\x9b\x02\x3d\x00\x3e\x00\x3f\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x40\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x81\x00\x52\x01\xaf\xfe\x00\x00\x00\x00\xaf\xfe\x41\x00\x57\x05\x00\x00\x00\x00\x37\x00\x82\x00\x83\x00\x84\x00\x00\x00\x98\x02\x99\x02\x00\x00\x85\x00\x9a\x02\x00\x00\x40\x00\x00\x00\x9b\x02\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x53\x01\x00\x00\x00\x00\x00\x00\x8b\x00\x8c\x00\x00\x00\x00\x00\x8e\x00\x8f\x00\x81\x00\xc4\x01\x9c\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x83\x00\x84\x00\xc5\x01\xc6\x01\xc7\x01\xc8\x01\x85\x00\x40\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x9c\x02\x00\x00\x41\x00\x00\x00\x00\x00\x53\x01\x4a\x00\x4b\x00\x4c\x00\x8b\x00\x8c\x00\x00\x00\x00\x00\x8e\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x9d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x9c\x02\x00\x00\x00\x00\x4d\x00\x14\x05\x00\x00\x00\x00\x15\x05\x16\x05\x17\x05\x00\x00\x00\x00\x18\x05\x3f\x00\x00\x00\x9d\x02\x37\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x49\x05\x00\x00\x00\x00\x18\x05\x3f\x00\x00\x00\x19\x05\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x05\x00\x00\x4d\x00\x37\x00\x00\x00\x00\x00\x00\x00\x40\x00\x98\x02\x99\x02\x00\x00\x00\x00\x9a\x02\x00\x00\x9d\x02\x13\x00\x9b\x02\x3d\x00\x3e\x00\x3f\x00\x00\x00\x41\x00\x37\x00\x14\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x72\x05\x17\x05\x15\x00\x00\x00\x18\x05\x3f\x00\x16\x00\x41\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x40\x00\x73\x05\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x9c\x02\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x1a\x05\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x1a\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4d\x00\x00\x00\x00\x00\x81\x00\x81\x01\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x9d\x02\x00\x00\x82\x00\x83\x00\x84\x00\x00\x00\x00\x00\x4d\x00\x37\x00\x85\x00\x00\x00\x00\x00\x1b\x02\xe9\x03\xc9\x02\x00\x00\x3b\x00\x9a\x02\x00\x00\x00\x00\x1a\x05\xca\x02\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x53\x01\x00\x00\x00\x00\x00\x00\x8b\x00\x8c\x00\x00\x00\x00\x00\x8e\x00\x8f\x00\x37\x00\x00\x00\x00\x00\x00\x00\x1a\x02\xe8\x03\xc9\x02\x00\x00\x3b\x00\x9a\x02\x00\x00\x00\x00\x00\x00\xca\x02\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\xbb\x03\x61\x04\xc9\x02\x00\x00\x3b\x00\x9a\x02\x00\x00\x41\x00\x00\x00\xca\x02\x3d\x00\x3e\x00\x3f\x00\x00\x00\x6d\x01\x6e\x01\x6f\x01\x70\x01\x71\x01\x00\x00\x72\x01\x00\x00\x40\x00\x00\x00\x1d\x01\x37\x00\x73\x00\x1e\x01\x37\x03\x00\x00\x38\x03\x99\x02\x00\x00\x00\x00\x9a\x02\x00\x00\x41\x00\x00\x00\x9b\x02\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcb\x02\x1f\x01\x40\x00\x00\x00\x20\x01\x00\x00\x6b\x03\x6f\x01\x70\x01\x71\x01\x11\x00\x72\x01\x00\x00\x21\x01\x00\x00\x1d\x01\x41\x00\x73\x00\x1e\x01\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\xcb\x02\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x1f\x01\x00\x00\x00\x00\x20\x01\x41\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x11\x00\x45\x00\x46\x00\x21\x01\x47\x00\x48\x00\x49\x00\x00\x00\xcb\x02\x9d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x9c\x02\x9d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x9d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x03\x99\x02\x00\x00\x4d\x00\x9a\x02\x00\x00\x00\x00\x00\x00\x9b\x02\x3d\x00\x3e\x00\x3f\x00\x1e\x03\x28\x01\x00\x00\x9d\x02\x00\x00\x1d\x01\x00\x00\x73\x00\x1e\x01\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x03\x99\x02\x00\x00\x00\x00\x9a\x02\x00\x00\x00\x00\x00\x00\x9b\x02\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x1f\x01\x00\x00\x00\x00\x20\x01\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x11\x00\x37\x00\x00\x00\x21\x01\x00\x00\x00\x00\x79\x04\x99\x02\x00\x00\x00\x00\x9a\x02\x00\x00\x41\x00\x00\x00\x9b\x02\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x4d\x01\x61\x04\x99\x02\x00\x00\x00\x00\x9a\x02\x00\x00\x41\x00\x00\x00\x9b\x02\x3d\x00\x3e\x00\x3f\x00\xc2\x01\x00\x00\x4f\x01\x50\x01\x00\x00\x00\x00\x00\x00\x9c\x02\x00\x00\x40\x00\x00\x00\x00\x00\x77\x00\x00\x00\x78\x00\x79\x00\x7a\x00\x00\x00\x7b\x00\x00\x00\x00\x00\x7e\x00\x7f\x00\x41\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x9c\x02\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x9c\x02\x9d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x9c\x02\x9d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x9d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x04\x99\x02\x00\x00\x4d\x00\x9a\x02\x00\x00\x00\x00\x00\x00\x9b\x02\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x37\x00\x9d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x04\x00\x00\x00\x00\x00\x00\xbe\x04\x3d\x00\x3e\x00\x3f\x00\x00\x00\xbf\x04\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x04\x00\x00\x00\x00\x00\x00\xbe\x04\x3d\x00\x3e\x00\x3f\x00\x40\x00\x4d\x05\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x04\x00\x00\xb8\x04\x00\x00\x00\x00\x00\x00\x41\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x37\x00\x00\x00\x37\x02\x40\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x41\x00\x00\x00\x00\x00\x00\x00\x9c\x02\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4d\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x9d\x02\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x9d\x02\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4d\x00\x00\x00\x00\x00\x81\x00\x52\x01\x42\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x9d\x02\x00\x00\x82\x00\x83\x00\x84\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x85\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x01\x4a\x00\x4b\x00\x4c\x00\x8b\x00\x8c\x00\x00\x00\x00\x00\x8e\x00\x8f\x00\x00\x00\x38\x02\x7a\x00\x4d\x00\x7b\x00\x00\x00\x00\x00\xcc\x01\x7f\x00\x37\x00\x00\x00\xdd\x01\xcd\x01\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x81\x00\x05\x05\x00\x00\xde\x01\xdf\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x83\x00\x84\x00\x00\x00\x37\x00\x00\x00\xe2\x01\x85\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x01\x00\x00\x40\x00\x00\x00\x8b\x00\x8c\x00\x00\x00\x00\x00\x8e\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x37\x00\x00\x00\xe2\x01\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x02\x00\x00\x00\x00\x41\x00\x37\x00\x00\x00\x00\x00\x00\x00\x52\x02\x00\x00\x3a\x00\x00\x00\x3b\x00\x42\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xde\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x41\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\xe0\x01\x47\x00\xe3\x01\x49\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x01\x00\x00\x00\x00\xe4\x01\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\xe3\x01\x49\x00\x4e\x01\x00\x00\x4f\x01\x50\x01\x42\x00\x00\x00\x00\x00\x6f\x05\x4b\x00\x4c\x00\x00\x00\x00\x00\x77\x00\x00\x00\x78\x00\x79\x00\x7a\x00\x00\x00\x7b\x00\x4d\x00\x00\x00\x7e\x00\x7f\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\xe4\x01\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x02\x4a\x00\x4b\x00\x4c\x00\x37\x00\x00\x00\x00\x00\x00\x00\x52\x02\x00\x00\x3a\x00\x00\x00\x3b\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xac\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x02\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x52\x02\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x11\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\x03\x40\x00\x00\x00\xf6\x03\x37\x00\x00\x00\x00\x00\x00\x00\x52\x02\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x01\x00\x00\xf3\x03\x40\x00\x00\x00\xf4\x03\x37\x00\x00\x00\x00\x00\x00\x00\x52\x02\x00\x00\x3a\x00\xc3\x02\x3b\x00\x4f\x01\x50\x01\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x77\x00\x00\x00\x78\x00\x79\x00\x7a\x00\x42\x00\x7b\x00\x40\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\xf3\x03\x00\x00\x00\x00\xb6\x04\x37\x00\x00\x00\x00\x00\x00\x00\x52\x02\x4d\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x02\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x52\x02\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x41\x02\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\xd7\x02\x43\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x41\x02\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x42\x02\x43\x02\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x37\x00\x00\x00\x41\x02\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\xb8\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x41\x02\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\xb7\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\xb5\x03\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x03\x00\x00\x4d\x01\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x41\x02\x00\x00\x39\x00\x00\x00\x3a\x00\xc2\x01\x3b\x00\x4f\x01\x50\x01\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x77\x00\xb4\x03\x78\x00\x79\x00\x7a\x00\x42\x00\x7b\x00\x40\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x37\x00\x00\x00\x41\x02\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x4d\x00\x00\x00\x8f\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\xcf\x03\xa4\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x37\x00\x00\x00\x1a\x04\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x05\x00\x00\xa5\x01\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x38\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\xa1\x00\xa2\x00\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\xe7\x01\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x42\x00\x00\x00\x40\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x52\x05\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x37\x00\x00\x00\x8e\x01\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x4d\x00\x00\x00\x8f\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\xa2\x01\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x18\x02\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x19\x02\x37\x00\x00\x00\x1a\x04\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\xa1\x00\xa2\x00\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x18\x02\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x42\x00\x00\x00\x40\x00\x11\x00\x17\x04\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x37\x00\x00\x00\x00\x00\x00\x00\x18\x02\x00\x00\x3a\x00\x00\x00\x3b\x00\x4d\x00\x00\x00\x8f\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbe\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x10\x04\x37\x00\x00\x00\x00\x00\x00\x00\x18\x02\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\xfc\x03\x37\x00\x00\x00\x00\x00\x00\x00\x18\x02\x00\x00\x3a\x00\x00\x00\x3b\x00\xa1\x00\xa2\x00\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x40\x00\x00\x00\xc9\x03\x37\x00\x00\x00\x00\x00\x00\x00\x18\x02\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x42\x00\x00\x00\x40\x00\x11\x00\x48\x04\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x37\x00\x00\x00\xf7\x04\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x4d\x00\x00\x00\x8f\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x18\x02\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x54\x05\x37\x00\x00\x00\x00\x00\x00\x00\x1b\x02\x00\x00\x3a\x00\x00\x00\x3b\x00\xa1\x00\xa2\x00\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x1a\x02\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x42\x00\x00\x00\x40\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x37\x00\x00\x00\x00\x00\x00\x00\xbb\x03\x00\x00\x3a\x00\x00\x00\x3b\x00\x4d\x00\x00\x00\x8f\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\xac\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\xca\x03\x00\x00\x3a\x00\x00\x00\x3b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\xf3\x04\x00\x00\x3a\x00\x00\x00\x3b\x00\xa1\x00\xa2\x00\x41\x00\x00\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x01\x00\x00\x00\x00\x41\x00\x00\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x42\x00\x00\x00\x40\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\xe1\x02\x47\x00\x48\x00\x49\x00\x00\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\xd8\x02\x47\x00\x48\x00\x49\x00\x00\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd6\x02\x00\x00\x00\x00\x41\x00\x00\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x02\x00\x00\x00\x00\x41\x00\x00\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x4e\x03\x47\x00\x48\x00\x49\x00\x00\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x05\x04\x47\x00\x48\x00\x49\x00\x00\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xea\x03\x00\x00\x00\x00\x41\x00\x00\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x04\x00\x00\x00\x00\x41\x00\x00\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x49\x04\x47\x00\x48\x00\x49\x00\x00\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x05\x05\x47\x00\x48\x00\x49\x00\x00\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x05\x00\x00\x00\x00\x41\x00\x00\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x48\x05\x00\x00\x00\x00\x41\x00\x00\x00\x38\x01\x3d\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x37\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x80\x03\x3d\x00\x3e\x00\x3f\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x41\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x0e\x02\xa7\x00\x13\x00\xa8\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x15\x02\x16\x02\x8a\x05\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x17\x02\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\xe4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x02\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x9f\x03\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\xd6\x00\xd7\x00\xd8\x00\xfc\x00\xd9\x00\x00\x00\xfd\x00\x00\x00\x15\x00\x00\x00\xfe\x00\x00\x00\x16\x00\xff\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x01\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xdb\x00\xdc\x00\xdd\x00\x00\x00\x01\x01\xb0\x00\xde\x00\xb2\x00\x02\x01\x03\x01\x00\x00\x00\x00\x04\x01\xdf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x05\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x06\x01\x07\x01\x08\x01\x09\x01\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x5d\x04\x5e\x04\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\xd6\x00\xd7\x00\xd8\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x5f\x04\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x01\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xdb\x00\xdc\x00\xdd\x00\x00\x00\x00\x00\xb0\x00\xde\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x05\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x06\x01\x07\x01\x08\x01\x09\x01\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x54\x04\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\xd6\x00\xd7\x00\xd8\x00\x00\x00\xd9\x00\x00\x00\xfd\x00\x00\x00\x15\x00\x00\x00\x55\x04\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x01\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xdb\x00\xdc\x00\xdd\x00\x00\x00\x00\x00\xb0\x00\xde\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x05\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x06\x01\x07\x01\x08\x01\x09\x01\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x5d\x04\x5e\x04\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\xd6\x00\xd7\x00\xd8\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x5f\x04\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x01\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xdb\x00\xdc\x00\xdd\x00\x00\x00\x00\x00\xb0\x00\xde\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x05\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x06\x01\x07\x01\x08\x01\x09\x01\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x54\x04\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\xd6\x00\xd7\x00\xd8\x00\x00\x00\xd9\x00\x00\x00\xfd\x00\x00\x00\x15\x00\x00\x00\x55\x04\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x01\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xdb\x00\xdc\x00\xdd\x00\x00\x00\x00\x00\xb0\x00\xde\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x05\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x06\x01\x07\x01\x08\x01\x09\x01\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\xd6\x00\xd7\x00\xd8\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x01\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xdb\x00\xdc\x00\xdd\x00\x00\x00\x00\x00\xb0\x00\xde\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x05\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x06\x01\x07\x01\x08\x01\x09\x01\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x67\x01\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\x68\x01\x83\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x69\x01\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x6a\x01\x6b\x01\xbb\x00\x2c\x00\x8a\x00\x8b\x00\x8c\x00\x2d\x00\x8d\x00\x8e\x00\x8f\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x67\x01\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x83\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x9c\x01\xba\x00\x00\x00\x00\x00\x6a\x01\x6b\x01\xbb\x00\x2c\x00\x8a\x00\x8b\x00\x8c\x00\x2d\x00\x8d\x00\x8e\x00\x8f\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x67\x01\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\x68\x01\x83\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x69\x01\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x6a\x01\x6b\x01\xbb\x00\x2c\x00\x8a\x00\x8b\x00\x8c\x00\x2d\x00\x8d\x00\x8e\x00\x8f\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x83\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x48\x02\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x2c\x02\x6b\x01\xbb\x00\x2c\x00\x8a\x00\x8b\x00\x8c\x00\x2d\x00\x8d\x00\x8e\x00\x8f\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x83\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x4b\x02\xba\x00\x00\x00\x00\x00\x2c\x02\x6b\x01\xbb\x00\x2c\x00\x8a\x00\x8b\x00\x8c\x00\x2d\x00\x8d\x00\x8e\x00\x8f\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x83\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\xa1\x01\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x6b\x01\xbb\x00\x2c\x00\x8a\x00\x8b\x00\x8c\x00\x2d\x00\x8d\x00\x8e\x00\x8f\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x00\x00\xb3\x00\x00\x00\xbf\x02\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x83\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x6b\x01\xbb\x00\x2c\x00\x8a\x00\x8b\x00\x8c\x00\x2d\x00\x8d\x00\x8e\x00\x8f\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x83\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x2c\x02\x6b\x01\xbb\x00\x2c\x00\x8a\x00\x8b\x00\x8c\x00\x2d\x00\x8d\x00\x8e\x00\x8f\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xdb\xfd\xdb\xfd\xdb\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xdb\xfd\x00\x00\xdb\xfd\xdb\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdb\xfd\x00\x00\x00\x00\x00\x00\xdb\xfd\x00\x00\x00\x00\x00\x00\xdb\xfd\x00\x00\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\x00\x00\xdb\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\x00\x00\xdb\xfd\x00\x00\x00\x00\x00\x00\xdb\xfd\x00\x00\xdb\xfd\xdb\xfd\xdb\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xdb\xfd\xdb\xfd\xdb\xfd\x00\x00\x00\x00\x00\x00\xdb\xfd\x00\x00\x00\x00\x00\x00\xdb\xfd\x00\x00\xdb\xfd\x00\x00\xdb\xfd\x00\x00\x00\x00\x00\x00\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\x00\x00\xdb\xfd\x00\x00\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xdb\xfd\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\xd6\x00\xd7\x00\xd8\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\xda\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xdb\x00\xdc\x00\xdd\x00\x00\x00\x00\x00\xb0\x00\xde\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x83\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x6b\x01\xbb\x00\x2c\x00\x8a\x00\x8b\x00\x8c\x00\x2d\x00\x8d\x00\x8e\x00\x8f\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\xe4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x03\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x9f\x03\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\xae\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\xb8\x01\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x01\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\xae\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\x95\x03\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\xe4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x9f\x03\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\xae\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\x95\x03\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\xe4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\xe4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\xe4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\xe2\x03\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\xb1\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\xa7\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\x00\x00\xa8\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\x00\x00\xa8\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x00\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\xa7\x00\x13\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xac\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xad\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\xa7\x00\x13\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x14\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x13\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x8b\x03\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\xa7\x00\x13\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x14\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x63\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbb\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x00\x00\x6a\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\x00\x00\x4f\x00\x13\x00\x00\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\x00\x00\xcb\x00\x14\x00\x6d\x00\x6e\x00\xcc\x00\xcd\x00\xce\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe6\x01\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\xe7\x01\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x01\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x50\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\xe2\x01\x00\x00\x00\x00\x00\x00\x6a\x01\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x50\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x3b\x02\x3c\x02\x3d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x3e\x02\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x69\x01\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x01\x61\x00\x62\x00\x63\x00\x64\x00\x3f\x02\x40\x02\x00\x00\x67\x00\x68\x00\x41\x02\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\xa4\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x50\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x72\x02\x98\x03\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\xa4\x00\x0f\x00\x10\x00\x5e\x00\xe9\x01\x00\x00\x00\x00\x5f\x00\x11\x00\x60\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x01\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x3b\x01\x3c\x01\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\xa3\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\xcd\x02\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\xa4\x00\x0f\x00\x10\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x11\x00\x60\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x01\x00\x00\x14\x00\x00\x00\x00\x00\xa1\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x9f\x02\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\xa4\x00\x0f\x00\x10\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x11\x00\x60\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x01\x00\x00\x14\x00\x00\x00\x00\x00\x56\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\xcd\x02\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\xa4\x00\x0f\x00\x10\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x11\x00\x60\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x01\x00\x00\x14\x00\x00\x00\x00\x00\x1b\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x9f\x02\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\xa4\x00\x0f\x00\x10\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x11\x00\x60\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x01\x00\x00\x14\x00\x00\x00\x00\x00\x05\x03\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\xcd\x02\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\xa4\x00\x0f\x00\x10\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x11\x00\x60\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x01\x00\x00\x14\x00\x00\x00\x00\x00\x04\x03\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x9f\x02\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\xa4\x00\x0f\x00\x10\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x11\x00\x60\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x01\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x04\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\xe5\x02\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\xd0\x04\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\xbe\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x9f\x02\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\xa4\x00\x0f\x00\x10\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x11\x00\x60\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x01\x00\x00\x14\x00\x00\x00\x00\x00\x6e\x02\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x50\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\xa4\x00\x0f\x00\x10\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x11\x00\x60\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\xc1\x04\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x01\x00\x00\x14\x00\x00\x00\x00\x00\x5b\x02\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x50\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\xa4\x00\x0f\x00\x10\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x11\x00\x60\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x1c\x03\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\xe5\x02\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\xff\x04\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\xa4\x00\x0f\x00\x10\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x11\x00\x60\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\xe5\x02\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\x04\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x50\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x50\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x54\x05\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x8b\xfe\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x01\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\xe5\x02\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x61\x03\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x01\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\xe5\x02\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x61\x03\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x01\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x01\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\xe5\x02\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x01\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x00\x00\x58\x00\x59\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x5c\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x00\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x00\x00\x15\x00\x00\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x13\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x14\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x33\x03\x34\x03\x35\x03\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x01\x63\x00\x64\x00\x00\x00\x00\x00\x00\x00\x67\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x25\x02\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x2c\x00\x00\x00\x00\x00\x6f\x00\x70\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x36\x03\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x13\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x13\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x03\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x13\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\xae\x04\x2a\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x15\x02\x16\x02\x00\x00\x17\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x02\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x02\x16\x02\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x02\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x02\x16\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x02\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x83\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x00\x00\x00\x13\x00\x00\x00\x87\x00\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x89\x00\x00\x00\x2c\x00\x8a\x00\x8b\x00\x8c\x00\x2d\x00\x8d\x00\x8e\x00\x8f\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x83\x00\x84\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x01\xbd\x02\x13\x00\x00\x00\xda\x01\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\xdb\x01\x00\x00\x2c\x00\x8a\x00\x8b\x00\x8c\x00\x00\x00\x8d\x00\x00\x00\x8f\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x13\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x04\x00\x00\x00\x00\x15\x00\x00\x00\xa4\x04\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\xa5\x04\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\xa3\x04\x00\x00\x00\x00\x15\x00\x00\x00\xa4\x04\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\xa5\x04\xa6\x04\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xa7\x04\x00\x00\x00\x00\x2c\x00\x64\x00\x13\x00\x00\x00\x2d\x00\x67\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\xa6\x04\x13\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x14\x00\x2c\x00\x64\x00\x00\x00\x00\x00\x2d\x00\x67\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xa4\x04\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x86\x00\x00\x00\x00\x00\x00\x00\x94\x01\x13\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x00\x00\x3a\x05\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\xa6\x04\x13\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x14\x00\x2c\x00\x64\x00\x00\x00\x00\x00\x2d\x00\x67\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xd9\x01\x13\x00\x00\x00\x00\x00\xda\x01\x00\x00\x88\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x8d\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x13\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x2d\x00\x8d\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x87\x01\x13\x00\x00\x00\x00\x00\x88\x01\x00\x00\x89\x01\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x64\x00\x00\x00\x00\x00\x00\x00\x67\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x13\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x8d\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x63\x00\x64\x00\x00\x00\x00\x00\x00\x00\x67\x00\x5a\x02\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x13\x00\x2b\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x57\x01\x58\x01\x2d\x00\x92\x00\x93\x00\x81\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x82\x00\x83\x00\x84\x00\x59\x01\x5a\x01\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x00\x00\x00\x00\x00\x00\x00\x74\x01\x69\x01\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x01\x00\x00\x00\x00\x2c\x00\x8a\x00\x8b\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x5b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x01\x5d\x01\x00\x00\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x5f\x01\x60\x01\x9c\x01\x62\x01\x11\x00\x7b\x00\x7c\x00\x7d\x00\x63\x01\x7f\x00\xa5\x00\x00\x00\x00\x00\x64\x01\x13\x00\x65\x01\x8f\x00\x57\x01\x58\x01\x00\x00\x92\x00\x93\x00\x14\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x15\x00\x00\x00\x59\x01\x5a\x01\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x5b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x01\x5d\x01\x00\x00\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x5f\x01\x60\x01\x61\x01\x62\x01\x11\x00\x7b\x00\x7c\x00\x7d\x00\x63\x01\x7f\x00\xa5\x00\x00\x00\x63\x00\x64\x01\x00\x00\x65\x01\x8f\x00\x57\x01\x58\x01\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x96\x01\x97\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x5b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x01\x5d\x01\x00\x00\x5e\x01\x00\x00\x00\x00\x13\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x5f\x01\x98\x01\x14\x00\x99\x01\x11\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xa5\x00\x23\x01\x00\x00\x9a\x01\x15\x00\x65\x01\x24\x01\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x13\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x86\x00\x00\x00\x00\x00\x00\x00\x25\x01\x13\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x86\x00\x00\x00\x24\x00\x00\x00\x74\x01\x13\x00\x88\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x86\x00\x00\x00\x00\x00\x00\x00\x34\x01\x13\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x86\x00\x00\x00\x24\x00\x00\x00\x25\x01\x13\x00\x88\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x86\x00\x00\x00\x00\x00\x00\x00\x74\x01\x13\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x86\x00\x00\x00\x24\x00\x00\x00\x25\x01\x13\x00\x88\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x2c\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x8a\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\xff\x14\x00\x00\x00\x00\x00\x06\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\xf3\x02\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xbb\x02\x00\x00\x24\x00\x2c\x00\x00\x00\x13\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x13\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x2c\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x13\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x29\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x2c\x00\x16\x00\x00\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x13\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x13\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x29\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x17\x00\x18\x00\x19\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf6\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\xe1\x00\x91\x00\x63\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x99\x03\x9a\x03\x9b\x03\x00\x00\x00\x00\xf6\x01\x00\x00\x00\x00\x9c\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x8f\x00\x57\x01\x58\x01\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x01\xa4\x00\x0f\x00\x10\x00\x9e\x01\x9f\x01\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x9d\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x5b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x01\x5d\x01\x00\x00\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x5f\x01\x98\x01\x00\x00\x99\x01\x11\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xa5\x00\x8f\x00\x57\x01\x58\x01\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x02\x00\x00\x00\x00\x7b\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x5b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x01\x5d\x01\x00\x00\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x5f\x01\x98\x01\x00\x00\x99\x01\x11\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xa5\x00\x8f\x00\x57\x01\x58\x01\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x02\x00\x00\x00\x00\x8b\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x5b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x01\x5d\x01\x00\x00\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x5f\x01\x98\x01\x00\x00\x99\x01\x11\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xa5\x00\x8f\x00\x57\x01\x58\x01\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x5b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x01\x5d\x01\x00\x00\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x5f\x01\x98\x01\x00\x00\x99\x01\x11\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xa5\x00\x8f\x00\x57\x01\x58\x01\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x96\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x5b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x01\x5d\x01\x00\x00\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x5f\x01\x98\x01\x00\x00\x99\x01\x11\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xa5\x00\x8f\x00\x8d\x03\x58\x01\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8e\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x5b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x01\x5d\x01\x00\x00\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x5f\x01\x98\x01\x00\x00\x99\x01\x11\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xa5\x00\x8f\x00\x57\x01\x58\x01\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x5b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x01\x5d\x01\x00\x00\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x5f\x01\x98\x01\x00\x00\x99\x01\x11\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xa5\x00\x8f\x00\x57\x01\x58\x01\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd1\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x5b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x01\x5d\x01\x00\x00\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x5f\x01\x98\x01\x00\x00\x99\x01\x11\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xa5\x00\x8f\x00\x90\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x03\x90\x03\x91\x03\x92\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x90\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x7d\x04\x91\x03\x92\x03\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x90\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x01\x0a\x01\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x90\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9e\x00\x00\x00\x9f\x00\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x90\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x69\x02\x00\x00\x00\x00\x68\x02\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x90\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x67\x02\x00\x00\x00\x00\x68\x02\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x90\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x5e\x02\x5f\x02\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\xe1\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x9f\x03\x9a\x03\x9b\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x90\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x4f\x03\x5f\x02\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x00\xe1\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\xd8\x03\x9a\x03\x9b\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xb3\x01\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\xb4\x01\xb5\x01\xb6\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x90\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd5\x03\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x90\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x7b\x04\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x90\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd3\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xe1\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x81\x04\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x9c\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xe1\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\xe2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xe1\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x28\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xe1\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x27\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xe4\x00\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xd0\x01\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xc1\x01\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xc0\x01\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xba\x01\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x90\x01\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x8a\x01\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x89\x01\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x5a\x02\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x50\x02\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x4f\x02\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x4e\x02\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x4d\x02\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xa7\x03\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xa6\x03\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xa2\x03\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x95\x03\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x50\x03\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xef\x03\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xe0\x03\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xdf\x03\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xd4\x03\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xd2\x03\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x82\x04\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x7a\x04\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x60\x04\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xe5\x04\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xb5\x04\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xb4\x04\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\xb3\x04\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x1e\x05\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x47\x05\x91\x00\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x00\x00\x8f\x01\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x00\x00\xc0\x02\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x00\x00\x29\x04\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x8f\x00\x00\x00\xd0\x04\x00\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x8f\x00\x00\x00\x73\x00\x74\x00\x92\x00\x53\x02\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x00\xa2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x72\x00\x00\x00\x00\x00\x73\x00\x74\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7c\x00\x7d\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyReduceArr = Happy_Data_Array.array (13, 830) [+	(13 , happyReduce_13),+	(14 , happyReduce_14),+	(15 , happyReduce_15),+	(16 , happyReduce_16),+	(17 , happyReduce_17),+	(18 , happyReduce_18),+	(19 , happyReduce_19),+	(20 , happyReduce_20),+	(21 , happyReduce_21),+	(22 , happyReduce_22),+	(23 , happyReduce_23),+	(24 , happyReduce_24),+	(25 , happyReduce_25),+	(26 , happyReduce_26),+	(27 , happyReduce_27),+	(28 , happyReduce_28),+	(29 , happyReduce_29),+	(30 , happyReduce_30),+	(31 , happyReduce_31),+	(32 , happyReduce_32),+	(33 , happyReduce_33),+	(34 , happyReduce_34),+	(35 , happyReduce_35),+	(36 , happyReduce_36),+	(37 , happyReduce_37),+	(38 , happyReduce_38),+	(39 , happyReduce_39),+	(40 , happyReduce_40),+	(41 , happyReduce_41),+	(42 , happyReduce_42),+	(43 , happyReduce_43),+	(44 , happyReduce_44),+	(45 , happyReduce_45),+	(46 , happyReduce_46),+	(47 , happyReduce_47),+	(48 , happyReduce_48),+	(49 , happyReduce_49),+	(50 , happyReduce_50),+	(51 , happyReduce_51),+	(52 , happyReduce_52),+	(53 , happyReduce_53),+	(54 , happyReduce_54),+	(55 , happyReduce_55),+	(56 , happyReduce_56),+	(57 , happyReduce_57),+	(58 , happyReduce_58),+	(59 , happyReduce_59),+	(60 , happyReduce_60),+	(61 , happyReduce_61),+	(62 , happyReduce_62),+	(63 , happyReduce_63),+	(64 , happyReduce_64),+	(65 , happyReduce_65),+	(66 , happyReduce_66),+	(67 , happyReduce_67),+	(68 , happyReduce_68),+	(69 , happyReduce_69),+	(70 , happyReduce_70),+	(71 , happyReduce_71),+	(72 , happyReduce_72),+	(73 , happyReduce_73),+	(74 , happyReduce_74),+	(75 , happyReduce_75),+	(76 , happyReduce_76),+	(77 , happyReduce_77),+	(78 , happyReduce_78),+	(79 , happyReduce_79),+	(80 , happyReduce_80),+	(81 , happyReduce_81),+	(82 , happyReduce_82),+	(83 , happyReduce_83),+	(84 , happyReduce_84),+	(85 , happyReduce_85),+	(86 , happyReduce_86),+	(87 , happyReduce_87),+	(88 , happyReduce_88),+	(89 , happyReduce_89),+	(90 , happyReduce_90),+	(91 , happyReduce_91),+	(92 , happyReduce_92),+	(93 , happyReduce_93),+	(94 , happyReduce_94),+	(95 , happyReduce_95),+	(96 , happyReduce_96),+	(97 , happyReduce_97),+	(98 , happyReduce_98),+	(99 , happyReduce_99),+	(100 , happyReduce_100),+	(101 , happyReduce_101),+	(102 , happyReduce_102),+	(103 , happyReduce_103),+	(104 , happyReduce_104),+	(105 , happyReduce_105),+	(106 , happyReduce_106),+	(107 , happyReduce_107),+	(108 , happyReduce_108),+	(109 , happyReduce_109),+	(110 , happyReduce_110),+	(111 , happyReduce_111),+	(112 , happyReduce_112),+	(113 , happyReduce_113),+	(114 , happyReduce_114),+	(115 , happyReduce_115),+	(116 , happyReduce_116),+	(117 , happyReduce_117),+	(118 , happyReduce_118),+	(119 , happyReduce_119),+	(120 , happyReduce_120),+	(121 , happyReduce_121),+	(122 , happyReduce_122),+	(123 , happyReduce_123),+	(124 , happyReduce_124),+	(125 , happyReduce_125),+	(126 , happyReduce_126),+	(127 , happyReduce_127),+	(128 , happyReduce_128),+	(129 , happyReduce_129),+	(130 , happyReduce_130),+	(131 , happyReduce_131),+	(132 , happyReduce_132),+	(133 , happyReduce_133),+	(134 , happyReduce_134),+	(135 , happyReduce_135),+	(136 , happyReduce_136),+	(137 , happyReduce_137),+	(138 , happyReduce_138),+	(139 , happyReduce_139),+	(140 , happyReduce_140),+	(141 , happyReduce_141),+	(142 , happyReduce_142),+	(143 , happyReduce_143),+	(144 , happyReduce_144),+	(145 , happyReduce_145),+	(146 , happyReduce_146),+	(147 , happyReduce_147),+	(148 , happyReduce_148),+	(149 , happyReduce_149),+	(150 , happyReduce_150),+	(151 , happyReduce_151),+	(152 , happyReduce_152),+	(153 , happyReduce_153),+	(154 , happyReduce_154),+	(155 , happyReduce_155),+	(156 , happyReduce_156),+	(157 , happyReduce_157),+	(158 , happyReduce_158),+	(159 , happyReduce_159),+	(160 , happyReduce_160),+	(161 , happyReduce_161),+	(162 , happyReduce_162),+	(163 , happyReduce_163),+	(164 , happyReduce_164),+	(165 , happyReduce_165),+	(166 , happyReduce_166),+	(167 , happyReduce_167),+	(168 , happyReduce_168),+	(169 , happyReduce_169),+	(170 , happyReduce_170),+	(171 , happyReduce_171),+	(172 , happyReduce_172),+	(173 , happyReduce_173),+	(174 , happyReduce_174),+	(175 , happyReduce_175),+	(176 , happyReduce_176),+	(177 , happyReduce_177),+	(178 , happyReduce_178),+	(179 , happyReduce_179),+	(180 , happyReduce_180),+	(181 , happyReduce_181),+	(182 , happyReduce_182),+	(183 , happyReduce_183),+	(184 , happyReduce_184),+	(185 , happyReduce_185),+	(186 , happyReduce_186),+	(187 , happyReduce_187),+	(188 , happyReduce_188),+	(189 , happyReduce_189),+	(190 , happyReduce_190),+	(191 , happyReduce_191),+	(192 , happyReduce_192),+	(193 , happyReduce_193),+	(194 , happyReduce_194),+	(195 , happyReduce_195),+	(196 , happyReduce_196),+	(197 , happyReduce_197),+	(198 , happyReduce_198),+	(199 , happyReduce_199),+	(200 , happyReduce_200),+	(201 , happyReduce_201),+	(202 , happyReduce_202),+	(203 , happyReduce_203),+	(204 , happyReduce_204),+	(205 , happyReduce_205),+	(206 , happyReduce_206),+	(207 , happyReduce_207),+	(208 , happyReduce_208),+	(209 , happyReduce_209),+	(210 , happyReduce_210),+	(211 , happyReduce_211),+	(212 , happyReduce_212),+	(213 , happyReduce_213),+	(214 , happyReduce_214),+	(215 , happyReduce_215),+	(216 , happyReduce_216),+	(217 , happyReduce_217),+	(218 , happyReduce_218),+	(219 , happyReduce_219),+	(220 , happyReduce_220),+	(221 , happyReduce_221),+	(222 , happyReduce_222),+	(223 , happyReduce_223),+	(224 , happyReduce_224),+	(225 , happyReduce_225),+	(226 , happyReduce_226),+	(227 , happyReduce_227),+	(228 , happyReduce_228),+	(229 , happyReduce_229),+	(230 , happyReduce_230),+	(231 , happyReduce_231),+	(232 , happyReduce_232),+	(233 , happyReduce_233),+	(234 , happyReduce_234),+	(235 , happyReduce_235),+	(236 , happyReduce_236),+	(237 , happyReduce_237),+	(238 , happyReduce_238),+	(239 , happyReduce_239),+	(240 , happyReduce_240),+	(241 , happyReduce_241),+	(242 , happyReduce_242),+	(243 , happyReduce_243),+	(244 , happyReduce_244),+	(245 , happyReduce_245),+	(246 , happyReduce_246),+	(247 , happyReduce_247),+	(248 , happyReduce_248),+	(249 , happyReduce_249),+	(250 , happyReduce_250),+	(251 , happyReduce_251),+	(252 , happyReduce_252),+	(253 , happyReduce_253),+	(254 , happyReduce_254),+	(255 , happyReduce_255),+	(256 , happyReduce_256),+	(257 , happyReduce_257),+	(258 , happyReduce_258),+	(259 , happyReduce_259),+	(260 , happyReduce_260),+	(261 , happyReduce_261),+	(262 , happyReduce_262),+	(263 , happyReduce_263),+	(264 , happyReduce_264),+	(265 , happyReduce_265),+	(266 , happyReduce_266),+	(267 , happyReduce_267),+	(268 , happyReduce_268),+	(269 , happyReduce_269),+	(270 , happyReduce_270),+	(271 , happyReduce_271),+	(272 , happyReduce_272),+	(273 , happyReduce_273),+	(274 , happyReduce_274),+	(275 , happyReduce_275),+	(276 , happyReduce_276),+	(277 , happyReduce_277),+	(278 , happyReduce_278),+	(279 , happyReduce_279),+	(280 , happyReduce_280),+	(281 , happyReduce_281),+	(282 , happyReduce_282),+	(283 , happyReduce_283),+	(284 , happyReduce_284),+	(285 , happyReduce_285),+	(286 , happyReduce_286),+	(287 , happyReduce_287),+	(288 , happyReduce_288),+	(289 , happyReduce_289),+	(290 , happyReduce_290),+	(291 , happyReduce_291),+	(292 , happyReduce_292),+	(293 , happyReduce_293),+	(294 , happyReduce_294),+	(295 , happyReduce_295),+	(296 , happyReduce_296),+	(297 , happyReduce_297),+	(298 , happyReduce_298),+	(299 , happyReduce_299),+	(300 , happyReduce_300),+	(301 , happyReduce_301),+	(302 , happyReduce_302),+	(303 , happyReduce_303),+	(304 , happyReduce_304),+	(305 , happyReduce_305),+	(306 , happyReduce_306),+	(307 , happyReduce_307),+	(308 , happyReduce_308),+	(309 , happyReduce_309),+	(310 , happyReduce_310),+	(311 , happyReduce_311),+	(312 , happyReduce_312),+	(313 , happyReduce_313),+	(314 , happyReduce_314),+	(315 , happyReduce_315),+	(316 , happyReduce_316),+	(317 , happyReduce_317),+	(318 , happyReduce_318),+	(319 , happyReduce_319),+	(320 , happyReduce_320),+	(321 , happyReduce_321),+	(322 , happyReduce_322),+	(323 , happyReduce_323),+	(324 , happyReduce_324),+	(325 , happyReduce_325),+	(326 , happyReduce_326),+	(327 , happyReduce_327),+	(328 , happyReduce_328),+	(329 , happyReduce_329),+	(330 , happyReduce_330),+	(331 , happyReduce_331),+	(332 , happyReduce_332),+	(333 , happyReduce_333),+	(334 , happyReduce_334),+	(335 , happyReduce_335),+	(336 , happyReduce_336),+	(337 , happyReduce_337),+	(338 , happyReduce_338),+	(339 , happyReduce_339),+	(340 , happyReduce_340),+	(341 , happyReduce_341),+	(342 , happyReduce_342),+	(343 , happyReduce_343),+	(344 , happyReduce_344),+	(345 , happyReduce_345),+	(346 , happyReduce_346),+	(347 , happyReduce_347),+	(348 , happyReduce_348),+	(349 , happyReduce_349),+	(350 , happyReduce_350),+	(351 , happyReduce_351),+	(352 , happyReduce_352),+	(353 , happyReduce_353),+	(354 , happyReduce_354),+	(355 , happyReduce_355),+	(356 , happyReduce_356),+	(357 , happyReduce_357),+	(358 , happyReduce_358),+	(359 , happyReduce_359),+	(360 , happyReduce_360),+	(361 , happyReduce_361),+	(362 , happyReduce_362),+	(363 , happyReduce_363),+	(364 , happyReduce_364),+	(365 , happyReduce_365),+	(366 , happyReduce_366),+	(367 , happyReduce_367),+	(368 , happyReduce_368),+	(369 , happyReduce_369),+	(370 , happyReduce_370),+	(371 , happyReduce_371),+	(372 , happyReduce_372),+	(373 , happyReduce_373),+	(374 , happyReduce_374),+	(375 , happyReduce_375),+	(376 , happyReduce_376),+	(377 , happyReduce_377),+	(378 , happyReduce_378),+	(379 , happyReduce_379),+	(380 , happyReduce_380),+	(381 , happyReduce_381),+	(382 , happyReduce_382),+	(383 , happyReduce_383),+	(384 , happyReduce_384),+	(385 , happyReduce_385),+	(386 , happyReduce_386),+	(387 , happyReduce_387),+	(388 , happyReduce_388),+	(389 , happyReduce_389),+	(390 , happyReduce_390),+	(391 , happyReduce_391),+	(392 , happyReduce_392),+	(393 , happyReduce_393),+	(394 , happyReduce_394),+	(395 , happyReduce_395),+	(396 , happyReduce_396),+	(397 , happyReduce_397),+	(398 , happyReduce_398),+	(399 , happyReduce_399),+	(400 , happyReduce_400),+	(401 , happyReduce_401),+	(402 , happyReduce_402),+	(403 , happyReduce_403),+	(404 , happyReduce_404),+	(405 , happyReduce_405),+	(406 , happyReduce_406),+	(407 , happyReduce_407),+	(408 , happyReduce_408),+	(409 , happyReduce_409),+	(410 , happyReduce_410),+	(411 , happyReduce_411),+	(412 , happyReduce_412),+	(413 , happyReduce_413),+	(414 , happyReduce_414),+	(415 , happyReduce_415),+	(416 , happyReduce_416),+	(417 , happyReduce_417),+	(418 , happyReduce_418),+	(419 , happyReduce_419),+	(420 , happyReduce_420),+	(421 , happyReduce_421),+	(422 , happyReduce_422),+	(423 , happyReduce_423),+	(424 , happyReduce_424),+	(425 , happyReduce_425),+	(426 , happyReduce_426),+	(427 , happyReduce_427),+	(428 , happyReduce_428),+	(429 , happyReduce_429),+	(430 , happyReduce_430),+	(431 , happyReduce_431),+	(432 , happyReduce_432),+	(433 , happyReduce_433),+	(434 , happyReduce_434),+	(435 , happyReduce_435),+	(436 , happyReduce_436),+	(437 , happyReduce_437),+	(438 , happyReduce_438),+	(439 , happyReduce_439),+	(440 , happyReduce_440),+	(441 , happyReduce_441),+	(442 , happyReduce_442),+	(443 , happyReduce_443),+	(444 , happyReduce_444),+	(445 , happyReduce_445),+	(446 , happyReduce_446),+	(447 , happyReduce_447),+	(448 , happyReduce_448),+	(449 , happyReduce_449),+	(450 , happyReduce_450),+	(451 , happyReduce_451),+	(452 , happyReduce_452),+	(453 , happyReduce_453),+	(454 , happyReduce_454),+	(455 , happyReduce_455),+	(456 , happyReduce_456),+	(457 , happyReduce_457),+	(458 , happyReduce_458),+	(459 , happyReduce_459),+	(460 , happyReduce_460),+	(461 , happyReduce_461),+	(462 , happyReduce_462),+	(463 , happyReduce_463),+	(464 , happyReduce_464),+	(465 , happyReduce_465),+	(466 , happyReduce_466),+	(467 , happyReduce_467),+	(468 , happyReduce_468),+	(469 , happyReduce_469),+	(470 , happyReduce_470),+	(471 , happyReduce_471),+	(472 , happyReduce_472),+	(473 , happyReduce_473),+	(474 , happyReduce_474),+	(475 , happyReduce_475),+	(476 , happyReduce_476),+	(477 , happyReduce_477),+	(478 , happyReduce_478),+	(479 , happyReduce_479),+	(480 , happyReduce_480),+	(481 , happyReduce_481),+	(482 , happyReduce_482),+	(483 , happyReduce_483),+	(484 , happyReduce_484),+	(485 , happyReduce_485),+	(486 , happyReduce_486),+	(487 , happyReduce_487),+	(488 , happyReduce_488),+	(489 , happyReduce_489),+	(490 , happyReduce_490),+	(491 , happyReduce_491),+	(492 , happyReduce_492),+	(493 , happyReduce_493),+	(494 , happyReduce_494),+	(495 , happyReduce_495),+	(496 , happyReduce_496),+	(497 , happyReduce_497),+	(498 , happyReduce_498),+	(499 , happyReduce_499),+	(500 , happyReduce_500),+	(501 , happyReduce_501),+	(502 , happyReduce_502),+	(503 , happyReduce_503),+	(504 , happyReduce_504),+	(505 , happyReduce_505),+	(506 , happyReduce_506),+	(507 , happyReduce_507),+	(508 , happyReduce_508),+	(509 , happyReduce_509),+	(510 , happyReduce_510),+	(511 , happyReduce_511),+	(512 , happyReduce_512),+	(513 , happyReduce_513),+	(514 , happyReduce_514),+	(515 , happyReduce_515),+	(516 , happyReduce_516),+	(517 , happyReduce_517),+	(518 , happyReduce_518),+	(519 , happyReduce_519),+	(520 , happyReduce_520),+	(521 , happyReduce_521),+	(522 , happyReduce_522),+	(523 , happyReduce_523),+	(524 , happyReduce_524),+	(525 , happyReduce_525),+	(526 , happyReduce_526),+	(527 , happyReduce_527),+	(528 , happyReduce_528),+	(529 , happyReduce_529),+	(530 , happyReduce_530),+	(531 , happyReduce_531),+	(532 , happyReduce_532),+	(533 , happyReduce_533),+	(534 , happyReduce_534),+	(535 , happyReduce_535),+	(536 , happyReduce_536),+	(537 , happyReduce_537),+	(538 , happyReduce_538),+	(539 , happyReduce_539),+	(540 , happyReduce_540),+	(541 , happyReduce_541),+	(542 , happyReduce_542),+	(543 , happyReduce_543),+	(544 , happyReduce_544),+	(545 , happyReduce_545),+	(546 , happyReduce_546),+	(547 , happyReduce_547),+	(548 , happyReduce_548),+	(549 , happyReduce_549),+	(550 , happyReduce_550),+	(551 , happyReduce_551),+	(552 , happyReduce_552),+	(553 , happyReduce_553),+	(554 , happyReduce_554),+	(555 , happyReduce_555),+	(556 , happyReduce_556),+	(557 , happyReduce_557),+	(558 , happyReduce_558),+	(559 , happyReduce_559),+	(560 , happyReduce_560),+	(561 , happyReduce_561),+	(562 , happyReduce_562),+	(563 , happyReduce_563),+	(564 , happyReduce_564),+	(565 , happyReduce_565),+	(566 , happyReduce_566),+	(567 , happyReduce_567),+	(568 , happyReduce_568),+	(569 , happyReduce_569),+	(570 , happyReduce_570),+	(571 , happyReduce_571),+	(572 , happyReduce_572),+	(573 , happyReduce_573),+	(574 , happyReduce_574),+	(575 , happyReduce_575),+	(576 , happyReduce_576),+	(577 , happyReduce_577),+	(578 , happyReduce_578),+	(579 , happyReduce_579),+	(580 , happyReduce_580),+	(581 , happyReduce_581),+	(582 , happyReduce_582),+	(583 , happyReduce_583),+	(584 , happyReduce_584),+	(585 , happyReduce_585),+	(586 , happyReduce_586),+	(587 , happyReduce_587),+	(588 , happyReduce_588),+	(589 , happyReduce_589),+	(590 , happyReduce_590),+	(591 , happyReduce_591),+	(592 , happyReduce_592),+	(593 , happyReduce_593),+	(594 , happyReduce_594),+	(595 , happyReduce_595),+	(596 , happyReduce_596),+	(597 , happyReduce_597),+	(598 , happyReduce_598),+	(599 , happyReduce_599),+	(600 , happyReduce_600),+	(601 , happyReduce_601),+	(602 , happyReduce_602),+	(603 , happyReduce_603),+	(604 , happyReduce_604),+	(605 , happyReduce_605),+	(606 , happyReduce_606),+	(607 , happyReduce_607),+	(608 , happyReduce_608),+	(609 , happyReduce_609),+	(610 , happyReduce_610),+	(611 , happyReduce_611),+	(612 , happyReduce_612),+	(613 , happyReduce_613),+	(614 , happyReduce_614),+	(615 , happyReduce_615),+	(616 , happyReduce_616),+	(617 , happyReduce_617),+	(618 , happyReduce_618),+	(619 , happyReduce_619),+	(620 , happyReduce_620),+	(621 , happyReduce_621),+	(622 , happyReduce_622),+	(623 , happyReduce_623),+	(624 , happyReduce_624),+	(625 , happyReduce_625),+	(626 , happyReduce_626),+	(627 , happyReduce_627),+	(628 , happyReduce_628),+	(629 , happyReduce_629),+	(630 , happyReduce_630),+	(631 , happyReduce_631),+	(632 , happyReduce_632),+	(633 , happyReduce_633),+	(634 , happyReduce_634),+	(635 , happyReduce_635),+	(636 , happyReduce_636),+	(637 , happyReduce_637),+	(638 , happyReduce_638),+	(639 , happyReduce_639),+	(640 , happyReduce_640),+	(641 , happyReduce_641),+	(642 , happyReduce_642),+	(643 , happyReduce_643),+	(644 , happyReduce_644),+	(645 , happyReduce_645),+	(646 , happyReduce_646),+	(647 , happyReduce_647),+	(648 , happyReduce_648),+	(649 , happyReduce_649),+	(650 , happyReduce_650),+	(651 , happyReduce_651),+	(652 , happyReduce_652),+	(653 , happyReduce_653),+	(654 , happyReduce_654),+	(655 , happyReduce_655),+	(656 , happyReduce_656),+	(657 , happyReduce_657),+	(658 , happyReduce_658),+	(659 , happyReduce_659),+	(660 , happyReduce_660),+	(661 , happyReduce_661),+	(662 , happyReduce_662),+	(663 , happyReduce_663),+	(664 , happyReduce_664),+	(665 , happyReduce_665),+	(666 , happyReduce_666),+	(667 , happyReduce_667),+	(668 , happyReduce_668),+	(669 , happyReduce_669),+	(670 , happyReduce_670),+	(671 , happyReduce_671),+	(672 , happyReduce_672),+	(673 , happyReduce_673),+	(674 , happyReduce_674),+	(675 , happyReduce_675),+	(676 , happyReduce_676),+	(677 , happyReduce_677),+	(678 , happyReduce_678),+	(679 , happyReduce_679),+	(680 , happyReduce_680),+	(681 , happyReduce_681),+	(682 , happyReduce_682),+	(683 , happyReduce_683),+	(684 , happyReduce_684),+	(685 , happyReduce_685),+	(686 , happyReduce_686),+	(687 , happyReduce_687),+	(688 , happyReduce_688),+	(689 , happyReduce_689),+	(690 , happyReduce_690),+	(691 , happyReduce_691),+	(692 , happyReduce_692),+	(693 , happyReduce_693),+	(694 , happyReduce_694),+	(695 , happyReduce_695),+	(696 , happyReduce_696),+	(697 , happyReduce_697),+	(698 , happyReduce_698),+	(699 , happyReduce_699),+	(700 , happyReduce_700),+	(701 , happyReduce_701),+	(702 , happyReduce_702),+	(703 , happyReduce_703),+	(704 , happyReduce_704),+	(705 , happyReduce_705),+	(706 , happyReduce_706),+	(707 , happyReduce_707),+	(708 , happyReduce_708),+	(709 , happyReduce_709),+	(710 , happyReduce_710),+	(711 , happyReduce_711),+	(712 , happyReduce_712),+	(713 , happyReduce_713),+	(714 , happyReduce_714),+	(715 , happyReduce_715),+	(716 , happyReduce_716),+	(717 , happyReduce_717),+	(718 , happyReduce_718),+	(719 , happyReduce_719),+	(720 , happyReduce_720),+	(721 , happyReduce_721),+	(722 , happyReduce_722),+	(723 , happyReduce_723),+	(724 , happyReduce_724),+	(725 , happyReduce_725),+	(726 , happyReduce_726),+	(727 , happyReduce_727),+	(728 , happyReduce_728),+	(729 , happyReduce_729),+	(730 , happyReduce_730),+	(731 , happyReduce_731),+	(732 , happyReduce_732),+	(733 , happyReduce_733),+	(734 , happyReduce_734),+	(735 , happyReduce_735),+	(736 , happyReduce_736),+	(737 , happyReduce_737),+	(738 , happyReduce_738),+	(739 , happyReduce_739),+	(740 , happyReduce_740),+	(741 , happyReduce_741),+	(742 , happyReduce_742),+	(743 , happyReduce_743),+	(744 , happyReduce_744),+	(745 , happyReduce_745),+	(746 , happyReduce_746),+	(747 , happyReduce_747),+	(748 , happyReduce_748),+	(749 , happyReduce_749),+	(750 , happyReduce_750),+	(751 , happyReduce_751),+	(752 , happyReduce_752),+	(753 , happyReduce_753),+	(754 , happyReduce_754),+	(755 , happyReduce_755),+	(756 , happyReduce_756),+	(757 , happyReduce_757),+	(758 , happyReduce_758),+	(759 , happyReduce_759),+	(760 , happyReduce_760),+	(761 , happyReduce_761),+	(762 , happyReduce_762),+	(763 , happyReduce_763),+	(764 , happyReduce_764),+	(765 , happyReduce_765),+	(766 , happyReduce_766),+	(767 , happyReduce_767),+	(768 , happyReduce_768),+	(769 , happyReduce_769),+	(770 , happyReduce_770),+	(771 , happyReduce_771),+	(772 , happyReduce_772),+	(773 , happyReduce_773),+	(774 , happyReduce_774),+	(775 , happyReduce_775),+	(776 , happyReduce_776),+	(777 , happyReduce_777),+	(778 , happyReduce_778),+	(779 , happyReduce_779),+	(780 , happyReduce_780),+	(781 , happyReduce_781),+	(782 , happyReduce_782),+	(783 , happyReduce_783),+	(784 , happyReduce_784),+	(785 , happyReduce_785),+	(786 , happyReduce_786),+	(787 , happyReduce_787),+	(788 , happyReduce_788),+	(789 , happyReduce_789),+	(790 , happyReduce_790),+	(791 , happyReduce_791),+	(792 , happyReduce_792),+	(793 , happyReduce_793),+	(794 , happyReduce_794),+	(795 , happyReduce_795),+	(796 , happyReduce_796),+	(797 , happyReduce_797),+	(798 , happyReduce_798),+	(799 , happyReduce_799),+	(800 , happyReduce_800),+	(801 , happyReduce_801),+	(802 , happyReduce_802),+	(803 , happyReduce_803),+	(804 , happyReduce_804),+	(805 , happyReduce_805),+	(806 , happyReduce_806),+	(807 , happyReduce_807),+	(808 , happyReduce_808),+	(809 , happyReduce_809),+	(810 , happyReduce_810),+	(811 , happyReduce_811),+	(812 , happyReduce_812),+	(813 , happyReduce_813),+	(814 , happyReduce_814),+	(815 , happyReduce_815),+	(816 , happyReduce_816),+	(817 , happyReduce_817),+	(818 , happyReduce_818),+	(819 , happyReduce_819),+	(820 , happyReduce_820),+	(821 , happyReduce_821),+	(822 , happyReduce_822),+	(823 , happyReduce_823),+	(824 , happyReduce_824),+	(825 , happyReduce_825),+	(826 , happyReduce_826),+	(827 , happyReduce_827),+	(828 , happyReduce_828),+	(829 , happyReduce_829),+	(830 , happyReduce_830)+	]++happy_n_terms = 154 :: Int+happy_n_nonterms = 312 :: Int++happyReduce_13 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_13 = happySpecReduce_1  0# happyReduction_13+happyReduction_13 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_13 _  = notHappyAtAll ++happyReduce_14 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_14 = happySpecReduce_1  0# happyReduction_14+happyReduction_14 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_14 _  = notHappyAtAll ++happyReduce_15 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_15 = happySpecReduce_1  0# happyReduction_15+happyReduction_15 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_15 _  = notHappyAtAll ++happyReduce_16 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_16 = happySpecReduce_1  0# happyReduction_16+happyReduction_16 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_16 _  = notHappyAtAll ++happyReduce_17 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_17 = happyMonadReduce 3# 0# happyReduction_17+happyReduction_17 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ getRdrName funTyCon)+                               [mop happy_var_1,mu AnnRarrow happy_var_2,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_18 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_18 = happyMonadReduce 3# 0# happyReduction_18+happyReduction_18 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ eqTyCon_RDR)+                               [mop happy_var_1,mj AnnTilde happy_var_2,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_19 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_19 = happySpecReduce_3  1# happyReduction_19+happyReduction_19 _+	(HappyAbsSyn18  happy_var_2)+	_+	 =  HappyAbsSyn17+		 (fromOL happy_var_2+	)+happyReduction_19 _ _ _  = notHappyAtAll ++happyReduce_20 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_20 = happySpecReduce_3  1# happyReduction_20+happyReduction_20 _+	(HappyAbsSyn18  happy_var_2)+	_+	 =  HappyAbsSyn17+		 (fromOL happy_var_2+	)+happyReduction_20 _ _ _  = notHappyAtAll ++happyReduce_21 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_21 = happySpecReduce_3  2# happyReduction_21+happyReduction_21 (HappyAbsSyn19  happy_var_3)+	_+	(HappyAbsSyn18  happy_var_1)+	 =  HappyAbsSyn18+		 (happy_var_1 `appOL` unitOL happy_var_3+	)+happyReduction_21 _ _ _  = notHappyAtAll ++happyReduce_22 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_22 = happySpecReduce_2  2# happyReduction_22+happyReduction_22 _+	(HappyAbsSyn18  happy_var_1)+	 =  HappyAbsSyn18+		 (happy_var_1+	)+happyReduction_22 _ _  = notHappyAtAll ++happyReduce_23 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_23 = happySpecReduce_1  2# happyReduction_23+happyReduction_23 (HappyAbsSyn19  happy_var_1)+	 =  HappyAbsSyn18+		 (unitOL happy_var_1+	)+happyReduction_23 _  = notHappyAtAll ++happyReduce_24 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_24 = happyReduce 4# 3# happyReduction_24+happyReduction_24 ((HappyAbsSyn30  happy_var_4) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn24  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn19+		 (sL1 happy_var_1 $ HsUnit { hsunitName = happy_var_2+                              , hsunitBody = fromOL happy_var_4 }+	) `HappyStk` happyRest++happyReduce_25 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_25 = happySpecReduce_1  4# happyReduction_25+happyReduction_25 (HappyAbsSyn24  happy_var_1)+	 =  HappyAbsSyn20+		 (sL1 happy_var_1 $ HsUnitId happy_var_1 []+	)+happyReduction_25 _  = notHappyAtAll ++happyReduce_26 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_26 = happyReduce 4# 4# happyReduction_26+happyReduction_26 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn21  happy_var_3) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn24  happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn20+		 (sLL happy_var_1 happy_var_4 $ HsUnitId happy_var_1 (fromOL happy_var_3)+	) `HappyStk` happyRest++happyReduce_27 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_27 = happySpecReduce_3  5# happyReduction_27+happyReduction_27 (HappyAbsSyn22  happy_var_3)+	_+	(HappyAbsSyn21  happy_var_1)+	 =  HappyAbsSyn21+		 (happy_var_1 `appOL` unitOL happy_var_3+	)+happyReduction_27 _ _ _  = notHappyAtAll ++happyReduce_28 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_28 = happySpecReduce_2  5# happyReduction_28+happyReduction_28 _+	(HappyAbsSyn21  happy_var_1)+	 =  HappyAbsSyn21+		 (happy_var_1+	)+happyReduction_28 _ _  = notHappyAtAll ++happyReduce_29 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_29 = happySpecReduce_1  5# happyReduction_29+happyReduction_29 (HappyAbsSyn22  happy_var_1)+	 =  HappyAbsSyn21+		 (unitOL happy_var_1+	)+happyReduction_29 _  = notHappyAtAll ++happyReduce_30 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_30 = happySpecReduce_3  6# happyReduction_30+happyReduction_30 (HappyAbsSyn23  happy_var_3)+	_+	(HappyAbsSyn317  happy_var_1)+	 =  HappyAbsSyn22+		 (sLL happy_var_1 happy_var_3 $ (happy_var_1, happy_var_3)+	)+happyReduction_30 _ _ _  = notHappyAtAll ++happyReduce_31 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_31 = happyReduce 4# 6# happyReduction_31+happyReduction_31 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn317  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn317  happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn22+		 (sLL happy_var_1 happy_var_4 $ (happy_var_1, sLL happy_var_2 happy_var_4 $ HsModuleVar happy_var_3)+	) `HappyStk` happyRest++happyReduce_32 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_32 = happySpecReduce_3  7# happyReduction_32+happyReduction_32 (HappyTerminal happy_var_3)+	(HappyAbsSyn317  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn23+		 (sLL happy_var_1 happy_var_3 $ HsModuleVar happy_var_2+	)+happyReduction_32 _ _ _  = notHappyAtAll ++happyReduce_33 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_33 = happySpecReduce_3  7# happyReduction_33+happyReduction_33 (HappyAbsSyn317  happy_var_3)+	_+	(HappyAbsSyn20  happy_var_1)+	 =  HappyAbsSyn23+		 (sLL happy_var_1 happy_var_3 $ HsModuleId happy_var_1 happy_var_3+	)+happyReduction_33 _ _ _  = notHappyAtAll ++happyReduce_34 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_34 = happySpecReduce_1  8# happyReduction_34+happyReduction_34 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn24+		 (sL1 happy_var_1 $ PackageName (getSTRING happy_var_1)+	)+happyReduction_34 _  = notHappyAtAll ++happyReduce_35 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_35 = happySpecReduce_1  8# happyReduction_35+happyReduction_35 (HappyAbsSyn25  happy_var_1)+	 =  HappyAbsSyn24+		 (sL1 happy_var_1 $ PackageName (unLoc happy_var_1)+	)+happyReduction_35 _  = notHappyAtAll ++happyReduce_36 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_36 = happySpecReduce_1  9# happyReduction_36+happyReduction_36 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 $ getVARID happy_var_1+	)+happyReduction_36 _  = notHappyAtAll ++happyReduce_37 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_37 = happySpecReduce_1  9# happyReduction_37+happyReduction_37 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 $ getCONID happy_var_1+	)+happyReduction_37 _  = notHappyAtAll ++happyReduce_38 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_38 = happySpecReduce_1  9# happyReduction_38+happyReduction_38 (HappyAbsSyn25  happy_var_1)+	 =  HappyAbsSyn25+		 (happy_var_1+	)+happyReduction_38 _  = notHappyAtAll ++happyReduce_39 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_39 = happySpecReduce_1  10# happyReduction_39+happyReduction_39 (HappyAbsSyn25  happy_var_1)+	 =  HappyAbsSyn25+		 (happy_var_1+	)+happyReduction_39 _  = notHappyAtAll ++happyReduce_40 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_40 = happySpecReduce_3  10# happyReduction_40+happyReduction_40 (HappyAbsSyn25  happy_var_3)+	_+	(HappyAbsSyn25  happy_var_1)+	 =  HappyAbsSyn25+		 (sLL happy_var_1 happy_var_3 $ appendFS (unLoc happy_var_1) (consFS '-' (unLoc happy_var_3))+	)+happyReduction_40 _ _ _  = notHappyAtAll ++happyReduce_41 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_41 = happySpecReduce_0  11# happyReduction_41+happyReduction_41  =  HappyAbsSyn27+		 (Nothing+	)++happyReduce_42 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_42 = happySpecReduce_3  11# happyReduction_42+happyReduction_42 _+	(HappyAbsSyn28  happy_var_2)+	_+	 =  HappyAbsSyn27+		 (Just (fromOL happy_var_2)+	)+happyReduction_42 _ _ _  = notHappyAtAll ++happyReduce_43 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_43 = happySpecReduce_3  12# happyReduction_43+happyReduction_43 (HappyAbsSyn29  happy_var_3)+	_+	(HappyAbsSyn28  happy_var_1)+	 =  HappyAbsSyn28+		 (happy_var_1 `appOL` unitOL happy_var_3+	)+happyReduction_43 _ _ _  = notHappyAtAll ++happyReduce_44 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_44 = happySpecReduce_2  12# happyReduction_44+happyReduction_44 _+	(HappyAbsSyn28  happy_var_1)+	 =  HappyAbsSyn28+		 (happy_var_1+	)+happyReduction_44 _ _  = notHappyAtAll ++happyReduce_45 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_45 = happySpecReduce_1  12# happyReduction_45+happyReduction_45 (HappyAbsSyn29  happy_var_1)+	 =  HappyAbsSyn28+		 (unitOL happy_var_1+	)+happyReduction_45 _  = notHappyAtAll ++happyReduce_46 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_46 = happySpecReduce_3  13# happyReduction_46+happyReduction_46 (HappyAbsSyn317  happy_var_3)+	_+	(HappyAbsSyn317  happy_var_1)+	 =  HappyAbsSyn29+		 (sLL happy_var_1 happy_var_3 $ Renaming happy_var_1 (Just happy_var_3)+	)+happyReduction_46 _ _ _  = notHappyAtAll ++happyReduce_47 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_47 = happySpecReduce_1  13# happyReduction_47+happyReduction_47 (HappyAbsSyn317  happy_var_1)+	 =  HappyAbsSyn29+		 (sL1 happy_var_1    $ Renaming happy_var_1 Nothing+	)+happyReduction_47 _  = notHappyAtAll ++happyReduce_48 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_48 = happySpecReduce_3  14# happyReduction_48+happyReduction_48 _+	(HappyAbsSyn30  happy_var_2)+	_+	 =  HappyAbsSyn30+		 (happy_var_2+	)+happyReduction_48 _ _ _  = notHappyAtAll ++happyReduce_49 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_49 = happySpecReduce_3  14# happyReduction_49+happyReduction_49 _+	(HappyAbsSyn30  happy_var_2)+	_+	 =  HappyAbsSyn30+		 (happy_var_2+	)+happyReduction_49 _ _ _  = notHappyAtAll ++happyReduce_50 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_50 = happySpecReduce_3  15# happyReduction_50+happyReduction_50 (HappyAbsSyn32  happy_var_3)+	_+	(HappyAbsSyn30  happy_var_1)+	 =  HappyAbsSyn30+		 (happy_var_1 `appOL` unitOL happy_var_3+	)+happyReduction_50 _ _ _  = notHappyAtAll ++happyReduce_51 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_51 = happySpecReduce_2  15# happyReduction_51+happyReduction_51 _+	(HappyAbsSyn30  happy_var_1)+	 =  HappyAbsSyn30+		 (happy_var_1+	)+happyReduction_51 _ _  = notHappyAtAll ++happyReduce_52 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_52 = happySpecReduce_1  15# happyReduction_52+happyReduction_52 (HappyAbsSyn32  happy_var_1)+	 =  HappyAbsSyn30+		 (unitOL happy_var_1+	)+happyReduction_52 _  = notHappyAtAll ++happyReduce_53 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_53 = happyReduce 7# 16# happyReduction_53+happyReduction_53 ((HappyAbsSyn39  happy_var_7) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn48  happy_var_5) `HappyStk`+	(HappyAbsSyn38  happy_var_4) `HappyStk`+	(HappyAbsSyn317  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn35  happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn32+		 (sL1 happy_var_2 $ DeclD ModuleD happy_var_3 (Just (sL1 happy_var_2 (HsModule (Just happy_var_3) happy_var_5 (fst $ snd happy_var_7) (snd $ snd happy_var_7) happy_var_4 happy_var_1)))+	) `HappyStk` happyRest++happyReduce_54 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_54 = happyReduce 7# 16# happyReduction_54+happyReduction_54 ((HappyAbsSyn39  happy_var_7) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn48  happy_var_5) `HappyStk`+	(HappyAbsSyn38  happy_var_4) `HappyStk`+	(HappyAbsSyn317  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn35  happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn32+		 (sL1 happy_var_2 $ DeclD SignatureD happy_var_3 (Just (sL1 happy_var_2 (HsModule (Just happy_var_3) happy_var_5 (fst $ snd happy_var_7) (snd $ snd happy_var_7) happy_var_4 happy_var_1)))+	) `HappyStk` happyRest++happyReduce_55 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_55 = happySpecReduce_3  16# happyReduction_55+happyReduction_55 (HappyAbsSyn317  happy_var_3)+	(HappyTerminal happy_var_2)+	_+	 =  HappyAbsSyn32+		 (sL1 happy_var_2 $ DeclD ModuleD happy_var_3 Nothing+	)+happyReduction_55 _ _ _  = notHappyAtAll ++happyReduce_56 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_56 = happySpecReduce_3  16# happyReduction_56+happyReduction_56 (HappyAbsSyn317  happy_var_3)+	(HappyTerminal happy_var_2)+	_+	 =  HappyAbsSyn32+		 (sL1 happy_var_2 $ DeclD SignatureD happy_var_3 Nothing+	)+happyReduction_56 _ _ _  = notHappyAtAll ++happyReduce_57 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_57 = happySpecReduce_3  16# happyReduction_57+happyReduction_57 (HappyAbsSyn27  happy_var_3)+	(HappyAbsSyn20  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn32+		 (sL1 happy_var_1 $ IncludeD (IncludeDecl { idUnitId = happy_var_2+                                              , idModRenaming = happy_var_3+                                              , idSignatureInclude = False })+	)+happyReduction_57 _ _ _  = notHappyAtAll ++happyReduce_58 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_58 = happySpecReduce_3  16# happyReduction_58+happyReduction_58 (HappyAbsSyn20  happy_var_3)+	_+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn32+		 (sL1 happy_var_1 $ IncludeD (IncludeDecl { idUnitId = happy_var_3+                                              , idModRenaming = Nothing+                                              , idSignatureInclude = True })+	)+happyReduction_58 _ _ _  = notHappyAtAll ++happyReduce_59 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_59 = happyMonadReduce 7# 17# happyReduction_59+happyReduction_59 ((HappyAbsSyn39  happy_var_7) `HappyStk`+	(HappyTerminal happy_var_6) `HappyStk`+	(HappyAbsSyn48  happy_var_5) `HappyStk`+	(HappyAbsSyn38  happy_var_4) `HappyStk`+	(HappyAbsSyn317  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn35  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( fileSrcSpan >>= \ loc ->+                ams (cL loc (HsModule (Just happy_var_3) happy_var_5 (fst $ snd happy_var_7)+                              (snd $ snd happy_var_7) happy_var_4 happy_var_1)+                    )+                    ([mj AnnSignature happy_var_2, mj AnnWhere happy_var_6] ++ fst happy_var_7)))+	) (\r -> happyReturn (HappyAbsSyn33 r))++happyReduce_60 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_60 = happyMonadReduce 7# 18# happyReduction_60+happyReduction_60 ((HappyAbsSyn39  happy_var_7) `HappyStk`+	(HappyTerminal happy_var_6) `HappyStk`+	(HappyAbsSyn48  happy_var_5) `HappyStk`+	(HappyAbsSyn38  happy_var_4) `HappyStk`+	(HappyAbsSyn317  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn35  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( fileSrcSpan >>= \ loc ->+                ams (cL loc (HsModule (Just happy_var_3) happy_var_5 (fst $ snd happy_var_7)+                              (snd $ snd happy_var_7) happy_var_4 happy_var_1)+                    )+                    ([mj AnnModule happy_var_2, mj AnnWhere happy_var_6] ++ fst happy_var_7)))+	) (\r -> happyReturn (HappyAbsSyn33 r))++happyReduce_61 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_61 = happyMonadReduce 1# 18# happyReduction_61+happyReduction_61 ((HappyAbsSyn39  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( fileSrcSpan >>= \ loc ->+                   ams (cL loc (HsModule Nothing Nothing+                               (fst $ snd happy_var_1) (snd $ snd happy_var_1) Nothing Nothing))+                       (fst happy_var_1)))+	) (\r -> happyReturn (HappyAbsSyn33 r))++happyReduce_62 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_62 = happySpecReduce_1  19# happyReduction_62+happyReduction_62 (HappyAbsSyn35  happy_var_1)+	 =  HappyAbsSyn35+		 (happy_var_1+	)+happyReduction_62 _  = notHappyAtAll ++happyReduce_63 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_63 = happySpecReduce_0  19# happyReduction_63+happyReduction_63  =  HappyAbsSyn35+		 (Nothing+	)++happyReduce_64 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_64 = happyMonadReduce 0# 20# happyReduction_64+happyReduction_64 (happyRest) tk+	 = happyThen ((( pushModuleContext))+	) (\r -> happyReturn (HappyAbsSyn36 r))++happyReduce_65 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_65 = happyMonadReduce 0# 21# happyReduction_65+happyReduction_65 (happyRest) tk+	 = happyThen ((( pushModuleContext))+	) (\r -> happyReturn (HappyAbsSyn36 r))++happyReduce_66 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_66 = happyMonadReduce 3# 22# happyReduction_66+happyReduction_66 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn138  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ajs (Just (sLL happy_var_1 happy_var_3 $ DeprecatedTxt (sL1 happy_var_1 (getDEPRECATED_PRAGs happy_var_1)) (snd $ unLoc happy_var_2)))+                             (mo happy_var_1:mc happy_var_3: (fst $ unLoc happy_var_2))))+	) (\r -> happyReturn (HappyAbsSyn38 r))++happyReduce_67 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_67 = happyMonadReduce 3# 22# happyReduction_67+happyReduction_67 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn138  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ajs (Just (sLL happy_var_1 happy_var_3 $ WarningTxt (sL1 happy_var_1 (getWARNING_PRAGs happy_var_1)) (snd $ unLoc happy_var_2)))+                                (mo happy_var_1:mc happy_var_3 : (fst $ unLoc happy_var_2))))+	) (\r -> happyReturn (HappyAbsSyn38 r))++happyReduce_68 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_68 = happySpecReduce_0  22# happyReduction_68+happyReduction_68  =  HappyAbsSyn38+		 (Nothing+	)++happyReduce_69 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_69 = happySpecReduce_3  23# happyReduction_69+happyReduction_69 (HappyTerminal happy_var_3)+	(HappyAbsSyn39  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn39+		 ((moc happy_var_1:mcc happy_var_3:(fst happy_var_2)+                                         , snd happy_var_2)+	)+happyReduction_69 _ _ _  = notHappyAtAll ++happyReduce_70 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_70 = happySpecReduce_3  23# happyReduction_70+happyReduction_70 _+	(HappyAbsSyn39  happy_var_2)+	_+	 =  HappyAbsSyn39+		 ((fst happy_var_2, snd happy_var_2)+	)+happyReduction_70 _ _ _  = notHappyAtAll ++happyReduce_71 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_71 = happySpecReduce_3  24# happyReduction_71+happyReduction_71 (HappyTerminal happy_var_3)+	(HappyAbsSyn39  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn39+		 ((moc happy_var_1:mcc happy_var_3+                                                   :(fst happy_var_2), snd happy_var_2)+	)+happyReduction_71 _ _ _  = notHappyAtAll ++happyReduce_72 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_72 = happySpecReduce_3  24# happyReduction_72+happyReduction_72 _+	(HappyAbsSyn39  happy_var_2)+	_+	 =  HappyAbsSyn39+		 (([],snd happy_var_2)+	)+happyReduction_72 _ _ _  = notHappyAtAll ++happyReduce_73 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_73 = happySpecReduce_2  25# happyReduction_73+happyReduction_73 (HappyAbsSyn42  happy_var_2)+	(HappyAbsSyn60  happy_var_1)+	 =  HappyAbsSyn39+		 ((happy_var_1, happy_var_2)+	)+happyReduction_73 _ _  = notHappyAtAll ++happyReduce_74 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_74 = happySpecReduce_2  26# happyReduction_74+happyReduction_74 (HappyAbsSyn75  happy_var_2)+	(HappyAbsSyn44  happy_var_1)+	 =  HappyAbsSyn42+		 ((reverse happy_var_1, cvTopDecls happy_var_2)+	)+happyReduction_74 _ _  = notHappyAtAll ++happyReduce_75 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_75 = happySpecReduce_2  26# happyReduction_75+happyReduction_75 (HappyAbsSyn75  happy_var_2)+	(HappyAbsSyn44  happy_var_1)+	 =  HappyAbsSyn42+		 ((reverse happy_var_1, cvTopDecls happy_var_2)+	)+happyReduction_75 _ _  = notHappyAtAll ++happyReduce_76 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_76 = happySpecReduce_1  26# happyReduction_76+happyReduction_76 (HappyAbsSyn44  happy_var_1)+	 =  HappyAbsSyn42+		 ((reverse happy_var_1, [])+	)+happyReduction_76 _  = notHappyAtAll ++happyReduce_77 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_77 = happyMonadReduce 7# 27# happyReduction_77+happyReduction_77 ((HappyAbsSyn44  happy_var_7) `HappyStk`+	(HappyTerminal happy_var_6) `HappyStk`+	(HappyAbsSyn48  happy_var_5) `HappyStk`+	(HappyAbsSyn38  happy_var_4) `HappyStk`+	(HappyAbsSyn317  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn35  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( fileSrcSpan >>= \ loc ->+                   ams (cL loc (HsModule (Just happy_var_3) happy_var_5 happy_var_7 [] happy_var_4 happy_var_1+                          )) [mj AnnModule happy_var_2,mj AnnWhere happy_var_6]))+	) (\r -> happyReturn (HappyAbsSyn33 r))++happyReduce_78 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_78 = happyMonadReduce 7# 27# happyReduction_78+happyReduction_78 ((HappyAbsSyn44  happy_var_7) `HappyStk`+	(HappyTerminal happy_var_6) `HappyStk`+	(HappyAbsSyn48  happy_var_5) `HappyStk`+	(HappyAbsSyn38  happy_var_4) `HappyStk`+	(HappyAbsSyn317  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn35  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( fileSrcSpan >>= \ loc ->+                   ams (cL loc (HsModule (Just happy_var_3) happy_var_5 happy_var_7 [] happy_var_4 happy_var_1+                          )) [mj AnnModule happy_var_2,mj AnnWhere happy_var_6]))+	) (\r -> happyReturn (HappyAbsSyn33 r))++happyReduce_79 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_79 = happyMonadReduce 1# 27# happyReduction_79+happyReduction_79 ((HappyAbsSyn44  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( fileSrcSpan >>= \ loc ->+                   return (cL loc (HsModule Nothing Nothing happy_var_1 [] Nothing+                          Nothing))))+	) (\r -> happyReturn (HappyAbsSyn33 r))++happyReduce_80 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_80 = happySpecReduce_2  28# happyReduction_80+happyReduction_80 (HappyAbsSyn44  happy_var_2)+	_+	 =  HappyAbsSyn44+		 (happy_var_2+	)+happyReduction_80 _ _  = notHappyAtAll ++happyReduce_81 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_81 = happySpecReduce_2  28# happyReduction_81+happyReduction_81 (HappyAbsSyn44  happy_var_2)+	_+	 =  HappyAbsSyn44+		 (happy_var_2+	)+happyReduction_81 _ _  = notHappyAtAll ++happyReduce_82 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_82 = happySpecReduce_2  29# happyReduction_82+happyReduction_82 (HappyAbsSyn44  happy_var_2)+	_+	 =  HappyAbsSyn44+		 (happy_var_2+	)+happyReduction_82 _ _  = notHappyAtAll ++happyReduce_83 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_83 = happySpecReduce_2  29# happyReduction_83+happyReduction_83 (HappyAbsSyn44  happy_var_2)+	_+	 =  HappyAbsSyn44+		 (happy_var_2+	)+happyReduction_83 _ _  = notHappyAtAll ++happyReduce_84 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_84 = happySpecReduce_2  30# happyReduction_84+happyReduction_84 (HappyAbsSyn44  happy_var_2)+	_+	 =  HappyAbsSyn44+		 (happy_var_2+	)+happyReduction_84 _ _  = notHappyAtAll ++happyReduce_85 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_85 = happySpecReduce_1  31# happyReduction_85+happyReduction_85 (HappyAbsSyn44  happy_var_1)+	 =  HappyAbsSyn44+		 (happy_var_1+	)+happyReduction_85 _  = notHappyAtAll ++happyReduce_86 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_86 = happySpecReduce_1  31# happyReduction_86+happyReduction_86 (HappyAbsSyn44  happy_var_1)+	 =  HappyAbsSyn44+		 (happy_var_1+	)+happyReduction_86 _  = notHappyAtAll ++happyReduce_87 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_87 = happyMonadReduce 3# 32# happyReduction_87+happyReduction_87 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn49  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amsL (comb2 happy_var_1 happy_var_3) [mop happy_var_1,mcp happy_var_3] >>+                                       return (Just (sLL happy_var_1 happy_var_3 (fromOL happy_var_2)))))+	) (\r -> happyReturn (HappyAbsSyn48 r))++happyReduce_88 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_88 = happySpecReduce_0  32# happyReduction_88+happyReduction_88  =  HappyAbsSyn48+		 (Nothing+	)++happyReduce_89 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_89 = happyMonadReduce 3# 33# happyReduction_89+happyReduction_89 ((HappyAbsSyn49  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn49  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (oll happy_var_1) AnnComma (gl happy_var_2)+                                         >> return (happy_var_1 `appOL` happy_var_3)))+	) (\r -> happyReturn (HappyAbsSyn49 r))++happyReduce_90 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_90 = happySpecReduce_1  33# happyReduction_90+happyReduction_90 (HappyAbsSyn49  happy_var_1)+	 =  HappyAbsSyn49+		 (happy_var_1+	)+happyReduction_90 _  = notHappyAtAll ++happyReduce_91 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_91 = happyMonadReduce 5# 34# happyReduction_91+happyReduction_91 ((HappyAbsSyn49  happy_var_5) `HappyStk`+	(HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn49  happy_var_3) `HappyStk`+	(HappyAbsSyn49  happy_var_2) `HappyStk`+	(HappyAbsSyn49  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( (addAnnotation (oll (happy_var_1 `appOL` happy_var_2 `appOL` happy_var_3))+                                            AnnComma (gl happy_var_4) ) >>+                              return (happy_var_1 `appOL` happy_var_2 `appOL` happy_var_3 `appOL` happy_var_5)))+	) (\r -> happyReturn (HappyAbsSyn49 r))++happyReduce_92 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_92 = happySpecReduce_3  34# happyReduction_92+happyReduction_92 (HappyAbsSyn49  happy_var_3)+	(HappyAbsSyn49  happy_var_2)+	(HappyAbsSyn49  happy_var_1)+	 =  HappyAbsSyn49+		 (happy_var_1 `appOL` happy_var_2 `appOL` happy_var_3+	)+happyReduction_92 _ _ _  = notHappyAtAll ++happyReduce_93 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_93 = happySpecReduce_1  34# happyReduction_93+happyReduction_93 (HappyAbsSyn49  happy_var_1)+	 =  HappyAbsSyn49+		 (happy_var_1+	)+happyReduction_93 _  = notHappyAtAll ++happyReduce_94 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_94 = happySpecReduce_2  35# happyReduction_94+happyReduction_94 (HappyAbsSyn49  happy_var_2)+	(HappyAbsSyn49  happy_var_1)+	 =  HappyAbsSyn49+		 (happy_var_1 `appOL` happy_var_2+	)+happyReduction_94 _ _  = notHappyAtAll ++happyReduce_95 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_95 = happySpecReduce_0  35# happyReduction_95+happyReduction_95  =  HappyAbsSyn49+		 (nilOL+	)++happyReduce_96 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_96 = happySpecReduce_1  36# happyReduction_96+happyReduction_96 (HappyAbsSyn324  happy_var_1)+	 =  HappyAbsSyn49+		 (unitOL (sL1 happy_var_1 (case (unLoc happy_var_1) of (n, doc) -> IEGroup noExt n doc))+	)+happyReduction_96 _  = notHappyAtAll ++happyReduce_97 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_97 = happySpecReduce_1  36# happyReduction_97+happyReduction_97 (HappyAbsSyn323  happy_var_1)+	 =  HappyAbsSyn49+		 (unitOL (sL1 happy_var_1 (IEDocNamed noExt ((fst . unLoc) happy_var_1)))+	)+happyReduction_97 _  = notHappyAtAll ++happyReduce_98 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_98 = happySpecReduce_1  36# happyReduction_98+happyReduction_98 (HappyAbsSyn321  happy_var_1)+	 =  HappyAbsSyn49+		 (unitOL (sL1 happy_var_1 (IEDoc noExt (unLoc happy_var_1)))+	)+happyReduction_98 _  = notHappyAtAll ++happyReduce_99 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_99 = happyMonadReduce 2# 37# happyReduction_99+happyReduction_99 ((HappyAbsSyn54  happy_var_2) `HappyStk`+	(HappyAbsSyn58  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( mkModuleImpExp happy_var_1 (snd $ unLoc happy_var_2)+                                          >>= \ie -> amsu (sLL happy_var_1 happy_var_2 ie) (fst $ unLoc happy_var_2)))+	) (\r -> happyReturn (HappyAbsSyn49 r))++happyReduce_100 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_100 = happyMonadReduce 2# 37# happyReduction_100+happyReduction_100 ((HappyAbsSyn317  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amsu (sLL happy_var_1 happy_var_2 (IEModuleContents noExt happy_var_2))+                                             [mj AnnModule happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn49 r))++happyReduce_101 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_101 = happyMonadReduce 2# 37# happyReduction_101+happyReduction_101 ((HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amsu (sLL happy_var_1 happy_var_2 (IEVar noExt (sLL happy_var_1 happy_var_2 (IEPattern happy_var_2))))+                                             [mj AnnPattern happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn49 r))++happyReduce_102 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_102 = happySpecReduce_0  38# happyReduction_102+happyReduction_102  =  HappyAbsSyn54+		 (sL0 ([],ImpExpAbs)+	)++happyReduce_103 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_103 = happyMonadReduce 3# 38# happyReduction_103+happyReduction_103 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn55  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( mkImpExpSubSpec (reverse (snd happy_var_2))+                                      >>= \(as,ie) -> return $ sLL happy_var_1 happy_var_3+                                            (as ++ [mop happy_var_1,mcp happy_var_3] ++ fst happy_var_2, ie)))+	) (\r -> happyReturn (HappyAbsSyn54 r))++happyReduce_104 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_104 = happySpecReduce_0  39# happyReduction_104+happyReduction_104  =  HappyAbsSyn55+		 (([],[])+	)++happyReduce_105 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_105 = happySpecReduce_1  39# happyReduction_105+happyReduction_105 (HappyAbsSyn55  happy_var_1)+	 =  HappyAbsSyn55+		 (happy_var_1+	)+happyReduction_105 _  = notHappyAtAll ++happyReduce_106 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_106 = happyMonadReduce 3# 40# happyReduction_106+happyReduction_106 ((HappyAbsSyn57  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn55  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( case (head (snd happy_var_1)) of+                                                    l@(dL->L _ ImpExpQcWildcard) ->+                                                       return ([mj AnnComma happy_var_2, mj AnnDotdot l]+                                                               ,(snd (unLoc happy_var_3)  : snd happy_var_1))+                                                    l -> (ams (head (snd happy_var_1)) [mj AnnComma happy_var_2] >>+                                                          return (fst happy_var_1 ++ fst (unLoc happy_var_3),+                                                                  snd (unLoc happy_var_3) : snd happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn55 r))++happyReduce_107 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_107 = happySpecReduce_1  40# happyReduction_107+happyReduction_107 (HappyAbsSyn57  happy_var_1)+	 =  HappyAbsSyn55+		 ((fst (unLoc happy_var_1),[snd (unLoc happy_var_1)])+	)+happyReduction_107 _  = notHappyAtAll ++happyReduce_108 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_108 = happySpecReduce_1  41# happyReduction_108+happyReduction_108 (HappyAbsSyn58  happy_var_1)+	 =  HappyAbsSyn57+		 (sL1 happy_var_1 ([],happy_var_1)+	)+happyReduction_108 _  = notHappyAtAll ++happyReduce_109 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_109 = happySpecReduce_1  41# happyReduction_109+happyReduction_109 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn57+		 (sL1 happy_var_1 ([mj AnnDotdot happy_var_1], sL1 happy_var_1 ImpExpQcWildcard)+	)+happyReduction_109 _  = notHappyAtAll ++happyReduce_110 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_110 = happySpecReduce_1  42# happyReduction_110+happyReduction_110 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn58+		 (sL1 happy_var_1 (ImpExpQcName happy_var_1)+	)+happyReduction_110 _  = notHappyAtAll ++happyReduce_111 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_111 = happyMonadReduce 2# 42# happyReduction_111+happyReduction_111 ((HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { n <- mkTypeImpExp happy_var_2+                                          ; ams (sLL happy_var_1 happy_var_2 (ImpExpQcType n))+                                                [mj AnnType happy_var_1] }))+	) (\r -> happyReturn (HappyAbsSyn58 r))++happyReduce_112 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_112 = happySpecReduce_1  43# happyReduction_112+happyReduction_112 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_112 _  = notHappyAtAll ++happyReduce_113 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_113 = happySpecReduce_1  43# happyReduction_113+happyReduction_113 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_113 _  = notHappyAtAll ++happyReduce_114 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_114 = happySpecReduce_2  44# happyReduction_114+happyReduction_114 (HappyTerminal happy_var_2)+	(HappyAbsSyn60  happy_var_1)+	 =  HappyAbsSyn60+		 (mj AnnSemi happy_var_2 : happy_var_1+	)+happyReduction_114 _ _  = notHappyAtAll ++happyReduce_115 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_115 = happySpecReduce_1  44# happyReduction_115+happyReduction_115 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn60+		 ([mj AnnSemi happy_var_1]+	)+happyReduction_115 _  = notHappyAtAll ++happyReduce_116 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_116 = happySpecReduce_2  45# happyReduction_116+happyReduction_116 (HappyTerminal happy_var_2)+	(HappyAbsSyn60  happy_var_1)+	 =  HappyAbsSyn60+		 (mj AnnSemi happy_var_2 : happy_var_1+	)+happyReduction_116 _ _  = notHappyAtAll ++happyReduce_117 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_117 = happySpecReduce_0  45# happyReduction_117+happyReduction_117  =  HappyAbsSyn60+		 ([]+	)++happyReduce_118 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_118 = happySpecReduce_2  46# happyReduction_118+happyReduction_118 (HappyAbsSyn64  happy_var_2)+	(HappyAbsSyn44  happy_var_1)+	 =  HappyAbsSyn44+		 (happy_var_2 : happy_var_1+	)+happyReduction_118 _ _  = notHappyAtAll ++happyReduce_119 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_119 = happyMonadReduce 3# 47# happyReduction_119+happyReduction_119 ((HappyAbsSyn60  happy_var_3) `HappyStk`+	(HappyAbsSyn64  happy_var_2) `HappyStk`+	(HappyAbsSyn44  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams happy_var_2 happy_var_3 >> return (happy_var_2 : happy_var_1)))+	) (\r -> happyReturn (HappyAbsSyn44 r))++happyReduce_120 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_120 = happySpecReduce_0  47# happyReduction_120+happyReduction_120  =  HappyAbsSyn44+		 ([]+	)++happyReduce_121 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_121 = happyMonadReduce 8# 48# happyReduction_121+happyReduction_121 ((HappyAbsSyn70  happy_var_8) `HappyStk`+	(HappyAbsSyn69  happy_var_7) `HappyStk`+	(HappyAbsSyn317  happy_var_6) `HappyStk`+	(HappyAbsSyn67  happy_var_5) `HappyStk`+	(HappyAbsSyn66  happy_var_4) `HappyStk`+	(HappyAbsSyn66  happy_var_3) `HappyStk`+	(HappyAbsSyn65  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (cL (comb4 happy_var_1 happy_var_6 (snd happy_var_7) happy_var_8) $+                  ImportDecl { ideclExt = noExt+                             , ideclSourceSrc = snd $ fst happy_var_2+                             , ideclName = happy_var_6, ideclPkgQual = snd happy_var_5+                             , ideclSource = snd happy_var_2, ideclSafe = snd happy_var_3+                             , ideclQualified = snd happy_var_4, ideclImplicit = False+                             , ideclAs = unLoc (snd happy_var_7)+                             , ideclHiding = unLoc happy_var_8 })+                   ((mj AnnImport happy_var_1 : (fst $ fst happy_var_2) ++ fst happy_var_3 ++ fst happy_var_4+                                    ++ fst happy_var_5 ++ fst happy_var_7))))+	) (\r -> happyReturn (HappyAbsSyn64 r))++happyReduce_122 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_122 = happySpecReduce_2  49# happyReduction_122+happyReduction_122 (HappyTerminal happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn65+		 ((([mo happy_var_1,mc happy_var_2],getSOURCE_PRAGs happy_var_1)+                                      ,True)+	)+happyReduction_122 _ _  = notHappyAtAll ++happyReduce_123 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_123 = happySpecReduce_0  49# happyReduction_123+happyReduction_123  =  HappyAbsSyn65+		 ((([],NoSourceText),False)+	)++happyReduce_124 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_124 = happySpecReduce_1  50# happyReduction_124+happyReduction_124 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn66+		 (([mj AnnSafe happy_var_1],True)+	)+happyReduction_124 _  = notHappyAtAll ++happyReduce_125 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_125 = happySpecReduce_0  50# happyReduction_125+happyReduction_125  =  HappyAbsSyn66+		 (([],False)+	)++happyReduce_126 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_126 = happyMonadReduce 1# 51# happyReduction_126+happyReduction_126 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { let { pkgFS = getSTRING happy_var_1 }+                        ; unless (looksLikePackageName (unpackFS pkgFS)) $+                             addError (getLoc happy_var_1) $ vcat [+                             text "Parse error" <> colon <+> quotes (ppr pkgFS),+                             text "Version number or non-alphanumeric" <+>+                             text "character in package name"]+                        ; return ([mj AnnPackageName happy_var_1], Just (StringLiteral (getSTRINGs happy_var_1) pkgFS)) }))+	) (\r -> happyReturn (HappyAbsSyn67 r))++happyReduce_127 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_127 = happySpecReduce_0  51# happyReduction_127+happyReduction_127  =  HappyAbsSyn67+		 (([],Nothing)+	)++happyReduce_128 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_128 = happySpecReduce_1  52# happyReduction_128+happyReduction_128 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn66+		 (([mj AnnQualified happy_var_1],True)+	)+happyReduction_128 _  = notHappyAtAll ++happyReduce_129 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_129 = happySpecReduce_0  52# happyReduction_129+happyReduction_129  =  HappyAbsSyn66+		 (([],False)+	)++happyReduce_130 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_130 = happySpecReduce_2  53# happyReduction_130+happyReduction_130 (HappyAbsSyn317  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn69+		 (([mj AnnAs happy_var_1]+                                                 ,sLL happy_var_1 happy_var_2 (Just happy_var_2))+	)+happyReduction_130 _ _  = notHappyAtAll ++happyReduce_131 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_131 = happySpecReduce_0  53# happyReduction_131+happyReduction_131  =  HappyAbsSyn69+		 (([],noLoc Nothing)+	)++happyReduce_132 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_132 = happyMonadReduce 1# 54# happyReduction_132+happyReduction_132 ((HappyAbsSyn71  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let (b, ie) = unLoc happy_var_1 in+                                       checkImportSpec ie+                                        >>= \checkedIe ->+                                          return (cL (gl happy_var_1) (Just (b, checkedIe)))))+	) (\r -> happyReturn (HappyAbsSyn70 r))++happyReduce_133 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_133 = happySpecReduce_0  54# happyReduction_133+happyReduction_133  =  HappyAbsSyn70+		 (noLoc Nothing+	)++happyReduce_134 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_134 = happyMonadReduce 3# 55# happyReduction_134+happyReduction_134 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn49  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (False,+                                                      sLL happy_var_1 happy_var_3 $ fromOL happy_var_2))+                                                   [mop happy_var_1,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn71 r))++happyReduce_135 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_135 = happyMonadReduce 4# 55# happyReduction_135+happyReduction_135 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn49  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_4 (True,+                                                      sLL happy_var_1 happy_var_4 $ fromOL happy_var_3))+                                               [mj AnnHiding happy_var_1,mop happy_var_2,mcp happy_var_4]))+	) (\r -> happyReturn (HappyAbsSyn71 r))++happyReduce_136 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_136 = happySpecReduce_0  56# happyReduction_136+happyReduction_136  =  HappyAbsSyn72+		 (noLoc (NoSourceText,9)+	)++happyReduce_137 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_137 = happySpecReduce_1  56# happyReduction_137+happyReduction_137 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn72+		 (sL1 happy_var_1 (getINTEGERs happy_var_1,fromInteger (il_value (getINTEGER happy_var_1)))+	)+happyReduction_137 _  = notHappyAtAll ++happyReduce_138 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_138 = happySpecReduce_1  57# happyReduction_138+happyReduction_138 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn73+		 (sL1 happy_var_1 InfixN+	)+happyReduction_138 _  = notHappyAtAll ++happyReduce_139 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_139 = happySpecReduce_1  57# happyReduction_139+happyReduction_139 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn73+		 (sL1 happy_var_1 InfixL+	)+happyReduction_139 _  = notHappyAtAll ++happyReduce_140 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_140 = happySpecReduce_1  57# happyReduction_140+happyReduction_140 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn73+		 (sL1 happy_var_1 InfixR+	)+happyReduction_140 _  = notHappyAtAll ++happyReduce_141 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_141 = happyMonadReduce 3# 58# happyReduction_141+happyReduction_141 ((HappyAbsSyn16  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn74  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (oll $ unLoc happy_var_1) AnnComma (gl happy_var_2) >>+                              return (sLL happy_var_1 happy_var_3 ((unLoc happy_var_1) `appOL` unitOL happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn74 r))++happyReduce_142 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_142 = happySpecReduce_1  58# happyReduction_142+happyReduction_142 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn74+		 (sL1 happy_var_1 (unitOL happy_var_1)+	)+happyReduction_142 _  = notHappyAtAll ++happyReduce_143 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_143 = happySpecReduce_2  59# happyReduction_143+happyReduction_143 (HappyAbsSyn77  happy_var_2)+	(HappyAbsSyn75  happy_var_1)+	 =  HappyAbsSyn75+		 (happy_var_1 `snocOL` happy_var_2+	)+happyReduction_143 _ _  = notHappyAtAll ++happyReduce_144 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_144 = happyMonadReduce 3# 60# happyReduction_144+happyReduction_144 ((HappyAbsSyn60  happy_var_3) `HappyStk`+	(HappyAbsSyn77  happy_var_2) `HappyStk`+	(HappyAbsSyn75  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams happy_var_2 happy_var_3 >> return (happy_var_1 `snocOL` happy_var_2)))+	) (\r -> happyReturn (HappyAbsSyn75 r))++happyReduce_145 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_145 = happySpecReduce_0  60# happyReduction_145+happyReduction_145  =  HappyAbsSyn75+		 (nilOL+	)++happyReduce_146 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_146 = happySpecReduce_1  61# happyReduction_146+happyReduction_146 (HappyAbsSyn78  happy_var_1)+	 =  HappyAbsSyn77+		 (sL1 happy_var_1 (TyClD noExt (unLoc happy_var_1))+	)+happyReduction_146 _  = notHappyAtAll ++happyReduce_147 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_147 = happySpecReduce_1  61# happyReduction_147+happyReduction_147 (HappyAbsSyn78  happy_var_1)+	 =  HappyAbsSyn77+		 (sL1 happy_var_1 (TyClD noExt (unLoc happy_var_1))+	)+happyReduction_147 _  = notHappyAtAll ++happyReduce_148 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_148 = happySpecReduce_1  61# happyReduction_148+happyReduction_148 (HappyAbsSyn80  happy_var_1)+	 =  HappyAbsSyn77+		 (sL1 happy_var_1 (InstD noExt (unLoc happy_var_1))+	)+happyReduction_148 _  = notHappyAtAll ++happyReduce_149 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_149 = happySpecReduce_1  61# happyReduction_149+happyReduction_149 (HappyAbsSyn104  happy_var_1)+	 =  HappyAbsSyn77+		 (sLL happy_var_1 happy_var_1 (DerivD noExt (unLoc happy_var_1))+	)+happyReduction_149 _  = notHappyAtAll ++happyReduce_150 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_150 = happySpecReduce_1  61# happyReduction_150+happyReduction_150 (HappyAbsSyn105  happy_var_1)+	 =  HappyAbsSyn77+		 (sL1 happy_var_1 (RoleAnnotD noExt (unLoc happy_var_1))+	)+happyReduction_150 _  = notHappyAtAll ++happyReduce_151 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_151 = happyMonadReduce 4# 61# happyReduction_151+happyReduction_151 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn170  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_4 (DefD noExt (DefaultDecl noExt happy_var_3)))+                                                         [mj AnnDefault happy_var_1+                                                         ,mop happy_var_2,mcp happy_var_4]))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_152 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_152 = happyMonadReduce 2# 61# happyReduction_152+happyReduction_152 ((HappyAbsSyn141  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 (snd $ unLoc happy_var_2))+                                           (mj AnnForeign happy_var_1:(fst $ unLoc happy_var_2))))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_153 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_153 = happyMonadReduce 3# 61# happyReduction_153+happyReduction_153 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn134  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ WarningD noExt (Warnings noExt (getDEPRECATED_PRAGs happy_var_1) (fromOL happy_var_2)))+                                                       [mo happy_var_1,mc happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_154 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_154 = happyMonadReduce 3# 61# happyReduction_154+happyReduction_154 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn134  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ WarningD noExt (Warnings noExt (getWARNING_PRAGs happy_var_1) (fromOL happy_var_2)))+                                                       [mo happy_var_1,mc happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_155 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_155 = happyMonadReduce 3# 61# happyReduction_155+happyReduction_155 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn127  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ RuleD noExt (HsRules noExt (getRULES_PRAGs happy_var_1) (fromOL happy_var_2)))+                                                       [mo happy_var_1,mc happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_156 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_156 = happySpecReduce_1  61# happyReduction_156+happyReduction_156 (HappyAbsSyn77  happy_var_1)+	 =  HappyAbsSyn77+		 (happy_var_1+	)+happyReduction_156 _  = notHappyAtAll ++happyReduce_157 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_157 = happySpecReduce_1  61# happyReduction_157+happyReduction_157 (HappyAbsSyn77  happy_var_1)+	 =  HappyAbsSyn77+		 (happy_var_1+	)+happyReduction_157 _  = notHappyAtAll ++happyReduce_158 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_158 = happySpecReduce_1  61# happyReduction_158+happyReduction_158 (HappyAbsSyn209  happy_var_1)+	 =  HappyAbsSyn77+		 (sLL happy_var_1 happy_var_1 $ mkSpliceDecl happy_var_1+	)+happyReduction_158 _  = notHappyAtAll ++happyReduce_159 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_159 = happyMonadReduce 4# 62# happyReduction_159+happyReduction_159 ((HappyAbsSyn118  happy_var_4) `HappyStk`+	(HappyAbsSyn175  happy_var_3) `HappyStk`+	(HappyAbsSyn101  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (mkClassDecl (comb4 happy_var_1 happy_var_2 happy_var_3 happy_var_4) happy_var_2 happy_var_3 (snd $ unLoc happy_var_4))+                        (mj AnnClass happy_var_1:(fst $ unLoc happy_var_3)++(fst $ unLoc happy_var_4))))+	) (\r -> happyReturn (HappyAbsSyn78 r))++happyReduce_160 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_160 = happyMonadReduce 4# 63# happyReduction_160+happyReduction_160 ((HappyAbsSyn147  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn147  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (mkTySynonym (comb2 happy_var_1 happy_var_4) happy_var_2 happy_var_4)+                        [mj AnnType happy_var_1,mj AnnEqual happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn78 r))++happyReduce_161 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_161 = happyMonadReduce 6# 63# happyReduction_161+happyReduction_161 ((HappyAbsSyn88  happy_var_6) `HappyStk`+	(HappyAbsSyn85  happy_var_5) `HappyStk`+	(HappyAbsSyn98  happy_var_4) `HappyStk`+	(HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (mkFamDecl (comb4 happy_var_1 happy_var_3 happy_var_4 happy_var_5) (snd $ unLoc happy_var_6) happy_var_3+                                   (snd $ unLoc happy_var_4) (snd $ unLoc happy_var_5))+                        (mj AnnType happy_var_1:mj AnnFamily happy_var_2:(fst $ unLoc happy_var_4)+                           ++ (fst $ unLoc happy_var_5) ++ (fst $ unLoc happy_var_6))))+	) (\r -> happyReturn (HappyAbsSyn78 r))++happyReduce_162 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_162 = happyMonadReduce 5# 63# happyReduction_162+happyReduction_162 ((HappyAbsSyn192  happy_var_5) `HappyStk`+	(HappyAbsSyn184  happy_var_4) `HappyStk`+	(HappyAbsSyn101  happy_var_3) `HappyStk`+	(HappyAbsSyn103  happy_var_2) `HappyStk`+	(HappyAbsSyn96  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (mkTyData (comb4 happy_var_1 happy_var_3 happy_var_4 happy_var_5) (snd $ unLoc happy_var_1) happy_var_2 happy_var_3+                           Nothing (reverse (snd $ unLoc happy_var_4))+                                   (fmap reverse happy_var_5))+                                   -- We need the location on tycl_hdr in case+                                   -- constrs and deriving are both empty+                        ((fst $ unLoc happy_var_1):(fst $ unLoc happy_var_4))))+	) (\r -> happyReturn (HappyAbsSyn78 r))++happyReduce_163 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_163 = happyMonadReduce 6# 63# happyReduction_163+happyReduction_163 ((HappyAbsSyn192  happy_var_6) `HappyStk`+	(HappyAbsSyn180  happy_var_5) `HappyStk`+	(HappyAbsSyn97  happy_var_4) `HappyStk`+	(HappyAbsSyn101  happy_var_3) `HappyStk`+	(HappyAbsSyn103  happy_var_2) `HappyStk`+	(HappyAbsSyn96  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (mkTyData (comb4 happy_var_1 happy_var_3 happy_var_5 happy_var_6) (snd $ unLoc happy_var_1) happy_var_2 happy_var_3+                            (snd $ unLoc happy_var_4) (snd $ unLoc happy_var_5)+                            (fmap reverse happy_var_6) )+                                   -- We need the location on tycl_hdr in case+                                   -- constrs and deriving are both empty+                    ((fst $ unLoc happy_var_1):(fst $ unLoc happy_var_4)++(fst $ unLoc happy_var_5))))+	) (\r -> happyReturn (HappyAbsSyn78 r))++happyReduce_164 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_164 = happyMonadReduce 4# 63# happyReduction_164+happyReduction_164 ((HappyAbsSyn98  happy_var_4) `HappyStk`+	(HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (mkFamDecl (comb3 happy_var_1 happy_var_2 happy_var_4) DataFamily happy_var_3+                                   (snd $ unLoc happy_var_4) Nothing)+                        (mj AnnData happy_var_1:mj AnnFamily happy_var_2:(fst $ unLoc happy_var_4))))+	) (\r -> happyReturn (HappyAbsSyn78 r))++happyReduce_165 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_165 = happyMonadReduce 4# 64# happyReduction_165+happyReduction_165 ((HappyAbsSyn122  happy_var_4) `HappyStk`+	(HappyAbsSyn168  happy_var_3) `HappyStk`+	(HappyAbsSyn81  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc happy_var_4)+             ; let cid = ClsInstDecl { cid_ext = noExt+                                     , cid_poly_ty = happy_var_3, cid_binds = binds+                                     , cid_sigs = mkClassOpSigs sigs+                                     , cid_tyfam_insts = ats+                                     , cid_overlap_mode = happy_var_2+                                     , cid_datafam_insts = adts }+             ; ams (cL (comb3 happy_var_1 (hsSigType happy_var_3) happy_var_4) (ClsInstD { cid_d_ext = noExt, cid_inst = cid }))+                   (mj AnnInstance happy_var_1 : (fst $ unLoc happy_var_4)) }))+	) (\r -> happyReturn (HappyAbsSyn80 r))++happyReduce_166 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_166 = happyMonadReduce 3# 64# happyReduction_166+happyReduction_166 ((HappyAbsSyn91  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams happy_var_3 (fst $ unLoc happy_var_3)+                >> amms (mkTyFamInst (comb2 happy_var_1 happy_var_3) (snd $ unLoc happy_var_3))+                    (mj AnnType happy_var_1:mj AnnInstance happy_var_2:(fst $ unLoc happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn80 r))++happyReduce_167 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_167 = happyMonadReduce 6# 64# happyReduction_167+happyReduction_167 ((HappyAbsSyn192  happy_var_6) `HappyStk`+	(HappyAbsSyn184  happy_var_5) `HappyStk`+	(HappyAbsSyn102  happy_var_4) `HappyStk`+	(HappyAbsSyn103  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn96  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (mkDataFamInst (comb4 happy_var_1 happy_var_4 happy_var_5 happy_var_6) (snd $ unLoc happy_var_1) happy_var_3 (snd $ unLoc happy_var_4)+                                      Nothing (reverse (snd  $ unLoc happy_var_5))+                                              (fmap reverse happy_var_6))+                    ((fst $ unLoc happy_var_1):mj AnnInstance happy_var_2:(fst $ unLoc happy_var_4)++(fst $ unLoc happy_var_5))))+	) (\r -> happyReturn (HappyAbsSyn80 r))++happyReduce_168 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_168 = happyMonadReduce 7# 64# happyReduction_168+happyReduction_168 ((HappyAbsSyn192  happy_var_7) `HappyStk`+	(HappyAbsSyn180  happy_var_6) `HappyStk`+	(HappyAbsSyn97  happy_var_5) `HappyStk`+	(HappyAbsSyn102  happy_var_4) `HappyStk`+	(HappyAbsSyn103  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn96  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (mkDataFamInst (comb4 happy_var_1 happy_var_4 happy_var_6 happy_var_7) (snd $ unLoc happy_var_1) happy_var_3 (snd $ unLoc happy_var_4)+                                   (snd $ unLoc happy_var_5) (snd $ unLoc happy_var_6)+                                   (fmap reverse happy_var_7))+                    ((fst $ unLoc happy_var_1):mj AnnInstance happy_var_2+                       :(fst $ unLoc happy_var_4)++(fst $ unLoc happy_var_5)++(fst $ unLoc happy_var_6))))+	) (\r -> happyReturn (HappyAbsSyn80 r))++happyReduce_169 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_169 = happyMonadReduce 2# 65# happyReduction_169+happyReduction_169 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ajs (Just (sLL happy_var_1 happy_var_2 (Overlappable (getOVERLAPPABLE_PRAGs happy_var_1))))+                                       [mo happy_var_1,mc happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn81 r))++happyReduce_170 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_170 = happyMonadReduce 2# 65# happyReduction_170+happyReduction_170 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ajs (Just (sLL happy_var_1 happy_var_2 (Overlapping (getOVERLAPPING_PRAGs happy_var_1))))+                                       [mo happy_var_1,mc happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn81 r))++happyReduce_171 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_171 = happyMonadReduce 2# 65# happyReduction_171+happyReduction_171 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ajs (Just (sLL happy_var_1 happy_var_2 (Overlaps (getOVERLAPS_PRAGs happy_var_1))))+                                       [mo happy_var_1,mc happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn81 r))++happyReduce_172 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_172 = happyMonadReduce 2# 65# happyReduction_172+happyReduction_172 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ajs (Just (sLL happy_var_1 happy_var_2 (Incoherent (getINCOHERENT_PRAGs happy_var_1))))+                                       [mo happy_var_1,mc happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn81 r))++happyReduce_173 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_173 = happySpecReduce_0  65# happyReduction_173+happyReduction_173  =  HappyAbsSyn81+		 (Nothing+	)++happyReduce_174 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_174 = happyMonadReduce 1# 66# happyReduction_174+happyReduction_174 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sL1 happy_var_1 StockStrategy)+                                       [mj AnnStock happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn82 r))++happyReduce_175 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_175 = happyMonadReduce 1# 66# happyReduction_175+happyReduction_175 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sL1 happy_var_1 AnyclassStrategy)+                                       [mj AnnAnyclass happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn82 r))++happyReduce_176 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_176 = happyMonadReduce 1# 66# happyReduction_176+happyReduction_176 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sL1 happy_var_1 NewtypeStrategy)+                                       [mj AnnNewtype happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn82 r))++happyReduce_177 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_177 = happyMonadReduce 2# 67# happyReduction_177+happyReduction_177 ((HappyAbsSyn147  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 (ViaStrategy (mkLHsSigType happy_var_2)))+                                            [mj AnnVia happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn82 r))++happyReduce_178 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_178 = happyMonadReduce 1# 68# happyReduction_178+happyReduction_178 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ajs (Just (sL1 happy_var_1 StockStrategy))+                                       [mj AnnStock happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn84 r))++happyReduce_179 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_179 = happyMonadReduce 1# 68# happyReduction_179+happyReduction_179 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ajs (Just (sL1 happy_var_1 AnyclassStrategy))+                                       [mj AnnAnyclass happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn84 r))++happyReduce_180 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_180 = happyMonadReduce 1# 68# happyReduction_180+happyReduction_180 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ajs (Just (sL1 happy_var_1 NewtypeStrategy))+                                       [mj AnnNewtype happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn84 r))++happyReduce_181 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_181 = happySpecReduce_1  68# happyReduction_181+happyReduction_181 (HappyAbsSyn82  happy_var_1)+	 =  HappyAbsSyn84+		 (Just happy_var_1+	)+happyReduction_181 _  = notHappyAtAll ++happyReduce_182 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_182 = happySpecReduce_0  68# happyReduction_182+happyReduction_182  =  HappyAbsSyn84+		 (Nothing+	)++happyReduce_183 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_183 = happySpecReduce_0  69# happyReduction_183+happyReduction_183  =  HappyAbsSyn85+		 (noLoc ([], Nothing)+	)++happyReduce_184 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_184 = happySpecReduce_2  69# happyReduction_184+happyReduction_184 (HappyAbsSyn86  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn85+		 (sLL happy_var_1 happy_var_2 ([mj AnnVbar happy_var_1]+                                                , Just (happy_var_2))+	)+happyReduction_184 _ _  = notHappyAtAll ++happyReduce_185 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_185 = happyMonadReduce 3# 70# happyReduction_185+happyReduction_185 ((HappyAbsSyn87  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn16  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (InjectivityAnn happy_var_1 (reverse (unLoc happy_var_3))))+                  [mu AnnRarrow happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn86 r))++happyReduce_186 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_186 = happySpecReduce_2  71# happyReduction_186+happyReduction_186 (HappyAbsSyn16  happy_var_2)+	(HappyAbsSyn87  happy_var_1)+	 =  HappyAbsSyn87+		 (sLL happy_var_1 happy_var_2 (happy_var_2 : unLoc happy_var_1)+	)+happyReduction_186 _ _  = notHappyAtAll ++happyReduce_187 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_187 = happySpecReduce_1  71# happyReduction_187+happyReduction_187 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn87+		 (sLL happy_var_1 happy_var_1 [happy_var_1]+	)+happyReduction_187 _  = notHappyAtAll ++happyReduce_188 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_188 = happySpecReduce_0  72# happyReduction_188+happyReduction_188  =  HappyAbsSyn88+		 (noLoc ([],OpenTypeFamily)+	)++happyReduce_189 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_189 = happySpecReduce_2  72# happyReduction_189+happyReduction_189 (HappyAbsSyn89  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn88+		 (sLL happy_var_1 happy_var_2 (mj AnnWhere happy_var_1:(fst $ unLoc happy_var_2)+                    ,ClosedTypeFamily (fmap reverse $ snd $ unLoc happy_var_2))+	)+happyReduction_189 _ _  = notHappyAtAll ++happyReduce_190 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_190 = happySpecReduce_3  73# happyReduction_190+happyReduction_190 (HappyTerminal happy_var_3)+	(HappyAbsSyn90  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn89+		 (sLL happy_var_1 happy_var_3 ([moc happy_var_1,mcc happy_var_3]+                                                ,Just (unLoc happy_var_2))+	)+happyReduction_190 _ _ _  = notHappyAtAll ++happyReduce_191 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_191 = happySpecReduce_3  73# happyReduction_191+happyReduction_191 _+	(HappyAbsSyn90  happy_var_2)+	_+	 =  HappyAbsSyn89+		 (let (dL->L loc _) = happy_var_2 in+                                             cL loc ([],Just (unLoc happy_var_2))+	)+happyReduction_191 _ _ _  = notHappyAtAll ++happyReduce_192 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_192 = happySpecReduce_3  73# happyReduction_192+happyReduction_192 (HappyTerminal happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn89+		 (sLL happy_var_1 happy_var_3 ([moc happy_var_1,mj AnnDotdot happy_var_2+                                                 ,mcc happy_var_3],Nothing)+	)+happyReduction_192 _ _ _  = notHappyAtAll ++happyReduce_193 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_193 = happySpecReduce_3  73# happyReduction_193+happyReduction_193 _+	(HappyTerminal happy_var_2)+	_+	 =  HappyAbsSyn89+		 (let (dL->L loc _) = happy_var_2 in+                                             cL loc ([mj AnnDotdot happy_var_2],Nothing)+	)+happyReduction_193 _ _ _  = notHappyAtAll ++happyReduce_194 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_194 = happyMonadReduce 3# 74# happyReduction_194+happyReduction_194 ((HappyAbsSyn91  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn90  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let (dL->L loc (anns, eqn)) = happy_var_3 in+                                         asl (unLoc happy_var_1) happy_var_2 (cL loc eqn)+                                         >> ams happy_var_3 anns+                                         >> return (sLL happy_var_1 happy_var_3 (cL loc eqn : unLoc happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn90 r))++happyReduce_195 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_195 = happyMonadReduce 2# 74# happyReduction_195+happyReduction_195 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn90  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) AnnSemi (gl happy_var_2)+                                         >> return (sLL happy_var_1 happy_var_2  (unLoc happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn90 r))++happyReduce_196 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_196 = happyMonadReduce 1# 74# happyReduction_196+happyReduction_196 ((HappyAbsSyn91  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let (dL->L loc (anns, eqn)) = happy_var_1 in+                                         ams happy_var_1 anns+                                         >> return (sLL happy_var_1 happy_var_1 [cL loc eqn])))+	) (\r -> happyReturn (HappyAbsSyn90 r))++happyReduce_197 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_197 = happySpecReduce_0  74# happyReduction_197+happyReduction_197  =  HappyAbsSyn90+		 (noLoc []+	)++happyReduce_198 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_198 = happyMonadReduce 6# 75# happyReduction_198+happyReduction_198 ((HappyAbsSyn147  happy_var_6) `HappyStk`+	(HappyTerminal happy_var_5) `HappyStk`+	(HappyAbsSyn147  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn173  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { hintExplicitForall happy_var_1+                    ; (eqn,ann) <- mkTyFamInstEqn (Just happy_var_2) happy_var_4 happy_var_6+                    ; return (sLL happy_var_1 happy_var_6+                               (mu AnnForall happy_var_1:mj AnnDot happy_var_3:mj AnnEqual happy_var_5:ann,eqn)) }))+	) (\r -> happyReturn (HappyAbsSyn91 r))++happyReduce_199 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_199 = happyMonadReduce 3# 75# happyReduction_199+happyReduction_199 ((HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn147  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { (eqn,ann) <- mkTyFamInstEqn Nothing happy_var_1 happy_var_3+                    ; return (sLL happy_var_1 happy_var_3 (mj AnnEqual happy_var_2:ann, eqn))  }))+	) (\r -> happyReturn (HappyAbsSyn91 r))++happyReduce_200 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_200 = happyMonadReduce 4# 76# happyReduction_200+happyReduction_200 ((HappyAbsSyn98  happy_var_4) `HappyStk`+	(HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyAbsSyn60  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (liftM mkTyClD (mkFamDecl (comb3 happy_var_1 happy_var_3 happy_var_4) DataFamily happy_var_3+                                                  (snd $ unLoc happy_var_4) Nothing))+                        (mj AnnData happy_var_1:happy_var_2++(fst $ unLoc happy_var_4))))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_201 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_201 = happyMonadReduce 3# 76# happyReduction_201+happyReduction_201 ((HappyAbsSyn100  happy_var_3) `HappyStk`+	(HappyAbsSyn147  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (liftM mkTyClD+                        (mkFamDecl (comb3 happy_var_1 happy_var_2 happy_var_3) OpenTypeFamily happy_var_2+                                   (fst . snd $ unLoc happy_var_3)+                                   (snd . snd $ unLoc happy_var_3)))+                       (mj AnnType happy_var_1:(fst $ unLoc happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_202 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_202 = happyMonadReduce 4# 76# happyReduction_202+happyReduction_202 ((HappyAbsSyn100  happy_var_4) `HappyStk`+	(HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (liftM mkTyClD+                        (mkFamDecl (comb3 happy_var_1 happy_var_3 happy_var_4) OpenTypeFamily happy_var_3+                                   (fst . snd $ unLoc happy_var_4)+                                   (snd . snd $ unLoc happy_var_4)))+                       (mj AnnType happy_var_1:mj AnnFamily happy_var_2:(fst $ unLoc happy_var_4))))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_203 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_203 = happyMonadReduce 2# 76# happyReduction_203+happyReduction_203 ((HappyAbsSyn91  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams happy_var_2 (fst $ unLoc happy_var_2) >>+                   amms (liftM mkInstD (mkTyFamInst (comb2 happy_var_1 happy_var_2) (snd $ unLoc happy_var_2)))+                        (mj AnnType happy_var_1:(fst $ unLoc happy_var_2))))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_204 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_204 = happyMonadReduce 3# 76# happyReduction_204+happyReduction_204 ((HappyAbsSyn91  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams happy_var_3 (fst $ unLoc happy_var_3) >>+                   amms (liftM mkInstD (mkTyFamInst (comb2 happy_var_1 happy_var_3) (snd $ unLoc happy_var_3)))+                        (mj AnnType happy_var_1:mj AnnInstance happy_var_2:(fst $ unLoc happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_205 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_205 = happySpecReduce_0  77# happyReduction_205+happyReduction_205  =  HappyAbsSyn60+		 ([]+	)++happyReduce_206 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_206 = happySpecReduce_1  77# happyReduction_206+happyReduction_206 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn60+		 ([mj AnnFamily happy_var_1]+	)+happyReduction_206 _  = notHappyAtAll ++happyReduce_207 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_207 = happySpecReduce_0  78# happyReduction_207+happyReduction_207  =  HappyAbsSyn60+		 ([]+	)++happyReduce_208 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_208 = happySpecReduce_1  78# happyReduction_208+happyReduction_208 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn60+		 ([mj AnnInstance happy_var_1]+	)+happyReduction_208 _  = notHappyAtAll ++happyReduce_209 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_209 = happyMonadReduce 3# 79# happyReduction_209+happyReduction_209 ((HappyAbsSyn91  happy_var_3) `HappyStk`+	(HappyAbsSyn60  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams happy_var_3 (fst $ unLoc happy_var_3) >>+                   amms (mkTyFamInst (comb2 happy_var_1 happy_var_3) (snd $ unLoc happy_var_3))+                        (mj AnnType happy_var_1:happy_var_2++(fst $ unLoc happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn80 r))++happyReduce_210 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_210 = happyMonadReduce 5# 79# happyReduction_210+happyReduction_210 ((HappyAbsSyn192  happy_var_5) `HappyStk`+	(HappyAbsSyn184  happy_var_4) `HappyStk`+	(HappyAbsSyn102  happy_var_3) `HappyStk`+	(HappyAbsSyn103  happy_var_2) `HappyStk`+	(HappyAbsSyn96  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (mkDataFamInst (comb4 happy_var_1 happy_var_3 happy_var_4 happy_var_5) (snd $ unLoc happy_var_1) happy_var_2 (snd $ unLoc happy_var_3)+                                    Nothing (reverse (snd $ unLoc happy_var_4))+                                            (fmap reverse happy_var_5))+                       ((fst $ unLoc happy_var_1):(fst $ unLoc happy_var_3) ++ (fst $ unLoc happy_var_4))))+	) (\r -> happyReturn (HappyAbsSyn80 r))++happyReduce_211 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_211 = happyMonadReduce 6# 79# happyReduction_211+happyReduction_211 ((HappyAbsSyn192  happy_var_6) `HappyStk`+	(HappyAbsSyn184  happy_var_5) `HappyStk`+	(HappyAbsSyn102  happy_var_4) `HappyStk`+	(HappyAbsSyn103  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn96  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (mkDataFamInst (comb4 happy_var_1 happy_var_4 happy_var_5 happy_var_6) (snd $ unLoc happy_var_1) happy_var_3 (snd $ unLoc happy_var_4)+                                    Nothing (reverse (snd $ unLoc happy_var_5))+                                            (fmap reverse happy_var_6))+                       ((fst $ unLoc happy_var_1):mj AnnInstance happy_var_2:(fst $ unLoc happy_var_4)++(fst $ unLoc happy_var_5))))+	) (\r -> happyReturn (HappyAbsSyn80 r))++happyReduce_212 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_212 = happyMonadReduce 6# 79# happyReduction_212+happyReduction_212 ((HappyAbsSyn192  happy_var_6) `HappyStk`+	(HappyAbsSyn180  happy_var_5) `HappyStk`+	(HappyAbsSyn97  happy_var_4) `HappyStk`+	(HappyAbsSyn102  happy_var_3) `HappyStk`+	(HappyAbsSyn103  happy_var_2) `HappyStk`+	(HappyAbsSyn96  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (mkDataFamInst (comb4 happy_var_1 happy_var_3 happy_var_5 happy_var_6) (snd $ unLoc happy_var_1) happy_var_2+                                (snd $ unLoc happy_var_3) (snd $ unLoc happy_var_4) (snd $ unLoc happy_var_5)+                                (fmap reverse happy_var_6))+                        ((fst $ unLoc happy_var_1):(fst $ unLoc happy_var_3)++(fst $ unLoc happy_var_4)++(fst $ unLoc happy_var_5))))+	) (\r -> happyReturn (HappyAbsSyn80 r))++happyReduce_213 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_213 = happyMonadReduce 7# 79# happyReduction_213+happyReduction_213 ((HappyAbsSyn192  happy_var_7) `HappyStk`+	(HappyAbsSyn180  happy_var_6) `HappyStk`+	(HappyAbsSyn97  happy_var_5) `HappyStk`+	(HappyAbsSyn102  happy_var_4) `HappyStk`+	(HappyAbsSyn103  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn96  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (mkDataFamInst (comb4 happy_var_1 happy_var_4 happy_var_6 happy_var_7) (snd $ unLoc happy_var_1) happy_var_3+                                (snd $ unLoc happy_var_4) (snd $ unLoc happy_var_5) (snd $ unLoc happy_var_6)+                                (fmap reverse happy_var_7))+                        ((fst $ unLoc happy_var_1):mj AnnInstance happy_var_2:(fst $ unLoc happy_var_4)++(fst $ unLoc happy_var_5)++(fst $ unLoc happy_var_6))))+	) (\r -> happyReturn (HappyAbsSyn80 r))++happyReduce_214 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_214 = happySpecReduce_1  80# happyReduction_214+happyReduction_214 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn96+		 (sL1 happy_var_1 (mj AnnData    happy_var_1,DataType)+	)+happyReduction_214 _  = notHappyAtAll ++happyReduce_215 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_215 = happySpecReduce_1  80# happyReduction_215+happyReduction_215 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn96+		 (sL1 happy_var_1 (mj AnnNewtype happy_var_1,NewType)+	)+happyReduction_215 _  = notHappyAtAll ++happyReduce_216 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_216 = happySpecReduce_0  81# happyReduction_216+happyReduction_216  =  HappyAbsSyn97+		 (noLoc     ([]               , Nothing)+	)++happyReduce_217 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_217 = happySpecReduce_2  81# happyReduction_217+happyReduction_217 (HappyAbsSyn179  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn97+		 (sLL happy_var_1 happy_var_2 ([mu AnnDcolon happy_var_1], Just happy_var_2)+	)+happyReduction_217 _ _  = notHappyAtAll ++happyReduce_218 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_218 = happySpecReduce_0  82# happyReduction_218+happyReduction_218  =  HappyAbsSyn98+		 (noLoc     ([]               , noLoc (NoSig noExt)         )+	)++happyReduce_219 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_219 = happySpecReduce_2  82# happyReduction_219+happyReduction_219 (HappyAbsSyn179  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn98+		 (sLL happy_var_1 happy_var_2 ([mu AnnDcolon happy_var_1], sLL happy_var_1 happy_var_2 (KindSig noExt happy_var_2))+	)+happyReduction_219 _ _  = notHappyAtAll ++happyReduce_220 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_220 = happySpecReduce_0  83# happyReduction_220+happyReduction_220  =  HappyAbsSyn98+		 (noLoc     ([]               , noLoc     (NoSig    noExt)   )+	)++happyReduce_221 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_221 = happySpecReduce_2  83# happyReduction_221+happyReduction_221 (HappyAbsSyn179  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn98+		 (sLL happy_var_1 happy_var_2 ([mu AnnDcolon happy_var_1], sLL happy_var_1 happy_var_2 (KindSig  noExt happy_var_2))+	)+happyReduction_221 _ _  = notHappyAtAll ++happyReduce_222 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_222 = happySpecReduce_2  83# happyReduction_222+happyReduction_222 (HappyAbsSyn174  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn98+		 (sLL happy_var_1 happy_var_2 ([mj AnnEqual happy_var_1] , sLL happy_var_1 happy_var_2 (TyVarSig noExt happy_var_2))+	)+happyReduction_222 _ _  = notHappyAtAll ++happyReduce_223 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_223 = happySpecReduce_0  84# happyReduction_223+happyReduction_223  =  HappyAbsSyn100+		 (noLoc ([], (noLoc (NoSig noExt), Nothing))+	)++happyReduce_224 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_224 = happySpecReduce_2  84# happyReduction_224+happyReduction_224 (HappyAbsSyn179  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn100+		 (sLL happy_var_1 happy_var_2 ( [mu AnnDcolon happy_var_1]+                                 , (sLL happy_var_2 happy_var_2 (KindSig noExt happy_var_2), Nothing))+	)+happyReduction_224 _ _  = notHappyAtAll ++happyReduce_225 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_225 = happyReduce 4# 84# happyReduction_225+happyReduction_225 ((HappyAbsSyn86  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn174  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn100+		 (sLL happy_var_1 happy_var_4 ([mj AnnEqual happy_var_1, mj AnnVbar happy_var_3]+                            , (sLL happy_var_1 happy_var_2 (TyVarSig noExt happy_var_2), Just happy_var_4))+	) `HappyStk` happyRest++happyReduce_226 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_226 = happyMonadReduce 3# 85# happyReduction_226+happyReduction_226 ((HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn157  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) (toUnicodeAnn AnnDarrow happy_var_2) (gl happy_var_2)+                                       >> (return (sLL happy_var_1 happy_var_3 (Just happy_var_1, happy_var_3)))))+	) (\r -> happyReturn (HappyAbsSyn101 r))++happyReduce_227 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_227 = happySpecReduce_1  85# happyReduction_227+happyReduction_227 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn101+		 (sL1 happy_var_1 (Nothing, happy_var_1)+	)+happyReduction_227 _  = notHappyAtAll ++happyReduce_228 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_228 = happyMonadReduce 6# 86# happyReduction_228+happyReduction_228 ((HappyAbsSyn147  happy_var_6) `HappyStk`+	(HappyTerminal happy_var_5) `HappyStk`+	(HappyAbsSyn157  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn173  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( hintExplicitForall happy_var_1+                                                       >> (addAnnotation (gl happy_var_4) (toUnicodeAnn AnnDarrow happy_var_5) (gl happy_var_5)+                                                           >> return (sLL happy_var_1 happy_var_6 ([mu AnnForall happy_var_1, mj AnnDot happy_var_3]+                                                                                , (Just happy_var_4, Just happy_var_2, happy_var_6)))+                                                          )))+	) (\r -> happyReturn (HappyAbsSyn102 r))++happyReduce_229 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_229 = happyMonadReduce 4# 86# happyReduction_229+happyReduction_229 ((HappyAbsSyn147  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn173  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( hintExplicitForall happy_var_1+                                          >> return (sLL happy_var_1 happy_var_4 ([mu AnnForall happy_var_1, mj AnnDot happy_var_3]+                                                               , (Nothing, Just happy_var_2, happy_var_4)))))+	) (\r -> happyReturn (HappyAbsSyn102 r))++happyReduce_230 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_230 = happyMonadReduce 3# 86# happyReduction_230+happyReduction_230 ((HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn157  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) (toUnicodeAnn AnnDarrow happy_var_2) (gl happy_var_2)+                                       >> (return (sLL happy_var_1 happy_var_3([], (Just happy_var_1, Nothing, happy_var_3))))))+	) (\r -> happyReturn (HappyAbsSyn102 r))++happyReduce_231 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_231 = happySpecReduce_1  86# happyReduction_231+happyReduction_231 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn102+		 (sL1 happy_var_1 ([], (Nothing, Nothing, happy_var_1))+	)+happyReduction_231 _  = notHappyAtAll ++happyReduce_232 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_232 = happyMonadReduce 4# 87# happyReduction_232+happyReduction_232 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ajs (Just (sLL happy_var_1 happy_var_4 (CType (getCTYPEs happy_var_1) (Just (Header (getSTRINGs happy_var_2) (getSTRING happy_var_2)))+                                        (getSTRINGs happy_var_3,getSTRING happy_var_3))))+                              [mo happy_var_1,mj AnnHeader happy_var_2,mj AnnVal happy_var_3,mc happy_var_4]))+	) (\r -> happyReturn (HappyAbsSyn103 r))++happyReduce_233 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_233 = happyMonadReduce 3# 87# happyReduction_233+happyReduction_233 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ajs (Just (sLL happy_var_1 happy_var_3 (CType (getCTYPEs happy_var_1) Nothing  (getSTRINGs happy_var_2, getSTRING happy_var_2))))+                              [mo happy_var_1,mj AnnVal happy_var_2,mc happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn103 r))++happyReduce_234 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_234 = happySpecReduce_0  87# happyReduction_234+happyReduction_234  =  HappyAbsSyn103+		 (Nothing+	)++happyReduce_235 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_235 = happyMonadReduce 5# 88# happyReduction_235+happyReduction_235 ((HappyAbsSyn168  happy_var_5) `HappyStk`+	(HappyAbsSyn81  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn84  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { let { err = text "in the stand-alone deriving instance"+                                    <> colon <+> quotes (ppr happy_var_5) }+                      ; ams (sLL happy_var_1 (hsSigType happy_var_5)+                                 (DerivDecl noExt (mkHsWildCardBndrs happy_var_5) happy_var_2 happy_var_4))+                            [mj AnnDeriving happy_var_1, mj AnnInstance happy_var_3] }))+	) (\r -> happyReturn (HappyAbsSyn104 r))++happyReduce_236 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_236 = happyMonadReduce 4# 89# happyReduction_236+happyReduction_236 ((HappyAbsSyn106  happy_var_4) `HappyStk`+	(HappyAbsSyn16  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (mkRoleAnnotDecl (comb3 happy_var_1 happy_var_3 happy_var_4) happy_var_3 (reverse (unLoc happy_var_4)))+                  [mj AnnType happy_var_1,mj AnnRole happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn105 r))++happyReduce_237 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_237 = happySpecReduce_0  90# happyReduction_237+happyReduction_237  =  HappyAbsSyn106+		 (noLoc []+	)++happyReduce_238 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_238 = happySpecReduce_1  90# happyReduction_238+happyReduction_238 (HappyAbsSyn106  happy_var_1)+	 =  HappyAbsSyn106+		 (happy_var_1+	)+happyReduction_238 _  = notHappyAtAll ++happyReduce_239 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_239 = happySpecReduce_1  91# happyReduction_239+happyReduction_239 (HappyAbsSyn108  happy_var_1)+	 =  HappyAbsSyn106+		 (sLL happy_var_1 happy_var_1 [happy_var_1]+	)+happyReduction_239 _  = notHappyAtAll ++happyReduce_240 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_240 = happySpecReduce_2  91# happyReduction_240+happyReduction_240 (HappyAbsSyn108  happy_var_2)+	(HappyAbsSyn106  happy_var_1)+	 =  HappyAbsSyn106+		 (sLL happy_var_1 happy_var_2 $ happy_var_2 : unLoc happy_var_1+	)+happyReduction_240 _ _  = notHappyAtAll ++happyReduce_241 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_241 = happySpecReduce_1  92# happyReduction_241+happyReduction_241 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn108+		 (sL1 happy_var_1 $ Just $ getVARID happy_var_1+	)+happyReduction_241 _  = notHappyAtAll ++happyReduce_242 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_242 = happySpecReduce_1  92# happyReduction_242+happyReduction_242 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn108+		 (sL1 happy_var_1 Nothing+	)+happyReduction_242 _  = notHappyAtAll ++happyReduce_243 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_243 = happyMonadReduce 4# 93# happyReduction_243+happyReduction_243 ((HappyAbsSyn247  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn110  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen (((      let (name, args,as ) = happy_var_2 in+                 ams (sLL happy_var_1 happy_var_4 . ValD noExt $ mkPatSynBind name args happy_var_4+                                                    ImplicitBidirectional)+               (as ++ [mj AnnPattern happy_var_1, mj AnnEqual happy_var_3])))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_244 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_244 = happyMonadReduce 4# 93# happyReduction_244+happyReduction_244 ((HappyAbsSyn247  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn110  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen (((    let (name, args, as) = happy_var_2 in+               ams (sLL happy_var_1 happy_var_4 . ValD noExt $ mkPatSynBind name args happy_var_4 Unidirectional)+               (as ++ [mj AnnPattern happy_var_1,mu AnnLarrow happy_var_3])))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_245 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_245 = happyMonadReduce 5# 93# happyReduction_245+happyReduction_245 ((HappyAbsSyn113  happy_var_5) `HappyStk`+	(HappyAbsSyn247  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn110  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { let (name, args, as) = happy_var_2+                  ; mg <- mkPatSynMatchGroup name (snd $ unLoc happy_var_5)+                  ; ams (sLL happy_var_1 happy_var_5 . ValD noExt $+                           mkPatSynBind name args happy_var_4 (ExplicitBidirectional mg))+                       (as ++ ((mj AnnPattern happy_var_1:mu AnnLarrow happy_var_3:(fst $ unLoc happy_var_5))) )+                   }))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_246 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_246 = happySpecReduce_2  94# happyReduction_246+happyReduction_246 (HappyAbsSyn111  happy_var_2)+	(HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn110+		 ((happy_var_1, PrefixCon happy_var_2, [])+	)+happyReduction_246 _ _  = notHappyAtAll ++happyReduce_247 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_247 = happySpecReduce_3  94# happyReduction_247+happyReduction_247 (HappyAbsSyn16  happy_var_3)+	(HappyAbsSyn16  happy_var_2)+	(HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn110+		 ((happy_var_2, InfixCon happy_var_1 happy_var_3, [])+	)+happyReduction_247 _ _ _  = notHappyAtAll ++happyReduce_248 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_248 = happyReduce 4# 94# happyReduction_248+happyReduction_248 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn112  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn16  happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn110+		 ((happy_var_1, RecCon happy_var_3, [moc happy_var_2, mcc happy_var_4] )+	) `HappyStk` happyRest++happyReduce_249 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_249 = happySpecReduce_0  95# happyReduction_249+happyReduction_249  =  HappyAbsSyn111+		 ([]+	)++happyReduce_250 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_250 = happySpecReduce_2  95# happyReduction_250+happyReduction_250 (HappyAbsSyn111  happy_var_2)+	(HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn111+		 (happy_var_1 : happy_var_2+	)+happyReduction_250 _ _  = notHappyAtAll ++happyReduce_251 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_251 = happySpecReduce_1  96# happyReduction_251+happyReduction_251 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn112+		 ([RecordPatSynField happy_var_1 happy_var_1]+	)+happyReduction_251 _  = notHappyAtAll ++happyReduce_252 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_252 = happyMonadReduce 3# 96# happyReduction_252+happyReduction_252 ((HappyAbsSyn112  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn16  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (getLoc happy_var_1) AnnComma (getLoc happy_var_2) >>+                                         return ((RecordPatSynField happy_var_1 happy_var_1) : happy_var_3 )))+	) (\r -> happyReturn (HappyAbsSyn112 r))++happyReduce_253 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_253 = happyReduce 4# 97# happyReduction_253+happyReduction_253 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn116  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn113+		 (sLL happy_var_1 happy_var_4 ((mj AnnWhere happy_var_1:moc happy_var_2+                                           :mcc happy_var_4:(fst $ unLoc happy_var_3)),sL1 happy_var_3 (snd $ unLoc happy_var_3))+	) `HappyStk` happyRest++happyReduce_254 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_254 = happyReduce 4# 97# happyReduction_254+happyReduction_254 (_ `HappyStk`+	(HappyAbsSyn116  happy_var_3) `HappyStk`+	_ `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn113+		 (cL (comb2 happy_var_1 happy_var_3) ((mj AnnWhere happy_var_1:(fst $ unLoc happy_var_3))+                                          ,sL1 happy_var_3 (snd $ unLoc happy_var_3))+	) `HappyStk` happyRest++happyReduce_255 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_255 = happyMonadReduce 4# 98# happyReduction_255+happyReduction_255 ((HappyAbsSyn147  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn87  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_4 $ PatSynSig noExt (unLoc happy_var_2) (mkLHsSigType happy_var_4))+                          [mj AnnPattern happy_var_1, mu AnnDcolon happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn114 r))++happyReduce_256 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_256 = happySpecReduce_1  99# happyReduction_256+happyReduction_256 (HappyAbsSyn77  happy_var_1)+	 =  HappyAbsSyn77+		 (happy_var_1+	)+happyReduction_256 _  = notHappyAtAll ++happyReduce_257 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_257 = happySpecReduce_1  99# happyReduction_257+happyReduction_257 (HappyAbsSyn77  happy_var_1)+	 =  HappyAbsSyn77+		 (happy_var_1+	)+happyReduction_257 _  = notHappyAtAll ++happyReduce_258 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_258 = happyMonadReduce 4# 99# happyReduction_258+happyReduction_258 ((HappyAbsSyn147  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                       do { v <- checkValSigLhs happy_var_2+                          ; let err = text "in default signature" <> colon <+>+                                      quotes (ppr happy_var_2)+                          ; ams (sLL happy_var_1 happy_var_4 $ SigD noExt $ ClassOpSig noExt True [v] $ mkLHsSigType happy_var_4)+                                [mj AnnDefault happy_var_1,mu AnnDcolon happy_var_3] }))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_259 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_259 = happyMonadReduce 3# 100# happyReduction_259+happyReduction_259 ((HappyAbsSyn77  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn116  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( if isNilOL (snd $ unLoc happy_var_1)+                                             then return (sLL happy_var_1 happy_var_3 (mj AnnSemi happy_var_2:(fst $ unLoc happy_var_1)+                                                                    , unitOL happy_var_3))+                                             else ams (lastOL (snd $ unLoc happy_var_1)) [mj AnnSemi happy_var_2]+                                           >> return (sLL happy_var_1 happy_var_3 (fst $ unLoc happy_var_1+                                                                ,(snd $ unLoc happy_var_1) `appOL` unitOL happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn116 r))++happyReduce_260 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_260 = happyMonadReduce 2# 100# happyReduction_260+happyReduction_260 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn116  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( if isNilOL (snd $ unLoc happy_var_1)+                                             then return (sLL happy_var_1 happy_var_2 (mj AnnSemi happy_var_2:(fst $ unLoc happy_var_1)+                                                                                   ,snd $ unLoc happy_var_1))+                                             else ams (lastOL (snd $ unLoc happy_var_1)) [mj AnnSemi happy_var_2]+                                           >> return (sLL happy_var_1 happy_var_2  (unLoc happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn116 r))++happyReduce_261 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_261 = happySpecReduce_1  100# happyReduction_261+happyReduction_261 (HappyAbsSyn77  happy_var_1)+	 =  HappyAbsSyn116+		 (sL1 happy_var_1 ([], unitOL happy_var_1)+	)+happyReduction_261 _  = notHappyAtAll ++happyReduce_262 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_262 = happySpecReduce_0  100# happyReduction_262+happyReduction_262  =  HappyAbsSyn116+		 (noLoc ([],nilOL)+	)++happyReduce_263 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_263 = happySpecReduce_3  101# happyReduction_263+happyReduction_263 (HappyTerminal happy_var_3)+	(HappyAbsSyn116  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn117+		 (sLL happy_var_1 happy_var_3 (moc happy_var_1:mcc happy_var_3:(fst $ unLoc happy_var_2)+                                             ,snd $ unLoc happy_var_2)+	)+happyReduction_263 _ _ _  = notHappyAtAll ++happyReduce_264 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_264 = happySpecReduce_3  101# happyReduction_264+happyReduction_264 _+	(HappyAbsSyn116  happy_var_2)+	_+	 =  HappyAbsSyn117+		 (happy_var_2+	)+happyReduction_264 _ _ _  = notHappyAtAll ++happyReduce_265 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_265 = happySpecReduce_2  102# happyReduction_265+happyReduction_265 (HappyAbsSyn117  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn118+		 (sLL happy_var_1 happy_var_2 (mj AnnWhere happy_var_1:(fst $ unLoc happy_var_2)+                                             ,snd $ unLoc happy_var_2)+	)+happyReduction_265 _ _  = notHappyAtAll ++happyReduce_266 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_266 = happySpecReduce_0  102# happyReduction_266+happyReduction_266  =  HappyAbsSyn118+		 (noLoc ([],nilOL)+	)++happyReduce_267 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_267 = happySpecReduce_1  103# happyReduction_267+happyReduction_267 (HappyAbsSyn80  happy_var_1)+	 =  HappyAbsSyn119+		 (sLL happy_var_1 happy_var_1 (unitOL (sL1 happy_var_1 (InstD noExt (unLoc happy_var_1))))+	)+happyReduction_267 _  = notHappyAtAll ++happyReduce_268 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_268 = happySpecReduce_1  103# happyReduction_268+happyReduction_268 (HappyAbsSyn77  happy_var_1)+	 =  HappyAbsSyn119+		 (sLL happy_var_1 happy_var_1 (unitOL happy_var_1)+	)+happyReduction_268 _  = notHappyAtAll ++happyReduce_269 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_269 = happyMonadReduce 3# 104# happyReduction_269+happyReduction_269 ((HappyAbsSyn119  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn116  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( if isNilOL (snd $ unLoc happy_var_1)+                                             then return (sLL happy_var_1 happy_var_3 (mj AnnSemi happy_var_2:(fst $ unLoc happy_var_1)+                                                                    , unLoc happy_var_3))+                                             else ams (lastOL $ snd $ unLoc happy_var_1) [mj AnnSemi happy_var_2]+                                           >> return+                                            (sLL happy_var_1 happy_var_3 (fst $ unLoc happy_var_1+                                                       ,(snd $ unLoc happy_var_1) `appOL` unLoc happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn116 r))++happyReduce_270 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_270 = happyMonadReduce 2# 104# happyReduction_270+happyReduction_270 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn116  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( if isNilOL (snd $ unLoc happy_var_1)+                                             then return (sLL happy_var_1 happy_var_2 (mj AnnSemi happy_var_2:(fst $ unLoc happy_var_1)+                                                                                   ,snd $ unLoc happy_var_1))+                                             else ams (lastOL $ snd $ unLoc happy_var_1) [mj AnnSemi happy_var_2]+                                           >> return (sLL happy_var_1 happy_var_2 (unLoc happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn116 r))++happyReduce_271 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_271 = happySpecReduce_1  104# happyReduction_271+happyReduction_271 (HappyAbsSyn119  happy_var_1)+	 =  HappyAbsSyn116+		 (sL1 happy_var_1 ([],unLoc happy_var_1)+	)+happyReduction_271 _  = notHappyAtAll ++happyReduce_272 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_272 = happySpecReduce_0  104# happyReduction_272+happyReduction_272  =  HappyAbsSyn116+		 (noLoc ([],nilOL)+	)++happyReduce_273 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_273 = happySpecReduce_3  105# happyReduction_273+happyReduction_273 (HappyTerminal happy_var_3)+	(HappyAbsSyn116  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn117+		 (sLL happy_var_1 happy_var_3 (moc happy_var_1:mcc happy_var_3:(fst $ unLoc happy_var_2),snd $ unLoc happy_var_2)+	)+happyReduction_273 _ _ _  = notHappyAtAll ++happyReduce_274 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_274 = happySpecReduce_3  105# happyReduction_274+happyReduction_274 _+	(HappyAbsSyn116  happy_var_2)+	_+	 =  HappyAbsSyn117+		 (cL (gl happy_var_2) (unLoc happy_var_2)+	)+happyReduction_274 _ _ _  = notHappyAtAll ++happyReduce_275 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_275 = happySpecReduce_2  106# happyReduction_275+happyReduction_275 (HappyAbsSyn117  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn122+		 (sLL happy_var_1 happy_var_2 (mj AnnWhere happy_var_1:(fst $ unLoc happy_var_2)+                                             ,(snd $ unLoc happy_var_2))+	)+happyReduction_275 _ _  = notHappyAtAll ++happyReduce_276 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_276 = happySpecReduce_0  106# happyReduction_276+happyReduction_276  =  HappyAbsSyn122+		 (noLoc ([],nilOL)+	)++happyReduce_277 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_277 = happyMonadReduce 3# 107# happyReduction_277+happyReduction_277 ((HappyAbsSyn77  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn116  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( if isNilOL (snd $ unLoc happy_var_1)+                                 then return (sLL happy_var_1 happy_var_3 (mj AnnSemi happy_var_2:(fst $ unLoc happy_var_1)+                                                        , unitOL happy_var_3))+                                 else do ams (lastOL $ snd $ unLoc happy_var_1) [mj AnnSemi happy_var_2]+                                           >> return (+                                          let { this = unitOL happy_var_3;+                                                rest = snd $ unLoc happy_var_1;+                                                these = rest `appOL` this }+                                          in rest `seq` this `seq` these `seq`+                                             (sLL happy_var_1 happy_var_3 (fst $ unLoc happy_var_1,these)))))+	) (\r -> happyReturn (HappyAbsSyn116 r))++happyReduce_278 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_278 = happyMonadReduce 2# 107# happyReduction_278+happyReduction_278 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn116  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( if isNilOL (snd $ unLoc happy_var_1)+                                  then return (sLL happy_var_1 happy_var_2 ((mj AnnSemi happy_var_2:(fst $ unLoc happy_var_1)+                                                          ,snd $ unLoc happy_var_1)))+                                  else ams (lastOL $ snd $ unLoc happy_var_1) [mj AnnSemi happy_var_2]+                                           >> return (sLL happy_var_1 happy_var_2 (unLoc happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn116 r))++happyReduce_279 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_279 = happySpecReduce_1  107# happyReduction_279+happyReduction_279 (HappyAbsSyn77  happy_var_1)+	 =  HappyAbsSyn116+		 (sL1 happy_var_1 ([], unitOL happy_var_1)+	)+happyReduction_279 _  = notHappyAtAll ++happyReduce_280 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_280 = happySpecReduce_0  107# happyReduction_280+happyReduction_280  =  HappyAbsSyn116+		 (noLoc ([],nilOL)+	)++happyReduce_281 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_281 = happySpecReduce_3  108# happyReduction_281+happyReduction_281 (HappyTerminal happy_var_3)+	(HappyAbsSyn116  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn124+		 (sLL happy_var_1 happy_var_3 (moc happy_var_1:mcc happy_var_3:(fst $ unLoc happy_var_2)+                                                   ,sL1 happy_var_2 $ snd $ unLoc happy_var_2)+	)+happyReduction_281 _ _ _  = notHappyAtAll ++happyReduce_282 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_282 = happySpecReduce_3  108# happyReduction_282+happyReduction_282 _+	(HappyAbsSyn116  happy_var_2)+	_+	 =  HappyAbsSyn124+		 (cL (gl happy_var_2) (fst $ unLoc happy_var_2,sL1 happy_var_2 $ snd $ unLoc happy_var_2)+	)+happyReduction_282 _ _ _  = notHappyAtAll ++happyReduce_283 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_283 = happyMonadReduce 1# 109# happyReduction_283+happyReduction_283 ((HappyAbsSyn124  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { val_binds <- cvBindGroup (unLoc $ snd $ unLoc happy_var_1)+                                  ; return (sL1 happy_var_1 (fst $ unLoc happy_var_1+                                                    ,sL1 happy_var_1 $ HsValBinds noExt val_binds)) }))+	) (\r -> happyReturn (HappyAbsSyn125 r))++happyReduce_284 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_284 = happySpecReduce_3  109# happyReduction_284+happyReduction_284 (HappyTerminal happy_var_3)+	(HappyAbsSyn260  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn125+		 (sLL happy_var_1 happy_var_3 ([moc happy_var_1,mcc happy_var_3]+                                             ,sL1 happy_var_2 $ HsIPBinds noExt (IPBinds noExt (reverse $ unLoc happy_var_2)))+	)+happyReduction_284 _ _ _  = notHappyAtAll ++happyReduce_285 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_285 = happySpecReduce_3  109# happyReduction_285+happyReduction_285 _+	(HappyAbsSyn260  happy_var_2)+	_+	 =  HappyAbsSyn125+		 (cL (getLoc happy_var_2) ([]+                                            ,sL1 happy_var_2 $ HsIPBinds noExt (IPBinds noExt (reverse $ unLoc happy_var_2)))+	)+happyReduction_285 _ _ _  = notHappyAtAll ++happyReduce_286 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_286 = happySpecReduce_2  110# happyReduction_286+happyReduction_286 (HappyAbsSyn125  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn125+		 (sLL happy_var_1 happy_var_2 (mj AnnWhere happy_var_1 : (fst $ unLoc happy_var_2)+                                             ,snd $ unLoc happy_var_2)+	)+happyReduction_286 _ _  = notHappyAtAll ++happyReduce_287 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_287 = happySpecReduce_0  110# happyReduction_287+happyReduction_287  =  HappyAbsSyn125+		 (noLoc ([],noLoc emptyLocalBinds)+	)++happyReduce_288 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_288 = happyMonadReduce 3# 111# happyReduction_288+happyReduction_288 ((HappyAbsSyn128  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn127  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (oll happy_var_1) AnnSemi (gl happy_var_2)+                                          >> return (happy_var_1 `snocOL` happy_var_3)))+	) (\r -> happyReturn (HappyAbsSyn127 r))++happyReduce_289 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_289 = happyMonadReduce 2# 111# happyReduction_289+happyReduction_289 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn127  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (oll happy_var_1) AnnSemi (gl happy_var_2)+                                          >> return happy_var_1))+	) (\r -> happyReturn (HappyAbsSyn127 r))++happyReduce_290 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_290 = happySpecReduce_1  111# happyReduction_290+happyReduction_290 (HappyAbsSyn128  happy_var_1)+	 =  HappyAbsSyn127+		 (unitOL happy_var_1+	)+happyReduction_290 _  = notHappyAtAll ++happyReduce_291 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_291 = happySpecReduce_0  111# happyReduction_291+happyReduction_291  =  HappyAbsSyn127+		 (nilOL+	)++happyReduce_292 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_292 = happyMonadReduce 6# 112# happyReduction_292+happyReduction_292 ((HappyAbsSyn207  happy_var_6) `HappyStk`+	(HappyTerminal happy_var_5) `HappyStk`+	(HappyAbsSyn207  happy_var_4) `HappyStk`+	(HappyAbsSyn131  happy_var_3) `HappyStk`+	(HappyAbsSyn129  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen (((runExpCmdP happy_var_4 >>= \ happy_var_4 ->+           runExpCmdP happy_var_6 >>= \ happy_var_6 ->+           ams (sLL happy_var_1 happy_var_6 $ HsRule { rd_ext = noExt+                                   , rd_name = cL (gl happy_var_1) (getSTRINGs happy_var_1, getSTRING happy_var_1)+                                   , rd_act = (snd happy_var_2) `orElse` AlwaysActive+                                   , rd_tyvs = sndOf3 happy_var_3, rd_tmvs = thdOf3 happy_var_3+                                   , rd_lhs = happy_var_4, rd_rhs = happy_var_6 })+               (mj AnnEqual happy_var_5 : (fst happy_var_2) ++ (fstOf3 happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn128 r))++happyReduce_293 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_293 = happySpecReduce_0  113# happyReduction_293+happyReduction_293  =  HappyAbsSyn129+		 (([],Nothing)+	)++happyReduce_294 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_294 = happySpecReduce_1  113# happyReduction_294+happyReduction_294 (HappyAbsSyn130  happy_var_1)+	 =  HappyAbsSyn129+		 ((fst happy_var_1,Just (snd happy_var_1))+	)+happyReduction_294 _  = notHappyAtAll ++happyReduce_295 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_295 = happySpecReduce_3  114# happyReduction_295+happyReduction_295 (HappyTerminal happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn130+		 (([mos happy_var_1,mj AnnVal happy_var_2,mcs happy_var_3]+                                  ,ActiveAfter  (getINTEGERs happy_var_2) (fromInteger (il_value (getINTEGER happy_var_2))))+	)+happyReduction_295 _ _ _  = notHappyAtAll ++happyReduce_296 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_296 = happyReduce 4# 114# happyReduction_296+happyReduction_296 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn130+		 (([mos happy_var_1,mj AnnTilde happy_var_2,mj AnnVal happy_var_3,mcs happy_var_4]+                                  ,ActiveBefore (getINTEGERs happy_var_3) (fromInteger (il_value (getINTEGER happy_var_3))))+	) `HappyStk` happyRest++happyReduce_297 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_297 = happySpecReduce_3  114# happyReduction_297+happyReduction_297 (HappyTerminal happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn130+		 (([mos happy_var_1,mj AnnTilde happy_var_2,mcs happy_var_3]+                                  ,NeverActive)+	)+happyReduction_297 _ _ _  = notHappyAtAll ++happyReduce_298 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_298 = happyMonadReduce 6# 115# happyReduction_298+happyReduction_298 ((HappyTerminal happy_var_6) `HappyStk`+	(HappyAbsSyn132  happy_var_5) `HappyStk`+	(HappyTerminal happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn132  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let tyvs = mkRuleTyVarBndrs happy_var_2+                                                              in hintExplicitForall happy_var_1+                                                              >> checkRuleTyVarBndrNames (mkRuleTyVarBndrs happy_var_2)+                                                              >> return ([mu AnnForall happy_var_1,mj AnnDot happy_var_3,+                                                                          mu AnnForall happy_var_4,mj AnnDot happy_var_6],+                                                                         Just (mkRuleTyVarBndrs happy_var_2), mkRuleBndrs happy_var_5)))+	) (\r -> happyReturn (HappyAbsSyn131 r))++happyReduce_299 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_299 = happySpecReduce_3  115# happyReduction_299+happyReduction_299 (HappyTerminal happy_var_3)+	(HappyAbsSyn132  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn131+		 (([mu AnnForall happy_var_1,mj AnnDot happy_var_3],+                                                              Nothing, mkRuleBndrs happy_var_2)+	)+happyReduction_299 _ _ _  = notHappyAtAll ++happyReduce_300 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_300 = happySpecReduce_0  115# happyReduction_300+happyReduction_300  =  HappyAbsSyn131+		 (([], Nothing, [])+	)++happyReduce_301 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_301 = happySpecReduce_2  116# happyReduction_301+happyReduction_301 (HappyAbsSyn132  happy_var_2)+	(HappyAbsSyn133  happy_var_1)+	 =  HappyAbsSyn132+		 (happy_var_1 : happy_var_2+	)+happyReduction_301 _ _  = notHappyAtAll ++happyReduce_302 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_302 = happySpecReduce_0  116# happyReduction_302+happyReduction_302  =  HappyAbsSyn132+		 ([]+	)++happyReduce_303 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_303 = happySpecReduce_1  117# happyReduction_303+happyReduction_303 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn133+		 (sLL happy_var_1 happy_var_1 (RuleTyTmVar happy_var_1 Nothing)+	)+happyReduction_303 _  = notHappyAtAll ++happyReduce_304 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_304 = happyMonadReduce 5# 117# happyReduction_304+happyReduction_304 ((HappyTerminal happy_var_5) `HappyStk`+	(HappyAbsSyn147  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_5 (RuleTyTmVar happy_var_2 (Just happy_var_4)))+                                               [mop happy_var_1,mu AnnDcolon happy_var_3,mcp happy_var_5]))+	) (\r -> happyReturn (HappyAbsSyn133 r))++happyReduce_305 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_305 = happyMonadReduce 3# 118# happyReduction_305+happyReduction_305 ((HappyAbsSyn134  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn134  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (oll happy_var_1) AnnSemi (gl happy_var_2)+                                          >> return (happy_var_1 `appOL` happy_var_3)))+	) (\r -> happyReturn (HappyAbsSyn134 r))++happyReduce_306 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_306 = happyMonadReduce 2# 118# happyReduction_306+happyReduction_306 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn134  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (oll happy_var_1) AnnSemi (gl happy_var_2)+                                          >> return happy_var_1))+	) (\r -> happyReturn (HappyAbsSyn134 r))++happyReduce_307 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_307 = happySpecReduce_1  118# happyReduction_307+happyReduction_307 (HappyAbsSyn134  happy_var_1)+	 =  HappyAbsSyn134+		 (happy_var_1+	)+happyReduction_307 _  = notHappyAtAll ++happyReduce_308 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_308 = happySpecReduce_0  118# happyReduction_308+happyReduction_308  =  HappyAbsSyn134+		 (nilOL+	)++happyReduce_309 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_309 = happyMonadReduce 2# 119# happyReduction_309+happyReduction_309 ((HappyAbsSyn138  happy_var_2) `HappyStk`+	(HappyAbsSyn87  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amsu (sLL happy_var_1 happy_var_2 (Warning noExt (unLoc happy_var_1) (WarningTxt (noLoc NoSourceText) $ snd $ unLoc happy_var_2)))+                     (fst $ unLoc happy_var_2)))+	) (\r -> happyReturn (HappyAbsSyn134 r))++happyReduce_310 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_310 = happyMonadReduce 3# 120# happyReduction_310+happyReduction_310 ((HappyAbsSyn134  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn134  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (oll happy_var_1) AnnSemi (gl happy_var_2)+                                          >> return (happy_var_1 `appOL` happy_var_3)))+	) (\r -> happyReturn (HappyAbsSyn134 r))++happyReduce_311 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_311 = happyMonadReduce 2# 120# happyReduction_311+happyReduction_311 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn134  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (oll happy_var_1) AnnSemi (gl happy_var_2)+                                          >> return happy_var_1))+	) (\r -> happyReturn (HappyAbsSyn134 r))++happyReduce_312 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_312 = happySpecReduce_1  120# happyReduction_312+happyReduction_312 (HappyAbsSyn134  happy_var_1)+	 =  HappyAbsSyn134+		 (happy_var_1+	)+happyReduction_312 _  = notHappyAtAll ++happyReduce_313 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_313 = happySpecReduce_0  120# happyReduction_313+happyReduction_313  =  HappyAbsSyn134+		 (nilOL+	)++happyReduce_314 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_314 = happyMonadReduce 2# 121# happyReduction_314+happyReduction_314 ((HappyAbsSyn138  happy_var_2) `HappyStk`+	(HappyAbsSyn87  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amsu (sLL happy_var_1 happy_var_2 $ (Warning noExt (unLoc happy_var_1) (DeprecatedTxt (noLoc NoSourceText) $ snd $ unLoc happy_var_2)))+                     (fst $ unLoc happy_var_2)))+	) (\r -> happyReturn (HappyAbsSyn134 r))++happyReduce_315 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_315 = happySpecReduce_1  122# happyReduction_315+happyReduction_315 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn138+		 (sL1 happy_var_1 ([],[cL (gl happy_var_1) (getStringLiteral happy_var_1)])+	)+happyReduction_315 _  = notHappyAtAll ++happyReduce_316 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_316 = happySpecReduce_3  122# happyReduction_316+happyReduction_316 (HappyTerminal happy_var_3)+	(HappyAbsSyn139  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn138+		 (sLL happy_var_1 happy_var_3 $ ([mos happy_var_1,mcs happy_var_3],fromOL (unLoc happy_var_2))+	)+happyReduction_316 _ _ _  = notHappyAtAll ++happyReduce_317 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_317 = happyMonadReduce 3# 123# happyReduction_317+happyReduction_317 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn139  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (oll $ unLoc happy_var_1) AnnComma (gl happy_var_2) >>+                               return (sLL happy_var_1 happy_var_3 (unLoc happy_var_1 `snocOL`+                                                  (cL (gl happy_var_3) (getStringLiteral happy_var_3))))))+	) (\r -> happyReturn (HappyAbsSyn139 r))++happyReduce_318 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_318 = happySpecReduce_1  123# happyReduction_318+happyReduction_318 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn139+		 (sLL happy_var_1 happy_var_1 (unitOL (cL (gl happy_var_1) (getStringLiteral happy_var_1)))+	)+happyReduction_318 _  = notHappyAtAll ++happyReduce_319 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_319 = happySpecReduce_0  123# happyReduction_319+happyReduction_319  =  HappyAbsSyn139+		 (noLoc nilOL+	)++happyReduce_320 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_320 = happyMonadReduce 4# 124# happyReduction_320+happyReduction_320 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                            ams (sLL happy_var_1 happy_var_4 (AnnD noExt $ HsAnnotation noExt+                                            (getANN_PRAGs happy_var_1)+                                            (ValueAnnProvenance happy_var_2) happy_var_3))+                                            [mo happy_var_1,mc happy_var_4]))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_321 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_321 = happyMonadReduce 5# 124# happyReduction_321+happyReduction_321 ((HappyTerminal happy_var_5) `HappyStk`+	(HappyAbsSyn207  happy_var_4) `HappyStk`+	(HappyAbsSyn16  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_4 >>= \ happy_var_4 ->+                                            ams (sLL happy_var_1 happy_var_5 (AnnD noExt $ HsAnnotation noExt+                                            (getANN_PRAGs happy_var_1)+                                            (TypeAnnProvenance happy_var_3) happy_var_4))+                                            [mo happy_var_1,mj AnnType happy_var_2,mc happy_var_5]))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_322 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_322 = happyMonadReduce 4# 124# happyReduction_322+happyReduction_322 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                            ams (sLL happy_var_1 happy_var_4 (AnnD noExt $ HsAnnotation noExt+                                                (getANN_PRAGs happy_var_1)+                                                 ModuleAnnProvenance happy_var_3))+                                                [mo happy_var_1,mj AnnModule happy_var_2,mc happy_var_4]))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_323 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_323 = happyMonadReduce 4# 125# happyReduction_323+happyReduction_323 ((HappyAbsSyn144  happy_var_4) `HappyStk`+	(HappyAbsSyn143  happy_var_3) `HappyStk`+	(HappyAbsSyn142  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( mkImport happy_var_2 happy_var_3 (snd $ unLoc happy_var_4) >>= \i ->+                 return (sLL happy_var_1 happy_var_4 (mj AnnImport happy_var_1 : (fst $ unLoc happy_var_4),i))))+	) (\r -> happyReturn (HappyAbsSyn141 r))++happyReduce_324 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_324 = happyMonadReduce 3# 125# happyReduction_324+happyReduction_324 ((HappyAbsSyn144  happy_var_3) `HappyStk`+	(HappyAbsSyn142  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { d <- mkImport happy_var_2 (noLoc PlaySafe) (snd $ unLoc happy_var_3);+                    return (sLL happy_var_1 happy_var_3 (mj AnnImport happy_var_1 : (fst $ unLoc happy_var_3),d)) }))+	) (\r -> happyReturn (HappyAbsSyn141 r))++happyReduce_325 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_325 = happyMonadReduce 3# 125# happyReduction_325+happyReduction_325 ((HappyAbsSyn144  happy_var_3) `HappyStk`+	(HappyAbsSyn142  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( mkExport happy_var_2 (snd $ unLoc happy_var_3) >>= \i ->+                  return (sLL happy_var_1 happy_var_3 (mj AnnExport happy_var_1 : (fst $ unLoc happy_var_3),i) )))+	) (\r -> happyReturn (HappyAbsSyn141 r))++happyReduce_326 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_326 = happySpecReduce_1  126# happyReduction_326+happyReduction_326 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn142+		 (sLL happy_var_1 happy_var_1 StdCallConv+	)+happyReduction_326 _  = notHappyAtAll ++happyReduce_327 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_327 = happySpecReduce_1  126# happyReduction_327+happyReduction_327 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn142+		 (sLL happy_var_1 happy_var_1 CCallConv+	)+happyReduction_327 _  = notHappyAtAll ++happyReduce_328 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_328 = happySpecReduce_1  126# happyReduction_328+happyReduction_328 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn142+		 (sLL happy_var_1 happy_var_1 CApiConv+	)+happyReduction_328 _  = notHappyAtAll ++happyReduce_329 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_329 = happySpecReduce_1  126# happyReduction_329+happyReduction_329 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn142+		 (sLL happy_var_1 happy_var_1 PrimCallConv+	)+happyReduction_329 _  = notHappyAtAll ++happyReduce_330 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_330 = happySpecReduce_1  126# happyReduction_330+happyReduction_330 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn142+		 (sLL happy_var_1 happy_var_1 JavaScriptCallConv+	)+happyReduction_330 _  = notHappyAtAll ++happyReduce_331 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_331 = happySpecReduce_1  127# happyReduction_331+happyReduction_331 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn143+		 (sLL happy_var_1 happy_var_1 PlayRisky+	)+happyReduction_331 _  = notHappyAtAll ++happyReduce_332 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_332 = happySpecReduce_1  127# happyReduction_332+happyReduction_332 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn143+		 (sLL happy_var_1 happy_var_1 PlaySafe+	)+happyReduction_332 _  = notHappyAtAll ++happyReduce_333 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_333 = happySpecReduce_1  127# happyReduction_333+happyReduction_333 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn143+		 (sLL happy_var_1 happy_var_1 PlayInterruptible+	)+happyReduction_333 _  = notHappyAtAll ++happyReduce_334 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_334 = happyReduce 4# 128# happyReduction_334+happyReduction_334 ((HappyAbsSyn147  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn144+		 (sLL happy_var_1 happy_var_4 ([mu AnnDcolon happy_var_3]+                                             ,(cL (getLoc happy_var_1)+                                                    (getStringLiteral happy_var_1), happy_var_2, mkLHsSigType happy_var_4))+	) `HappyStk` happyRest++happyReduce_335 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_335 = happySpecReduce_3  128# happyReduction_335+happyReduction_335 (HappyAbsSyn147  happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn144+		 (sLL happy_var_1 happy_var_3 ([mu AnnDcolon happy_var_2]+                                             ,(noLoc (StringLiteral NoSourceText nilFS), happy_var_1, mkLHsSigType happy_var_3))+	)+happyReduction_335 _ _ _  = notHappyAtAll ++happyReduce_336 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_336 = happySpecReduce_0  129# happyReduction_336+happyReduction_336  =  HappyAbsSyn145+		 (([],Nothing)+	)++happyReduce_337 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_337 = happySpecReduce_2  129# happyReduction_337+happyReduction_337 (HappyAbsSyn147  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn145+		 (([mu AnnDcolon happy_var_1],Just happy_var_2)+	)+happyReduction_337 _ _  = notHappyAtAll ++happyReduce_338 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_338 = happySpecReduce_0  130# happyReduction_338+happyReduction_338  =  HappyAbsSyn146+		 (([], Nothing)+	)++happyReduce_339 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_339 = happySpecReduce_2  130# happyReduction_339+happyReduction_339 (HappyAbsSyn16  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn146+		 (([mu AnnDcolon happy_var_1], Just happy_var_2)+	)+happyReduction_339 _ _  = notHappyAtAll ++happyReduce_340 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_340 = happySpecReduce_1  131# happyReduction_340+happyReduction_340 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn147+		 (happy_var_1+	)+happyReduction_340 _  = notHappyAtAll ++happyReduce_341 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_341 = happySpecReduce_1  132# happyReduction_341+happyReduction_341 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn147+		 (happy_var_1+	)+happyReduction_341 _  = notHappyAtAll ++happyReduce_342 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_342 = happyMonadReduce 3# 133# happyReduction_342+happyReduction_342 ((HappyAbsSyn16  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn87  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl $ head $ unLoc happy_var_1)+                                                       AnnComma (gl happy_var_2)+                                         >> return (sLL happy_var_1 happy_var_3 (happy_var_3 : unLoc happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn87 r))++happyReduce_343 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_343 = happySpecReduce_1  133# happyReduction_343+happyReduction_343 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn87+		 (sL1 happy_var_1 [happy_var_1]+	)+happyReduction_343 _  = notHappyAtAll ++happyReduce_344 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_344 = happySpecReduce_1  134# happyReduction_344+happyReduction_344 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn150+		 (unitOL (mkLHsSigType happy_var_1)+	)+happyReduction_344 _  = notHappyAtAll ++happyReduce_345 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_345 = happyMonadReduce 3# 134# happyReduction_345+happyReduction_345 ((HappyAbsSyn150  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn147  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) AnnComma (gl happy_var_2)+                                >> return (unitOL (mkLHsSigType happy_var_1) `appOL` happy_var_3)))+	) (\r -> happyReturn (HappyAbsSyn150 r))++happyReduce_346 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_346 = happySpecReduce_2  135# happyReduction_346+happyReduction_346 (HappyTerminal happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn151+		 (sLL happy_var_1 happy_var_2 ([mo happy_var_1, mc happy_var_2], getUNPACK_PRAGs happy_var_1, SrcUnpack)+	)+happyReduction_346 _ _  = notHappyAtAll ++happyReduce_347 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_347 = happySpecReduce_2  135# happyReduction_347+happyReduction_347 (HappyTerminal happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn151+		 (sLL happy_var_1 happy_var_2 ([mo happy_var_1, mc happy_var_2], getNOUNPACK_PRAGs happy_var_1, SrcNoUnpack)+	)+happyReduction_347 _ _  = notHappyAtAll ++happyReduce_348 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_348 = happySpecReduce_1  136# happyReduction_348+happyReduction_348 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn152+		 ((mj AnnDot happy_var_1,    ForallInvis)+	)+happyReduction_348 _  = notHappyAtAll ++happyReduce_349 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_349 = happySpecReduce_1  136# happyReduction_349+happyReduction_349 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn152+		 ((mj AnnRarrow happy_var_1, ForallVis)+	)+happyReduction_349 _  = notHappyAtAll ++happyReduce_350 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_350 = happySpecReduce_1  137# happyReduction_350+happyReduction_350 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn147+		 (happy_var_1+	)+happyReduction_350 _  = notHappyAtAll ++happyReduce_351 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_351 = happyMonadReduce 3# 137# happyReduction_351+happyReduction_351 ((HappyAbsSyn179  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn147  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ HsKindSig noExt happy_var_1 happy_var_3)+                                      [mu AnnDcolon happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_352 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_352 = happySpecReduce_1  138# happyReduction_352+happyReduction_352 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn147+		 (happy_var_1+	)+happyReduction_352 _  = notHappyAtAll ++happyReduce_353 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_353 = happyMonadReduce 3# 138# happyReduction_353+happyReduction_353 ((HappyAbsSyn179  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn147  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ HsKindSig noExt happy_var_1 happy_var_3)+                                      [mu AnnDcolon happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_354 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_354 = happyMonadReduce 4# 139# happyReduction_354+happyReduction_354 ((HappyAbsSyn147  happy_var_4) `HappyStk`+	(HappyAbsSyn152  happy_var_3) `HappyStk`+	(HappyAbsSyn173  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let (fv_ann, fv_flag) = happy_var_3 in+                                           hintExplicitForall happy_var_1 *>+                                           ams (sLL happy_var_1 happy_var_4 $+                                                HsForAllTy { hst_fvf = fv_flag+                                                           , hst_bndrs = happy_var_2+                                                           , hst_xforall = noExt+                                                           , hst_body = happy_var_4 })+                                               [mu AnnForall happy_var_1,fv_ann]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_355 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_355 = happyMonadReduce 3# 139# happyReduction_355+happyReduction_355 ((HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn157  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) (toUnicodeAnn AnnDarrow happy_var_2) (gl happy_var_2)+                                         >> return (sLL happy_var_1 happy_var_3 $+                                            HsQualTy { hst_ctxt = happy_var_1+                                                     , hst_xqual = noExt+                                                     , hst_body = happy_var_3 })))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_356 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_356 = happyMonadReduce 3# 139# happyReduction_356+happyReduction_356 ((HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn262  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (HsIParamTy noExt happy_var_1 happy_var_3))+                                             [mu AnnDcolon happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_357 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_357 = happySpecReduce_1  139# happyReduction_357+happyReduction_357 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn147+		 (happy_var_1+	)+happyReduction_357 _  = notHappyAtAll ++happyReduce_358 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_358 = happyMonadReduce 4# 140# happyReduction_358+happyReduction_358 ((HappyAbsSyn147  happy_var_4) `HappyStk`+	(HappyAbsSyn152  happy_var_3) `HappyStk`+	(HappyAbsSyn173  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let (fv_ann, fv_flag) = happy_var_3 in+                                            hintExplicitForall happy_var_1 *>+                                            ams (sLL happy_var_1 happy_var_4 $+                                                 HsForAllTy { hst_fvf = fv_flag+                                                            , hst_bndrs = happy_var_2+                                                            , hst_xforall = noExt+                                                            , hst_body = happy_var_4 })+                                                [mu AnnForall happy_var_1,fv_ann]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_359 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_359 = happyMonadReduce 3# 140# happyReduction_359+happyReduction_359 ((HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn157  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) (toUnicodeAnn AnnDarrow happy_var_2) (gl happy_var_2)+                                         >> return (sLL happy_var_1 happy_var_3 $+                                            HsQualTy { hst_ctxt = happy_var_1+                                                     , hst_xqual = noExt+                                                     , hst_body = happy_var_3 })))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_360 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_360 = happyMonadReduce 3# 140# happyReduction_360+happyReduction_360 ((HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn262  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (HsIParamTy noExt happy_var_1 happy_var_3))+                                             [mu AnnDcolon happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_361 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_361 = happySpecReduce_1  140# happyReduction_361+happyReduction_361 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn147+		 (happy_var_1+	)+happyReduction_361 _  = notHappyAtAll ++happyReduce_362 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_362 = happyMonadReduce 1# 141# happyReduction_362+happyReduction_362 ((HappyAbsSyn147  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { (anns,ctx) <- checkContext happy_var_1+                                                ; if null (unLoc ctx)+                                                   then addAnnotation (gl happy_var_1) AnnUnit (gl happy_var_1)+                                                   else return ()+                                                ; ams ctx anns+                                                }))+	) (\r -> happyReturn (HappyAbsSyn157 r))++happyReduce_363 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_363 = happyMonadReduce 1# 142# happyReduction_363+happyReduction_363 ((HappyAbsSyn147  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { (anns,ctx) <- checkContext happy_var_1+                                                ; if null (unLoc ctx)+                                                   then addAnnotation (gl happy_var_1) AnnUnit (gl happy_var_1)+                                                   else return ()+                                                ; ams ctx anns+                                                }))+	) (\r -> happyReturn (HappyAbsSyn157 r))++happyReduce_364 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_364 = happySpecReduce_1  143# happyReduction_364+happyReduction_364 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn147+		 (happy_var_1+	)+happyReduction_364 _  = notHappyAtAll ++happyReduce_365 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_365 = happyMonadReduce 3# 143# happyReduction_365+happyReduction_365 ((HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn147  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams happy_var_1 [mu AnnRarrow happy_var_2] -- See note [GADT decl discards annotations]+                                       >> ams (sLL happy_var_1 happy_var_3 $ HsFunTy noExt happy_var_1 happy_var_3)+                                              [mu AnnRarrow happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_366 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_366 = happySpecReduce_1  144# happyReduction_366+happyReduction_366 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn147+		 (happy_var_1+	)+happyReduction_366 _  = notHappyAtAll ++happyReduce_367 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_367 = happySpecReduce_2  144# happyReduction_367+happyReduction_367 (HappyAbsSyn321  happy_var_2)+	(HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn147+		 (sLL happy_var_1 happy_var_2 $ HsDocTy noExt happy_var_1 happy_var_2+	)+happyReduction_367 _ _  = notHappyAtAll ++happyReduce_368 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_368 = happySpecReduce_2  144# happyReduction_368+happyReduction_368 (HappyAbsSyn147  happy_var_2)+	(HappyAbsSyn321  happy_var_1)+	 =  HappyAbsSyn147+		 (sLL happy_var_1 happy_var_2 $ HsDocTy noExt happy_var_2 happy_var_1+	)+happyReduction_368 _ _  = notHappyAtAll ++happyReduce_369 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_369 = happyMonadReduce 3# 144# happyReduction_369+happyReduction_369 ((HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn147  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams happy_var_1 [mu AnnRarrow happy_var_2] -- See note [GADT decl discards annotations]+                                         >> ams (sLL happy_var_1 happy_var_3 $ HsFunTy noExt happy_var_1 happy_var_3)+                                                [mu AnnRarrow happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_370 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_370 = happyMonadReduce 4# 144# happyReduction_370+happyReduction_370 ((HappyAbsSyn147  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn321  happy_var_2) `HappyStk`+	(HappyAbsSyn147  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams happy_var_1 [mu AnnRarrow happy_var_3] -- See note [GADT decl discards annotations]+                                         >> ams (sLL happy_var_1 happy_var_4 $+                                                 HsFunTy noExt (cL (comb2 happy_var_1 happy_var_2)+                                                            (HsDocTy noExt happy_var_1 happy_var_2))+                                                         happy_var_4)+                                                [mu AnnRarrow happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_371 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_371 = happyMonadReduce 4# 144# happyReduction_371+happyReduction_371 ((HappyAbsSyn147  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn147  happy_var_2) `HappyStk`+	(HappyAbsSyn321  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams happy_var_2 [mu AnnRarrow happy_var_3] -- See note [GADT decl discards annotations]+                                         >> ams (sLL happy_var_1 happy_var_4 $+                                                 HsFunTy noExt (cL (comb2 happy_var_1 happy_var_2)+                                                            (HsDocTy noExt happy_var_2 happy_var_1))+                                                         happy_var_4)+                                                [mu AnnRarrow happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_372 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_372 = happyMonadReduce 1# 145# happyReduction_372+happyReduction_372 ((HappyAbsSyn162  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( mergeOps (unLoc happy_var_1)))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_373 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_373 = happySpecReduce_1  146# happyReduction_373+happyReduction_373 (HappyAbsSyn163  happy_var_1)+	 =  HappyAbsSyn162+		 (sL1 happy_var_1 [happy_var_1]+	)+happyReduction_373 _  = notHappyAtAll ++happyReduce_374 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_374 = happySpecReduce_2  146# happyReduction_374+happyReduction_374 (HappyAbsSyn163  happy_var_2)+	(HappyAbsSyn162  happy_var_1)+	 =  HappyAbsSyn162+		 (sLL happy_var_1 happy_var_2 $ happy_var_2 : (unLoc happy_var_1)+	)+happyReduction_374 _ _  = notHappyAtAll ++happyReduce_375 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_375 = happySpecReduce_1  147# happyReduction_375+happyReduction_375 (HappyAbsSyn163  happy_var_1)+	 =  HappyAbsSyn163+		 (happy_var_1+	)+happyReduction_375 _  = notHappyAtAll ++happyReduce_376 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_376 = happySpecReduce_1  147# happyReduction_376+happyReduction_376 (HappyAbsSyn321  happy_var_1)+	 =  HappyAbsSyn163+		 (sL1 happy_var_1 $ TyElDocPrev (unLoc happy_var_1)+	)+happyReduction_376 _  = notHappyAtAll ++happyReduce_377 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_377 = happyMonadReduce 1# 148# happyReduction_377+happyReduction_377 ((HappyAbsSyn165  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( mergeOps happy_var_1))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_378 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_378 = happySpecReduce_1  149# happyReduction_378+happyReduction_378 (HappyAbsSyn163  happy_var_1)+	 =  HappyAbsSyn165+		 ([happy_var_1]+	)+happyReduction_378 _  = notHappyAtAll ++happyReduce_379 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_379 = happySpecReduce_2  149# happyReduction_379+happyReduction_379 (HappyAbsSyn163  happy_var_2)+	(HappyAbsSyn165  happy_var_1)+	 =  HappyAbsSyn165+		 (happy_var_2 : happy_var_1+	)+happyReduction_379 _ _  = notHappyAtAll ++happyReduce_380 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_380 = happySpecReduce_1  150# happyReduction_380+happyReduction_380 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn163+		 (sL1 happy_var_1 $ TyElOpd (unLoc happy_var_1)+	)+happyReduction_380 _  = notHappyAtAll ++happyReduce_381 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_381 = happySpecReduce_2  150# happyReduction_381+happyReduction_381 (HappyAbsSyn147  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn163+		 (sLL happy_var_1 happy_var_2 $ (TyElKindApp (comb2 happy_var_1 happy_var_2) happy_var_2)+	)+happyReduction_381 _ _  = notHappyAtAll ++happyReduce_382 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_382 = happySpecReduce_1  150# happyReduction_382+happyReduction_382 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn163+		 (sL1 happy_var_1 $ if isBangRdr (unLoc happy_var_1) then TyElBang else+                                                   if isTildeRdr (unLoc happy_var_1) then TyElTilde else+                                                   TyElOpr (unLoc happy_var_1)+	)+happyReduction_382 _  = notHappyAtAll ++happyReduce_383 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_383 = happySpecReduce_1  150# happyReduction_383+happyReduction_383 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn163+		 (sL1 happy_var_1 $ TyElOpr (unLoc happy_var_1)+	)+happyReduction_383 _  = notHappyAtAll ++happyReduce_384 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_384 = happyMonadReduce 2# 150# happyReduction_384+happyReduction_384 ((HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 $ TyElOpr (unLoc happy_var_2))+                                               [mj AnnSimpleQuote happy_var_1,mj AnnVal happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn163 r))++happyReduce_385 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_385 = happyMonadReduce 2# 150# happyReduction_385+happyReduction_385 ((HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 $ TyElOpr (unLoc happy_var_2))+                                               [mj AnnSimpleQuote happy_var_1,mj AnnVal happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn163 r))++happyReduce_386 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_386 = happySpecReduce_1  150# happyReduction_386+happyReduction_386 (HappyAbsSyn151  happy_var_1)+	 =  HappyAbsSyn163+		 (sL1 happy_var_1 $ TyElUnpackedness (unLoc happy_var_1)+	)+happyReduction_386 _  = notHappyAtAll ++happyReduce_387 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_387 = happySpecReduce_1  151# happyReduction_387+happyReduction_387 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn147+		 (sL1 happy_var_1 (HsTyVar noExt NotPromoted happy_var_1)+	)+happyReduction_387 _  = notHappyAtAll ++happyReduce_388 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_388 = happySpecReduce_1  151# happyReduction_388+happyReduction_388 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn147+		 (sL1 happy_var_1 (HsTyVar noExt NotPromoted happy_var_1)+	)+happyReduction_388 _  = notHappyAtAll ++happyReduce_389 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_389 = happyMonadReduce 1# 151# happyReduction_389+happyReduction_389 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { warnStarIsType (getLoc happy_var_1)+                                               ; return $ sL1 happy_var_1 (HsStarTy noExt (isUnicode happy_var_1)) }))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_390 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_390 = happyMonadReduce 3# 151# happyReduction_390+happyReduction_390 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn189  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( amms (checkRecordSyntax+                                                    (sLL happy_var_1 happy_var_3 $ HsRecTy noExt happy_var_2))+                                                        -- Constructor sigs only+                                                 [moc happy_var_1,mcc happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_391 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_391 = happyMonadReduce 2# 151# happyReduction_391+happyReduction_391 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 $ HsTupleTy noExt+                                                    HsBoxedOrConstraintTuple [])+                                                [mop happy_var_1,mcp happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_392 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_392 = happyMonadReduce 5# 151# happyReduction_392+happyReduction_392 ((HappyTerminal happy_var_5) `HappyStk`+	(HappyAbsSyn170  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn147  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_2) AnnComma+                                                          (gl happy_var_3) >>+                                            ams (sLL happy_var_1 happy_var_5 $ HsTupleTy noExt++                                             HsBoxedOrConstraintTuple (happy_var_2 : happy_var_4))+                                                [mop happy_var_1,mcp happy_var_5]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_393 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_393 = happyMonadReduce 2# 151# happyReduction_393+happyReduction_393 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 $ HsTupleTy noExt HsUnboxedTuple [])+                                             [mo happy_var_1,mc happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_394 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_394 = happyMonadReduce 3# 151# happyReduction_394+happyReduction_394 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn170  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ HsTupleTy noExt HsUnboxedTuple happy_var_2)+                                             [mo happy_var_1,mc happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_395 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_395 = happyMonadReduce 3# 151# happyReduction_395+happyReduction_395 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn170  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ HsSumTy noExt happy_var_2)+                                             [mo happy_var_1,mc happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_396 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_396 = happyMonadReduce 3# 151# happyReduction_396+happyReduction_396 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn147  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ HsListTy  noExt happy_var_2) [mos happy_var_1,mcs happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_397 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_397 = happyMonadReduce 3# 151# happyReduction_397+happyReduction_397 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn147  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ HsParTy   noExt happy_var_2) [mop happy_var_1,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_398 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_398 = happySpecReduce_1  151# happyReduction_398+happyReduction_398 (HappyAbsSyn206  happy_var_1)+	 =  HappyAbsSyn147+		 (mapLoc (HsSpliceTy noExt) happy_var_1+	)+happyReduction_398 _  = notHappyAtAll ++happyReduce_399 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_399 = happySpecReduce_1  151# happyReduction_399+happyReduction_399 (HappyAbsSyn206  happy_var_1)+	 =  HappyAbsSyn147+		 (mapLoc (HsSpliceTy noExt) happy_var_1+	)+happyReduction_399 _  = notHappyAtAll ++happyReduce_400 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_400 = happyMonadReduce 2# 151# happyReduction_400+happyReduction_400 ((HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 $ HsTyVar noExt IsPromoted happy_var_2) [mj AnnSimpleQuote happy_var_1,mj AnnName happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_401 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_401 = happyMonadReduce 6# 151# happyReduction_401+happyReduction_401 ((HappyTerminal happy_var_6) `HappyStk`+	(HappyAbsSyn170  happy_var_5) `HappyStk`+	(HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_3) AnnComma (gl happy_var_4) >>+                                ams (sLL happy_var_1 happy_var_6 $ HsExplicitTupleTy noExt (happy_var_3 : happy_var_5))+                                    [mj AnnSimpleQuote happy_var_1,mop happy_var_2,mcp happy_var_6]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_402 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_402 = happyMonadReduce 4# 151# happyReduction_402+happyReduction_402 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn170  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_4 $ HsExplicitListTy noExt IsPromoted happy_var_3)+                                                       [mj AnnSimpleQuote happy_var_1,mos happy_var_2,mcs happy_var_4]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_403 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_403 = happyMonadReduce 2# 151# happyReduction_403+happyReduction_403 ((HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 $ HsTyVar noExt IsPromoted happy_var_2)+                                                       [mj AnnSimpleQuote happy_var_1,mj AnnName happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_404 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_404 = happyMonadReduce 5# 151# happyReduction_404+happyReduction_404 ((HappyTerminal happy_var_5) `HappyStk`+	(HappyAbsSyn170  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn147  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_2) AnnComma+                                                           (gl happy_var_3) >>+                                             ams (sLL happy_var_1 happy_var_5 $ HsExplicitListTy noExt NotPromoted (happy_var_2 : happy_var_4))+                                                 [mos happy_var_1,mcs happy_var_5]))+	) (\r -> happyReturn (HappyAbsSyn147 r))++happyReduce_405 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_405 = happySpecReduce_1  151# happyReduction_405+happyReduction_405 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn147+		 (sLL happy_var_1 happy_var_1 $ HsTyLit noExt $ HsNumTy (getINTEGERs happy_var_1)+                                                           (il_value (getINTEGER happy_var_1))+	)+happyReduction_405 _  = notHappyAtAll ++happyReduce_406 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_406 = happySpecReduce_1  151# happyReduction_406+happyReduction_406 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn147+		 (sLL happy_var_1 happy_var_1 $ HsTyLit noExt $ HsStrTy (getSTRINGs happy_var_1)+                                                                     (getSTRING  happy_var_1)+	)+happyReduction_406 _  = notHappyAtAll ++happyReduce_407 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_407 = happySpecReduce_1  151# happyReduction_407+happyReduction_407 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn147+		 (sL1 happy_var_1 $ mkAnonWildCardTy+	)+happyReduction_407 _  = notHappyAtAll ++happyReduce_408 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_408 = happySpecReduce_1  152# happyReduction_408+happyReduction_408 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn168+		 (mkLHsSigType happy_var_1+	)+happyReduction_408 _  = notHappyAtAll ++happyReduce_409 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_409 = happySpecReduce_1  153# happyReduction_409+happyReduction_409 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn169+		 ([mkLHsSigType happy_var_1]+	)+happyReduction_409 _  = notHappyAtAll ++happyReduce_410 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_410 = happyMonadReduce 3# 153# happyReduction_410+happyReduction_410 ((HappyAbsSyn169  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn147  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) AnnComma (gl happy_var_2)+                                           >> return (mkLHsSigType happy_var_1 : happy_var_3)))+	) (\r -> happyReturn (HappyAbsSyn169 r))++happyReduce_411 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_411 = happySpecReduce_1  154# happyReduction_411+happyReduction_411 (HappyAbsSyn170  happy_var_1)+	 =  HappyAbsSyn170+		 (happy_var_1+	)+happyReduction_411 _  = notHappyAtAll ++happyReduce_412 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_412 = happySpecReduce_0  154# happyReduction_412+happyReduction_412  =  HappyAbsSyn170+		 ([]+	)++happyReduce_413 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_413 = happySpecReduce_1  155# happyReduction_413+happyReduction_413 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn170+		 ([happy_var_1]+	)+happyReduction_413 _  = notHappyAtAll ++happyReduce_414 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_414 = happyMonadReduce 3# 155# happyReduction_414+happyReduction_414 ((HappyAbsSyn170  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn147  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) AnnComma (gl happy_var_2)+                                          >> return (happy_var_1 : happy_var_3)))+	) (\r -> happyReturn (HappyAbsSyn170 r))++happyReduce_415 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_415 = happyMonadReduce 3# 156# happyReduction_415+happyReduction_415 ((HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn147  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) AnnVbar (gl happy_var_2)+                                          >> return [happy_var_1,happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn170 r))++happyReduce_416 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_416 = happyMonadReduce 3# 156# happyReduction_416+happyReduction_416 ((HappyAbsSyn170  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn147  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) AnnVbar (gl happy_var_2)+                                          >> return (happy_var_1 : happy_var_3)))+	) (\r -> happyReturn (HappyAbsSyn170 r))++happyReduce_417 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_417 = happySpecReduce_2  157# happyReduction_417+happyReduction_417 (HappyAbsSyn173  happy_var_2)+	(HappyAbsSyn174  happy_var_1)+	 =  HappyAbsSyn173+		 (happy_var_1 : happy_var_2+	)+happyReduction_417 _ _  = notHappyAtAll ++happyReduce_418 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_418 = happySpecReduce_0  157# happyReduction_418+happyReduction_418  =  HappyAbsSyn173+		 ([]+	)++happyReduce_419 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_419 = happySpecReduce_1  158# happyReduction_419+happyReduction_419 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn174+		 (sL1 happy_var_1 (UserTyVar noExt happy_var_1)+	)+happyReduction_419 _  = notHappyAtAll ++happyReduce_420 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_420 = happyMonadReduce 5# 158# happyReduction_420+happyReduction_420 ((HappyTerminal happy_var_5) `HappyStk`+	(HappyAbsSyn179  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_5  (KindedTyVar noExt happy_var_2 happy_var_4))+                                               [mop happy_var_1,mu AnnDcolon happy_var_3+                                               ,mcp happy_var_5]))+	) (\r -> happyReturn (HappyAbsSyn174 r))++happyReduce_421 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_421 = happySpecReduce_0  159# happyReduction_421+happyReduction_421  =  HappyAbsSyn175+		 (noLoc ([],[])+	)++happyReduce_422 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_422 = happySpecReduce_2  159# happyReduction_422+happyReduction_422 (HappyAbsSyn176  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn175+		 ((sLL happy_var_1 happy_var_2 ([mj AnnVbar happy_var_1]+                                                 ,reverse (unLoc happy_var_2)))+	)+happyReduction_422 _ _  = notHappyAtAll ++happyReduce_423 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_423 = happyMonadReduce 3# 160# happyReduction_423+happyReduction_423 ((HappyAbsSyn177  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn176  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl $ head $ unLoc happy_var_1) AnnComma (gl happy_var_2)+                           >> return (sLL happy_var_1 happy_var_3 (happy_var_3 : unLoc happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn176 r))++happyReduce_424 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_424 = happySpecReduce_1  160# happyReduction_424+happyReduction_424 (HappyAbsSyn177  happy_var_1)+	 =  HappyAbsSyn176+		 (sL1 happy_var_1 [happy_var_1]+	)+happyReduction_424 _  = notHappyAtAll ++happyReduce_425 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_425 = happyMonadReduce 3# 161# happyReduction_425+happyReduction_425 ((HappyAbsSyn87  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn87  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (cL (comb3 happy_var_1 happy_var_2 happy_var_3)+                                       (reverse (unLoc happy_var_1), reverse (unLoc happy_var_3)))+                                       [mu AnnRarrow happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn177 r))++happyReduce_426 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_426 = happySpecReduce_0  162# happyReduction_426+happyReduction_426  =  HappyAbsSyn87+		 (noLoc []+	)++happyReduce_427 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_427 = happySpecReduce_2  162# happyReduction_427+happyReduction_427 (HappyAbsSyn16  happy_var_2)+	(HappyAbsSyn87  happy_var_1)+	 =  HappyAbsSyn87+		 (sLL happy_var_1 happy_var_2 (happy_var_2 : unLoc happy_var_1)+	)+happyReduction_427 _ _  = notHappyAtAll ++happyReduce_428 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_428 = happySpecReduce_1  163# happyReduction_428+happyReduction_428 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn179+		 (happy_var_1+	)+happyReduction_428 _  = notHappyAtAll ++happyReduce_429 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_429 = happyMonadReduce 4# 164# happyReduction_429+happyReduction_429 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn181  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( checkEmptyGADTs $+                                                      cL (comb2 happy_var_1 happy_var_3)+                                                        ([mj AnnWhere happy_var_1+                                                         ,moc happy_var_2+                                                         ,mcc happy_var_4]+                                                        , unLoc happy_var_3)))+	) (\r -> happyReturn (HappyAbsSyn180 r))++happyReduce_430 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_430 = happyMonadReduce 4# 164# happyReduction_430+happyReduction_430 (_ `HappyStk`+	(HappyAbsSyn181  happy_var_3) `HappyStk`+	_ `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( checkEmptyGADTs $+                                                      cL (comb2 happy_var_1 happy_var_3)+                                                        ([mj AnnWhere happy_var_1]+                                                        , unLoc happy_var_3)))+	) (\r -> happyReturn (HappyAbsSyn180 r))++happyReduce_431 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_431 = happySpecReduce_0  164# happyReduction_431+happyReduction_431  =  HappyAbsSyn180+		 (noLoc ([],[])+	)++happyReduce_432 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_432 = happyMonadReduce 3# 165# happyReduction_432+happyReduction_432 ((HappyAbsSyn181  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn182  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) AnnSemi (gl happy_var_2)+                     >> return (cL (comb2 happy_var_1 happy_var_3) (happy_var_1 : unLoc happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn181 r))++happyReduce_433 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_433 = happySpecReduce_1  165# happyReduction_433+happyReduction_433 (HappyAbsSyn182  happy_var_1)+	 =  HappyAbsSyn181+		 (cL (gl happy_var_1) [happy_var_1]+	)+happyReduction_433 _  = notHappyAtAll ++happyReduce_434 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_434 = happySpecReduce_0  165# happyReduction_434+happyReduction_434  =  HappyAbsSyn181+		 (noLoc []+	)++happyReduce_435 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_435 = happyMonadReduce 3# 166# happyReduction_435+happyReduction_435 ((HappyAbsSyn182  happy_var_3) `HappyStk`+	_ `HappyStk`+	(HappyAbsSyn35  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( return $ addConDoc happy_var_3 happy_var_1))+	) (\r -> happyReturn (HappyAbsSyn182 r))++happyReduce_436 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_436 = happyMonadReduce 1# 166# happyReduction_436+happyReduction_436 ((HappyAbsSyn182  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( return happy_var_1))+	) (\r -> happyReturn (HappyAbsSyn182 r))++happyReduce_437 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_437 = happyMonadReduce 3# 167# happyReduction_437+happyReduction_437 ((HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn87  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let (gadt,anns) = mkGadtDecl (unLoc happy_var_1) happy_var_3+                   in ams (sLL happy_var_1 happy_var_3 gadt)+                       (mu AnnDcolon happy_var_2:anns)))+	) (\r -> happyReturn (HappyAbsSyn182 r))++happyReduce_438 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_438 = happySpecReduce_3  168# happyReduction_438+happyReduction_438 (HappyAbsSyn181  happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyAbsSyn35  happy_var_1)+	 =  HappyAbsSyn184+		 (cL (comb2 happy_var_2 happy_var_3) ([mj AnnEqual happy_var_2]+                                                     ,addConDocs (unLoc happy_var_3) happy_var_1)+	)+happyReduction_438 _ _ _  = notHappyAtAll ++happyReduce_439 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_439 = happyMonadReduce 5# 169# happyReduction_439+happyReduction_439 ((HappyAbsSyn182  happy_var_5) `HappyStk`+	(HappyAbsSyn35  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn35  happy_var_2) `HappyStk`+	(HappyAbsSyn181  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl $ head $ unLoc happy_var_1) AnnVbar (gl happy_var_3)+               >> return (sLL happy_var_1 happy_var_5 (addConDoc happy_var_5 happy_var_2 : addConDocFirst (unLoc happy_var_1) happy_var_4))))+	) (\r -> happyReturn (HappyAbsSyn181 r))++happyReduce_440 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_440 = happySpecReduce_1  169# happyReduction_440+happyReduction_440 (HappyAbsSyn182  happy_var_1)+	 =  HappyAbsSyn181+		 (sL1 happy_var_1 [happy_var_1]+	)+happyReduction_440 _  = notHappyAtAll ++happyReduce_441 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_441 = happyMonadReduce 5# 170# happyReduction_441+happyReduction_441 ((HappyAbsSyn188  happy_var_5) `HappyStk`+	(HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn157  happy_var_3) `HappyStk`+	(HappyAbsSyn187  happy_var_2) `HappyStk`+	(HappyAbsSyn35  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (let (con,details,doc_prev) = unLoc happy_var_5 in+                  addConDoc (cL (comb4 happy_var_2 happy_var_3 happy_var_4 happy_var_5) (mkConDeclH98 con+                                                       (snd $ unLoc happy_var_2)+                                                       (Just happy_var_3)+                                                       details))+                            (happy_var_1 `mplus` doc_prev))+                        (mu AnnDarrow happy_var_4:(fst $ unLoc happy_var_2))))+	) (\r -> happyReturn (HappyAbsSyn182 r))++happyReduce_442 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_442 = happyMonadReduce 3# 170# happyReduction_442+happyReduction_442 ((HappyAbsSyn188  happy_var_3) `HappyStk`+	(HappyAbsSyn187  happy_var_2) `HappyStk`+	(HappyAbsSyn35  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams ( let (con,details,doc_prev) = unLoc happy_var_3 in+                  addConDoc (cL (comb2 happy_var_2 happy_var_3) (mkConDeclH98 con+                                                      (snd $ unLoc happy_var_2)+                                                      Nothing   -- No context+                                                      details))+                            (happy_var_1 `mplus` doc_prev))+                       (fst $ unLoc happy_var_2)))+	) (\r -> happyReturn (HappyAbsSyn182 r))++happyReduce_443 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_443 = happySpecReduce_3  171# happyReduction_443+happyReduction_443 (HappyTerminal happy_var_3)+	(HappyAbsSyn173  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn187+		 (sLL happy_var_1 happy_var_3 ([mu AnnForall happy_var_1,mj AnnDot happy_var_3], Just happy_var_2)+	)+happyReduction_443 _ _ _  = notHappyAtAll ++happyReduce_444 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_444 = happySpecReduce_0  171# happyReduction_444+happyReduction_444  =  HappyAbsSyn187+		 (noLoc ([], Nothing)+	)++happyReduce_445 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_445 = happyMonadReduce 1# 172# happyReduction_445+happyReduction_445 ((HappyAbsSyn162  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { c <- mergeDataCon (unLoc happy_var_1)+                                                 ; return $ sL1 happy_var_1 c }))+	) (\r -> happyReturn (HappyAbsSyn188 r))++happyReduce_446 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_446 = happySpecReduce_0  173# happyReduction_446+happyReduction_446  =  HappyAbsSyn189+		 ([]+	)++happyReduce_447 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_447 = happySpecReduce_1  173# happyReduction_447+happyReduction_447 (HappyAbsSyn189  happy_var_1)+	 =  HappyAbsSyn189+		 (happy_var_1+	)+happyReduction_447 _  = notHappyAtAll ++happyReduce_448 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_448 = happyMonadReduce 5# 174# happyReduction_448+happyReduction_448 ((HappyAbsSyn189  happy_var_5) `HappyStk`+	(HappyAbsSyn35  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn35  happy_var_2) `HappyStk`+	(HappyAbsSyn191  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) AnnComma (gl happy_var_3) >>+               return ((addFieldDoc happy_var_1 happy_var_4) : addFieldDocs happy_var_5 happy_var_2)))+	) (\r -> happyReturn (HappyAbsSyn189 r))++happyReduce_449 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_449 = happySpecReduce_1  174# happyReduction_449+happyReduction_449 (HappyAbsSyn191  happy_var_1)+	 =  HappyAbsSyn189+		 ([happy_var_1]+	)+happyReduction_449 _  = notHappyAtAll ++happyReduce_450 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_450 = happyMonadReduce 5# 175# happyReduction_450+happyReduction_450 ((HappyAbsSyn35  happy_var_5) `HappyStk`+	(HappyAbsSyn147  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn87  happy_var_2) `HappyStk`+	(HappyAbsSyn35  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (cL (comb2 happy_var_2 happy_var_4)+                      (ConDeclField noExt (reverse (map (\ln@(dL->L l n) -> cL l $ FieldOcc noExt ln) (unLoc happy_var_2))) happy_var_4 (happy_var_1 `mplus` happy_var_5)))+                   [mu AnnDcolon happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn191 r))++happyReduce_451 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_451 = happySpecReduce_0  176# happyReduction_451+happyReduction_451  =  HappyAbsSyn192+		 (noLoc []+	)++happyReduce_452 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_452 = happySpecReduce_1  176# happyReduction_452+happyReduction_452 (HappyAbsSyn192  happy_var_1)+	 =  HappyAbsSyn192+		 (happy_var_1+	)+happyReduction_452 _  = notHappyAtAll ++happyReduce_453 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_453 = happySpecReduce_2  177# happyReduction_453+happyReduction_453 (HappyAbsSyn194  happy_var_2)+	(HappyAbsSyn192  happy_var_1)+	 =  HappyAbsSyn192+		 (sLL happy_var_1 happy_var_2 $ happy_var_2 : unLoc happy_var_1+	)+happyReduction_453 _ _  = notHappyAtAll ++happyReduce_454 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_454 = happySpecReduce_1  177# happyReduction_454+happyReduction_454 (HappyAbsSyn194  happy_var_1)+	 =  HappyAbsSyn192+		 (sLL happy_var_1 happy_var_1 [happy_var_1]+	)+happyReduction_454 _  = notHappyAtAll ++happyReduce_455 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_455 = happyMonadReduce 2# 178# happyReduction_455+happyReduction_455 ((HappyAbsSyn195  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let { full_loc = comb2 happy_var_1 happy_var_2 }+                 in ams (cL full_loc $ HsDerivingClause noExt Nothing happy_var_2)+                        [mj AnnDeriving happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn194 r))++happyReduce_456 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_456 = happyMonadReduce 3# 178# happyReduction_456+happyReduction_456 ((HappyAbsSyn195  happy_var_3) `HappyStk`+	(HappyAbsSyn82  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let { full_loc = comb2 happy_var_1 happy_var_3 }+                 in ams (cL full_loc $ HsDerivingClause noExt (Just happy_var_2) happy_var_3)+                        [mj AnnDeriving happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn194 r))++happyReduce_457 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_457 = happyMonadReduce 3# 178# happyReduction_457+happyReduction_457 ((HappyAbsSyn82  happy_var_3) `HappyStk`+	(HappyAbsSyn195  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let { full_loc = comb2 happy_var_1 happy_var_3 }+                 in ams (cL full_loc $ HsDerivingClause noExt (Just happy_var_3) happy_var_2)+                        [mj AnnDeriving happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn194 r))++happyReduce_458 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_458 = happySpecReduce_1  179# happyReduction_458+happyReduction_458 (HappyAbsSyn147  happy_var_1)+	 =  HappyAbsSyn195+		 (sL1 happy_var_1 [mkLHsSigType happy_var_1]+	)+happyReduction_458 _  = notHappyAtAll ++happyReduce_459 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_459 = happyMonadReduce 2# 179# happyReduction_459+happyReduction_459 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 [])+                                     [mop happy_var_1,mcp happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn195 r))++happyReduce_460 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_460 = happyMonadReduce 3# 179# happyReduction_460+happyReduction_460 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn169  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 happy_var_2)+                                     [mop happy_var_1,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn195 r))++happyReduce_461 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_461 = happySpecReduce_1  180# happyReduction_461+happyReduction_461 (HappyAbsSyn197  happy_var_1)+	 =  HappyAbsSyn77+		 (sL1 happy_var_1 (DocD noExt (unLoc happy_var_1))+	)+happyReduction_461 _  = notHappyAtAll ++happyReduce_462 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_462 = happySpecReduce_1  181# happyReduction_462+happyReduction_462 (HappyAbsSyn321  happy_var_1)+	 =  HappyAbsSyn197+		 (sL1 happy_var_1 (DocCommentNext (unLoc happy_var_1))+	)+happyReduction_462 _  = notHappyAtAll ++happyReduce_463 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_463 = happySpecReduce_1  181# happyReduction_463+happyReduction_463 (HappyAbsSyn321  happy_var_1)+	 =  HappyAbsSyn197+		 (sL1 happy_var_1 (DocCommentPrev (unLoc happy_var_1))+	)+happyReduction_463 _  = notHappyAtAll ++happyReduce_464 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_464 = happySpecReduce_1  181# happyReduction_464+happyReduction_464 (HappyAbsSyn323  happy_var_1)+	 =  HappyAbsSyn197+		 (sL1 happy_var_1 (case (unLoc happy_var_1) of (n, doc) -> DocCommentNamed n doc)+	)+happyReduction_464 _  = notHappyAtAll ++happyReduce_465 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_465 = happySpecReduce_1  181# happyReduction_465+happyReduction_465 (HappyAbsSyn324  happy_var_1)+	 =  HappyAbsSyn197+		 (sL1 happy_var_1 (case (unLoc happy_var_1) of (n, doc) -> DocGroup n doc)+	)+happyReduction_465 _  = notHappyAtAll ++happyReduce_466 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_466 = happySpecReduce_1  182# happyReduction_466+happyReduction_466 (HappyAbsSyn77  happy_var_1)+	 =  HappyAbsSyn77+		 (happy_var_1+	)+happyReduction_466 _  = notHappyAtAll ++happyReduce_467 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_467 = happyMonadReduce 3# 182# happyReduction_467+happyReduction_467 ((HappyAbsSyn200  happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                   do { let { e = sLL happy_var_1 happy_var_2 (SectionR noExt (sL1 happy_var_1 (HsVar noExt (sL1 happy_var_1 bang_RDR))) happy_var_2)+                                            ; l = comb2 happy_var_1 happy_var_3 };+                                        (ann, r) <- checkValDef empty SrcStrict e Nothing happy_var_3 ;+                                        hintBangPat (comb2 happy_var_1 happy_var_2) (unLoc e) ;+                                        -- Depending upon what the pattern looks like we might get either+                                        -- a FunBind or PatBind back from checkValDef. See Note+                                        -- [FunBind vs PatBind]+                                        case r of {+                                          (FunBind _ n _ _ _) ->+                                                amsL l [mj AnnFunId n] >> return () ;+                                          (PatBind _ (dL->L l _) _rhs _) ->+                                                amsL l [] >> return () } ;++                                        _ <- amsL l (ann ++ fst (unLoc happy_var_3) ++ [mj AnnBang happy_var_1]) ;+                                        return $! (sL l $ ValD noExt r) }))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_468 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_468 = happyMonadReduce 3# 182# happyReduction_468+happyReduction_468 ((HappyAbsSyn200  happy_var_3) `HappyStk`+	(HappyAbsSyn145  happy_var_2) `HappyStk`+	(HappyAbsSyn209  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { (ann,r) <- checkValDef empty NoSrcStrict happy_var_1 (snd happy_var_2) happy_var_3;+                                        let { l = comb2 happy_var_1 happy_var_3 };+                                        -- Depending upon what the pattern looks like we might get either+                                        -- a FunBind or PatBind back from checkValDef. See Note+                                        -- [FunBind vs PatBind]+                                        case r of {+                                          (FunBind _ n _ _ _) ->+                                                amsL l (mj AnnFunId n:(fst happy_var_2)) >> return () ;+                                          (PatBind _ (dL->L lh _lhs) _rhs _) ->+                                                amsL lh (fst happy_var_2) >> return () } ;+                                        _ <- amsL l (ann ++ (fst $ unLoc happy_var_3));+                                        return $! (sL l $ ValD noExt r) }))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_469 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_469 = happySpecReduce_1  182# happyReduction_469+happyReduction_469 (HappyAbsSyn77  happy_var_1)+	 =  HappyAbsSyn77+		 (happy_var_1+	)+happyReduction_469 _  = notHappyAtAll ++happyReduce_470 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_470 = happySpecReduce_1  182# happyReduction_470+happyReduction_470 (HappyAbsSyn77  happy_var_1)+	 =  HappyAbsSyn77+		 (happy_var_1+	)+happyReduction_470 _  = notHappyAtAll ++happyReduce_471 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_471 = happySpecReduce_1  183# happyReduction_471+happyReduction_471 (HappyAbsSyn77  happy_var_1)+	 =  HappyAbsSyn77+		 (happy_var_1+	)+happyReduction_471 _  = notHappyAtAll ++happyReduce_472 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_472 = happySpecReduce_1  183# happyReduction_472+happyReduction_472 (HappyAbsSyn209  happy_var_1)+	 =  HappyAbsSyn77+		 (sLL happy_var_1 happy_var_1 $ mkSpliceDecl happy_var_1+	)+happyReduction_472 _  = notHappyAtAll ++happyReduce_473 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_473 = happyMonadReduce 3# 184# happyReduction_473+happyReduction_473 ((HappyAbsSyn125  happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 -> return $+                                  sL (comb3 happy_var_1 happy_var_2 happy_var_3)+                                    ((mj AnnEqual happy_var_1 : (fst $ unLoc happy_var_3))+                                    ,GRHSs noExt (unguardedRHS (comb3 happy_var_1 happy_var_2 happy_var_3) happy_var_2)+                                   (snd $ unLoc happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn200 r))++happyReduce_474 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_474 = happySpecReduce_2  184# happyReduction_474+happyReduction_474 (HappyAbsSyn125  happy_var_2)+	(HappyAbsSyn201  happy_var_1)+	 =  HappyAbsSyn200+		 (sLL happy_var_1 happy_var_2  (fst $ unLoc happy_var_2+                                    ,GRHSs noExt (reverse (unLoc happy_var_1))+                                                    (snd $ unLoc happy_var_2))+	)+happyReduction_474 _ _  = notHappyAtAll ++happyReduce_475 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_475 = happySpecReduce_2  185# happyReduction_475+happyReduction_475 (HappyAbsSyn202  happy_var_2)+	(HappyAbsSyn201  happy_var_1)+	 =  HappyAbsSyn201+		 (sLL happy_var_1 happy_var_2 (happy_var_2 : unLoc happy_var_1)+	)+happyReduction_475 _ _  = notHappyAtAll ++happyReduce_476 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_476 = happySpecReduce_1  185# happyReduction_476+happyReduction_476 (HappyAbsSyn202  happy_var_1)+	 =  HappyAbsSyn201+		 (sL1 happy_var_1 [happy_var_1]+	)+happyReduction_476 _  = notHappyAtAll ++happyReduce_477 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_477 = happyMonadReduce 4# 186# happyReduction_477+happyReduction_477 ((HappyAbsSyn207  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn232  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_4 >>= \ happy_var_4 ->+                                     ams (sL (comb2 happy_var_1 happy_var_4) $ GRHS noExt (unLoc happy_var_2) happy_var_4)+                                         [mj AnnVbar happy_var_1,mj AnnEqual happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn202 r))++happyReduce_478 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_478 = happyMonadReduce 3# 187# happyReduction_478+happyReduction_478 ((HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn209  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { v <- checkValSigLhs happy_var_1+                              ; _ <- amsL (comb2 happy_var_1 happy_var_3) [mu AnnDcolon happy_var_2]+                              ; return (sLL happy_var_1 happy_var_3 $ SigD noExt $+                                  TypeSig noExt [v] (mkLHsSigWcType happy_var_3))}))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_479 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_479 = happyMonadReduce 5# 187# happyReduction_479+happyReduction_479 ((HappyAbsSyn147  happy_var_5) `HappyStk`+	(HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn87  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn16  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { let sig = TypeSig noExt (happy_var_1 : reverse (unLoc happy_var_3))+                                     (mkLHsSigWcType happy_var_5)+                 ; addAnnotation (gl happy_var_1) AnnComma (gl happy_var_2)+                 ; ams ( sLL happy_var_1 happy_var_5 $ SigD noExt sig )+                       [mu AnnDcolon happy_var_4] }))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_480 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_480 = happyMonadReduce 3# 187# happyReduction_480+happyReduction_480 ((HappyAbsSyn74  happy_var_3) `HappyStk`+	(HappyAbsSyn72  happy_var_2) `HappyStk`+	(HappyAbsSyn73  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( checkPrecP happy_var_2 happy_var_3 >>+                 ams (sLL happy_var_1 happy_var_3 $ SigD noExt+                        (FixSig noExt (FixitySig noExt (fromOL $ unLoc happy_var_3)+                                (Fixity (fst $ unLoc happy_var_2) (snd $ unLoc happy_var_2) (unLoc happy_var_1)))))+                     [mj AnnInfix happy_var_1,mj AnnVal happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_481 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_481 = happySpecReduce_1  187# happyReduction_481+happyReduction_481 (HappyAbsSyn114  happy_var_1)+	 =  HappyAbsSyn77+		 (sLL happy_var_1 happy_var_1 . SigD noExt . unLoc $ happy_var_1+	)+happyReduction_481 _  = notHappyAtAll ++happyReduce_482 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_482 = happyMonadReduce 4# 187# happyReduction_482+happyReduction_482 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn146  happy_var_3) `HappyStk`+	(HappyAbsSyn87  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let (dcolon, tc) = happy_var_3+                   in ams+                       (sLL happy_var_1 happy_var_4+                         (SigD noExt (CompleteMatchSig noExt (getCOMPLETE_PRAGs happy_var_1) happy_var_2 tc)))+                    ([ mo happy_var_1 ] ++ dcolon ++ [mc happy_var_4])))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_483 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_483 = happyMonadReduce 4# 187# happyReduction_483+happyReduction_483 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn16  happy_var_3) `HappyStk`+	(HappyAbsSyn129  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams ((sLL happy_var_1 happy_var_4 $ SigD noExt (InlineSig noExt happy_var_3+                            (mkInlinePragma (getINLINE_PRAGs happy_var_1) (getINLINE happy_var_1)+                                            (snd happy_var_2)))))+                       ((mo happy_var_1:fst happy_var_2) ++ [mc happy_var_4])))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_484 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_484 = happyMonadReduce 3# 187# happyReduction_484+happyReduction_484 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (SigD noExt (SCCFunSig noExt (getSCC_PRAGs happy_var_1) happy_var_2 Nothing)))+                 [mo happy_var_1, mc happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_485 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_485 = happyMonadReduce 4# 187# happyReduction_485+happyReduction_485 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { scc <- getSCC happy_var_3+                ; let str_lit = StringLiteral (getSTRINGs happy_var_3) scc+                ; ams (sLL happy_var_1 happy_var_4 (SigD noExt (SCCFunSig noExt (getSCC_PRAGs happy_var_1) happy_var_2 (Just ( sL1 happy_var_3 str_lit)))))+                      [mo happy_var_1, mc happy_var_4] }))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_486 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_486 = happyMonadReduce 6# 187# happyReduction_486+happyReduction_486 ((HappyTerminal happy_var_6) `HappyStk`+	(HappyAbsSyn150  happy_var_5) `HappyStk`+	(HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn16  happy_var_3) `HappyStk`+	(HappyAbsSyn129  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (+                 let inl_prag = mkInlinePragma (getSPEC_PRAGs happy_var_1)+                                             (NoUserInline, FunLike) (snd happy_var_2)+                  in sLL happy_var_1 happy_var_6 $ SigD noExt (SpecSig noExt happy_var_3 (fromOL happy_var_5) inl_prag))+                    (mo happy_var_1:mu AnnDcolon happy_var_4:mc happy_var_6:(fst happy_var_2))))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_487 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_487 = happyMonadReduce 6# 187# happyReduction_487+happyReduction_487 ((HappyTerminal happy_var_6) `HappyStk`+	(HappyAbsSyn150  happy_var_5) `HappyStk`+	(HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn16  happy_var_3) `HappyStk`+	(HappyAbsSyn129  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_6 $ SigD noExt (SpecSig noExt happy_var_3 (fromOL happy_var_5)+                               (mkInlinePragma (getSPEC_INLINE_PRAGs happy_var_1)+                                               (getSPEC_INLINE happy_var_1) (snd happy_var_2))))+                       (mo happy_var_1:mu AnnDcolon happy_var_4:mc happy_var_6:(fst happy_var_2))))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_488 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_488 = happyMonadReduce 4# 187# happyReduction_488+happyReduction_488 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn168  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_4+                                  $ SigD noExt (SpecInstSig noExt (getSPEC_PRAGs happy_var_1) happy_var_3))+                       [mo happy_var_1,mj AnnInstance happy_var_2,mc happy_var_4]))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_489 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_489 = happyMonadReduce 3# 187# happyReduction_489+happyReduction_489 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn264  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ SigD noExt (MinimalSig noExt (getMINIMAL_PRAGs happy_var_1) happy_var_2))+                   [mo happy_var_1,mc happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn77 r))++happyReduce_490 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_490 = happySpecReduce_0  188# happyReduction_490+happyReduction_490  =  HappyAbsSyn129+		 (([],Nothing)+	)++happyReduce_491 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_491 = happySpecReduce_1  188# happyReduction_491+happyReduction_491 (HappyAbsSyn205  happy_var_1)+	 =  HappyAbsSyn129+		 ((fst happy_var_1,Just (snd happy_var_1))+	)+happyReduction_491 _  = notHappyAtAll ++happyReduce_492 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_492 = happySpecReduce_3  189# happyReduction_492+happyReduction_492 (HappyTerminal happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn205+		 (([mj AnnOpenS happy_var_1,mj AnnVal happy_var_2,mj AnnCloseS happy_var_3]+                                  ,ActiveAfter  (getINTEGERs happy_var_2) (fromInteger (il_value (getINTEGER happy_var_2))))+	)+happyReduction_492 _ _ _  = notHappyAtAll ++happyReduce_493 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_493 = happyReduce 4# 189# happyReduction_493+happyReduction_493 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn205+		 (([mj AnnOpenS happy_var_1,mj AnnTilde happy_var_2,mj AnnVal happy_var_3+                                                 ,mj AnnCloseS happy_var_4]+                                  ,ActiveBefore (getINTEGERs happy_var_3) (fromInteger (il_value (getINTEGER happy_var_3))))+	) `HappyStk` happyRest++happyReduce_494 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_494 = happySpecReduce_1  190# happyReduction_494+happyReduction_494 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn206+		 (let { loc = getLoc happy_var_1+                                ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc happy_var_1+                                ; quoterId = mkUnqual varName quoter }+                            in sL1 happy_var_1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote)+	)+happyReduction_494 _  = notHappyAtAll ++happyReduce_495 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_495 = happySpecReduce_1  190# happyReduction_495+happyReduction_495 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn206+		 (let { loc = getLoc happy_var_1+                                ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc happy_var_1+                                ; quoterId = mkQual varName (qual, quoter) }+                            in sL (getLoc happy_var_1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote)+	)+happyReduction_495 _  = notHappyAtAll ++happyReduce_496 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_496 = happyMonadReduce 3# 191# happyReduction_496+happyReduction_496 ((HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                   fmap ecFromExp $+                                   ams (sLL happy_var_1 happy_var_3 $ ExprWithTySig noExt happy_var_1 (mkLHsSigWcType happy_var_3))+                                       [mu AnnDcolon happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_497 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_497 = happyMonadReduce 3# 191# happyReduction_497+happyReduction_497 ((HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                   runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                   fmap ecFromCmd $+                                   ams (sLL happy_var_1 happy_var_3 $ HsCmdArrApp noExt happy_var_1 happy_var_3+                                                        HsFirstOrderApp True)+                                       [mu Annlarrowtail happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_498 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_498 = happyMonadReduce 3# 191# happyReduction_498+happyReduction_498 ((HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                   runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                   fmap ecFromCmd $+                                   ams (sLL happy_var_1 happy_var_3 $ HsCmdArrApp noExt happy_var_3 happy_var_1+                                                      HsFirstOrderApp False)+                                       [mu Annrarrowtail happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_499 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_499 = happyMonadReduce 3# 191# happyReduction_499+happyReduction_499 ((HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                   runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                   fmap ecFromCmd $+                                   ams (sLL happy_var_1 happy_var_3 $ HsCmdArrApp noExt happy_var_1 happy_var_3+                                                      HsHigherOrderApp True)+                                       [mu AnnLarrowtail happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_500 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_500 = happyMonadReduce 3# 191# happyReduction_500+happyReduction_500 ((HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                   runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                   fmap ecFromCmd $+                                   ams (sLL happy_var_1 happy_var_3 $ HsCmdArrApp noExt happy_var_3 happy_var_1+                                                      HsHigherOrderApp False)+                                       [mu AnnRarrowtail happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_501 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_501 = happySpecReduce_1  191# happyReduction_501+happyReduction_501 (HappyAbsSyn207  happy_var_1)+	 =  HappyAbsSyn207+		 (happy_var_1+	)+happyReduction_501 _  = notHappyAtAll ++happyReduce_502 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_502 = happySpecReduce_1  192# happyReduction_502+happyReduction_502 (HappyAbsSyn207  happy_var_1)+	 =  HappyAbsSyn207+		 (happy_var_1+	)+happyReduction_502 _  = notHappyAtAll ++happyReduce_503 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_503 = happySpecReduce_3  192# happyReduction_503+happyReduction_503 (HappyAbsSyn207  happy_var_3)+	(HappyAbsSyn209  happy_var_2)+	(HappyAbsSyn207  happy_var_1)+	 =  HappyAbsSyn207+		 (ExpCmdP $+                                 runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                 runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                 ams (sLL happy_var_1 happy_var_3 (ecOpApp happy_var_1 happy_var_2 happy_var_3))+                                     [mj AnnVal happy_var_2]+	)+happyReduction_503 _ _ _  = notHappyAtAll ++happyReduce_504 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_504 = happyMonadReduce 1# 193# happyReduction_504+happyReduction_504 ((HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1))+	) (\r -> happyReturn (HappyAbsSyn209 r))++happyReduce_505 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_505 = happyMonadReduce 3# 193# happyReduction_505+happyReduction_505 ((HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyAbsSyn209  happy_var_2) `HappyStk`+	(HappyAbsSyn209  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                         do { when (srcSpanEnd (getLoc happy_var_2)+                                                == srcSpanStart (getLoc happy_var_3)+                                                && checkIfBang happy_var_2) $+                                                warnSpaceAfterBang (comb2 happy_var_2 happy_var_3);+                                              ams (sLL happy_var_1 happy_var_3 (OpApp noExt happy_var_1 happy_var_2 happy_var_3))+                                                   [mj AnnVal happy_var_2]+                                            }))+	) (\r -> happyReturn (HappyAbsSyn209 r))++happyReduce_506 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_506 = happyMonadReduce 2# 194# happyReduction_506+happyReduction_506 ((HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                           fmap ecFromExp $+                                           ams (sLL happy_var_1 happy_var_2 $ NegApp noExt happy_var_2 noSyntaxExpr)+                                               [mj AnnMinus happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_507 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_507 = happyMonadReduce 2# 194# happyReduction_507+happyReduction_507 ((HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyAbsSyn214  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                  fmap ecFromExp $+                                  ams (sLL happy_var_1 happy_var_2 $ HsTickPragma noExt (snd $ fst $ fst $ unLoc happy_var_1)+                                                                (snd $ fst $ unLoc happy_var_1) (snd $ unLoc happy_var_1) happy_var_2)+                                      (fst $ fst $ fst $ unLoc happy_var_1)))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_508 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_508 = happyMonadReduce 4# 194# happyReduction_508+happyReduction_508 ((HappyAbsSyn207  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_4 >>= \ happy_var_4 ->+                                          fmap ecFromExp $+                                          ams (sLL happy_var_1 happy_var_4 $ HsCoreAnn noExt (getCORE_PRAGs happy_var_1) (getStringLiteral happy_var_2) happy_var_4)+                                              [mo happy_var_1,mj AnnVal happy_var_2+                                              ,mc happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_509 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_509 = happySpecReduce_1  194# happyReduction_509+happyReduction_509 (HappyAbsSyn207  happy_var_1)+	 =  HappyAbsSyn207+		 (happy_var_1+	)+happyReduction_509 _  = notHappyAtAll ++happyReduce_510 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_510 = happySpecReduce_1  195# happyReduction_510+happyReduction_510 (HappyAbsSyn207  happy_var_1)+	 =  HappyAbsSyn207+		 (happy_var_1+	)+happyReduction_510 _  = notHappyAtAll ++happyReduce_511 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_511 = happyMonadReduce 2# 195# happyReduction_511+happyReduction_511 ((HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyAbsSyn213  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                  fmap ecFromExp $+                                  ams (sLL happy_var_1 happy_var_2 $ HsSCC noExt (snd $ fst $ unLoc happy_var_1) (snd $ unLoc happy_var_1) happy_var_2)+                                      (fst $ fst $ unLoc happy_var_1)))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_512 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_512 = happySpecReduce_1  196# happyReduction_512+happyReduction_512 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn212+		 (([happy_var_1],True)+	)+happyReduction_512 _  = notHappyAtAll ++happyReduce_513 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_513 = happySpecReduce_0  196# happyReduction_513+happyReduction_513  =  HappyAbsSyn212+		 (([],False)+	)++happyReduce_514 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_514 = happyMonadReduce 3# 197# happyReduction_514+happyReduction_514 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do scc <- getSCC happy_var_2+                                            ; return $ sLL happy_var_1 happy_var_3+                                               (([mo happy_var_1,mj AnnValStr happy_var_2+                                                ,mc happy_var_3],getSCC_PRAGs happy_var_1),(StringLiteral (getSTRINGs happy_var_2) scc))))+	) (\r -> happyReturn (HappyAbsSyn213 r))++happyReduce_515 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_515 = happySpecReduce_3  197# happyReduction_515+happyReduction_515 (HappyTerminal happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn213+		 (sLL happy_var_1 happy_var_3 (([mo happy_var_1,mj AnnVal happy_var_2+                                         ,mc happy_var_3],getSCC_PRAGs happy_var_1)+                                        ,(StringLiteral NoSourceText (getVARID happy_var_2)))+	)+happyReduction_515 _ _ _  = notHappyAtAll ++happyReduce_516 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_516 = happyReduce 10# 198# happyReduction_516+happyReduction_516 ((HappyTerminal happy_var_10) `HappyStk`+	(HappyTerminal happy_var_9) `HappyStk`+	(HappyTerminal happy_var_8) `HappyStk`+	(HappyTerminal happy_var_7) `HappyStk`+	(HappyTerminal happy_var_6) `HappyStk`+	(HappyTerminal happy_var_5) `HappyStk`+	(HappyTerminal happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn214+		 (sLL happy_var_1 happy_var_10 $ ((([mo happy_var_1,mj AnnVal happy_var_2+                                              ,mj AnnVal happy_var_3,mj AnnColon happy_var_4+                                              ,mj AnnVal happy_var_5,mj AnnMinus happy_var_6+                                              ,mj AnnVal happy_var_7,mj AnnColon happy_var_8+                                              ,mj AnnVal happy_var_9,mc happy_var_10],+                                                getGENERATED_PRAGs happy_var_1)+                                              ,((getStringLiteral happy_var_2)+                                               ,( fromInteger $ il_value $ getINTEGER happy_var_3+                                                , fromInteger $ il_value $ getINTEGER happy_var_5+                                                )+                                               ,( fromInteger $ il_value $ getINTEGER happy_var_7+                                                , fromInteger $ il_value $ getINTEGER happy_var_9+                                                )+                                               ))+                                             , (( getINTEGERs happy_var_3+                                                , getINTEGERs happy_var_5+                                                )+                                               ,( getINTEGERs happy_var_7+                                                , getINTEGERs happy_var_9+                                                )))+	) `HappyStk` happyRest++happyReduce_517 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_517 = happyMonadReduce 2# 199# happyReduction_517+happyReduction_517 ((HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                        checkBlockArguments happy_var_2 >>= \_ ->+                                        return $ ExpCmdP $+                                          runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                          checkBlockArguments happy_var_1 >>= \_ ->+                                          return (sLL happy_var_1 happy_var_2 (ecHsApp happy_var_1 happy_var_2))))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_518 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_518 = happyMonadReduce 3# 199# happyReduction_518+happyReduction_518 ((HappyAbsSyn147  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                        checkBlockArguments happy_var_1 >>= \_ ->+                                        fmap ecFromExp $+                                        ams (sLL happy_var_1 happy_var_3 $ HsAppType noExt happy_var_1 (mkHsWildCardBndrs happy_var_3))+                                            [mj AnnAt happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_519 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_519 = happyMonadReduce 2# 199# happyReduction_519+happyReduction_519 ((HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                        fmap ecFromExp $+                                        ams (sLL happy_var_1 happy_var_2 $ HsStatic noExt happy_var_2)+                                            [mj AnnStatic happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_520 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_520 = happySpecReduce_1  199# happyReduction_520+happyReduction_520 (HappyAbsSyn207  happy_var_1)+	 =  HappyAbsSyn207+		 (happy_var_1+	)+happyReduction_520 _  = notHappyAtAll ++happyReduce_521 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_521 = happyMonadReduce 3# 200# happyReduction_521+happyReduction_521 ((HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn16  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                   fmap ecFromExp $+                                   ams (sLL happy_var_1 happy_var_3 $ EAsPat noExt happy_var_1 happy_var_3) [mj AnnAt happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_522 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_522 = happyMonadReduce 2# 200# happyReduction_522+happyReduction_522 ((HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                   fmap ecFromExp $+                                   ams (sLL happy_var_1 happy_var_2 $ ELazyPat noExt happy_var_2) [mj AnnTilde happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_523 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_523 = happyReduce 5# 200# happyReduction_523+happyReduction_523 ((HappyAbsSyn207  happy_var_5) `HappyStk`+	(HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn250  happy_var_3) `HappyStk`+	(HappyAbsSyn247  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn207+		 (ExpCmdP $+                      runExpCmdP happy_var_5 >>= \ happy_var_5 ->+                      ams (sLL happy_var_1 happy_var_5 $ ecHsLam (mkMatchGroup FromSource+                            [sLL happy_var_1 happy_var_5 $ Match { m_ext = noExt+                                               , m_ctxt = LambdaExpr+                                               , m_pats = happy_var_2:happy_var_3+                                               , m_grhss = unguardedGRHSs happy_var_5 }]))+                          [mj AnnLam happy_var_1, mu AnnRarrow happy_var_4]+	) `HappyStk` happyRest++happyReduce_524 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_524 = happyReduce 4# 200# happyReduction_524+happyReduction_524 ((HappyAbsSyn207  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn125  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn207+		 (ExpCmdP $+                                           runExpCmdP happy_var_4 >>= \ happy_var_4 ->+                                           ams (sLL happy_var_1 happy_var_4 $ ecHsLet (snd (unLoc happy_var_2)) happy_var_4)+                                               (mj AnnLet happy_var_1:mj AnnIn happy_var_3+                                                 :(fst $ unLoc happy_var_2))+	) `HappyStk` happyRest++happyReduce_525 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_525 = happyMonadReduce 3# 200# happyReduction_525+happyReduction_525 ((HappyAbsSyn238  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( happy_var_3 >>= \ happy_var_3 ->+               fmap ecFromExp $+               ams (sLL happy_var_1 happy_var_3 $ HsLamCase noExt+                                   (mkMatchGroup FromSource (snd $ unLoc happy_var_3)))+                   (mj AnnLam happy_var_1:mj AnnCase happy_var_2:(fst $ unLoc happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_526 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_526 = happyMonadReduce 8# 200# happyReduction_526+happyReduction_526 ((HappyAbsSyn207  happy_var_8) `HappyStk`+	(HappyTerminal happy_var_7) `HappyStk`+	(HappyAbsSyn212  happy_var_6) `HappyStk`+	(HappyAbsSyn207  happy_var_5) `HappyStk`+	(HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn212  happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                            return $ ExpCmdP $+                              runExpCmdP happy_var_5 >>= \ happy_var_5 ->+                              runExpCmdP happy_var_8 >>= \ happy_var_8 ->+                              checkDoAndIfThenElse happy_var_2 (snd happy_var_3) happy_var_5 (snd happy_var_6) happy_var_8 >>+                              ams (sLL happy_var_1 happy_var_8 $ ecHsIf happy_var_2 happy_var_5 happy_var_8)+                                  (mj AnnIf happy_var_1:mj AnnThen happy_var_4+                                     :mj AnnElse happy_var_7+                                     :(map (\l -> mj AnnSemi l) (fst happy_var_3))+                                    ++(map (\l -> mj AnnSemi l) (fst happy_var_6)))))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_527 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_527 = happyMonadReduce 2# 200# happyReduction_527+happyReduction_527 ((HappyAbsSyn245  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( hintMultiWayIf (getLoc happy_var_1) >>= \_ ->+                                           fmap ecFromExp $+                                           ams (sLL happy_var_1 happy_var_2 $ HsMultiIf noExt+                                                     (reverse $ snd $ unLoc happy_var_2))+                                               (mj AnnIf happy_var_1:(fst $ unLoc happy_var_2))))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_528 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_528 = happyMonadReduce 4# 200# happyReduction_528+happyReduction_528 ((HappyAbsSyn238  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                         return $ ExpCmdP $+                                           happy_var_4 >>= \ happy_var_4 ->+                                           ams (cL (comb3 happy_var_1 happy_var_3 happy_var_4) $+                                                   ecHsCase happy_var_2 (mkMatchGroup+                                                   FromSource (snd $ unLoc happy_var_4)))+                                               (mj AnnCase happy_var_1:mj AnnOf happy_var_3+                                                  :(fst $ unLoc happy_var_4))))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_529 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_529 = happySpecReduce_2  200# happyReduction_529+happyReduction_529 (HappyAbsSyn251  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn207+		 (ExpCmdP $+                                        happy_var_2 >>= \ happy_var_2 ->+                                        ams (cL (comb2 happy_var_1 happy_var_2)+                                               (ecHsDo (mapLoc snd happy_var_2)))+                                               (mj AnnDo happy_var_1:(fst $ unLoc happy_var_2))+	)+happyReduction_529 _ _  = notHappyAtAll ++happyReduce_530 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_530 = happyMonadReduce 2# 200# happyReduction_530+happyReduction_530 ((HappyAbsSyn251  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( happy_var_2 >>= \ happy_var_2 ->+                                       fmap ecFromExp $+                                       ams (cL (comb2 happy_var_1 happy_var_2)+                                              (mkHsDo MDoExpr (snd $ unLoc happy_var_2)))+                                           (mj AnnMdo happy_var_1:(fst $ unLoc happy_var_2))))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_531 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_531 = happyMonadReduce 4# 200# happyReduction_531+happyReduction_531 ((HappyAbsSyn207  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( (checkPattern empty <=< runExpCmdP) happy_var_2 >>= \ p ->+                           runExpCmdP happy_var_4 >>= \ happy_var_4@cmd ->+                           fmap ecFromExp $+                           ams (sLL happy_var_1 happy_var_4 $ HsProc noExt p (sLL happy_var_1 happy_var_4 $ HsCmdTop noExt cmd))+                                            -- TODO: is LL right here?+                               [mj AnnProc happy_var_1,mu AnnRarrow happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_532 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_532 = happySpecReduce_1  200# happyReduction_532+happyReduction_532 (HappyAbsSyn207  happy_var_1)+	 =  HappyAbsSyn207+		 (happy_var_1+	)+happyReduction_532 _  = notHappyAtAll ++happyReduce_533 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_533 = happyMonadReduce 4# 201# happyReduction_533+happyReduction_533 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn257  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                  do { r <- mkRecConstrOrUpdate happy_var_1 (comb2 happy_var_2 happy_var_4)+                                                                   (snd happy_var_3)+                                     ; _ <- amsL (comb2 happy_var_1 happy_var_4) (moc happy_var_2:mcc happy_var_4:(fst happy_var_3))+                                     ; fmap ecFromExp $+                                       checkRecordSyntax (sLL happy_var_1 happy_var_4 r) }))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_534 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_534 = happySpecReduce_1  201# happyReduction_534+happyReduction_534 (HappyAbsSyn207  happy_var_1)+	 =  HappyAbsSyn207+		 (happy_var_1+	)+happyReduction_534 _  = notHappyAtAll ++happyReduce_535 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_535 = happySpecReduce_1  202# happyReduction_535+happyReduction_535 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn207+		 (ecFromExp $ sL1 happy_var_1 (HsVar noExt   $! happy_var_1)+	)+happyReduction_535 _  = notHappyAtAll ++happyReduce_536 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_536 = happySpecReduce_1  202# happyReduction_536+happyReduction_536 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn207+		 (ecFromExp $ sL1 happy_var_1 (HsVar noExt   $! happy_var_1)+	)+happyReduction_536 _  = notHappyAtAll ++happyReduce_537 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_537 = happySpecReduce_1  202# happyReduction_537+happyReduction_537 (HappyAbsSyn262  happy_var_1)+	 =  HappyAbsSyn207+		 (ecFromExp $ sL1 happy_var_1 (HsIPVar noExt $! unLoc happy_var_1)+	)+happyReduction_537 _  = notHappyAtAll ++happyReduce_538 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_538 = happySpecReduce_1  202# happyReduction_538+happyReduction_538 (HappyAbsSyn25  happy_var_1)+	 =  HappyAbsSyn207+		 (ecFromExp $ sL1 happy_var_1 (HsOverLabel noExt Nothing $! unLoc happy_var_1)+	)+happyReduction_538 _  = notHappyAtAll ++happyReduce_539 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_539 = happySpecReduce_1  202# happyReduction_539+happyReduction_539 (HappyAbsSyn315  happy_var_1)+	 =  HappyAbsSyn207+		 (ecFromExp $ sL1 happy_var_1 (HsLit noExt  $! unLoc happy_var_1)+	)+happyReduction_539 _  = notHappyAtAll ++happyReduce_540 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_540 = happySpecReduce_1  202# happyReduction_540+happyReduction_540 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn207+		 (ecFromExp $ sL (getLoc happy_var_1) (HsOverLit noExt $! mkHsIntegral   (getINTEGER happy_var_1) )+	)+happyReduction_540 _  = notHappyAtAll ++happyReduce_541 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_541 = happySpecReduce_1  202# happyReduction_541+happyReduction_541 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn207+		 (ecFromExp $ sL (getLoc happy_var_1) (HsOverLit noExt $! mkHsFractional (getRATIONAL happy_var_1) )+	)+happyReduction_541 _  = notHappyAtAll ++happyReduce_542 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_542 = happySpecReduce_3  202# happyReduction_542+happyReduction_542 (HappyTerminal happy_var_3)+	(HappyAbsSyn207  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn207+		 (ExpCmdP $+                                           runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                           ams (sLL happy_var_1 happy_var_3 (ecHsPar happy_var_2)) [mop happy_var_1,mcp happy_var_3]+	)+happyReduction_542 _ _ _  = notHappyAtAll ++happyReduce_543 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_543 = happyMonadReduce 3# 202# happyReduction_543+happyReduction_543 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn227  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { e <- mkSumOrTuple Boxed (comb2 happy_var_1 happy_var_3) (snd happy_var_2)+                                              ; fmap ecFromExp $+                                                ams (sLL happy_var_1 happy_var_3 e) ((mop happy_var_1:fst happy_var_2) ++ [mcp happy_var_3]) }))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_544 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_544 = happyMonadReduce 3# 202# happyReduction_544+happyReduction_544 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                           fmap ecFromExp $+                                           ams (sLL happy_var_1 happy_var_3 (ExplicitTuple noExt [cL (gl happy_var_2)+                                                         (Present noExt happy_var_2)] Unboxed))+                                               [mo happy_var_1,mc happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_545 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_545 = happyMonadReduce 3# 202# happyReduction_545+happyReduction_545 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn227  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { e <- mkSumOrTuple Unboxed (comb2 happy_var_1 happy_var_3) (snd happy_var_2)+                                              ; fmap ecFromExp $+                                                ams (sLL happy_var_1 happy_var_3 e) ((mo happy_var_1:fst happy_var_2) ++ [mc happy_var_3]) }))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_546 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_546 = happyMonadReduce 3# 202# happyReduction_546+happyReduction_546 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn230  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( fmap ecFromExp $ ams (sLL happy_var_1 happy_var_3 (snd happy_var_2)) (mos happy_var_1:mcs happy_var_3:(fst happy_var_2))))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_547 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_547 = happySpecReduce_1  202# happyReduction_547+happyReduction_547 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn207+		 (ecFromExp $ sL1 happy_var_1 $ EWildPat noExt+	)+happyReduction_547 _  = notHappyAtAll ++happyReduce_548 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_548 = happySpecReduce_1  202# happyReduction_548+happyReduction_548 (HappyAbsSyn209  happy_var_1)+	 =  HappyAbsSyn207+		 (ecFromExp happy_var_1+	)+happyReduction_548 _  = notHappyAtAll ++happyReduce_549 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_549 = happyMonadReduce 2# 202# happyReduction_549+happyReduction_549 ((HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( fmap ecFromExp $ ams (sLL happy_var_1 happy_var_2 $ HsBracket noExt (VarBr noExt True  (unLoc happy_var_2))) [mj AnnSimpleQuote happy_var_1,mj AnnName happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_550 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_550 = happyMonadReduce 2# 202# happyReduction_550+happyReduction_550 ((HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( fmap ecFromExp $ ams (sLL happy_var_1 happy_var_2 $ HsBracket noExt (VarBr noExt True  (unLoc happy_var_2))) [mj AnnSimpleQuote happy_var_1,mj AnnName happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_551 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_551 = happyMonadReduce 2# 202# happyReduction_551+happyReduction_551 ((HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( fmap ecFromExp $ ams (sLL happy_var_1 happy_var_2 $ HsBracket noExt (VarBr noExt False (unLoc happy_var_2))) [mj AnnThTyQuote happy_var_1,mj AnnName happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_552 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_552 = happyMonadReduce 2# 202# happyReduction_552+happyReduction_552 ((HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( fmap ecFromExp $ ams (sLL happy_var_1 happy_var_2 $ HsBracket noExt (VarBr noExt False (unLoc happy_var_2))) [mj AnnThTyQuote happy_var_1,mj AnnName happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_553 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_553 = happyMonadReduce 1# 202# happyReduction_553+happyReduction_553 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( reportEmptyDoubleQuotes (getLoc happy_var_1)))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_554 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_554 = happyMonadReduce 3# 202# happyReduction_554+happyReduction_554 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                 fmap ecFromExp $+                                 ams (sLL happy_var_1 happy_var_3 $ HsBracket noExt (ExpBr noExt happy_var_2))+                                      (if (hasE happy_var_1) then [mj AnnOpenE happy_var_1, mu AnnCloseQ happy_var_3]+                                                    else [mu AnnOpenEQ happy_var_1,mu AnnCloseQ happy_var_3])))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_555 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_555 = happyMonadReduce 3# 202# happyReduction_555+happyReduction_555 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                 fmap ecFromExp $+                                 ams (sLL happy_var_1 happy_var_3 $ HsBracket noExt (TExpBr noExt happy_var_2))+                                      (if (hasE happy_var_1) then [mj AnnOpenE happy_var_1,mc happy_var_3] else [mo happy_var_1,mc happy_var_3])))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_556 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_556 = happyMonadReduce 3# 202# happyReduction_556+happyReduction_556 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn147  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( fmap ecFromExp $+                                 ams (sLL happy_var_1 happy_var_3 $ HsBracket noExt (TypBr noExt happy_var_2)) [mo happy_var_1,mu AnnCloseQ happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_557 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_557 = happyMonadReduce 3# 202# happyReduction_557+happyReduction_557 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( (checkPattern empty <=< runExpCmdP) happy_var_2 >>= \p ->+                                      fmap ecFromExp $+                                      ams (sLL happy_var_1 happy_var_3 $ HsBracket noExt (PatBr noExt p))+                                          [mo happy_var_1,mu AnnCloseQ happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_558 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_558 = happyMonadReduce 3# 202# happyReduction_558+happyReduction_558 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn224  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( fmap ecFromExp $+                                  ams (sLL happy_var_1 happy_var_3 $ HsBracket noExt (DecBrL noExt (snd happy_var_2)))+                                      (mo happy_var_1:mu AnnCloseQ happy_var_3:fst happy_var_2)))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_559 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_559 = happySpecReduce_1  202# happyReduction_559+happyReduction_559 (HappyAbsSyn206  happy_var_1)+	 =  HappyAbsSyn207+		 (ecFromExp $ sL1 happy_var_1 (HsSpliceE noExt (unLoc happy_var_1))+	)+happyReduction_559 _  = notHappyAtAll ++happyReduce_560 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_560 = happyMonadReduce 4# 202# happyReduction_560+happyReduction_560 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn222  happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                      fmap ecFromCmd $+                                      ams (sLL happy_var_1 happy_var_4 $ HsCmdArrForm noExt happy_var_2 Prefix+                                                           Nothing (reverse happy_var_3))+                                          [mu AnnOpenB happy_var_1,mu AnnCloseB happy_var_4]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_561 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_561 = happySpecReduce_1  203# happyReduction_561+happyReduction_561 (HappyAbsSyn206  happy_var_1)+	 =  HappyAbsSyn209+		 (mapLoc (HsSpliceE noExt) happy_var_1+	)+happyReduction_561 _  = notHappyAtAll ++happyReduce_562 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_562 = happySpecReduce_1  203# happyReduction_562+happyReduction_562 (HappyAbsSyn206  happy_var_1)+	 =  HappyAbsSyn209+		 (mapLoc (HsSpliceE noExt) happy_var_1+	)+happyReduction_562 _  = notHappyAtAll ++happyReduce_563 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_563 = happyMonadReduce 1# 204# happyReduction_563+happyReduction_563 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sL1 happy_var_1 $ mkUntypedSplice HasDollar+                                        (sL1 happy_var_1 $ HsVar noExt (sL1 happy_var_1 (mkUnqual varName+                                                           (getTH_ID_SPLICE happy_var_1)))))+                                       [mj AnnThIdSplice happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn206 r))++happyReduce_564 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_564 = happyMonadReduce 3# 204# happyReduction_564+happyReduction_564 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                   ams (sLL happy_var_1 happy_var_3 $ mkUntypedSplice HasParens happy_var_2)+                                       [mj AnnOpenPE happy_var_1,mj AnnCloseP happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn206 r))++happyReduce_565 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_565 = happyMonadReduce 1# 205# happyReduction_565+happyReduction_565 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sL1 happy_var_1 $ mkTypedSplice HasDollar+                                        (sL1 happy_var_1 $ HsVar noExt (sL1 happy_var_1 (mkUnqual varName+                                                        (getTH_ID_TY_SPLICE happy_var_1)))))+                                       [mj AnnThIdTySplice happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn206 r))++happyReduce_566 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_566 = happyMonadReduce 3# 205# happyReduction_566+happyReduction_566 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                    ams (sLL happy_var_1 happy_var_3 $ mkTypedSplice HasParens happy_var_2)+                                       [mj AnnOpenPTE happy_var_1,mj AnnCloseP happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn206 r))++happyReduce_567 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_567 = happySpecReduce_2  206# happyReduction_567+happyReduction_567 (HappyAbsSyn223  happy_var_2)+	(HappyAbsSyn222  happy_var_1)+	 =  HappyAbsSyn222+		 (happy_var_2 : happy_var_1+	)+happyReduction_567 _ _  = notHappyAtAll ++happyReduce_568 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_568 = happySpecReduce_0  206# happyReduction_568+happyReduction_568  =  HappyAbsSyn222+		 ([]+	)++happyReduce_569 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_569 = happyMonadReduce 1# 207# happyReduction_569+happyReduction_569 ((HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ cmd ->+                                    return (sL1 cmd $ HsCmdTop noExt cmd)))+	) (\r -> happyReturn (HappyAbsSyn223 r))++happyReduce_570 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_570 = happySpecReduce_3  208# happyReduction_570+happyReduction_570 (HappyTerminal happy_var_3)+	(HappyAbsSyn225  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn224+		 (([mj AnnOpenC happy_var_1+                                                  ,mj AnnCloseC happy_var_3],happy_var_2)+	)+happyReduction_570 _ _ _  = notHappyAtAll ++happyReduce_571 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_571 = happySpecReduce_3  208# happyReduction_571+happyReduction_571 _+	(HappyAbsSyn225  happy_var_2)+	_+	 =  HappyAbsSyn224+		 (([],happy_var_2)+	)+happyReduction_571 _ _ _  = notHappyAtAll ++happyReduce_572 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_572 = happySpecReduce_1  209# happyReduction_572+happyReduction_572 (HappyAbsSyn75  happy_var_1)+	 =  HappyAbsSyn225+		 (cvTopDecls happy_var_1+	)+happyReduction_572 _  = notHappyAtAll ++happyReduce_573 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_573 = happySpecReduce_1  209# happyReduction_573+happyReduction_573 (HappyAbsSyn75  happy_var_1)+	 =  HappyAbsSyn225+		 (cvTopDecls happy_var_1+	)+happyReduction_573 _  = notHappyAtAll ++happyReduce_574 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_574 = happySpecReduce_1  210# happyReduction_574+happyReduction_574 (HappyAbsSyn207  happy_var_1)+	 =  HappyAbsSyn207+		 (happy_var_1+	)+happyReduction_574 _  = notHappyAtAll ++happyReduce_575 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_575 = happyMonadReduce 2# 210# happyReduction_575+happyReduction_575 ((HappyAbsSyn209  happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                return $ ecFromExp $+                                sLL happy_var_1 happy_var_2 $ SectionL noExt happy_var_1 happy_var_2))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_576 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_576 = happyMonadReduce 2# 210# happyReduction_576+happyReduction_576 ((HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyAbsSyn209  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                return $ ecFromExp $+                                sLL happy_var_1 happy_var_2 $ SectionR noExt happy_var_1 happy_var_2))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_577 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_577 = happyMonadReduce 3# 210# happyReduction_577+happyReduction_577 ((HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                             runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                             fmap ecFromExp $+                             ams (sLL happy_var_1 happy_var_3 $ EViewPat noExt happy_var_1 happy_var_3) [mu AnnRarrow happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn207 r))++happyReduce_578 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_578 = happyMonadReduce 2# 211# happyReduction_578+happyReduction_578 ((HappyAbsSyn228  happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                             do { addAnnotation (gl happy_var_1) AnnComma (fst happy_var_2)+                                ; return ([],Tuple ((sL1 happy_var_1 (Present noExt happy_var_1)) : snd happy_var_2)) }))+	) (\r -> happyReturn (HappyAbsSyn227 r))++happyReduce_579 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_579 = happyMonadReduce 2# 211# happyReduction_579+happyReduction_579 ((HappyAbsSyn318  happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 -> return $+                            (mvbars (fst happy_var_2), Sum 1  (snd happy_var_2 + 1) happy_var_1)))+	) (\r -> happyReturn (HappyAbsSyn227 r))++happyReduce_580 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_580 = happyMonadReduce 2# 211# happyReduction_580+happyReduction_580 ((HappyAbsSyn229  happy_var_2) `HappyStk`+	(HappyAbsSyn318  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst happy_var_1)+                      ; return+                           ([],Tuple (map (\l -> cL l missingTupArg) (fst happy_var_1) ++ happy_var_2)) }))+	) (\r -> happyReturn (HappyAbsSyn227 r))++happyReduce_581 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_581 = happyMonadReduce 3# 211# happyReduction_581+happyReduction_581 ((HappyAbsSyn318  happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyAbsSyn318  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 -> return $+                  (mvbars (fst happy_var_1) ++ mvbars (fst happy_var_3), Sum (snd happy_var_1 + 1) (snd happy_var_1 + snd happy_var_3 + 1) happy_var_2)))+	) (\r -> happyReturn (HappyAbsSyn227 r))++happyReduce_582 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_582 = happyMonadReduce 2# 212# happyReduction_582+happyReduction_582 ((HappyAbsSyn229  happy_var_2) `HappyStk`+	(HappyAbsSyn318  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst happy_var_1)+             ; return (+            (head $ fst happy_var_1+            ,(map (\l -> cL l missingTupArg) (tail $ fst happy_var_1)) ++ happy_var_2)) }))+	) (\r -> happyReturn (HappyAbsSyn228 r))++happyReduce_583 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_583 = happyMonadReduce 2# 213# happyReduction_583+happyReduction_583 ((HappyAbsSyn228  happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                    addAnnotation (gl happy_var_1) AnnComma (fst happy_var_2) >>+                                    return ((cL (gl happy_var_1) (Present noExt happy_var_1)) : snd happy_var_2)))+	) (\r -> happyReturn (HappyAbsSyn229 r))++happyReduce_584 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_584 = happyMonadReduce 1# 213# happyReduction_584+happyReduction_584 ((HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                    return [cL (gl happy_var_1) (Present noExt happy_var_1)]))+	) (\r -> happyReturn (HappyAbsSyn229 r))++happyReduce_585 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_585 = happySpecReduce_0  213# happyReduction_585+happyReduction_585  =  HappyAbsSyn229+		 ([noLoc missingTupArg]+	)++happyReduce_586 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_586 = happyMonadReduce 1# 214# happyReduction_586+happyReduction_586 ((HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                     return ([],ExplicitList noExt Nothing [happy_var_1])))+	) (\r -> happyReturn (HappyAbsSyn230 r))++happyReduce_587 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_587 = happySpecReduce_1  214# happyReduction_587+happyReduction_587 (HappyAbsSyn231  happy_var_1)+	 =  HappyAbsSyn230+		 (([],ExplicitList noExt Nothing (reverse (unLoc happy_var_1)))+	)+happyReduction_587 _  = notHappyAtAll ++happyReduce_588 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_588 = happyMonadReduce 2# 214# happyReduction_588+happyReduction_588 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                  return ([mj AnnDotdot happy_var_2],+                                      ArithSeq noExt Nothing (From happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn230 r))++happyReduce_589 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_589 = happyMonadReduce 4# 214# happyReduction_589+happyReduction_589 ((HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                   runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                  return ([mj AnnComma happy_var_2,mj AnnDotdot happy_var_4],+                                  ArithSeq noExt Nothing+                                                             (FromThen happy_var_1 happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn230 r))++happyReduce_590 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_590 = happyMonadReduce 3# 214# happyReduction_590+happyReduction_590 ((HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                   runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                  return ([mj AnnDotdot happy_var_2],+                                   ArithSeq noExt Nothing+                                                               (FromTo happy_var_1 happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn230 r))++happyReduce_591 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_591 = happyMonadReduce 5# 214# happyReduction_591+happyReduction_591 ((HappyAbsSyn207  happy_var_5) `HappyStk`+	(HappyTerminal happy_var_4) `HappyStk`+	(HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                   runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                   runExpCmdP happy_var_5 >>= \ happy_var_5 ->+                                  return ([mj AnnComma happy_var_2,mj AnnDotdot happy_var_4],+                                    ArithSeq noExt Nothing+                                                (FromThenTo happy_var_1 happy_var_3 happy_var_5))))+	) (\r -> happyReturn (HappyAbsSyn230 r))++happyReduce_592 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_592 = happyMonadReduce 3# 214# happyReduction_592+happyReduction_592 ((HappyAbsSyn232  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( checkMonadComp >>= \ ctxt ->+                runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                return ([mj AnnVbar happy_var_2],+                        mkHsComp ctxt (unLoc happy_var_3) happy_var_1)))+	) (\r -> happyReturn (HappyAbsSyn230 r))++happyReduce_593 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_593 = happyMonadReduce 3# 215# happyReduction_593+happyReduction_593 ((HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn231  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                     addAnnotation (gl $ head $ unLoc happy_var_1)+                                                            AnnComma (gl happy_var_2) >>+                                      return (sLL happy_var_1 happy_var_3 (((:) $! happy_var_3) $! unLoc happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn231 r))++happyReduce_594 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_594 = happyMonadReduce 3# 215# happyReduction_594+happyReduction_594 ((HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                      runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                      addAnnotation (gl happy_var_1) AnnComma (gl happy_var_2) >>+                                      return (sLL happy_var_1 happy_var_3 [happy_var_3,happy_var_1])))+	) (\r -> happyReturn (HappyAbsSyn231 r))++happyReduce_595 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_595 = happySpecReduce_1  216# happyReduction_595+happyReduction_595 (HappyAbsSyn233  happy_var_1)+	 =  HappyAbsSyn232+		 (case (unLoc happy_var_1) of+                    [qs] -> sL1 happy_var_1 qs+                    -- We just had one thing in our "parallel" list so+                    -- we simply return that thing directly++                    qss -> sL1 happy_var_1 [sL1 happy_var_1 $ ParStmt noExt [ParStmtBlock noExt qs [] noSyntaxExpr |+                                            qs <- qss]+                                            noExpr noSyntaxExpr]+                    -- We actually found some actual parallel lists so+                    -- we wrap them into as a ParStmt+	)+happyReduction_595 _  = notHappyAtAll ++happyReduce_596 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_596 = happyMonadReduce 3# 217# happyReduction_596+happyReduction_596 ((HappyAbsSyn233  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn232  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl $ head $ unLoc happy_var_1) AnnVbar (gl happy_var_2) >>+                        return (sLL happy_var_1 happy_var_3 (reverse (unLoc happy_var_1) : unLoc happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn233 r))++happyReduce_597 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_597 = happySpecReduce_1  217# happyReduction_597+happyReduction_597 (HappyAbsSyn232  happy_var_1)+	 =  HappyAbsSyn233+		 (cL (getLoc happy_var_1) [reverse (unLoc happy_var_1)]+	)+happyReduction_597 _  = notHappyAtAll ++happyReduce_598 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_598 = happyMonadReduce 3# 218# happyReduction_598+happyReduction_598 ((HappyAbsSyn235  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn232  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl $ head $ unLoc happy_var_1) AnnComma (gl happy_var_2) >>+                amsL (comb2 happy_var_1 happy_var_3) (fst $ unLoc happy_var_3) >>+                return (sLL happy_var_1 happy_var_3 [sLL happy_var_1 happy_var_3 ((snd $ unLoc happy_var_3) (reverse (unLoc happy_var_1)))])))+	) (\r -> happyReturn (HappyAbsSyn232 r))++happyReduce_599 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_599 = happyMonadReduce 3# 218# happyReduction_599+happyReduction_599 ((HappyAbsSyn255  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn232  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( happy_var_3 >>= \ happy_var_3 ->+                addAnnotation (gl $ head $ unLoc happy_var_1) AnnComma (gl happy_var_2) >>+                return (sLL happy_var_1 happy_var_3 (happy_var_3 : unLoc happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn232 r))++happyReduce_600 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_600 = happyMonadReduce 1# 218# happyReduction_600+happyReduction_600 ((HappyAbsSyn235  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams happy_var_1 (fst $ unLoc happy_var_1) >>+                              return (sLL happy_var_1 happy_var_1 [cL (getLoc happy_var_1) ((snd $ unLoc happy_var_1) [])])))+	) (\r -> happyReturn (HappyAbsSyn232 r))++happyReduce_601 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_601 = happyMonadReduce 1# 218# happyReduction_601+happyReduction_601 ((HappyAbsSyn255  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( happy_var_1 >>= \ happy_var_1 ->+                                            return $ sL1 happy_var_1 [happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn232 r))++happyReduce_602 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_602 = happyMonadReduce 2# 219# happyReduction_602+happyReduction_602 ((HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 -> return $+                                 sLL happy_var_1 happy_var_2 ([mj AnnThen happy_var_1], \ss -> (mkTransformStmt ss happy_var_2))))+	) (\r -> happyReturn (HappyAbsSyn235 r))++happyReduce_603 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_603 = happyMonadReduce 4# 219# happyReduction_603+happyReduction_603 ((HappyAbsSyn207  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                 runExpCmdP happy_var_4 >>= \ happy_var_4 ->+                                 return $ sLL happy_var_1 happy_var_4 ([mj AnnThen happy_var_1,mj AnnBy  happy_var_3],+                                                     \ss -> (mkTransformByStmt ss happy_var_2 happy_var_4))))+	) (\r -> happyReturn (HappyAbsSyn235 r))++happyReduce_604 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_604 = happyMonadReduce 4# 219# happyReduction_604+happyReduction_604 ((HappyAbsSyn207  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_4 >>= \ happy_var_4 ->+               return $ sLL happy_var_1 happy_var_4 ([mj AnnThen happy_var_1,mj AnnGroup happy_var_2,mj AnnUsing happy_var_3],+                                   \ss -> (mkGroupUsingStmt ss happy_var_4))))+	) (\r -> happyReturn (HappyAbsSyn235 r))++happyReduce_605 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_605 = happyMonadReduce 6# 219# happyReduction_605+happyReduction_605 ((HappyAbsSyn207  happy_var_6) `HappyStk`+	(HappyTerminal happy_var_5) `HappyStk`+	(HappyAbsSyn207  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_4 >>= \ happy_var_4 ->+               runExpCmdP happy_var_6 >>= \ happy_var_6 ->+               return $ sLL happy_var_1 happy_var_6 ([mj AnnThen happy_var_1,mj AnnGroup happy_var_2,mj AnnBy happy_var_3,mj AnnUsing happy_var_5],+                                   \ss -> (mkGroupByUsingStmt ss happy_var_4 happy_var_6))))+	) (\r -> happyReturn (HappyAbsSyn235 r))++happyReduce_606 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_606 = happySpecReduce_1  220# happyReduction_606+happyReduction_606 (HappyAbsSyn232  happy_var_1)+	 =  HappyAbsSyn232+		 (cL (getLoc happy_var_1) (reverse (unLoc happy_var_1))+	)+happyReduction_606 _  = notHappyAtAll ++happyReduce_607 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_607 = happyMonadReduce 3# 221# happyReduction_607+happyReduction_607 ((HappyAbsSyn255  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn232  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( happy_var_3 >>= \ happy_var_3 ->+                               addAnnotation (gl $ head $ unLoc happy_var_1) AnnComma+                                             (gl happy_var_2) >>+                               return (sLL happy_var_1 happy_var_3 (happy_var_3 : unLoc happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn232 r))++happyReduce_608 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_608 = happyMonadReduce 1# 221# happyReduction_608+happyReduction_608 ((HappyAbsSyn255  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( happy_var_1 >>= \ happy_var_1 ->+                               return $ sL1 happy_var_1 [happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn232 r))++happyReduce_609 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_609 = happySpecReduce_3  222# happyReduction_609+happyReduction_609 (HappyTerminal happy_var_3)+	(HappyAbsSyn238  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn238+		 (happy_var_2 >>= \ happy_var_2 -> return $+                                     sLL happy_var_1 happy_var_3 ((moc happy_var_1:mcc happy_var_3:(fst $ unLoc happy_var_2))+                                               ,(reverse (snd $ unLoc happy_var_2)))+	)+happyReduction_609 _ _ _  = notHappyAtAll ++happyReduce_610 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_610 = happySpecReduce_3  222# happyReduction_610+happyReduction_610 _+	(HappyAbsSyn238  happy_var_2)+	_+	 =  HappyAbsSyn238+		 (happy_var_2 >>= \ happy_var_2 -> return $+                                       cL (getLoc happy_var_2) (fst $ unLoc happy_var_2+                                        ,(reverse (snd $ unLoc happy_var_2)))+	)+happyReduction_610 _ _ _  = notHappyAtAll ++happyReduce_611 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_611 = happySpecReduce_2  222# happyReduction_611+happyReduction_611 (HappyTerminal happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn238+		 (return $ sLL happy_var_1 happy_var_2 ([moc happy_var_1,mcc happy_var_2],[])+	)+happyReduction_611 _ _  = notHappyAtAll ++happyReduce_612 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_612 = happySpecReduce_2  222# happyReduction_612+happyReduction_612 _+	_+	 =  HappyAbsSyn238+		 (return $ noLoc ([],[])+	)++happyReduce_613 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_613 = happySpecReduce_1  223# happyReduction_613+happyReduction_613 (HappyAbsSyn238  happy_var_1)+	 =  HappyAbsSyn238+		 (happy_var_1 >>= \ happy_var_1 -> return $+                                     sL1 happy_var_1 (fst $ unLoc happy_var_1,snd $ unLoc happy_var_1)+	)+happyReduction_613 _  = notHappyAtAll ++happyReduce_614 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_614 = happySpecReduce_2  223# happyReduction_614+happyReduction_614 (HappyAbsSyn238  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn238+		 (happy_var_2 >>= \ happy_var_2 -> return $+                                     sLL happy_var_1 happy_var_2 ((mj AnnSemi happy_var_1:(fst $ unLoc happy_var_2))+                                               ,snd $ unLoc happy_var_2)+	)+happyReduction_614 _ _  = notHappyAtAll ++happyReduce_615 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_615 = happySpecReduce_3  224# happyReduction_615+happyReduction_615 (HappyAbsSyn241  happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyAbsSyn238  happy_var_1)+	 =  HappyAbsSyn238+		 (happy_var_1 >>= \ happy_var_1 ->+                                  happy_var_3 >>= \ happy_var_3 ->+                                     if null (snd $ unLoc happy_var_1)+                                     then return (sLL happy_var_1 happy_var_3 (mj AnnSemi happy_var_2:(fst $ unLoc happy_var_1)+                                                  ,[happy_var_3]))+                                     else (ams (head $ snd $ unLoc happy_var_1)+                                               (mj AnnSemi happy_var_2:(fst $ unLoc happy_var_1))+                                           >> return (sLL happy_var_1 happy_var_3 ([],happy_var_3 : (snd $ unLoc happy_var_1))) )+	)+happyReduction_615 _ _ _  = notHappyAtAll ++happyReduce_616 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_616 = happySpecReduce_2  224# happyReduction_616+happyReduction_616 (HappyTerminal happy_var_2)+	(HappyAbsSyn238  happy_var_1)+	 =  HappyAbsSyn238+		 (happy_var_1 >>= \ happy_var_1 ->+                                   if null (snd $ unLoc happy_var_1)+                                     then return (sLL happy_var_1 happy_var_2 (mj AnnSemi happy_var_2:(fst $ unLoc happy_var_1)+                                                  ,snd $ unLoc happy_var_1))+                                     else (ams (head $ snd $ unLoc happy_var_1)+                                               (mj AnnSemi happy_var_2:(fst $ unLoc happy_var_1))+                                           >> return (sLL happy_var_1 happy_var_2 ([],snd $ unLoc happy_var_1)))+	)+happyReduction_616 _ _  = notHappyAtAll ++happyReduce_617 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_617 = happySpecReduce_1  224# happyReduction_617+happyReduction_617 (HappyAbsSyn241  happy_var_1)+	 =  HappyAbsSyn238+		 (happy_var_1 >>= \ happy_var_1 -> return $ sL1 happy_var_1 ([],[happy_var_1])+	)+happyReduction_617 _  = notHappyAtAll ++happyReduce_618 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_618 = happySpecReduce_2  225# happyReduction_618+happyReduction_618 (HappyAbsSyn242  happy_var_2)+	(HappyAbsSyn247  happy_var_1)+	 =  HappyAbsSyn241+		 (happy_var_2 >>= \ happy_var_2 ->+                            ams (sLL happy_var_1 happy_var_2 (Match { m_ext = noExt+                                                  , m_ctxt = CaseAlt+                                                  , m_pats = [happy_var_1]+                                                  , m_grhss = snd $ unLoc happy_var_2 }))+                                      (fst $ unLoc happy_var_2)+	)+happyReduction_618 _ _  = notHappyAtAll ++happyReduce_619 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_619 = happySpecReduce_2  226# happyReduction_619+happyReduction_619 (HappyAbsSyn125  happy_var_2)+	(HappyAbsSyn243  happy_var_1)+	 =  HappyAbsSyn242+		 (happy_var_1 >>= \alt ->+                                      return $ sLL alt happy_var_2 (fst $ unLoc happy_var_2, GRHSs noExt (unLoc alt) (snd $ unLoc happy_var_2))+	)+happyReduction_619 _ _  = notHappyAtAll ++happyReduce_620 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_620 = happySpecReduce_2  227# happyReduction_620+happyReduction_620 (HappyAbsSyn207  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn243+		 (runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                ams (sLL happy_var_1 happy_var_2 (unguardedRHS (comb2 happy_var_1 happy_var_2) happy_var_2))+                                    [mu AnnRarrow happy_var_1]+	)+happyReduction_620 _ _  = notHappyAtAll ++happyReduce_621 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_621 = happySpecReduce_1  227# happyReduction_621+happyReduction_621 (HappyAbsSyn243  happy_var_1)+	 =  HappyAbsSyn243+		 (happy_var_1 >>= \gdpats ->+                                return $ sL1 gdpats (reverse (unLoc gdpats))+	)+happyReduction_621 _  = notHappyAtAll ++happyReduce_622 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_622 = happySpecReduce_2  228# happyReduction_622+happyReduction_622 (HappyAbsSyn246  happy_var_2)+	(HappyAbsSyn243  happy_var_1)+	 =  HappyAbsSyn243+		 (happy_var_1 >>= \gdpats ->+                         happy_var_2 >>= \gdpat ->+                         return $ sLL gdpats gdpat (gdpat : unLoc gdpats)+	)+happyReduction_622 _ _  = notHappyAtAll ++happyReduce_623 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_623 = happySpecReduce_1  228# happyReduction_623+happyReduction_623 (HappyAbsSyn246  happy_var_1)+	 =  HappyAbsSyn243+		 (happy_var_1 >>= \gdpat -> return $ sL1 gdpat [gdpat]+	)+happyReduction_623 _  = notHappyAtAll ++happyReduce_624 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_624 = happyMonadReduce 3# 229# happyReduction_624+happyReduction_624 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn243  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( happy_var_2 >>= \ happy_var_2 ->+                                             return $ sLL happy_var_1 happy_var_3 ([moc happy_var_1,mcc happy_var_3],unLoc happy_var_2)))+	) (\r -> happyReturn (HappyAbsSyn245 r))++happyReduce_625 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_625 = happyMonadReduce 2# 229# happyReduction_625+happyReduction_625 (_ `HappyStk`+	(HappyAbsSyn243  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( happy_var_1 >>= \ happy_var_1 ->+                                             return $ sL1 happy_var_1 ([],unLoc happy_var_1)))+	) (\r -> happyReturn (HappyAbsSyn245 r))++happyReduce_626 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_626 = happyReduce 4# 230# happyReduction_626+happyReduction_626 ((HappyAbsSyn207  happy_var_4) `HappyStk`+	(HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn232  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest)+	 = HappyAbsSyn246+		 (runExpCmdP happy_var_4 >>= \ happy_var_4 ->+                                     ams (sL (comb2 happy_var_1 happy_var_4) $ GRHS noExt (unLoc happy_var_2) happy_var_4)+                                         [mj AnnVbar happy_var_1,mu AnnRarrow happy_var_3]+	) `HappyStk` happyRest++happyReduce_627 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_627 = happyMonadReduce 1# 231# happyReduction_627+happyReduction_627 ((HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( (checkPattern empty <=< runExpCmdP) happy_var_1))+	) (\r -> happyReturn (HappyAbsSyn247 r))++happyReduce_628 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_628 = happyMonadReduce 2# 231# happyReduction_628+happyReduction_628 ((HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                           amms (checkPattern empty (sLL happy_var_1 happy_var_2 (SectionR noExt+                                                     (sL1 happy_var_1 (HsVar noExt (sL1 happy_var_1 bang_RDR))) happy_var_2)))+                                [mj AnnBang happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn247 r))++happyReduce_629 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_629 = happyMonadReduce 1# 232# happyReduction_629+happyReduction_629 ((HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                             checkPattern+                                (text "Possibly caused by a missing 'do'?") happy_var_1))+	) (\r -> happyReturn (HappyAbsSyn247 r))++happyReduce_630 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_630 = happyMonadReduce 2# 232# happyReduction_630+happyReduction_630 ((HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                             amms (checkPattern+                                     (text "Possibly caused by a missing 'do'?")+                                     (sLL happy_var_1 happy_var_2 (SectionR noExt (sL1 happy_var_1 (HsVar noExt (sL1 happy_var_1 bang_RDR))) happy_var_2)))+                                  [mj AnnBang happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn247 r))++happyReduce_631 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_631 = happyMonadReduce 1# 233# happyReduction_631+happyReduction_631 ((HappyAbsSyn207  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( (checkPattern empty <=< runExpCmdP) happy_var_1))+	) (\r -> happyReturn (HappyAbsSyn247 r))++happyReduce_632 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_632 = happyMonadReduce 2# 233# happyReduction_632+happyReduction_632 ((HappyAbsSyn207  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_2 >>= \ happy_var_2 ->+                                   amms (checkPattern empty+                                            (sLL happy_var_1 happy_var_2 (SectionR noExt+                                                (sL1 happy_var_1 (HsVar noExt (sL1 happy_var_1 bang_RDR))) happy_var_2)))+                                        [mj AnnBang happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn247 r))++happyReduce_633 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_633 = happySpecReduce_2  234# happyReduction_633+happyReduction_633 (HappyAbsSyn250  happy_var_2)+	(HappyAbsSyn247  happy_var_1)+	 =  HappyAbsSyn250+		 (happy_var_1 : happy_var_2+	)+happyReduction_633 _ _  = notHappyAtAll ++happyReduce_634 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_634 = happySpecReduce_0  234# happyReduction_634+happyReduction_634  =  HappyAbsSyn250+		 ([]+	)++happyReduce_635 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_635 = happySpecReduce_3  235# happyReduction_635+happyReduction_635 (HappyTerminal happy_var_3)+	(HappyAbsSyn251  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn251+		 (happy_var_2 >>= \ happy_var_2 -> return $+                                          sLL happy_var_1 happy_var_3 ((moc happy_var_1:mcc happy_var_3:(fst $ unLoc happy_var_2))+                                             ,(reverse $ snd $ unLoc happy_var_2))+	)+happyReduction_635 _ _ _  = notHappyAtAll ++happyReduce_636 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_636 = happySpecReduce_3  235# happyReduction_636+happyReduction_636 _+	(HappyAbsSyn251  happy_var_2)+	_+	 =  HappyAbsSyn251+		 (happy_var_2 >>= \ happy_var_2 -> return $+                                          cL (gl happy_var_2) (fst $ unLoc happy_var_2+                                                    ,reverse $ snd $ unLoc happy_var_2)+	)+happyReduction_636 _ _ _  = notHappyAtAll ++happyReduce_637 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_637 = happySpecReduce_3  236# happyReduction_637+happyReduction_637 (HappyAbsSyn255  happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyAbsSyn251  happy_var_1)+	 =  HappyAbsSyn251+		 (happy_var_1 >>= \ happy_var_1 ->+                            happy_var_3 >>= \ happy_var_3 ->+                            if null (snd $ unLoc happy_var_1)+                              then return (sLL happy_var_1 happy_var_3 (mj AnnSemi happy_var_2:(fst $ unLoc happy_var_1)+                                                     ,happy_var_3 : (snd $ unLoc happy_var_1)))+                              else do+                               { ams (head $ snd $ unLoc happy_var_1) [mj AnnSemi happy_var_2]+                               ; return $ sLL happy_var_1 happy_var_3 (fst $ unLoc happy_var_1,happy_var_3 :(snd $ unLoc happy_var_1)) }+	)+happyReduction_637 _ _ _  = notHappyAtAll ++happyReduce_638 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_638 = happySpecReduce_2  236# happyReduction_638+happyReduction_638 (HappyTerminal happy_var_2)+	(HappyAbsSyn251  happy_var_1)+	 =  HappyAbsSyn251+		 (happy_var_1 >>= \ happy_var_1 ->+                           if null (snd $ unLoc happy_var_1)+                             then return (sLL happy_var_1 happy_var_2 (mj AnnSemi happy_var_2:(fst $ unLoc happy_var_1),snd $ unLoc happy_var_1))+                             else do+                               { ams (head $ snd $ unLoc happy_var_1)+                                               [mj AnnSemi happy_var_2]+                               ; return happy_var_1 }+	)+happyReduction_638 _ _  = notHappyAtAll ++happyReduce_639 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_639 = happySpecReduce_1  236# happyReduction_639+happyReduction_639 (HappyAbsSyn255  happy_var_1)+	 =  HappyAbsSyn251+		 (happy_var_1 >>= \ happy_var_1 ->+                                   return $ sL1 happy_var_1 ([],[happy_var_1])+	)+happyReduction_639 _  = notHappyAtAll ++happyReduce_640 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_640 = happySpecReduce_0  236# happyReduction_640+happyReduction_640  =  HappyAbsSyn251+		 (return $ noLoc ([],[])+	)++happyReduce_641 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_641 = happyMonadReduce 1# 237# happyReduction_641+happyReduction_641 ((HappyAbsSyn255  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( fmap Just happy_var_1))+	) (\r -> happyReturn (HappyAbsSyn253 r))++happyReduce_642 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_642 = happySpecReduce_0  237# happyReduction_642+happyReduction_642  =  HappyAbsSyn253+		 (Nothing+	)++happyReduce_643 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_643 = happyMonadReduce 1# 238# happyReduction_643+happyReduction_643 ((HappyAbsSyn255  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( happy_var_1))+	) (\r -> happyReturn (HappyAbsSyn254 r))++happyReduce_644 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_644 = happySpecReduce_1  239# happyReduction_644+happyReduction_644 (HappyAbsSyn255  happy_var_1)+	 =  HappyAbsSyn255+		 (happy_var_1+	)+happyReduction_644 _  = notHappyAtAll ++happyReduce_645 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_645 = happySpecReduce_2  239# happyReduction_645+happyReduction_645 (HappyAbsSyn251  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn255+		 (happy_var_2 >>= \ happy_var_2 ->+                                           ams (sLL happy_var_1 happy_var_2 $ mkRecStmt (snd $ unLoc happy_var_2))+                                               (mj AnnRec happy_var_1:(fst $ unLoc happy_var_2))+	)+happyReduction_645 _ _  = notHappyAtAll ++happyReduce_646 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_646 = happySpecReduce_3  240# happyReduction_646+happyReduction_646 (HappyAbsSyn207  happy_var_3)+	(HappyTerminal happy_var_2)+	(HappyAbsSyn247  happy_var_1)+	 =  HappyAbsSyn255+		 (runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                           ams (sLL happy_var_1 happy_var_3 $ mkBindStmt happy_var_1 happy_var_3)+                                               [mu AnnLarrow happy_var_2]+	)+happyReduction_646 _ _ _  = notHappyAtAll ++happyReduce_647 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_647 = happySpecReduce_1  240# happyReduction_647+happyReduction_647 (HappyAbsSyn207  happy_var_1)+	 =  HappyAbsSyn255+		 (runExpCmdP happy_var_1 >>= \ happy_var_1 ->+                                           return $ sL1 happy_var_1 $ mkBodyStmt happy_var_1+	)+happyReduction_647 _  = notHappyAtAll ++happyReduce_648 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_648 = happySpecReduce_2  240# happyReduction_648+happyReduction_648 (HappyAbsSyn125  happy_var_2)+	(HappyTerminal happy_var_1)+	 =  HappyAbsSyn255+		 (ams (sLL happy_var_1 happy_var_2 $ LetStmt noExt (snd $ unLoc happy_var_2))+                                               (mj AnnLet happy_var_1:(fst $ unLoc happy_var_2))+	)+happyReduction_648 _ _  = notHappyAtAll ++happyReduce_649 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_649 = happySpecReduce_1  241# happyReduction_649+happyReduction_649 (HappyAbsSyn257  happy_var_1)+	 =  HappyAbsSyn257+		 (happy_var_1+	)+happyReduction_649 _  = notHappyAtAll ++happyReduce_650 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_650 = happySpecReduce_0  241# happyReduction_650+happyReduction_650  =  HappyAbsSyn257+		 (([],([], Nothing))+	)++happyReduce_651 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_651 = happyMonadReduce 3# 242# happyReduction_651+happyReduction_651 ((HappyAbsSyn257  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn259  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) AnnComma (gl happy_var_2) >>+                   return (case happy_var_3 of (ma,(flds, dd)) -> (ma,(happy_var_1 : flds, dd)))))+	) (\r -> happyReturn (HappyAbsSyn257 r))++happyReduce_652 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_652 = happySpecReduce_1  242# happyReduction_652+happyReduction_652 (HappyAbsSyn259  happy_var_1)+	 =  HappyAbsSyn257+		 (([],([happy_var_1], Nothing))+	)+happyReduction_652 _  = notHappyAtAll ++happyReduce_653 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_653 = happySpecReduce_1  242# happyReduction_653+happyReduction_653 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn257+		 (([mj AnnDotdot happy_var_1],([],   Just (getLoc happy_var_1)))+	)+happyReduction_653 _  = notHappyAtAll ++happyReduce_654 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_654 = happyMonadReduce 3# 243# happyReduction_654+happyReduction_654 ((HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn16  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                           ams  (sLL happy_var_1 happy_var_3 $ HsRecField (sL1 happy_var_1 $ mkFieldOcc happy_var_1) happy_var_3 False)+                                [mj AnnEqual happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn259 r))++happyReduce_655 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_655 = happySpecReduce_1  243# happyReduction_655+happyReduction_655 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn259+		 (sLL happy_var_1 happy_var_1 $ HsRecField (sL1 happy_var_1 $ mkFieldOcc happy_var_1) placeHolderPunRhs True+	)+happyReduction_655 _  = notHappyAtAll ++happyReduce_656 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_656 = happyMonadReduce 3# 244# happyReduction_656+happyReduction_656 ((HappyAbsSyn261  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn260  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl $ last $ unLoc happy_var_1) AnnSemi (gl happy_var_2) >>+                         return (let { this = happy_var_3; rest = unLoc happy_var_1 }+                              in rest `seq` this `seq` sLL happy_var_1 happy_var_3 (this : rest))))+	) (\r -> happyReturn (HappyAbsSyn260 r))++happyReduce_657 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_657 = happyMonadReduce 2# 244# happyReduction_657+happyReduction_657 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn260  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl $ last $ unLoc happy_var_1) AnnSemi (gl happy_var_2) >>+                         return (sLL happy_var_1 happy_var_2 (unLoc happy_var_1))))+	) (\r -> happyReturn (HappyAbsSyn260 r))++happyReduce_658 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_658 = happySpecReduce_1  244# happyReduction_658+happyReduction_658 (HappyAbsSyn261  happy_var_1)+	 =  HappyAbsSyn260+		 (let this = happy_var_1 in this `seq` sL1 happy_var_1 [this]+	)+happyReduction_658 _  = notHappyAtAll ++happyReduce_659 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_659 = happyMonadReduce 3# 245# happyReduction_659+happyReduction_659 ((HappyAbsSyn207  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn262  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( runExpCmdP happy_var_3 >>= \ happy_var_3 ->+                                          ams (sLL happy_var_1 happy_var_3 (IPBind noExt (Left happy_var_1) happy_var_3))+                                              [mj AnnEqual happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn261 r))++happyReduce_660 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_660 = happySpecReduce_1  246# happyReduction_660+happyReduction_660 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn262+		 (sL1 happy_var_1 (HsIPName (getIPDUPVARID happy_var_1))+	)+happyReduction_660 _  = notHappyAtAll ++happyReduce_661 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_661 = happySpecReduce_1  247# happyReduction_661+happyReduction_661 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (getLABELVARID happy_var_1)+	)+happyReduction_661 _  = notHappyAtAll ++happyReduce_662 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_662 = happySpecReduce_1  248# happyReduction_662+happyReduction_662 (HappyAbsSyn264  happy_var_1)+	 =  HappyAbsSyn264+		 (happy_var_1+	)+happyReduction_662 _  = notHappyAtAll ++happyReduce_663 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_663 = happySpecReduce_0  248# happyReduction_663+happyReduction_663  =  HappyAbsSyn264+		 (noLoc mkTrue+	)++happyReduce_664 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_664 = happySpecReduce_1  249# happyReduction_664+happyReduction_664 (HappyAbsSyn264  happy_var_1)+	 =  HappyAbsSyn264+		 (happy_var_1+	)+happyReduction_664 _  = notHappyAtAll ++happyReduce_665 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_665 = happyMonadReduce 3# 249# happyReduction_665+happyReduction_665 ((HappyAbsSyn264  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn264  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( aa happy_var_1 (AnnVbar, happy_var_2)+                              >> return (sLL happy_var_1 happy_var_3 (Or [happy_var_1,happy_var_3]))))+	) (\r -> happyReturn (HappyAbsSyn264 r))++happyReduce_666 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_666 = happySpecReduce_1  250# happyReduction_666+happyReduction_666 (HappyAbsSyn267  happy_var_1)+	 =  HappyAbsSyn264+		 (sLL (head happy_var_1) (last happy_var_1) (And (happy_var_1))+	)+happyReduction_666 _  = notHappyAtAll ++happyReduce_667 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_667 = happySpecReduce_1  251# happyReduction_667+happyReduction_667 (HappyAbsSyn264  happy_var_1)+	 =  HappyAbsSyn267+		 ([happy_var_1]+	)+happyReduction_667 _  = notHappyAtAll ++happyReduce_668 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_668 = happyMonadReduce 3# 251# happyReduction_668+happyReduction_668 ((HappyAbsSyn267  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn264  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( aa happy_var_1 (AnnComma, happy_var_2) >> return (happy_var_1 : happy_var_3)))+	) (\r -> happyReturn (HappyAbsSyn267 r))++happyReduce_669 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_669 = happyMonadReduce 3# 252# happyReduction_669+happyReduction_669 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn264  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (Parens happy_var_2)) [mop happy_var_1,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn264 r))++happyReduce_670 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_670 = happySpecReduce_1  252# happyReduction_670+happyReduction_670 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn264+		 (sL1 happy_var_1 (Var happy_var_1)+	)+happyReduction_670 _  = notHappyAtAll ++happyReduce_671 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_671 = happySpecReduce_1  253# happyReduction_671+happyReduction_671 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn87+		 (sL1 happy_var_1 [happy_var_1]+	)+happyReduction_671 _  = notHappyAtAll ++happyReduce_672 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_672 = happyMonadReduce 3# 253# happyReduction_672+happyReduction_672 ((HappyAbsSyn87  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn16  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) AnnComma (gl happy_var_2) >>+                                    return (sLL happy_var_1 happy_var_3 (happy_var_1 : unLoc happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn87 r))++happyReduce_673 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_673 = happySpecReduce_1  254# happyReduction_673+happyReduction_673 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_673 _  = notHappyAtAll ++happyReduce_674 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_674 = happySpecReduce_1  254# happyReduction_674+happyReduction_674 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_674 _  = notHappyAtAll ++happyReduce_675 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_675 = happySpecReduce_1  255# happyReduction_675+happyReduction_675 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_675 _  = notHappyAtAll ++happyReduce_676 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_676 = happySpecReduce_1  255# happyReduction_676+happyReduction_676 (HappyAbsSyn276  happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $ nameRdrName (dataConName (unLoc happy_var_1))+	)+happyReduction_676 _  = notHappyAtAll ++happyReduce_677 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_677 = happySpecReduce_1  256# happyReduction_677+happyReduction_677 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_677 _  = notHappyAtAll ++happyReduce_678 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_678 = happySpecReduce_1  256# happyReduction_678+happyReduction_678 (HappyAbsSyn276  happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $ nameRdrName (dataConName (unLoc happy_var_1))+	)+happyReduction_678 _  = notHappyAtAll ++happyReduce_679 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_679 = happySpecReduce_1  257# happyReduction_679+happyReduction_679 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_679 _  = notHappyAtAll ++happyReduce_680 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_680 = happyMonadReduce 3# 257# happyReduction_680+happyReduction_680 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (unLoc happy_var_2))+                                   [mop happy_var_1,mj AnnVal happy_var_2,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_681 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_681 = happySpecReduce_1  258# happyReduction_681+happyReduction_681 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_681 _  = notHappyAtAll ++happyReduce_682 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_682 = happyMonadReduce 3# 258# happyReduction_682+happyReduction_682 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (unLoc happy_var_2))+                                       [mop happy_var_1,mj AnnVal happy_var_2,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_683 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_683 = happySpecReduce_1  258# happyReduction_683+happyReduction_683 (HappyAbsSyn276  happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $ nameRdrName (dataConName (unLoc happy_var_1))+	)+happyReduction_683 _  = notHappyAtAll ++happyReduce_684 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_684 = happySpecReduce_1  259# happyReduction_684+happyReduction_684 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn87+		 (sL1 happy_var_1 [happy_var_1]+	)+happyReduction_684 _  = notHappyAtAll ++happyReduce_685 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_685 = happyMonadReduce 3# 259# happyReduction_685+happyReduction_685 ((HappyAbsSyn87  happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyAbsSyn16  happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( addAnnotation (gl happy_var_1) AnnComma (gl happy_var_2) >>+                                   return (sLL happy_var_1 happy_var_3 (happy_var_1 : unLoc happy_var_3))))+	) (\r -> happyReturn (HappyAbsSyn87 r))++happyReduce_686 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_686 = happyMonadReduce 2# 260# happyReduction_686+happyReduction_686 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 unitDataCon) [mop happy_var_1,mcp happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn276 r))++happyReduce_687 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_687 = happyMonadReduce 3# 260# happyReduction_687+happyReduction_687 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn318  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ tupleDataCon Boxed (snd happy_var_2 + 1))+                                       (mop happy_var_1:mcp happy_var_3:(mcommas (fst happy_var_2)))))+	) (\r -> happyReturn (HappyAbsSyn276 r))++happyReduce_688 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_688 = happyMonadReduce 2# 260# happyReduction_688+happyReduction_688 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 $ unboxedUnitDataCon) [mo happy_var_1,mc happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn276 r))++happyReduce_689 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_689 = happyMonadReduce 3# 260# happyReduction_689+happyReduction_689 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn318  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ tupleDataCon Unboxed (snd happy_var_2 + 1))+                                       (mo happy_var_1:mc happy_var_3:(mcommas (fst happy_var_2)))))+	) (\r -> happyReturn (HappyAbsSyn276 r))++happyReduce_690 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_690 = happySpecReduce_1  261# happyReduction_690+happyReduction_690 (HappyAbsSyn276  happy_var_1)+	 =  HappyAbsSyn276+		 (happy_var_1+	)+happyReduction_690 _  = notHappyAtAll ++happyReduce_691 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_691 = happyMonadReduce 2# 261# happyReduction_691+happyReduction_691 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 nilDataCon) [mos happy_var_1,mcs happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn276 r))++happyReduce_692 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_692 = happySpecReduce_1  262# happyReduction_692+happyReduction_692 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_692 _  = notHappyAtAll ++happyReduce_693 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_693 = happyMonadReduce 3# 262# happyReduction_693+happyReduction_693 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (unLoc happy_var_2))+                                       [mj AnnBackquote happy_var_1,mj AnnVal happy_var_2+                                       ,mj AnnBackquote happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_694 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_694 = happySpecReduce_1  263# happyReduction_694+happyReduction_694 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_694 _  = notHappyAtAll ++happyReduce_695 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_695 = happyMonadReduce 3# 263# happyReduction_695+happyReduction_695 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (unLoc happy_var_2))+                                       [mj AnnBackquote happy_var_1,mj AnnVal happy_var_2+                                       ,mj AnnBackquote happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_696 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_696 = happySpecReduce_1  264# happyReduction_696+happyReduction_696 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_696 _  = notHappyAtAll ++happyReduce_697 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_697 = happyMonadReduce 2# 264# happyReduction_697+happyReduction_697 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 $ getRdrName unitTyCon)+                                              [mop happy_var_1,mcp happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_698 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_698 = happyMonadReduce 2# 264# happyReduction_698+happyReduction_698 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 $ getRdrName unboxedUnitTyCon)+                                              [mo happy_var_1,mc happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_699 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_699 = happySpecReduce_1  265# happyReduction_699+happyReduction_699 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_699 _  = notHappyAtAll ++happyReduce_700 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_700 = happyMonadReduce 3# 265# happyReduction_700+happyReduction_700 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn318  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ getRdrName (tupleTyCon Boxed+                                                        (snd happy_var_2 + 1)))+                                       (mop happy_var_1:mcp happy_var_3:(mcommas (fst happy_var_2)))))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_701 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_701 = happyMonadReduce 3# 265# happyReduction_701+happyReduction_701 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn318  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ getRdrName (tupleTyCon Unboxed+                                                        (snd happy_var_2 + 1)))+                                       (mo happy_var_1:mc happy_var_3:(mcommas (fst happy_var_2)))))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_702 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_702 = happyMonadReduce 3# 265# happyReduction_702+happyReduction_702 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ getRdrName funTyCon)+                                       [mop happy_var_1,mu AnnRarrow happy_var_2,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_703 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_703 = happyMonadReduce 2# 265# happyReduction_703+happyReduction_703 ((HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_2 $ listTyCon_RDR) [mos happy_var_1,mcs happy_var_2]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_704 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_704 = happySpecReduce_1  266# happyReduction_704+happyReduction_704 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_704 _  = notHappyAtAll ++happyReduce_705 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_705 = happyMonadReduce 3# 266# happyReduction_705+happyReduction_705 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (unLoc happy_var_2))+                                               [mop happy_var_1,mj AnnVal happy_var_2,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_706 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_706 = happySpecReduce_1  267# happyReduction_706+happyReduction_706 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_706 _  = notHappyAtAll ++happyReduce_707 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_707 = happyMonadReduce 3# 267# happyReduction_707+happyReduction_707 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let { name :: Located RdrName+                                    ; name = sL1 happy_var_2 $! mkQual tcClsName (getQCONSYM happy_var_2) }+                                in ams (sLL happy_var_1 happy_var_3 (unLoc name)) [mop happy_var_1,mj AnnVal name,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_708 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_708 = happyMonadReduce 3# 267# happyReduction_708+happyReduction_708 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let { name :: Located RdrName+                                    ; name = sL1 happy_var_2 $! mkUnqual tcClsName (getCONSYM happy_var_2) }+                                in ams (sLL happy_var_1 happy_var_3 (unLoc name)) [mop happy_var_1,mj AnnVal name,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_709 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_709 = happyMonadReduce 3# 267# happyReduction_709+happyReduction_709 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let { name :: Located RdrName+                                    ; name = sL1 happy_var_2 $! consDataCon_RDR }+                                in ams (sLL happy_var_1 happy_var_3 (unLoc name)) [mop happy_var_1,mj AnnVal name,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_710 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_710 = happyMonadReduce 3# 267# happyReduction_710+happyReduction_710 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ eqTyCon_RDR) [mop happy_var_1,mj AnnTilde happy_var_2,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_711 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_711 = happySpecReduce_1  268# happyReduction_711+happyReduction_711 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_711 _  = notHappyAtAll ++happyReduce_712 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_712 = happyMonadReduce 3# 268# happyReduction_712+happyReduction_712 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (unLoc happy_var_2))+                                               [mj AnnBackquote happy_var_1,mj AnnVal happy_var_2+                                               ,mj AnnBackquote happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_713 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_713 = happySpecReduce_1  269# happyReduction_713+happyReduction_713 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkQual tcClsName (getQCONID happy_var_1)+	)+happyReduction_713 _  = notHappyAtAll ++happyReduce_714 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_714 = happySpecReduce_1  269# happyReduction_714+happyReduction_714 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_714 _  = notHappyAtAll ++happyReduce_715 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_715 = happySpecReduce_1  270# happyReduction_715+happyReduction_715 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn147+		 (sL1 happy_var_1                           (HsTyVar noExt NotPromoted happy_var_1)+	)+happyReduction_715 _  = notHappyAtAll ++happyReduce_716 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_716 = happySpecReduce_2  270# happyReduction_716+happyReduction_716 (HappyAbsSyn321  happy_var_2)+	(HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn147+		 (sLL happy_var_1 happy_var_2 (HsDocTy noExt (sL1 happy_var_1 (HsTyVar noExt NotPromoted happy_var_1)) happy_var_2)+	)+happyReduction_716 _ _  = notHappyAtAll ++happyReduce_717 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_717 = happySpecReduce_1  271# happyReduction_717+happyReduction_717 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual tcClsName (getCONID happy_var_1)+	)+happyReduction_717 _  = notHappyAtAll ++happyReduce_718 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_718 = happySpecReduce_1  272# happyReduction_718+happyReduction_718 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkQual tcClsName (getQCONSYM happy_var_1)+	)+happyReduction_718 _  = notHappyAtAll ++happyReduce_719 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_719 = happySpecReduce_1  272# happyReduction_719+happyReduction_719 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkQual tcClsName (getQVARSYM happy_var_1)+	)+happyReduction_719 _  = notHappyAtAll ++happyReduce_720 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_720 = happySpecReduce_1  272# happyReduction_720+happyReduction_720 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_720 _  = notHappyAtAll ++happyReduce_721 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_721 = happySpecReduce_1  273# happyReduction_721+happyReduction_721 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual tcClsName (getCONSYM happy_var_1)+	)+happyReduction_721 _  = notHappyAtAll ++happyReduce_722 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_722 = happySpecReduce_1  273# happyReduction_722+happyReduction_722 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual tcClsName (getVARSYM happy_var_1)+	)+happyReduction_722 _  = notHappyAtAll ++happyReduce_723 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_723 = happySpecReduce_1  273# happyReduction_723+happyReduction_723 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! consDataCon_RDR+	)+happyReduction_723 _  = notHappyAtAll ++happyReduce_724 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_724 = happySpecReduce_1  273# happyReduction_724+happyReduction_724 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual tcClsName (fsLit "-")+	)+happyReduction_724 _  = notHappyAtAll ++happyReduce_725 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_725 = happySpecReduce_1  273# happyReduction_725+happyReduction_725 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual tcClsName (fsLit "!")+	)+happyReduction_725 _  = notHappyAtAll ++happyReduce_726 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_726 = happySpecReduce_1  273# happyReduction_726+happyReduction_726 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual tcClsName (fsLit ".")+	)+happyReduction_726 _  = notHappyAtAll ++happyReduce_727 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_727 = happySpecReduce_1  273# happyReduction_727+happyReduction_727 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $ eqTyCon_RDR+	)+happyReduction_727 _  = notHappyAtAll ++happyReduce_728 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_728 = happySpecReduce_1  274# happyReduction_728+happyReduction_728 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_728 _  = notHappyAtAll ++happyReduce_729 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_729 = happySpecReduce_1  274# happyReduction_729+happyReduction_729 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_729 _  = notHappyAtAll ++happyReduce_730 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_730 = happySpecReduce_1  274# happyReduction_730+happyReduction_730 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $ getRdrName funTyCon+	)+happyReduction_730 _  = notHappyAtAll ++happyReduce_731 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_731 = happySpecReduce_1  274# happyReduction_731+happyReduction_731 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $ eqTyCon_RDR+	)+happyReduction_731 _  = notHappyAtAll ++happyReduce_732 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_732 = happySpecReduce_1  275# happyReduction_732+happyReduction_732 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_732 _  = notHappyAtAll ++happyReduce_733 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_733 = happyMonadReduce 3# 275# happyReduction_733+happyReduction_733 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (unLoc happy_var_2))+                                       [mj AnnBackquote happy_var_1,mj AnnVal happy_var_2+                                       ,mj AnnBackquote happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_734 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_734 = happySpecReduce_1  276# happyReduction_734+happyReduction_734 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn209+		 (sL1 happy_var_1 $ HsVar noExt happy_var_1+	)+happyReduction_734 _  = notHappyAtAll ++happyReduce_735 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_735 = happySpecReduce_1  276# happyReduction_735+happyReduction_735 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn209+		 (sL1 happy_var_1 $ HsVar noExt happy_var_1+	)+happyReduction_735 _  = notHappyAtAll ++happyReduce_736 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_736 = happySpecReduce_1  276# happyReduction_736+happyReduction_736 (HappyAbsSyn209  happy_var_1)+	 =  HappyAbsSyn209+		 (happy_var_1+	)+happyReduction_736 _  = notHappyAtAll ++happyReduce_737 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_737 = happySpecReduce_1  277# happyReduction_737+happyReduction_737 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn209+		 (sL1 happy_var_1 $ HsVar noExt happy_var_1+	)+happyReduction_737 _  = notHappyAtAll ++happyReduce_738 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_738 = happySpecReduce_1  277# happyReduction_738+happyReduction_738 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn209+		 (sL1 happy_var_1 $ HsVar noExt happy_var_1+	)+happyReduction_738 _  = notHappyAtAll ++happyReduce_739 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_739 = happySpecReduce_1  277# happyReduction_739+happyReduction_739 (HappyAbsSyn209  happy_var_1)+	 =  HappyAbsSyn209+		 (happy_var_1+	)+happyReduction_739 _  = notHappyAtAll ++happyReduce_740 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_740 = happyMonadReduce 3# 278# happyReduction_740+happyReduction_740 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyTerminal happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 $ EWildPat noExt)+                                       [mj AnnBackquote happy_var_1,mj AnnVal happy_var_2+                                       ,mj AnnBackquote happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn209 r))++happyReduce_741 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_741 = happySpecReduce_1  279# happyReduction_741+happyReduction_741 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_741 _  = notHappyAtAll ++happyReduce_742 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_742 = happyMonadReduce 3# 279# happyReduction_742+happyReduction_742 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (unLoc happy_var_2))+                                       [mj AnnBackquote happy_var_1,mj AnnVal happy_var_2+                                       ,mj AnnBackquote happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_743 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_743 = happySpecReduce_1  280# happyReduction_743+happyReduction_743 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_743 _  = notHappyAtAll ++happyReduce_744 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_744 = happyMonadReduce 3# 280# happyReduction_744+happyReduction_744 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (unLoc happy_var_2))+                                       [mj AnnBackquote happy_var_1,mj AnnVal happy_var_2+                                       ,mj AnnBackquote happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_745 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_745 = happySpecReduce_1  281# happyReduction_745+happyReduction_745 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_745 _  = notHappyAtAll ++happyReduce_746 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_746 = happyMonadReduce 3# 282# happyReduction_746+happyReduction_746 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (unLoc happy_var_2))+                                       [mj AnnBackquote happy_var_1,mj AnnVal happy_var_2+                                       ,mj AnnBackquote happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_747 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_747 = happySpecReduce_1  283# happyReduction_747+happyReduction_747 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual tvName (getVARID happy_var_1)+	)+happyReduction_747 _  = notHappyAtAll ++happyReduce_748 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_748 = happySpecReduce_1  283# happyReduction_748+happyReduction_748 (HappyAbsSyn25  happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual tvName (unLoc happy_var_1)+	)+happyReduction_748 _  = notHappyAtAll ++happyReduce_749 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_749 = happySpecReduce_1  283# happyReduction_749+happyReduction_749 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual tvName (fsLit "unsafe")+	)+happyReduction_749 _  = notHappyAtAll ++happyReduce_750 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_750 = happySpecReduce_1  283# happyReduction_750+happyReduction_750 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual tvName (fsLit "safe")+	)+happyReduction_750 _  = notHappyAtAll ++happyReduce_751 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_751 = happySpecReduce_1  283# happyReduction_751+happyReduction_751 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual tvName (fsLit "interruptible")+	)+happyReduction_751 _  = notHappyAtAll ++happyReduce_752 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_752 = happySpecReduce_1  284# happyReduction_752+happyReduction_752 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_752 _  = notHappyAtAll ++happyReduce_753 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_753 = happyMonadReduce 3# 284# happyReduction_753+happyReduction_753 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (unLoc happy_var_2))+                                       [mop happy_var_1,mj AnnVal happy_var_2,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_754 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_754 = happySpecReduce_1  285# happyReduction_754+happyReduction_754 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_754 _  = notHappyAtAll ++happyReduce_755 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_755 = happyMonadReduce 3# 285# happyReduction_755+happyReduction_755 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (unLoc happy_var_2))+                                       [mop happy_var_1,mj AnnVal happy_var_2,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_756 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_756 = happyMonadReduce 3# 285# happyReduction_756+happyReduction_756 ((HappyTerminal happy_var_3) `HappyStk`+	(HappyAbsSyn16  happy_var_2) `HappyStk`+	(HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sLL happy_var_1 happy_var_3 (unLoc happy_var_2))+                                       [mop happy_var_1,mj AnnVal happy_var_2,mcp happy_var_3]))+	) (\r -> happyReturn (HappyAbsSyn16 r))++happyReduce_757 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_757 = happySpecReduce_1  286# happyReduction_757+happyReduction_757 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_757 _  = notHappyAtAll ++happyReduce_758 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_758 = happySpecReduce_1  286# happyReduction_758+happyReduction_758 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkQual varName (getQVARID happy_var_1)+	)+happyReduction_758 _  = notHappyAtAll ++happyReduce_759 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_759 = happySpecReduce_1  287# happyReduction_759+happyReduction_759 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual varName (getVARID happy_var_1)+	)+happyReduction_759 _  = notHappyAtAll ++happyReduce_760 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_760 = happySpecReduce_1  287# happyReduction_760+happyReduction_760 (HappyAbsSyn25  happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual varName (unLoc happy_var_1)+	)+happyReduction_760 _  = notHappyAtAll ++happyReduce_761 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_761 = happySpecReduce_1  287# happyReduction_761+happyReduction_761 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual varName (fsLit "unsafe")+	)+happyReduction_761 _  = notHappyAtAll ++happyReduce_762 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_762 = happySpecReduce_1  287# happyReduction_762+happyReduction_762 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual varName (fsLit "safe")+	)+happyReduction_762 _  = notHappyAtAll ++happyReduce_763 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_763 = happySpecReduce_1  287# happyReduction_763+happyReduction_763 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual varName (fsLit "interruptible")+	)+happyReduction_763 _  = notHappyAtAll ++happyReduce_764 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_764 = happySpecReduce_1  287# happyReduction_764+happyReduction_764 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual varName (fsLit "forall")+	)+happyReduction_764 _  = notHappyAtAll ++happyReduce_765 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_765 = happySpecReduce_1  287# happyReduction_765+happyReduction_765 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual varName (fsLit "family")+	)+happyReduction_765 _  = notHappyAtAll ++happyReduce_766 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_766 = happySpecReduce_1  287# happyReduction_766+happyReduction_766 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkUnqual varName (fsLit "role")+	)+happyReduction_766 _  = notHappyAtAll ++happyReduce_767 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_767 = happySpecReduce_1  288# happyReduction_767+happyReduction_767 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_767 _  = notHappyAtAll ++happyReduce_768 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_768 = happySpecReduce_1  288# happyReduction_768+happyReduction_768 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_768 _  = notHappyAtAll ++happyReduce_769 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_769 = happySpecReduce_1  289# happyReduction_769+happyReduction_769 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_769 _  = notHappyAtAll ++happyReduce_770 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_770 = happySpecReduce_1  289# happyReduction_770+happyReduction_770 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_770 _  = notHappyAtAll ++happyReduce_771 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_771 = happySpecReduce_1  290# happyReduction_771+happyReduction_771 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $ mkQual varName (getQVARSYM happy_var_1)+	)+happyReduction_771 _  = notHappyAtAll ++happyReduce_772 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_772 = happySpecReduce_1  291# happyReduction_772+happyReduction_772 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_772 _  = notHappyAtAll ++happyReduce_773 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_773 = happySpecReduce_1  291# happyReduction_773+happyReduction_773 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $ mkUnqual varName (fsLit "-")+	)+happyReduction_773 _  = notHappyAtAll ++happyReduce_774 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_774 = happySpecReduce_1  292# happyReduction_774+happyReduction_774 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $ mkUnqual varName (getVARSYM happy_var_1)+	)+happyReduction_774 _  = notHappyAtAll ++happyReduce_775 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_775 = happySpecReduce_1  292# happyReduction_775+happyReduction_775 (HappyAbsSyn25  happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $ mkUnqual varName (unLoc happy_var_1)+	)+happyReduction_775 _  = notHappyAtAll ++happyReduce_776 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_776 = happySpecReduce_1  293# happyReduction_776+happyReduction_776 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "as")+	)+happyReduction_776 _  = notHappyAtAll ++happyReduce_777 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_777 = happySpecReduce_1  293# happyReduction_777+happyReduction_777 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "qualified")+	)+happyReduction_777 _  = notHappyAtAll ++happyReduce_778 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_778 = happySpecReduce_1  293# happyReduction_778+happyReduction_778 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "hiding")+	)+happyReduction_778 _  = notHappyAtAll ++happyReduce_779 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_779 = happySpecReduce_1  293# happyReduction_779+happyReduction_779 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "export")+	)+happyReduction_779 _  = notHappyAtAll ++happyReduce_780 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_780 = happySpecReduce_1  293# happyReduction_780+happyReduction_780 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "label")+	)+happyReduction_780 _  = notHappyAtAll ++happyReduce_781 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_781 = happySpecReduce_1  293# happyReduction_781+happyReduction_781 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "dynamic")+	)+happyReduction_781 _  = notHappyAtAll ++happyReduce_782 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_782 = happySpecReduce_1  293# happyReduction_782+happyReduction_782 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "stdcall")+	)+happyReduction_782 _  = notHappyAtAll ++happyReduce_783 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_783 = happySpecReduce_1  293# happyReduction_783+happyReduction_783 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "ccall")+	)+happyReduction_783 _  = notHappyAtAll ++happyReduce_784 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_784 = happySpecReduce_1  293# happyReduction_784+happyReduction_784 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "capi")+	)+happyReduction_784 _  = notHappyAtAll ++happyReduce_785 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_785 = happySpecReduce_1  293# happyReduction_785+happyReduction_785 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "prim")+	)+happyReduction_785 _  = notHappyAtAll ++happyReduce_786 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_786 = happySpecReduce_1  293# happyReduction_786+happyReduction_786 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "javascript")+	)+happyReduction_786 _  = notHappyAtAll ++happyReduce_787 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_787 = happySpecReduce_1  293# happyReduction_787+happyReduction_787 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "group")+	)+happyReduction_787 _  = notHappyAtAll ++happyReduce_788 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_788 = happySpecReduce_1  293# happyReduction_788+happyReduction_788 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "stock")+	)+happyReduction_788 _  = notHappyAtAll ++happyReduce_789 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_789 = happySpecReduce_1  293# happyReduction_789+happyReduction_789 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "anyclass")+	)+happyReduction_789 _  = notHappyAtAll ++happyReduce_790 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_790 = happySpecReduce_1  293# happyReduction_790+happyReduction_790 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "via")+	)+happyReduction_790 _  = notHappyAtAll ++happyReduce_791 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_791 = happySpecReduce_1  293# happyReduction_791+happyReduction_791 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "unit")+	)+happyReduction_791 _  = notHappyAtAll ++happyReduce_792 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_792 = happySpecReduce_1  293# happyReduction_792+happyReduction_792 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "dependency")+	)+happyReduction_792 _  = notHappyAtAll ++happyReduce_793 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_793 = happySpecReduce_1  293# happyReduction_793+happyReduction_793 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit "signature")+	)+happyReduction_793 _  = notHappyAtAll ++happyReduce_794 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_794 = happyMonadReduce 1# 294# happyReduction_794+happyReduction_794 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( ams (sL1 happy_var_1 (fsLit "!")) [mj AnnBang happy_var_1]))+	) (\r -> happyReturn (HappyAbsSyn25 r))++happyReduce_795 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_795 = happySpecReduce_1  294# happyReduction_795+happyReduction_795 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit ".")+	)+happyReduction_795 _  = notHappyAtAll ++happyReduce_796 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_796 = happySpecReduce_1  294# happyReduction_796+happyReduction_796 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn25+		 (sL1 happy_var_1 (fsLit (starSym (isUnicode happy_var_1)))+	)+happyReduction_796 _  = notHappyAtAll ++happyReduce_797 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_797 = happySpecReduce_1  295# happyReduction_797+happyReduction_797 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_797 _  = notHappyAtAll ++happyReduce_798 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_798 = happySpecReduce_1  295# happyReduction_798+happyReduction_798 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $! mkQual dataName (getQCONID happy_var_1)+	)+happyReduction_798 _  = notHappyAtAll ++happyReduce_799 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_799 = happySpecReduce_1  296# happyReduction_799+happyReduction_799 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $ mkUnqual dataName (getCONID happy_var_1)+	)+happyReduction_799 _  = notHappyAtAll ++happyReduce_800 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_800 = happySpecReduce_1  297# happyReduction_800+happyReduction_800 (HappyAbsSyn16  happy_var_1)+	 =  HappyAbsSyn16+		 (happy_var_1+	)+happyReduction_800 _  = notHappyAtAll ++happyReduce_801 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_801 = happySpecReduce_1  297# happyReduction_801+happyReduction_801 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $ mkQual dataName (getQCONSYM happy_var_1)+	)+happyReduction_801 _  = notHappyAtAll ++happyReduce_802 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_802 = happySpecReduce_1  298# happyReduction_802+happyReduction_802 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $ mkUnqual dataName (getCONSYM happy_var_1)+	)+happyReduction_802 _  = notHappyAtAll ++happyReduce_803 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_803 = happySpecReduce_1  298# happyReduction_803+happyReduction_803 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn16+		 (sL1 happy_var_1 $ consDataCon_RDR+	)+happyReduction_803 _  = notHappyAtAll ++happyReduce_804 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_804 = happySpecReduce_1  299# happyReduction_804+happyReduction_804 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn315+		 (sL1 happy_var_1 $ HsChar       (getCHARs happy_var_1) $ getCHAR happy_var_1+	)+happyReduction_804 _  = notHappyAtAll ++happyReduce_805 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_805 = happySpecReduce_1  299# happyReduction_805+happyReduction_805 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn315+		 (sL1 happy_var_1 $ HsString     (getSTRINGs happy_var_1)+                                                    $ getSTRING happy_var_1+	)+happyReduction_805 _  = notHappyAtAll ++happyReduce_806 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_806 = happySpecReduce_1  299# happyReduction_806+happyReduction_806 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn315+		 (sL1 happy_var_1 $ HsIntPrim    (getPRIMINTEGERs happy_var_1)+                                                    $ getPRIMINTEGER happy_var_1+	)+happyReduction_806 _  = notHappyAtAll ++happyReduce_807 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_807 = happySpecReduce_1  299# happyReduction_807+happyReduction_807 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn315+		 (sL1 happy_var_1 $ HsWordPrim   (getPRIMWORDs happy_var_1)+                                                    $ getPRIMWORD happy_var_1+	)+happyReduction_807 _  = notHappyAtAll ++happyReduce_808 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_808 = happySpecReduce_1  299# happyReduction_808+happyReduction_808 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn315+		 (sL1 happy_var_1 $ HsCharPrim   (getPRIMCHARs happy_var_1)+                                                    $ getPRIMCHAR happy_var_1+	)+happyReduction_808 _  = notHappyAtAll ++happyReduce_809 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_809 = happySpecReduce_1  299# happyReduction_809+happyReduction_809 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn315+		 (sL1 happy_var_1 $ HsStringPrim (getPRIMSTRINGs happy_var_1)+                                                    $ getPRIMSTRING happy_var_1+	)+happyReduction_809 _  = notHappyAtAll ++happyReduce_810 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_810 = happySpecReduce_1  299# happyReduction_810+happyReduction_810 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn315+		 (sL1 happy_var_1 $ HsFloatPrim  noExt $ getPRIMFLOAT happy_var_1+	)+happyReduction_810 _  = notHappyAtAll ++happyReduce_811 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_811 = happySpecReduce_1  299# happyReduction_811+happyReduction_811 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn315+		 (sL1 happy_var_1 $ HsDoublePrim noExt $ getPRIMDOUBLE happy_var_1+	)+happyReduction_811 _  = notHappyAtAll ++happyReduce_812 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_812 = happySpecReduce_1  300# happyReduction_812+happyReduction_812 _+	 =  HappyAbsSyn36+		 (()+	)++happyReduce_813 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_813 = happyMonadReduce 1# 300# happyReduction_813+happyReduction_813 (_ `HappyStk`+	happyRest) tk+	 = happyThen ((( popContext))+	) (\r -> happyReturn (HappyAbsSyn36 r))++happyReduce_814 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_814 = happySpecReduce_1  301# happyReduction_814+happyReduction_814 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn317+		 (sL1 happy_var_1 $ mkModuleNameFS (getCONID happy_var_1)+	)+happyReduction_814 _  = notHappyAtAll ++happyReduce_815 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_815 = happySpecReduce_1  301# happyReduction_815+happyReduction_815 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn317+		 (sL1 happy_var_1 $ let (mod,c) = getQCONID happy_var_1 in+                                  mkModuleNameFS+                                   (mkFastString+                                     (unpackFS mod ++ '.':unpackFS c))+	)+happyReduction_815 _  = notHappyAtAll ++happyReduce_816 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_816 = happySpecReduce_2  302# happyReduction_816+happyReduction_816 (HappyTerminal happy_var_2)+	(HappyAbsSyn318  happy_var_1)+	 =  HappyAbsSyn318+		 (((fst happy_var_1)++[gl happy_var_2],snd happy_var_1 + 1)+	)+happyReduction_816 _ _  = notHappyAtAll ++happyReduce_817 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_817 = happySpecReduce_1  302# happyReduction_817+happyReduction_817 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn318+		 (([gl happy_var_1],1)+	)+happyReduction_817 _  = notHappyAtAll ++happyReduce_818 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_818 = happySpecReduce_1  303# happyReduction_818+happyReduction_818 (HappyAbsSyn318  happy_var_1)+	 =  HappyAbsSyn318+		 (happy_var_1+	)+happyReduction_818 _  = notHappyAtAll ++happyReduce_819 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_819 = happySpecReduce_0  303# happyReduction_819+happyReduction_819  =  HappyAbsSyn318+		 (([], 0)+	)++happyReduce_820 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_820 = happySpecReduce_2  304# happyReduction_820+happyReduction_820 (HappyTerminal happy_var_2)+	(HappyAbsSyn318  happy_var_1)+	 =  HappyAbsSyn318+		 (((fst happy_var_1)++[gl happy_var_2],snd happy_var_1 + 1)+	)+happyReduction_820 _ _  = notHappyAtAll ++happyReduce_821 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_821 = happySpecReduce_1  304# happyReduction_821+happyReduction_821 (HappyTerminal happy_var_1)+	 =  HappyAbsSyn318+		 (([gl happy_var_1],1)+	)+happyReduction_821 _  = notHappyAtAll ++happyReduce_822 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_822 = happyMonadReduce 1# 305# happyReduction_822+happyReduction_822 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( return (sL1 happy_var_1 (mkHsDocString (getDOCNEXT happy_var_1)))))+	) (\r -> happyReturn (HappyAbsSyn321 r))++happyReduce_823 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_823 = happyMonadReduce 1# 306# happyReduction_823+happyReduction_823 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( return (sL1 happy_var_1 (mkHsDocString (getDOCPREV happy_var_1)))))+	) (\r -> happyReturn (HappyAbsSyn321 r))++happyReduce_824 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_824 = happyMonadReduce 1# 307# happyReduction_824+happyReduction_824 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen (((+      let string = getDOCNAMED happy_var_1+          (name, rest) = break isSpace string+      in return (sL1 happy_var_1 (name, mkHsDocString rest))))+	) (\r -> happyReturn (HappyAbsSyn323 r))++happyReduce_825 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_825 = happyMonadReduce 1# 308# happyReduction_825+happyReduction_825 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let (n, doc) = getDOCSECTION happy_var_1 in+        return (sL1 happy_var_1 (n, mkHsDocString doc))))+	) (\r -> happyReturn (HappyAbsSyn324 r))++happyReduce_826 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_826 = happyMonadReduce 1# 309# happyReduction_826+happyReduction_826 ((HappyTerminal happy_var_1) `HappyStk`+	happyRest) tk+	 = happyThen ((( let string = getDOCNEXT happy_var_1 in+                     return (Just (sL1 happy_var_1 (mkHsDocString string)))))+	) (\r -> happyReturn (HappyAbsSyn35 r))++happyReduce_827 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_827 = happySpecReduce_1  310# happyReduction_827+happyReduction_827 (HappyAbsSyn321  happy_var_1)+	 =  HappyAbsSyn35+		 (Just happy_var_1+	)+happyReduction_827 _  = notHappyAtAll ++happyReduce_828 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_828 = happySpecReduce_0  310# happyReduction_828+happyReduction_828  =  HappyAbsSyn35+		 (Nothing+	)++happyReduce_829 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_829 = happySpecReduce_1  311# happyReduction_829+happyReduction_829 (HappyAbsSyn321  happy_var_1)+	 =  HappyAbsSyn35+		 (Just happy_var_1+	)+happyReduction_829 _  = notHappyAtAll ++happyReduce_830 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )+happyReduce_830 = happySpecReduce_0  311# happyReduction_830+happyReduction_830  =  HappyAbsSyn35+		 (Nothing+	)++happyNewToken action sts stk+	= (lexer True)(\tk -> +	let cont i = happyDoAction i tk action sts stk in+	case tk of {+	L _ ITeof -> happyDoAction 153# tk action sts stk;+	L _ ITunderscore -> cont 1#;+	L _ ITas -> cont 2#;+	L _ ITcase -> cont 3#;+	L _ ITclass -> cont 4#;+	L _ ITdata -> cont 5#;+	L _ ITdefault -> cont 6#;+	L _ ITderiving -> cont 7#;+	L _ ITdo -> cont 8#;+	L _ ITelse -> cont 9#;+	L _ IThiding -> cont 10#;+	L _ ITif -> cont 11#;+	L _ ITimport -> cont 12#;+	L _ ITin -> cont 13#;+	L _ ITinfix -> cont 14#;+	L _ ITinfixl -> cont 15#;+	L _ ITinfixr -> cont 16#;+	L _ ITinstance -> cont 17#;+	L _ ITlet -> cont 18#;+	L _ ITmodule -> cont 19#;+	L _ ITnewtype -> cont 20#;+	L _ ITof -> cont 21#;+	L _ ITqualified -> cont 22#;+	L _ ITthen -> cont 23#;+	L _ ITtype -> cont 24#;+	L _ ITwhere -> cont 25#;+	L _ (ITforall _) -> cont 26#;+	L _ ITforeign -> cont 27#;+	L _ ITexport -> cont 28#;+	L _ ITlabel -> cont 29#;+	L _ ITdynamic -> cont 30#;+	L _ ITsafe -> cont 31#;+	L _ ITinterruptible -> cont 32#;+	L _ ITunsafe -> cont 33#;+	L _ ITmdo -> cont 34#;+	L _ ITfamily -> cont 35#;+	L _ ITrole -> cont 36#;+	L _ ITstdcallconv -> cont 37#;+	L _ ITccallconv -> cont 38#;+	L _ ITcapiconv -> cont 39#;+	L _ ITprimcallconv -> cont 40#;+	L _ ITjavascriptcallconv -> cont 41#;+	L _ ITproc -> cont 42#;+	L _ ITrec -> cont 43#;+	L _ ITgroup -> cont 44#;+	L _ ITby -> cont 45#;+	L _ ITusing -> cont 46#;+	L _ ITpattern -> cont 47#;+	L _ ITstatic -> cont 48#;+	L _ ITstock -> cont 49#;+	L _ ITanyclass -> cont 50#;+	L _ ITvia -> cont 51#;+	L _ ITunit -> cont 52#;+	L _ ITsignature -> cont 53#;+	L _ ITdependency -> cont 54#;+	L _ (ITinline_prag _ _ _) -> cont 55#;+	L _ (ITspec_prag _) -> cont 56#;+	L _ (ITspec_inline_prag _ _) -> cont 57#;+	L _ (ITsource_prag _) -> cont 58#;+	L _ (ITrules_prag _) -> cont 59#;+	L _ (ITcore_prag _) -> cont 60#;+	L _ (ITscc_prag _) -> cont 61#;+	L _ (ITgenerated_prag _) -> cont 62#;+	L _ (ITdeprecated_prag _) -> cont 63#;+	L _ (ITwarning_prag _) -> cont 64#;+	L _ (ITunpack_prag _) -> cont 65#;+	L _ (ITnounpack_prag _) -> cont 66#;+	L _ (ITann_prag _) -> cont 67#;+	L _ (ITminimal_prag _) -> cont 68#;+	L _ (ITctype _) -> cont 69#;+	L _ (IToverlapping_prag _) -> cont 70#;+	L _ (IToverlappable_prag _) -> cont 71#;+	L _ (IToverlaps_prag _) -> cont 72#;+	L _ (ITincoherent_prag _) -> cont 73#;+	L _ (ITcomplete_prag _) -> cont 74#;+	L _ ITclose_prag -> cont 75#;+	L _ ITdotdot -> cont 76#;+	L _ ITcolon -> cont 77#;+	L _ (ITdcolon _) -> cont 78#;+	L _ ITequal -> cont 79#;+	L _ ITlam -> cont 80#;+	L _ ITlcase -> cont 81#;+	L _ ITvbar -> cont 82#;+	L _ (ITlarrow _) -> cont 83#;+	L _ (ITrarrow _) -> cont 84#;+	L _ ITat -> cont 85#;+	L _ ITtilde -> cont 86#;+	L _ (ITdarrow _) -> cont 87#;+	L _ ITminus -> cont 88#;+	L _ ITbang -> cont 89#;+	L _ (ITstar _) -> cont 90#;+	L _ (ITlarrowtail _) -> cont 91#;+	L _ (ITrarrowtail _) -> cont 92#;+	L _ (ITLarrowtail _) -> cont 93#;+	L _ (ITRarrowtail _) -> cont 94#;+	L _ ITdot -> cont 95#;+	L _ ITtypeApp -> cont 96#;+	L _ ITocurly -> cont 97#;+	L _ ITccurly -> cont 98#;+	L _ ITvocurly -> cont 99#;+	L _ ITvccurly -> cont 100#;+	L _ ITobrack -> cont 101#;+	L _ ITcbrack -> cont 102#;+	L _ ITopabrack -> cont 103#;+	L _ ITcpabrack -> cont 104#;+	L _ IToparen -> cont 105#;+	L _ ITcparen -> cont 106#;+	L _ IToubxparen -> cont 107#;+	L _ ITcubxparen -> cont 108#;+	L _ (IToparenbar _) -> cont 109#;+	L _ (ITcparenbar _) -> cont 110#;+	L _ ITsemi -> cont 111#;+	L _ ITcomma -> cont 112#;+	L _ ITbackquote -> cont 113#;+	L _ ITsimpleQuote -> cont 114#;+	L _ (ITvarid    _) -> cont 115#;+	L _ (ITconid    _) -> cont 116#;+	L _ (ITvarsym   _) -> cont 117#;+	L _ (ITconsym   _) -> cont 118#;+	L _ (ITqvarid   _) -> cont 119#;+	L _ (ITqconid   _) -> cont 120#;+	L _ (ITqvarsym  _) -> cont 121#;+	L _ (ITqconsym  _) -> cont 122#;+	L _ (ITdupipvarid   _) -> cont 123#;+	L _ (ITlabelvarid   _) -> cont 124#;+	L _ (ITchar   _ _) -> cont 125#;+	L _ (ITstring _ _) -> cont 126#;+	L _ (ITinteger _) -> cont 127#;+	L _ (ITrational _) -> cont 128#;+	L _ (ITprimchar   _ _) -> cont 129#;+	L _ (ITprimstring _ _) -> cont 130#;+	L _ (ITprimint    _ _) -> cont 131#;+	L _ (ITprimword   _ _) -> cont 132#;+	L _ (ITprimfloat  _) -> cont 133#;+	L _ (ITprimdouble _) -> cont 134#;+	L _ (ITdocCommentNext _) -> cont 135#;+	L _ (ITdocCommentPrev _) -> cont 136#;+	L _ (ITdocCommentNamed _) -> cont 137#;+	L _ (ITdocSection _ _) -> cont 138#;+	L _ (ITopenExpQuote _ _) -> cont 139#;+	L _ ITopenPatQuote -> cont 140#;+	L _ ITopenTypQuote -> cont 141#;+	L _ ITopenDecQuote -> cont 142#;+	L _ (ITcloseQuote _) -> cont 143#;+	L _ (ITopenTExpQuote _) -> cont 144#;+	L _ ITcloseTExpQuote -> cont 145#;+	L _ (ITidEscape _) -> cont 146#;+	L _ ITparenEscape -> cont 147#;+	L _ (ITidTyEscape _) -> cont 148#;+	L _ ITparenTyEscape -> cont 149#;+	L _ ITtyQuote -> cont 150#;+	L _ (ITquasiQuote _) -> cont 151#;+	L _ (ITqQuasiQuote _) -> cont 152#;+	_ -> happyError' (tk, [])+	})++happyError_ explist 153# tk = happyError' (tk, explist)+happyError_ explist _ tk = happyError' (tk, explist)++happyThen :: () => P a -> (a -> P b) -> P b+happyThen = (>>=)+happyReturn :: () => a -> P a+happyReturn = (return)+happyParse :: () => Happy_GHC_Exts.Int# -> P (HappyAbsSyn )++happyNewToken :: () => Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )++happyDoAction :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )++happyReduceArr :: () => Happy_Data_Array.Array Int (Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ))++happyThen1 :: () => P a -> (a -> P b) -> P b+happyThen1 = happyThen+happyReturn1 :: () => a -> P a+happyReturn1 = happyReturn+happyError' :: () => (((Located Token)), [String]) -> P a+happyError' tk = (\(tokens, explist) -> happyError) tk+parseModule = happySomeParser where+ happySomeParser = happyThen (happyParse 0#) (\x -> case x of {HappyAbsSyn33 z -> happyReturn z; _other -> notHappyAtAll })++parseSignature = happySomeParser where+ happySomeParser = happyThen (happyParse 1#) (\x -> case x of {HappyAbsSyn33 z -> happyReturn z; _other -> notHappyAtAll })++parseImport = happySomeParser where+ happySomeParser = happyThen (happyParse 2#) (\x -> case x of {HappyAbsSyn64 z -> happyReturn z; _other -> notHappyAtAll })++parseStatement = happySomeParser where+ happySomeParser = happyThen (happyParse 3#) (\x -> case x of {HappyAbsSyn254 z -> happyReturn z; _other -> notHappyAtAll })++parseDeclaration = happySomeParser where+ happySomeParser = happyThen (happyParse 4#) (\x -> case x of {HappyAbsSyn77 z -> happyReturn z; _other -> notHappyAtAll })++parseExpression = happySomeParser where+ happySomeParser = happyThen (happyParse 5#) (\x -> case x of {HappyAbsSyn207 z -> happyReturn z; _other -> notHappyAtAll })++parsePattern = happySomeParser where+ happySomeParser = happyThen (happyParse 6#) (\x -> case x of {HappyAbsSyn247 z -> happyReturn z; _other -> notHappyAtAll })++parseTypeSignature = happySomeParser where+ happySomeParser = happyThen (happyParse 7#) (\x -> case x of {HappyAbsSyn77 z -> happyReturn z; _other -> notHappyAtAll })++parseStmt = happySomeParser where+ happySomeParser = happyThen (happyParse 8#) (\x -> case x of {HappyAbsSyn253 z -> happyReturn z; _other -> notHappyAtAll })++parseIdentifier = happySomeParser where+ happySomeParser = happyThen (happyParse 9#) (\x -> case x of {HappyAbsSyn16 z -> happyReturn z; _other -> notHappyAtAll })++parseType = happySomeParser where+ happySomeParser = happyThen (happyParse 10#) (\x -> case x of {HappyAbsSyn147 z -> happyReturn z; _other -> notHappyAtAll })++parseBackpack = happySomeParser where+ happySomeParser = happyThen (happyParse 11#) (\x -> case x of {HappyAbsSyn17 z -> happyReturn z; _other -> notHappyAtAll })++parseHeader = happySomeParser where+ happySomeParser = happyThen (happyParse 12#) (\x -> case x of {HappyAbsSyn33 z -> happyReturn z; _other -> notHappyAtAll })++happySeq = happyDoSeq+++happyError :: P a+happyError = srcParseFail++getVARID        (dL->L _ (ITvarid    x)) = x+getCONID        (dL->L _ (ITconid    x)) = x+getVARSYM       (dL->L _ (ITvarsym   x)) = x+getCONSYM       (dL->L _ (ITconsym   x)) = x+getQVARID       (dL->L _ (ITqvarid   x)) = x+getQCONID       (dL->L _ (ITqconid   x)) = x+getQVARSYM      (dL->L _ (ITqvarsym  x)) = x+getQCONSYM      (dL->L _ (ITqconsym  x)) = x+getIPDUPVARID   (dL->L _ (ITdupipvarid   x)) = x+getLABELVARID   (dL->L _ (ITlabelvarid   x)) = x+getCHAR         (dL->L _ (ITchar   _ x)) = x+getSTRING       (dL->L _ (ITstring _ x)) = x+getINTEGER      (dL->L _ (ITinteger x))  = x+getRATIONAL     (dL->L _ (ITrational x)) = x+getPRIMCHAR     (dL->L _ (ITprimchar _ x)) = x+getPRIMSTRING   (dL->L _ (ITprimstring _ x)) = x+getPRIMINTEGER  (dL->L _ (ITprimint  _ x)) = x+getPRIMWORD     (dL->L _ (ITprimword _ x)) = x+getPRIMFLOAT    (dL->L _ (ITprimfloat x)) = x+getPRIMDOUBLE   (dL->L _ (ITprimdouble x)) = x+getTH_ID_SPLICE (dL->L _ (ITidEscape x)) = x+getTH_ID_TY_SPLICE (dL->L _ (ITidTyEscape x)) = x+getINLINE       (dL->L _ (ITinline_prag _ inl conl)) = (inl,conl)+getSPEC_INLINE  (dL->L _ (ITspec_inline_prag _ True))  = (Inline,  FunLike)+getSPEC_INLINE  (dL->L _ (ITspec_inline_prag _ False)) = (NoInline,FunLike)+getCOMPLETE_PRAGs (dL->L _ (ITcomplete_prag x)) = x++getDOCNEXT (dL->L _ (ITdocCommentNext x)) = x+getDOCPREV (dL->L _ (ITdocCommentPrev x)) = x+getDOCNAMED (dL->L _ (ITdocCommentNamed x)) = x+getDOCSECTION (dL->L _ (ITdocSection n x)) = (n, x)++getINTEGERs     (dL->L _ (ITinteger (IL src _ _))) = src+getCHARs        (dL->L _ (ITchar       src _)) = src+getSTRINGs      (dL->L _ (ITstring     src _)) = src+getPRIMCHARs    (dL->L _ (ITprimchar   src _)) = src+getPRIMSTRINGs  (dL->L _ (ITprimstring src _)) = src+getPRIMINTEGERs (dL->L _ (ITprimint    src _)) = src+getPRIMWORDs    (dL->L _ (ITprimword   src _)) = src++-- See Note [Pragma source text] in BasicTypes for the following+getINLINE_PRAGs       (dL->L _ (ITinline_prag       src _ _)) = src+getSPEC_PRAGs         (dL->L _ (ITspec_prag         src))     = src+getSPEC_INLINE_PRAGs  (dL->L _ (ITspec_inline_prag  src _))   = src+getSOURCE_PRAGs       (dL->L _ (ITsource_prag       src)) = src+getRULES_PRAGs        (dL->L _ (ITrules_prag        src)) = src+getWARNING_PRAGs      (dL->L _ (ITwarning_prag      src)) = src+getDEPRECATED_PRAGs   (dL->L _ (ITdeprecated_prag   src)) = src+getSCC_PRAGs          (dL->L _ (ITscc_prag          src)) = src+getGENERATED_PRAGs    (dL->L _ (ITgenerated_prag    src)) = src+getCORE_PRAGs         (dL->L _ (ITcore_prag         src)) = src+getUNPACK_PRAGs       (dL->L _ (ITunpack_prag       src)) = src+getNOUNPACK_PRAGs     (dL->L _ (ITnounpack_prag     src)) = src+getANN_PRAGs          (dL->L _ (ITann_prag          src)) = src+getMINIMAL_PRAGs      (dL->L _ (ITminimal_prag      src)) = src+getOVERLAPPABLE_PRAGs (dL->L _ (IToverlappable_prag src)) = src+getOVERLAPPING_PRAGs  (dL->L _ (IToverlapping_prag  src)) = src+getOVERLAPS_PRAGs     (dL->L _ (IToverlaps_prag     src)) = src+getINCOHERENT_PRAGs   (dL->L _ (ITincoherent_prag   src)) = src+getCTYPEs             (dL->L _ (ITctype             src)) = src++getStringLiteral l = StringLiteral (getSTRINGs l) (getSTRING l)++isUnicode :: Located Token -> Bool+isUnicode (dL->L _ (ITforall         iu)) = iu == UnicodeSyntax+isUnicode (dL->L _ (ITdarrow         iu)) = iu == UnicodeSyntax+isUnicode (dL->L _ (ITdcolon         iu)) = iu == UnicodeSyntax+isUnicode (dL->L _ (ITlarrow         iu)) = iu == UnicodeSyntax+isUnicode (dL->L _ (ITrarrow         iu)) = iu == UnicodeSyntax+isUnicode (dL->L _ (ITlarrowtail     iu)) = iu == UnicodeSyntax+isUnicode (dL->L _ (ITrarrowtail     iu)) = iu == UnicodeSyntax+isUnicode (dL->L _ (ITLarrowtail     iu)) = iu == UnicodeSyntax+isUnicode (dL->L _ (ITRarrowtail     iu)) = iu == UnicodeSyntax+isUnicode (dL->L _ (IToparenbar      iu)) = iu == UnicodeSyntax+isUnicode (dL->L _ (ITcparenbar      iu)) = iu == UnicodeSyntax+isUnicode (dL->L _ (ITopenExpQuote _ iu)) = iu == UnicodeSyntax+isUnicode (dL->L _ (ITcloseQuote     iu)) = iu == UnicodeSyntax+isUnicode (dL->L _ (ITstar           iu)) = iu == UnicodeSyntax+isUnicode _                           = False++hasE :: Located Token -> Bool+hasE (dL->L _ (ITopenExpQuote HasE _)) = True+hasE (dL->L _ (ITopenTExpQuote HasE))  = True+hasE _                             = False++getSCC :: Located Token -> P FastString+getSCC lt = do let s = getSTRING lt+                   err = "Spaces are not allowed in SCCs"+               -- We probably actually want to be more restrictive than this+               if ' ' `elem` unpackFS s+                   then addFatalError (getLoc lt) (text err)+                   else return s++-- Utilities for combining source spans+comb2 :: (HasSrcSpan a , HasSrcSpan b) => a -> b -> SrcSpan+comb2 a b = a `seq` b `seq` combineLocs a b++comb3 :: (HasSrcSpan a , HasSrcSpan b , HasSrcSpan c) =>+         a -> b -> c -> SrcSpan+comb3 a b c = a `seq` b `seq` c `seq`+    combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))++comb4 :: (HasSrcSpan a , HasSrcSpan b , HasSrcSpan c , HasSrcSpan d) =>+         a -> b -> c -> d -> SrcSpan+comb4 a b c d = a `seq` b `seq` c `seq` d `seq`+    (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $+                combineSrcSpans (getLoc c) (getLoc d))++-- strict constructor version:+{-# INLINE sL #-}+sL :: HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a+sL span a = span `seq` a `seq` cL span a++-- See Note [Adding location info] for how these utility functions are used++-- replaced last 3 CPP macros in this file+{-# INLINE sL0 #-}+sL0 :: HasSrcSpan a => SrcSpanLess a -> a+sL0 = cL noSrcSpan       -- #define L0   L noSrcSpan++{-# INLINE sL1 #-}+sL1 :: (HasSrcSpan a , HasSrcSpan b) => a -> SrcSpanLess b -> b+sL1 x = sL (getLoc x)   -- #define sL1   sL (getLoc $1)++{-# INLINE sLL #-}+sLL :: (HasSrcSpan a , HasSrcSpan b , HasSrcSpan c) =>+       a -> b -> SrcSpanLess c -> c+sLL x y = sL (comb2 x y) -- #define LL   sL (comb2 $1 $>)++{- Note [Adding location info]+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~++This is done using the three functions below, sL0, sL1+and sLL.  Note that these functions were mechanically+converted from the three macros that used to exist before,+namely L0, L1 and LL.++They each add a SrcSpan to their argument.++   sL0  adds 'noSrcSpan', used for empty productions+     -- This doesn't seem to work anymore -=chak++   sL1  for a production with a single token on the lhs.  Grabs the SrcSpan+        from that token.++   sLL  for a production with >1 token on the lhs.  Makes up a SrcSpan from+        the first and last tokens.++These suffice for the majority of cases.  However, we must be+especially careful with empty productions: sLL won't work if the first+or last token on the lhs can represent an empty span.  In these cases,+we have to calculate the span using more of the tokens from the lhs, eg.++        | 'newtype' tycl_hdr '=' newconstr deriving+                { L (comb3 $1 $4 $5)+                    (mkTyData NewType (unLoc $2) $4 (unLoc $5)) }++We provide comb3 and comb4 functions which are useful in such cases.++Be careful: there's no checking that you actually got this right, the+only symptom will be that the SrcSpans of your syntax will be+incorrect.++-}++-- Make a source location for the file.  We're a bit lazy here and just+-- make a point SrcSpan at line 1, column 0.  Strictly speaking we should+-- try to find the span of the whole file (ToDo).+fileSrcSpan :: P SrcSpan+fileSrcSpan = do+  l <- getRealSrcLoc;+  let loc = mkSrcLoc (srcLocFile l) 1 1;+  return (mkSrcSpan loc loc)++-- Hint about the MultiWayIf extension+hintMultiWayIf :: SrcSpan -> P ()+hintMultiWayIf span = do+  mwiEnabled <- getBit MultiWayIfBit+  unless mwiEnabled $ addError span $+    text "Multi-way if-expressions need MultiWayIf turned on"++-- Hint about explicit-forall+hintExplicitForall :: Located Token -> P ()+hintExplicitForall tok = do+    forall   <- getBit ExplicitForallBit+    rulePrag <- getBit InRulePragBit+    unless (forall || rulePrag) $ addError (getLoc tok) $ vcat+      [ text "Illegal symbol" <+> quotes forallSymDoc <+> text "in type"+      , text "Perhaps you intended to use RankNTypes or a similar language"+      , text "extension to enable explicit-forall syntax:" <+>+        forallSymDoc <+> text "<tvs>. <type>"+      ]+  where+    forallSymDoc = text (forallSym (isUnicode tok))++checkIfBang :: LHsExpr GhcPs -> Bool+checkIfBang (dL->L _ (HsVar _ (dL->L _ op))) = op == bang_RDR+checkIfBang _ = False++-- | Warn about missing space after bang+warnSpaceAfterBang :: SrcSpan -> P ()+warnSpaceAfterBang span = do+    bang_on <- getBit BangPatBit+    unless bang_on $+      addWarning Opt_WarnSpaceAfterBang span msg+    where+      msg = text "Did you forget to enable BangPatterns?" $$+            text "If you mean to bind (!) then perhaps you want" $$+            text "to add a space after the bang for clarity."++-- When two single quotes don't followed by tyvar or gtycon, we report the+-- error as empty character literal, or TH quote that missing proper type+-- variable or constructor. See #13450.+reportEmptyDoubleQuotes :: SrcSpan -> P a+reportEmptyDoubleQuotes span = do+    thQuotes <- getBit ThQuotesBit+    if thQuotes+      then addFatalError span $ vcat+        [ text "Parser error on `''`"+        , text "Character literals may not be empty"+        , text "Or perhaps you intended to use quotation syntax of TemplateHaskell,"+        , text "but the type variable or constructor is missing"+        ]+      else addFatalError span $ vcat+        [ text "Parser error on `''`"+        , text "Character literals may not be empty"+        ]++{-+%************************************************************************+%*                                                                      *+        Helper functions for generating annotations in the parser+%*                                                                      *+%************************************************************************++For the general principles of the following routines, see Note [Api annotations]+in ApiAnnotation.hs++-}++-- |Construct an AddAnn from the annotation keyword and the location+-- of the keyword itself+mj :: HasSrcSpan e => AnnKeywordId -> e -> AddAnn+mj a l s = addAnnotation s a (gl l)++mjL :: AnnKeywordId -> SrcSpan -> AddAnn+mjL a l s = addAnnotation s a l++++-- |Construct an AddAnn from the annotation keyword and the Located Token. If+-- the token has a unicode equivalent and this has been used, provide the+-- unicode variant of the annotation.+mu :: AnnKeywordId -> Located Token -> AddAnn+mu a lt@(dL->L l t) = (\s -> addAnnotation s (toUnicodeAnn a lt) l)++-- | If the 'Token' is using its unicode variant return the unicode variant of+--   the annotation+toUnicodeAnn :: AnnKeywordId -> Located Token -> AnnKeywordId+toUnicodeAnn a t = if isUnicode t then unicodeAnn a else a++gl :: HasSrcSpan a => a -> SrcSpan+gl = getLoc++-- |Add an annotation to the located element, and return the located+-- element as a pass through+aa :: (HasSrcSpan a , HasSrcSpan c) => a -> (AnnKeywordId, c) -> P a+aa a@(dL->L l _) (b,s) = addAnnotation l b (gl s) >> return a++-- |Add an annotation to a located element resulting from a monadic action+am :: (HasSrcSpan a , HasSrcSpan b) => P a -> (AnnKeywordId, b) -> P a+am a (b,s) = do+  av@(dL->L l _) <- a+  addAnnotation l b (gl s)+  return av++-- | Add a list of AddAnns to the given AST element.  For example,+-- the parsing rule for @let@ looks like:+--+-- @+--      | 'let' binds 'in' exp    {% ams (sLL $1 $> $ HsLet (snd $ unLoc $2) $4)+--                                       (mj AnnLet $1:mj AnnIn $3+--                                         :(fst $ unLoc $2)) }+-- @+--+-- This adds an AnnLet annotation for @let@, an AnnIn for @in@, as well+-- as any annotations that may arise in the binds. This will include open+-- and closing braces if they are used to delimit the let expressions.+--+ams :: Located a -> [AddAnn] -> P (Located a)+ams a@(dL->L l _) bs = addAnnsAt l bs >> return a++amsL :: SrcSpan -> [AddAnn] -> P ()+amsL sp bs = addAnnsAt sp bs >> return ()++-- |Add all [AddAnn] to an AST element wrapped in a Just+ajs a@(Just (dL->L l _)) bs = addAnnsAt l bs >> return a++-- |Add a list of AddAnns to the given AST element, where the AST element is the+--  result of a monadic action+amms :: HasSrcSpan a => P a -> [AddAnn] -> P a+amms a bs = do { av@(dL->L l _) <- a+               ; addAnnsAt l bs+               ; return av }++-- |Add a list of AddAnns to the AST element, and return the element as a+--  OrdList+amsu :: HasSrcSpan a => a -> [AddAnn] -> P (OrdList a)+amsu a@(dL->L l _) bs = addAnnsAt l bs >> return (unitOL a)++-- |Synonyms for AddAnn versions of AnnOpen and AnnClose+mo,mc :: Located Token -> AddAnn+mo ll = mj AnnOpen ll+mc ll = mj AnnClose ll++moc,mcc :: Located Token -> AddAnn+moc ll = mj AnnOpenC ll+mcc ll = mj AnnCloseC ll++mop,mcp :: Located Token -> AddAnn+mop ll = mj AnnOpenP ll+mcp ll = mj AnnCloseP ll++mos,mcs :: Located Token -> AddAnn+mos ll = mj AnnOpenS ll+mcs ll = mj AnnCloseS ll++-- |Given a list of the locations of commas, provide a [AddAnn] with an AnnComma+--  entry for each SrcSpan+mcommas :: [SrcSpan] -> [AddAnn]+mcommas ss = map (mjL AnnCommaTuple) ss++-- |Given a list of the locations of '|'s, provide a [AddAnn] with an AnnVbar+--  entry for each SrcSpan+mvbars :: [SrcSpan] -> [AddAnn]+mvbars ss = map (mjL AnnVbar) ss++-- |Get the location of the last element of a OrdList, or noSrcSpan+oll :: HasSrcSpan a => OrdList a -> SrcSpan+oll l =+  if isNilOL l then noSrcSpan+               else getLoc (lastOL l)++-- |Add a semicolon annotation in the right place in a list. If the+-- leading list is empty, add it to the tail+asl :: (HasSrcSpan a , HasSrcSpan b) => [a] -> b -> a -> P()+asl [] (dL->L ls _) (dL->L l _) = addAnnotation l          AnnSemi ls+asl (x:_xs) (dL->L ls _) _x = addAnnotation (getLoc x) AnnSemi ls+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 17 "<built-in>" #-}+{-# LINE 1 "/Users/shaynefletcher/.stack/programs/x86_64-osx/ghc-8.6.4/lib/ghc-8.6.4/include/ghcversion.h" #-}+++++++++++++++++{-# LINE 18 "<built-in>" #-}+{-# LINE 1 "/var/folders/f_/bb4zyb7d2_z9bqm3hrqrjgp40000gn/T/ghc75776_0/ghc_2.h" #-}++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++{-# LINE 19 "<built-in>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp ++++++++++++++-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.+#if __GLASGOW_HASKELL__ > 706+#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool)+#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool)+#define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool)+#else+#define LT(n,m) (n Happy_GHC_Exts.<# m)+#define GTE(n,m) (n Happy_GHC_Exts.>=# m)+#define EQ(n,m) (n Happy_GHC_Exts.==# m)+#endif++{-# LINE 43 "templates/GenericTemplate.hs" #-}++data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList+++++++++{-# LINE 65 "templates/GenericTemplate.hs" #-}+++{-# LINE 75 "templates/GenericTemplate.hs" #-}+++++++++++infixr 9 `HappyStk`+data HappyStk a = HappyStk a (HappyStk a)++-----------------------------------------------------------------------------+-- starting the parse++happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll++-----------------------------------------------------------------------------+-- Accepting the parse++-- If the current token is 0#, it means we've just accepted a partial+-- parse (a %partial parser).  We must ignore the saved token on the top of+-- the stack in this case.+happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =+        happyReturn1 ans+happyAccept j tk st sts (HappyStk ans _) = +        (happyTcHack j (happyTcHack st)) (happyReturn1 ans)++-----------------------------------------------------------------------------+-- Arrays only: do the next action++++happyDoAction i tk st+        = {- nothing -}+          ++          case action of+                0#           -> {- nothing -}+                                     happyFail (happyExpListPerState ((Happy_GHC_Exts.I# (st)) :: Int)) i tk st+                -1#          -> {- nothing -}+                                     happyAccept i tk st+                n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}+                                                   +                                                   (happyReduceArr Happy_Data_Array.! rule) i tk st+                                                   where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))+                n                 -> {- nothing -}+                                     ++                                     happyShift new_state i tk st+                                     where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))+   where off    = happyAdjustOffset (indexShortOffAddr happyActOffsets st)+         off_i  = (off Happy_GHC_Exts.+#  i)+         check  = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#))+                  then EQ(indexShortOffAddr happyCheck off_i, i)+                  else False+         action+          | check     = indexShortOffAddr happyTable off_i+          | otherwise = indexShortOffAddr happyDefActions st+++++indexShortOffAddr (HappyA# arr) off =+        Happy_GHC_Exts.narrow16Int# i+  where+        i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low)+        high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))+        low  = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off'))+        off' = off Happy_GHC_Exts.*# 2#+++++{-# INLINE happyLt #-}+happyLt x y = LT(x,y)+++readArrayBit arr bit =+    Bits.testBit (Happy_GHC_Exts.I# (indexShortOffAddr arr ((unbox_int bit) `Happy_GHC_Exts.iShiftRA#` 4#))) (bit `mod` 16)+  where unbox_int (Happy_GHC_Exts.I# x) = x+++++++data HappyAddr = HappyA# Happy_GHC_Exts.Addr#+++-----------------------------------------------------------------------------+-- HappyState data type (not arrays)+++{-# LINE 180 "templates/GenericTemplate.hs" #-}++-----------------------------------------------------------------------------+-- Shifting a token++happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =+     let i = (case x of { HappyErrorToken (Happy_GHC_Exts.I# (i)) -> i }) in+--     trace "shifting the error token" $+     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)++happyShift new_state i tk st sts stk =+     happyNewToken new_state (HappyCons (st) (sts)) ((HappyTerminal (tk))`HappyStk`stk)++-- happyReduce is specialised for the common cases.++happySpecReduce_0 i fn 0# tk st sts stk+     = happyFail [] 0# tk st sts stk+happySpecReduce_0 nt fn j tk st@((action)) sts stk+     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)++happySpecReduce_1 i fn 0# tk st sts stk+     = happyFail [] 0# tk st sts stk+happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')+     = let r = fn v1 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_2 i fn 0# tk st sts stk+     = happyFail [] 0# tk st sts stk+happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')+     = let r = fn v1 v2 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_3 i fn 0# tk st sts stk+     = happyFail [] 0# tk st sts stk+happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')+     = let r = fn v1 v2 v3 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happyReduce k i fn 0# tk st sts stk+     = happyFail [] 0# tk st sts stk+happyReduce k nt fn j tk st sts stk+     = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of+         sts1@((HappyCons (st1@(action)) (_))) ->+                let r = fn stk in  -- it doesn't hurt to always seq here...+                happyDoSeq r (happyGoto nt j tk st1 sts1 r)++happyMonadReduce k nt fn 0# tk st sts stk+     = happyFail [] 0# tk st sts stk+happyMonadReduce k nt fn j tk st sts stk =+      case happyDrop k (HappyCons (st) (sts)) of+        sts1@((HappyCons (st1@(action)) (_))) ->+          let drop_stk = happyDropStk k stk in+          happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))++happyMonad2Reduce k nt fn 0# tk st sts stk+     = happyFail [] 0# tk st sts stk+happyMonad2Reduce k nt fn j tk st sts stk =+      case happyDrop k (HappyCons (st) (sts)) of+        sts1@((HappyCons (st1@(action)) (_))) ->+         let drop_stk = happyDropStk k stk++             off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st1)+             off_i = (off Happy_GHC_Exts.+#  nt)+             new_state = indexShortOffAddr happyTable off_i+++++          in+          happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))++happyDrop 0# l = l+happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t++happyDropStk 0# l = l+happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs++-----------------------------------------------------------------------------+-- Moving to a new state after a reduction+++happyGoto nt j tk st = +   {- nothing -}+   happyDoAction j tk new_state+   where off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st)+         off_i = (off Happy_GHC_Exts.+#  nt)+         new_state = indexShortOffAddr happyTable off_i+++++-----------------------------------------------------------------------------+-- Error recovery (0# is the error token)++-- parse error if we are in recovery and we fail again+happyFail explist 0# tk old_st _ stk@(x `HappyStk` _) =+     let i = (case x of { HappyErrorToken (Happy_GHC_Exts.I# (i)) -> i }) in+--      trace "failing" $ +        happyError_ explist i tk++{-  We don't need state discarding for our restricted implementation of+    "error".  In fact, it can cause some bogus parses, so I've disabled it+    for now --SDM++-- discard a state+happyFail  0# tk old_st (HappyCons ((action)) (sts)) +                                                (saved_tok `HappyStk` _ `HappyStk` stk) =+--      trace ("discarding state, depth " ++ show (length stk))  $+        happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))+-}++-- Enter error recovery: generate an error token,+--                       save the old token and carry on.+happyFail explist i tk (action) sts stk =+--      trace "entering error recovery" $+        happyDoAction 0# tk action sts ( (HappyErrorToken (Happy_GHC_Exts.I# (i))) `HappyStk` stk)++-- Internal happy errors:++notHappyAtAll :: a+notHappyAtAll = error "Internal Happy error\n"++-----------------------------------------------------------------------------+-- Hack to get the typechecker to accept our action functions+++happyTcHack :: Happy_GHC_Exts.Int# -> a -> a+happyTcHack x y = y+{-# INLINE happyTcHack #-}+++-----------------------------------------------------------------------------+-- Seq-ing.  If the --strict flag is given, then Happy emits +--      happySeq = happyDoSeq+-- otherwise it emits+--      happySeq = happyDontSeq++happyDoSeq, happyDontSeq :: a -> b -> b+happyDoSeq   a b = a `seq` b+happyDontSeq a b = b++-----------------------------------------------------------------------------+-- Don't inline any functions from the template.  GHC has a nasty habit+-- of deciding to inline happyGoto everywhere, which increases the size of+-- the generated parser quite a bit.+++{-# NOINLINE happyDoAction #-}+{-# NOINLINE happyTable #-}+{-# NOINLINE happyCheck #-}+{-# NOINLINE happyActOffsets #-}+{-# NOINLINE happyGotoOffsets #-}+{-# NOINLINE happyDefActions #-}++{-# NOINLINE happyShift #-}+{-# NOINLINE happySpecReduce_0 #-}+{-# NOINLINE happySpecReduce_1 #-}+{-# NOINLINE happySpecReduce_2 #-}+{-# NOINLINE happySpecReduce_3 #-}+{-# NOINLINE happyReduce #-}+{-# NOINLINE happyMonadReduce #-}+{-# NOINLINE happyGoto #-}+{-# NOINLINE happyFail #-}++-- end of Happy Template.+
+ ghc-lib/stage1/compiler/build/Config.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE CPP #-}+module Config where++import GhcPrelude++#include "ghc_boot_platform.h"++data IntegerLibrary = IntegerGMP+                    | IntegerSimple+                    deriving Eq++cBuildPlatformString :: String+cBuildPlatformString = BuildPlatform_NAME+cHostPlatformString :: String+cHostPlatformString = HostPlatform_NAME+cTargetPlatformString :: String+cTargetPlatformString = TargetPlatform_NAME++cProjectName          :: String+cProjectName          = "The Glorious Glasgow Haskell Compilation System"+cProjectGitCommitId   :: String+cProjectGitCommitId   = "bf73419518ca550e85188616f860961c7e2a336b"+cProjectVersion       :: String+cProjectVersion       = "8.9.20190402"+cProjectVersionInt    :: String+cProjectVersionInt    = "809"+cProjectPatchLevel    :: String+cProjectPatchLevel    = "20190402"+cProjectPatchLevel1   :: String+cProjectPatchLevel1   = "20190402"+cProjectPatchLevel2   :: String+cProjectPatchLevel2   = ""+cBooterVersion        :: String+cBooterVersion        = "8.6.4"+cStage                :: String+cStage                = show (STAGE :: Int)+cIntegerLibrary       :: String+cIntegerLibrary       = "integer-simple"+cIntegerLibraryType   :: IntegerLibrary+cIntegerLibraryType   = IntegerSimple+cGhcWithInterpreter   :: String+cGhcWithInterpreter   = "YES"+cGhcWithNativeCodeGen :: String+cGhcWithNativeCodeGen = "YES"+cGhcWithSMP           :: String+cGhcWithSMP           = "YES"+cGhcRTSWays           :: String+cGhcRTSWays           = "v thr p thr_p debug_p thr_debug_p l thr_l debug thr_debug dyn thr_dyn debug_dyn l_dyn thr_debug_dyn thr_l_dyn"+cGhcEnableTablesNextToCode :: String+cGhcEnableTablesNextToCode = "YES"+cLeadingUnderscore    :: String+cLeadingUnderscore    = "YES"+cGHC_UNLIT_PGM        :: String+cGHC_UNLIT_PGM        = "unlit"+cLibFFI               :: Bool+cLibFFI               = False+cGhcThreaded :: Bool+cGhcThreaded = True+cGhcDebugged :: Bool+cGhcDebugged = False+cGhcRtsWithLibdw :: Bool+cGhcRtsWithLibdw = False
+ ghc-lib/stage1/compiler/build/ghc_boot_platform.h view
@@ -0,0 +1,34 @@+#ifndef __PLATFORM_H__+#define __PLATFORM_H__++#define BuildPlatform_NAME  "x86_64-apple-darwin"+#define HostPlatform_NAME   "x86_64-apple-darwin"+#define TargetPlatform_NAME "x86_64-apple-darwin"++#define x86_64_apple_darwin_BUILD 1+#define x86_64_apple_darwin_HOST 1+#define x86_64_apple_darwin_TARGET 1++#define x86_64_BUILD_ARCH 1+#define x86_64_HOST_ARCH 1+#define x86_64_TARGET_ARCH 1+#define BUILD_ARCH "x86_64"+#define HOST_ARCH "x86_64"+#define TARGET_ARCH "x86_64"+#define LLVM_TARGET "x86_64-apple-darwin"++#define darwin_BUILD_OS 1+#define darwin_HOST_OS 1+#define darwin_TARGET_OS 1+#define BUILD_OS "darwin"+#define HOST_OS "darwin"+#define TARGET_OS "darwin"++#define apple_BUILD_VENDOR 1+#define apple_HOST_VENDOR 1+#define apple_TARGET_VENDOR  1+#define BUILD_VENDOR "apple"+#define HOST_VENDOR "apple"+#define TARGET_VENDOR "apple"++#endif /* __PLATFORM_H__ */
+ ghc-lib/stage1/compiler/build/primop-can-fail.hs-incl view
@@ -0,0 +1,231 @@+primOpCanFail IntQuotOp = True+primOpCanFail IntRemOp = True+primOpCanFail IntQuotRemOp = True+primOpCanFail Int8QuotOp = True+primOpCanFail Int8RemOp = True+primOpCanFail Int8QuotRemOp = True+primOpCanFail Word8QuotOp = True+primOpCanFail Word8RemOp = True+primOpCanFail Word8QuotRemOp = True+primOpCanFail Int16QuotOp = True+primOpCanFail Int16RemOp = True+primOpCanFail Int16QuotRemOp = True+primOpCanFail Word16QuotOp = True+primOpCanFail Word16RemOp = True+primOpCanFail Word16QuotRemOp = True+primOpCanFail WordQuotOp = True+primOpCanFail WordRemOp = True+primOpCanFail WordQuotRemOp = True+primOpCanFail WordQuotRem2Op = True+primOpCanFail DoubleDivOp = True+primOpCanFail DoubleLogOp = True+primOpCanFail DoubleAsinOp = True+primOpCanFail DoubleAcosOp = True+primOpCanFail FloatDivOp = True+primOpCanFail FloatLogOp = True+primOpCanFail FloatAsinOp = True+primOpCanFail FloatAcosOp = True+primOpCanFail ReadArrayOp = True+primOpCanFail WriteArrayOp = True+primOpCanFail IndexArrayOp = True+primOpCanFail CopyArrayOp = True+primOpCanFail CopyMutableArrayOp = True+primOpCanFail CloneArrayOp = True+primOpCanFail CloneMutableArrayOp = True+primOpCanFail FreezeArrayOp = True+primOpCanFail ThawArrayOp = True+primOpCanFail ReadSmallArrayOp = True+primOpCanFail WriteSmallArrayOp = True+primOpCanFail IndexSmallArrayOp = True+primOpCanFail CopySmallArrayOp = True+primOpCanFail CopySmallMutableArrayOp = True+primOpCanFail CloneSmallArrayOp = True+primOpCanFail CloneSmallMutableArrayOp = True+primOpCanFail FreezeSmallArrayOp = True+primOpCanFail ThawSmallArrayOp = True+primOpCanFail IndexByteArrayOp_Char = True+primOpCanFail IndexByteArrayOp_WideChar = True+primOpCanFail IndexByteArrayOp_Int = True+primOpCanFail IndexByteArrayOp_Word = True+primOpCanFail IndexByteArrayOp_Addr = True+primOpCanFail IndexByteArrayOp_Float = True+primOpCanFail IndexByteArrayOp_Double = True+primOpCanFail IndexByteArrayOp_StablePtr = True+primOpCanFail IndexByteArrayOp_Int8 = True+primOpCanFail IndexByteArrayOp_Int16 = True+primOpCanFail IndexByteArrayOp_Int32 = True+primOpCanFail IndexByteArrayOp_Int64 = True+primOpCanFail IndexByteArrayOp_Word8 = True+primOpCanFail IndexByteArrayOp_Word16 = True+primOpCanFail IndexByteArrayOp_Word32 = True+primOpCanFail IndexByteArrayOp_Word64 = True+primOpCanFail IndexByteArrayOp_Word8AsChar = True+primOpCanFail IndexByteArrayOp_Word8AsWideChar = True+primOpCanFail IndexByteArrayOp_Word8AsAddr = True+primOpCanFail IndexByteArrayOp_Word8AsFloat = True+primOpCanFail IndexByteArrayOp_Word8AsDouble = True+primOpCanFail IndexByteArrayOp_Word8AsStablePtr = True+primOpCanFail IndexByteArrayOp_Word8AsInt16 = True+primOpCanFail IndexByteArrayOp_Word8AsInt32 = True+primOpCanFail IndexByteArrayOp_Word8AsInt64 = True+primOpCanFail IndexByteArrayOp_Word8AsInt = True+primOpCanFail IndexByteArrayOp_Word8AsWord16 = True+primOpCanFail IndexByteArrayOp_Word8AsWord32 = True+primOpCanFail IndexByteArrayOp_Word8AsWord64 = True+primOpCanFail IndexByteArrayOp_Word8AsWord = True+primOpCanFail ReadByteArrayOp_Char = True+primOpCanFail ReadByteArrayOp_WideChar = True+primOpCanFail ReadByteArrayOp_Int = True+primOpCanFail ReadByteArrayOp_Word = True+primOpCanFail ReadByteArrayOp_Addr = True+primOpCanFail ReadByteArrayOp_Float = True+primOpCanFail ReadByteArrayOp_Double = True+primOpCanFail ReadByteArrayOp_StablePtr = True+primOpCanFail ReadByteArrayOp_Int8 = True+primOpCanFail ReadByteArrayOp_Int16 = True+primOpCanFail ReadByteArrayOp_Int32 = True+primOpCanFail ReadByteArrayOp_Int64 = True+primOpCanFail ReadByteArrayOp_Word8 = True+primOpCanFail ReadByteArrayOp_Word16 = True+primOpCanFail ReadByteArrayOp_Word32 = True+primOpCanFail ReadByteArrayOp_Word64 = True+primOpCanFail ReadByteArrayOp_Word8AsChar = True+primOpCanFail ReadByteArrayOp_Word8AsWideChar = True+primOpCanFail ReadByteArrayOp_Word8AsAddr = True+primOpCanFail ReadByteArrayOp_Word8AsFloat = True+primOpCanFail ReadByteArrayOp_Word8AsDouble = True+primOpCanFail ReadByteArrayOp_Word8AsStablePtr = True+primOpCanFail ReadByteArrayOp_Word8AsInt16 = True+primOpCanFail ReadByteArrayOp_Word8AsInt32 = True+primOpCanFail ReadByteArrayOp_Word8AsInt64 = True+primOpCanFail ReadByteArrayOp_Word8AsInt = True+primOpCanFail ReadByteArrayOp_Word8AsWord16 = True+primOpCanFail ReadByteArrayOp_Word8AsWord32 = True+primOpCanFail ReadByteArrayOp_Word8AsWord64 = True+primOpCanFail ReadByteArrayOp_Word8AsWord = True+primOpCanFail WriteByteArrayOp_Char = True+primOpCanFail WriteByteArrayOp_WideChar = True+primOpCanFail WriteByteArrayOp_Int = True+primOpCanFail WriteByteArrayOp_Word = True+primOpCanFail WriteByteArrayOp_Addr = True+primOpCanFail WriteByteArrayOp_Float = True+primOpCanFail WriteByteArrayOp_Double = True+primOpCanFail WriteByteArrayOp_StablePtr = True+primOpCanFail WriteByteArrayOp_Int8 = True+primOpCanFail WriteByteArrayOp_Int16 = True+primOpCanFail WriteByteArrayOp_Int32 = True+primOpCanFail WriteByteArrayOp_Int64 = True+primOpCanFail WriteByteArrayOp_Word8 = True+primOpCanFail WriteByteArrayOp_Word16 = True+primOpCanFail WriteByteArrayOp_Word32 = True+primOpCanFail WriteByteArrayOp_Word64 = True+primOpCanFail WriteByteArrayOp_Word8AsChar = True+primOpCanFail WriteByteArrayOp_Word8AsWideChar = True+primOpCanFail WriteByteArrayOp_Word8AsAddr = True+primOpCanFail WriteByteArrayOp_Word8AsFloat = True+primOpCanFail WriteByteArrayOp_Word8AsDouble = True+primOpCanFail WriteByteArrayOp_Word8AsStablePtr = True+primOpCanFail WriteByteArrayOp_Word8AsInt16 = True+primOpCanFail WriteByteArrayOp_Word8AsInt32 = True+primOpCanFail WriteByteArrayOp_Word8AsInt64 = True+primOpCanFail WriteByteArrayOp_Word8AsInt = True+primOpCanFail WriteByteArrayOp_Word8AsWord16 = True+primOpCanFail WriteByteArrayOp_Word8AsWord32 = True+primOpCanFail WriteByteArrayOp_Word8AsWord64 = True+primOpCanFail WriteByteArrayOp_Word8AsWord = True+primOpCanFail CompareByteArraysOp = True+primOpCanFail CopyByteArrayOp = True+primOpCanFail CopyMutableByteArrayOp = True+primOpCanFail CopyByteArrayToAddrOp = True+primOpCanFail CopyMutableByteArrayToAddrOp = True+primOpCanFail CopyAddrToByteArrayOp = True+primOpCanFail SetByteArrayOp = True+primOpCanFail AtomicReadByteArrayOp_Int = True+primOpCanFail AtomicWriteByteArrayOp_Int = True+primOpCanFail CasByteArrayOp_Int = True+primOpCanFail FetchAddByteArrayOp_Int = True+primOpCanFail FetchSubByteArrayOp_Int = True+primOpCanFail FetchAndByteArrayOp_Int = True+primOpCanFail FetchNandByteArrayOp_Int = True+primOpCanFail FetchOrByteArrayOp_Int = True+primOpCanFail FetchXorByteArrayOp_Int = True+primOpCanFail IndexArrayArrayOp_ByteArray = True+primOpCanFail IndexArrayArrayOp_ArrayArray = True+primOpCanFail ReadArrayArrayOp_ByteArray = True+primOpCanFail ReadArrayArrayOp_MutableByteArray = True+primOpCanFail ReadArrayArrayOp_ArrayArray = True+primOpCanFail ReadArrayArrayOp_MutableArrayArray = True+primOpCanFail WriteArrayArrayOp_ByteArray = True+primOpCanFail WriteArrayArrayOp_MutableByteArray = True+primOpCanFail WriteArrayArrayOp_ArrayArray = True+primOpCanFail WriteArrayArrayOp_MutableArrayArray = True+primOpCanFail CopyArrayArrayOp = True+primOpCanFail CopyMutableArrayArrayOp = True+primOpCanFail IndexOffAddrOp_Char = True+primOpCanFail IndexOffAddrOp_WideChar = True+primOpCanFail IndexOffAddrOp_Int = True+primOpCanFail IndexOffAddrOp_Word = True+primOpCanFail IndexOffAddrOp_Addr = True+primOpCanFail IndexOffAddrOp_Float = True+primOpCanFail IndexOffAddrOp_Double = True+primOpCanFail IndexOffAddrOp_StablePtr = True+primOpCanFail IndexOffAddrOp_Int8 = True+primOpCanFail IndexOffAddrOp_Int16 = True+primOpCanFail IndexOffAddrOp_Int32 = True+primOpCanFail IndexOffAddrOp_Int64 = True+primOpCanFail IndexOffAddrOp_Word8 = True+primOpCanFail IndexOffAddrOp_Word16 = True+primOpCanFail IndexOffAddrOp_Word32 = True+primOpCanFail IndexOffAddrOp_Word64 = True+primOpCanFail ReadOffAddrOp_Char = True+primOpCanFail ReadOffAddrOp_WideChar = True+primOpCanFail ReadOffAddrOp_Int = True+primOpCanFail ReadOffAddrOp_Word = True+primOpCanFail ReadOffAddrOp_Addr = True+primOpCanFail ReadOffAddrOp_Float = True+primOpCanFail ReadOffAddrOp_Double = True+primOpCanFail ReadOffAddrOp_StablePtr = True+primOpCanFail ReadOffAddrOp_Int8 = True+primOpCanFail ReadOffAddrOp_Int16 = True+primOpCanFail ReadOffAddrOp_Int32 = True+primOpCanFail ReadOffAddrOp_Int64 = True+primOpCanFail ReadOffAddrOp_Word8 = True+primOpCanFail ReadOffAddrOp_Word16 = True+primOpCanFail ReadOffAddrOp_Word32 = True+primOpCanFail ReadOffAddrOp_Word64 = True+primOpCanFail WriteOffAddrOp_Char = True+primOpCanFail WriteOffAddrOp_WideChar = True+primOpCanFail WriteOffAddrOp_Int = True+primOpCanFail WriteOffAddrOp_Word = True+primOpCanFail WriteOffAddrOp_Addr = True+primOpCanFail WriteOffAddrOp_Float = True+primOpCanFail WriteOffAddrOp_Double = True+primOpCanFail WriteOffAddrOp_StablePtr = True+primOpCanFail WriteOffAddrOp_Int8 = True+primOpCanFail WriteOffAddrOp_Int16 = True+primOpCanFail WriteOffAddrOp_Int32 = True+primOpCanFail WriteOffAddrOp_Int64 = True+primOpCanFail WriteOffAddrOp_Word8 = True+primOpCanFail WriteOffAddrOp_Word16 = True+primOpCanFail WriteOffAddrOp_Word32 = True+primOpCanFail WriteOffAddrOp_Word64 = True+primOpCanFail AtomicModifyMutVar2Op = True+primOpCanFail AtomicModifyMutVar_Op = True+primOpCanFail ReallyUnsafePtrEqualityOp = True+primOpCanFail (VecInsertOp _ _ _) = True+primOpCanFail (VecDivOp _ _ _) = True+primOpCanFail (VecQuotOp _ _ _) = True+primOpCanFail (VecRemOp _ _ _) = True+primOpCanFail (VecIndexByteArrayOp _ _ _) = True+primOpCanFail (VecReadByteArrayOp _ _ _) = True+primOpCanFail (VecWriteByteArrayOp _ _ _) = True+primOpCanFail (VecIndexOffAddrOp _ _ _) = True+primOpCanFail (VecReadOffAddrOp _ _ _) = True+primOpCanFail (VecWriteOffAddrOp _ _ _) = True+primOpCanFail (VecIndexScalarByteArrayOp _ _ _) = True+primOpCanFail (VecReadScalarByteArrayOp _ _ _) = True+primOpCanFail (VecWriteScalarByteArrayOp _ _ _) = True+primOpCanFail (VecIndexScalarOffAddrOp _ _ _) = True+primOpCanFail (VecReadScalarOffAddrOp _ _ _) = True+primOpCanFail (VecWriteScalarOffAddrOp _ _ _) = True+primOpCanFail _ = False
+ ghc-lib/stage1/compiler/build/primop-code-size.hs-incl view
@@ -0,0 +1,57 @@+primOpCodeSize OrdOp = 0+primOpCodeSize IntAddCOp = 2+primOpCodeSize IntSubCOp = 2+primOpCodeSize ChrOp = 0+primOpCodeSize Int2WordOp = 0+primOpCodeSize WordAddCOp = 2+primOpCodeSize WordSubCOp = 2+primOpCodeSize WordAdd2Op = 2+primOpCodeSize Word2IntOp = 0+primOpCodeSize DoubleExpOp =  primOpCodeSizeForeignCall +primOpCodeSize DoubleLogOp =  primOpCodeSizeForeignCall +primOpCodeSize DoubleSqrtOp =  primOpCodeSizeForeignCall +primOpCodeSize DoubleSinOp =  primOpCodeSizeForeignCall +primOpCodeSize DoubleCosOp =  primOpCodeSizeForeignCall +primOpCodeSize DoubleTanOp =  primOpCodeSizeForeignCall +primOpCodeSize DoubleAsinOp =  primOpCodeSizeForeignCall +primOpCodeSize DoubleAcosOp =  primOpCodeSizeForeignCall +primOpCodeSize DoubleAtanOp =  primOpCodeSizeForeignCall +primOpCodeSize DoubleSinhOp =  primOpCodeSizeForeignCall +primOpCodeSize DoubleCoshOp =  primOpCodeSizeForeignCall +primOpCodeSize DoubleTanhOp =  primOpCodeSizeForeignCall +primOpCodeSize DoubleAsinhOp =  primOpCodeSizeForeignCall +primOpCodeSize DoubleAcoshOp =  primOpCodeSizeForeignCall +primOpCodeSize DoubleAtanhOp =  primOpCodeSizeForeignCall +primOpCodeSize DoublePowerOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatExpOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatLogOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatSqrtOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatSinOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatCosOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatTanOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatAsinOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatAcosOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatAtanOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatSinhOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatCoshOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatTanhOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatAsinhOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatAcoshOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatAtanhOp =  primOpCodeSizeForeignCall +primOpCodeSize FloatPowerOp =  primOpCodeSizeForeignCall +primOpCodeSize WriteArrayOp = 2+primOpCodeSize CopyByteArrayOp =  primOpCodeSizeForeignCall + 4+primOpCodeSize CopyMutableByteArrayOp =  primOpCodeSizeForeignCall + 4 +primOpCodeSize CopyByteArrayToAddrOp =  primOpCodeSizeForeignCall + 4+primOpCodeSize CopyMutableByteArrayToAddrOp =  primOpCodeSizeForeignCall + 4+primOpCodeSize CopyAddrToByteArrayOp =  primOpCodeSizeForeignCall + 4+primOpCodeSize SetByteArrayOp =  primOpCodeSizeForeignCall + 4 +primOpCodeSize Addr2IntOp = 0+primOpCodeSize Int2AddrOp = 0+primOpCodeSize WriteMutVarOp =  primOpCodeSizeForeignCall +primOpCodeSize TouchOp =  0 +primOpCodeSize ParOp =  primOpCodeSizeForeignCall +primOpCodeSize SparkOp =  primOpCodeSizeForeignCall +primOpCodeSize AddrToAnyOp = 0+primOpCodeSize AnyToAddrOp = 0+primOpCodeSize _ =  primOpCodeSizeDefault
+ ghc-lib/stage1/compiler/build/primop-commutable.hs-incl view
@@ -0,0 +1,38 @@+commutableOp CharEqOp = True+commutableOp CharNeOp = True+commutableOp IntAddOp = True+commutableOp IntMulOp = True+commutableOp IntMulMayOfloOp = True+commutableOp AndIOp = True+commutableOp OrIOp = True+commutableOp XorIOp = True+commutableOp IntAddCOp = True+commutableOp IntEqOp = True+commutableOp IntNeOp = True+commutableOp Int8AddOp = True+commutableOp Int8MulOp = True+commutableOp Word8AddOp = True+commutableOp Word8MulOp = True+commutableOp Int16AddOp = True+commutableOp Int16MulOp = True+commutableOp Word16AddOp = True+commutableOp Word16MulOp = True+commutableOp WordAddOp = True+commutableOp WordAddCOp = True+commutableOp WordAdd2Op = True+commutableOp WordMulOp = True+commutableOp WordMul2Op = True+commutableOp AndOp = True+commutableOp OrOp = True+commutableOp XorOp = True+commutableOp DoubleEqOp = True+commutableOp DoubleNeOp = True+commutableOp DoubleAddOp = True+commutableOp DoubleMulOp = True+commutableOp FloatEqOp = True+commutableOp FloatNeOp = True+commutableOp FloatAddOp = True+commutableOp FloatMulOp = True+commutableOp (VecAddOp _ _ _) = True+commutableOp (VecMulOp _ _ _) = True+commutableOp _ = False
+ ghc-lib/stage1/compiler/build/primop-data-decl.hs-incl view
@@ -0,0 +1,580 @@+data PrimOp+   = CharGtOp+   | CharGeOp+   | CharEqOp+   | CharNeOp+   | CharLtOp+   | CharLeOp+   | OrdOp+   | IntAddOp+   | IntSubOp+   | IntMulOp+   | IntMulMayOfloOp+   | IntQuotOp+   | IntRemOp+   | IntQuotRemOp+   | AndIOp+   | OrIOp+   | XorIOp+   | NotIOp+   | IntNegOp+   | IntAddCOp+   | IntSubCOp+   | IntGtOp+   | IntGeOp+   | IntEqOp+   | IntNeOp+   | IntLtOp+   | IntLeOp+   | ChrOp+   | Int2WordOp+   | Int2FloatOp+   | Int2DoubleOp+   | Word2FloatOp+   | Word2DoubleOp+   | ISllOp+   | ISraOp+   | ISrlOp+   | Int8Extend+   | Int8Narrow+   | Int8NegOp+   | Int8AddOp+   | Int8SubOp+   | Int8MulOp+   | Int8QuotOp+   | Int8RemOp+   | Int8QuotRemOp+   | Int8EqOp+   | Int8GeOp+   | Int8GtOp+   | Int8LeOp+   | Int8LtOp+   | Int8NeOp+   | Word8Extend+   | Word8Narrow+   | Word8NotOp+   | Word8AddOp+   | Word8SubOp+   | Word8MulOp+   | Word8QuotOp+   | Word8RemOp+   | Word8QuotRemOp+   | Word8EqOp+   | Word8GeOp+   | Word8GtOp+   | Word8LeOp+   | Word8LtOp+   | Word8NeOp+   | Int16Extend+   | Int16Narrow+   | Int16NegOp+   | Int16AddOp+   | Int16SubOp+   | Int16MulOp+   | Int16QuotOp+   | Int16RemOp+   | Int16QuotRemOp+   | Int16EqOp+   | Int16GeOp+   | Int16GtOp+   | Int16LeOp+   | Int16LtOp+   | Int16NeOp+   | Word16Extend+   | Word16Narrow+   | Word16NotOp+   | Word16AddOp+   | Word16SubOp+   | Word16MulOp+   | Word16QuotOp+   | Word16RemOp+   | Word16QuotRemOp+   | Word16EqOp+   | Word16GeOp+   | Word16GtOp+   | Word16LeOp+   | Word16LtOp+   | Word16NeOp+   | WordAddOp+   | WordAddCOp+   | WordSubCOp+   | WordAdd2Op+   | WordSubOp+   | WordMulOp+   | WordMul2Op+   | WordQuotOp+   | WordRemOp+   | WordQuotRemOp+   | WordQuotRem2Op+   | AndOp+   | OrOp+   | XorOp+   | NotOp+   | SllOp+   | SrlOp+   | Word2IntOp+   | WordGtOp+   | WordGeOp+   | WordEqOp+   | WordNeOp+   | WordLtOp+   | WordLeOp+   | PopCnt8Op+   | PopCnt16Op+   | PopCnt32Op+   | PopCnt64Op+   | PopCntOp+   | Pdep8Op+   | Pdep16Op+   | Pdep32Op+   | Pdep64Op+   | PdepOp+   | Pext8Op+   | Pext16Op+   | Pext32Op+   | Pext64Op+   | PextOp+   | Clz8Op+   | Clz16Op+   | Clz32Op+   | Clz64Op+   | ClzOp+   | Ctz8Op+   | Ctz16Op+   | Ctz32Op+   | Ctz64Op+   | CtzOp+   | BSwap16Op+   | BSwap32Op+   | BSwap64Op+   | BSwapOp+   | BRev8Op+   | BRev16Op+   | BRev32Op+   | BRev64Op+   | BRevOp+   | Narrow8IntOp+   | Narrow16IntOp+   | Narrow32IntOp+   | Narrow8WordOp+   | Narrow16WordOp+   | Narrow32WordOp+   | DoubleGtOp+   | DoubleGeOp+   | DoubleEqOp+   | DoubleNeOp+   | DoubleLtOp+   | DoubleLeOp+   | DoubleAddOp+   | DoubleSubOp+   | DoubleMulOp+   | DoubleDivOp+   | DoubleNegOp+   | DoubleFabsOp+   | Double2IntOp+   | Double2FloatOp+   | DoubleExpOp+   | DoubleLogOp+   | DoubleSqrtOp+   | DoubleSinOp+   | DoubleCosOp+   | DoubleTanOp+   | DoubleAsinOp+   | DoubleAcosOp+   | DoubleAtanOp+   | DoubleSinhOp+   | DoubleCoshOp+   | DoubleTanhOp+   | DoubleAsinhOp+   | DoubleAcoshOp+   | DoubleAtanhOp+   | DoublePowerOp+   | DoubleDecode_2IntOp+   | DoubleDecode_Int64Op+   | FloatGtOp+   | FloatGeOp+   | FloatEqOp+   | FloatNeOp+   | FloatLtOp+   | FloatLeOp+   | FloatAddOp+   | FloatSubOp+   | FloatMulOp+   | FloatDivOp+   | FloatNegOp+   | FloatFabsOp+   | Float2IntOp+   | FloatExpOp+   | FloatLogOp+   | FloatSqrtOp+   | FloatSinOp+   | FloatCosOp+   | FloatTanOp+   | FloatAsinOp+   | FloatAcosOp+   | FloatAtanOp+   | FloatSinhOp+   | FloatCoshOp+   | FloatTanhOp+   | FloatAsinhOp+   | FloatAcoshOp+   | FloatAtanhOp+   | FloatPowerOp+   | Float2DoubleOp+   | FloatDecode_IntOp+   | NewArrayOp+   | SameMutableArrayOp+   | ReadArrayOp+   | WriteArrayOp+   | SizeofArrayOp+   | SizeofMutableArrayOp+   | IndexArrayOp+   | UnsafeFreezeArrayOp+   | UnsafeThawArrayOp+   | CopyArrayOp+   | CopyMutableArrayOp+   | CloneArrayOp+   | CloneMutableArrayOp+   | FreezeArrayOp+   | ThawArrayOp+   | CasArrayOp+   | NewSmallArrayOp+   | SameSmallMutableArrayOp+   | ReadSmallArrayOp+   | WriteSmallArrayOp+   | SizeofSmallArrayOp+   | SizeofSmallMutableArrayOp+   | IndexSmallArrayOp+   | UnsafeFreezeSmallArrayOp+   | UnsafeThawSmallArrayOp+   | CopySmallArrayOp+   | CopySmallMutableArrayOp+   | CloneSmallArrayOp+   | CloneSmallMutableArrayOp+   | FreezeSmallArrayOp+   | ThawSmallArrayOp+   | CasSmallArrayOp+   | NewByteArrayOp_Char+   | NewPinnedByteArrayOp_Char+   | NewAlignedPinnedByteArrayOp_Char+   | MutableByteArrayIsPinnedOp+   | ByteArrayIsPinnedOp+   | ByteArrayContents_Char+   | SameMutableByteArrayOp+   | ShrinkMutableByteArrayOp_Char+   | ResizeMutableByteArrayOp_Char+   | UnsafeFreezeByteArrayOp+   | SizeofByteArrayOp+   | SizeofMutableByteArrayOp+   | GetSizeofMutableByteArrayOp+   | IndexByteArrayOp_Char+   | IndexByteArrayOp_WideChar+   | IndexByteArrayOp_Int+   | IndexByteArrayOp_Word+   | IndexByteArrayOp_Addr+   | IndexByteArrayOp_Float+   | IndexByteArrayOp_Double+   | IndexByteArrayOp_StablePtr+   | IndexByteArrayOp_Int8+   | IndexByteArrayOp_Int16+   | IndexByteArrayOp_Int32+   | IndexByteArrayOp_Int64+   | IndexByteArrayOp_Word8+   | IndexByteArrayOp_Word16+   | IndexByteArrayOp_Word32+   | IndexByteArrayOp_Word64+   | IndexByteArrayOp_Word8AsChar+   | IndexByteArrayOp_Word8AsWideChar+   | IndexByteArrayOp_Word8AsAddr+   | IndexByteArrayOp_Word8AsFloat+   | IndexByteArrayOp_Word8AsDouble+   | IndexByteArrayOp_Word8AsStablePtr+   | IndexByteArrayOp_Word8AsInt16+   | IndexByteArrayOp_Word8AsInt32+   | IndexByteArrayOp_Word8AsInt64+   | IndexByteArrayOp_Word8AsInt+   | IndexByteArrayOp_Word8AsWord16+   | IndexByteArrayOp_Word8AsWord32+   | IndexByteArrayOp_Word8AsWord64+   | IndexByteArrayOp_Word8AsWord+   | ReadByteArrayOp_Char+   | ReadByteArrayOp_WideChar+   | ReadByteArrayOp_Int+   | ReadByteArrayOp_Word+   | ReadByteArrayOp_Addr+   | ReadByteArrayOp_Float+   | ReadByteArrayOp_Double+   | ReadByteArrayOp_StablePtr+   | ReadByteArrayOp_Int8+   | ReadByteArrayOp_Int16+   | ReadByteArrayOp_Int32+   | ReadByteArrayOp_Int64+   | ReadByteArrayOp_Word8+   | ReadByteArrayOp_Word16+   | ReadByteArrayOp_Word32+   | ReadByteArrayOp_Word64+   | ReadByteArrayOp_Word8AsChar+   | ReadByteArrayOp_Word8AsWideChar+   | ReadByteArrayOp_Word8AsAddr+   | ReadByteArrayOp_Word8AsFloat+   | ReadByteArrayOp_Word8AsDouble+   | ReadByteArrayOp_Word8AsStablePtr+   | ReadByteArrayOp_Word8AsInt16+   | ReadByteArrayOp_Word8AsInt32+   | ReadByteArrayOp_Word8AsInt64+   | ReadByteArrayOp_Word8AsInt+   | ReadByteArrayOp_Word8AsWord16+   | ReadByteArrayOp_Word8AsWord32+   | ReadByteArrayOp_Word8AsWord64+   | ReadByteArrayOp_Word8AsWord+   | WriteByteArrayOp_Char+   | WriteByteArrayOp_WideChar+   | WriteByteArrayOp_Int+   | WriteByteArrayOp_Word+   | WriteByteArrayOp_Addr+   | WriteByteArrayOp_Float+   | WriteByteArrayOp_Double+   | WriteByteArrayOp_StablePtr+   | WriteByteArrayOp_Int8+   | WriteByteArrayOp_Int16+   | WriteByteArrayOp_Int32+   | WriteByteArrayOp_Int64+   | WriteByteArrayOp_Word8+   | WriteByteArrayOp_Word16+   | WriteByteArrayOp_Word32+   | WriteByteArrayOp_Word64+   | WriteByteArrayOp_Word8AsChar+   | WriteByteArrayOp_Word8AsWideChar+   | WriteByteArrayOp_Word8AsAddr+   | WriteByteArrayOp_Word8AsFloat+   | WriteByteArrayOp_Word8AsDouble+   | WriteByteArrayOp_Word8AsStablePtr+   | WriteByteArrayOp_Word8AsInt16+   | WriteByteArrayOp_Word8AsInt32+   | WriteByteArrayOp_Word8AsInt64+   | WriteByteArrayOp_Word8AsInt+   | WriteByteArrayOp_Word8AsWord16+   | WriteByteArrayOp_Word8AsWord32+   | WriteByteArrayOp_Word8AsWord64+   | WriteByteArrayOp_Word8AsWord+   | CompareByteArraysOp+   | CopyByteArrayOp+   | CopyMutableByteArrayOp+   | CopyByteArrayToAddrOp+   | CopyMutableByteArrayToAddrOp+   | CopyAddrToByteArrayOp+   | SetByteArrayOp+   | AtomicReadByteArrayOp_Int+   | AtomicWriteByteArrayOp_Int+   | CasByteArrayOp_Int+   | FetchAddByteArrayOp_Int+   | FetchSubByteArrayOp_Int+   | FetchAndByteArrayOp_Int+   | FetchNandByteArrayOp_Int+   | FetchOrByteArrayOp_Int+   | FetchXorByteArrayOp_Int+   | NewArrayArrayOp+   | SameMutableArrayArrayOp+   | UnsafeFreezeArrayArrayOp+   | SizeofArrayArrayOp+   | SizeofMutableArrayArrayOp+   | IndexArrayArrayOp_ByteArray+   | IndexArrayArrayOp_ArrayArray+   | ReadArrayArrayOp_ByteArray+   | ReadArrayArrayOp_MutableByteArray+   | ReadArrayArrayOp_ArrayArray+   | ReadArrayArrayOp_MutableArrayArray+   | WriteArrayArrayOp_ByteArray+   | WriteArrayArrayOp_MutableByteArray+   | WriteArrayArrayOp_ArrayArray+   | WriteArrayArrayOp_MutableArrayArray+   | CopyArrayArrayOp+   | CopyMutableArrayArrayOp+   | AddrAddOp+   | AddrSubOp+   | AddrRemOp+   | Addr2IntOp+   | Int2AddrOp+   | AddrGtOp+   | AddrGeOp+   | AddrEqOp+   | AddrNeOp+   | AddrLtOp+   | AddrLeOp+   | IndexOffAddrOp_Char+   | IndexOffAddrOp_WideChar+   | IndexOffAddrOp_Int+   | IndexOffAddrOp_Word+   | IndexOffAddrOp_Addr+   | IndexOffAddrOp_Float+   | IndexOffAddrOp_Double+   | IndexOffAddrOp_StablePtr+   | IndexOffAddrOp_Int8+   | IndexOffAddrOp_Int16+   | IndexOffAddrOp_Int32+   | IndexOffAddrOp_Int64+   | IndexOffAddrOp_Word8+   | IndexOffAddrOp_Word16+   | IndexOffAddrOp_Word32+   | IndexOffAddrOp_Word64+   | ReadOffAddrOp_Char+   | ReadOffAddrOp_WideChar+   | ReadOffAddrOp_Int+   | ReadOffAddrOp_Word+   | ReadOffAddrOp_Addr+   | ReadOffAddrOp_Float+   | ReadOffAddrOp_Double+   | ReadOffAddrOp_StablePtr+   | ReadOffAddrOp_Int8+   | ReadOffAddrOp_Int16+   | ReadOffAddrOp_Int32+   | ReadOffAddrOp_Int64+   | ReadOffAddrOp_Word8+   | ReadOffAddrOp_Word16+   | ReadOffAddrOp_Word32+   | ReadOffAddrOp_Word64+   | WriteOffAddrOp_Char+   | WriteOffAddrOp_WideChar+   | WriteOffAddrOp_Int+   | WriteOffAddrOp_Word+   | WriteOffAddrOp_Addr+   | WriteOffAddrOp_Float+   | WriteOffAddrOp_Double+   | WriteOffAddrOp_StablePtr+   | WriteOffAddrOp_Int8+   | WriteOffAddrOp_Int16+   | WriteOffAddrOp_Int32+   | WriteOffAddrOp_Int64+   | WriteOffAddrOp_Word8+   | WriteOffAddrOp_Word16+   | WriteOffAddrOp_Word32+   | WriteOffAddrOp_Word64+   | NewMutVarOp+   | ReadMutVarOp+   | WriteMutVarOp+   | SameMutVarOp+   | AtomicModifyMutVar2Op+   | AtomicModifyMutVar_Op+   | CasMutVarOp+   | CatchOp+   | RaiseOp+   | RaiseIOOp+   | MaskAsyncExceptionsOp+   | MaskUninterruptibleOp+   | UnmaskAsyncExceptionsOp+   | MaskStatus+   | AtomicallyOp+   | RetryOp+   | CatchRetryOp+   | CatchSTMOp+   | NewTVarOp+   | ReadTVarOp+   | ReadTVarIOOp+   | WriteTVarOp+   | SameTVarOp+   | NewMVarOp+   | TakeMVarOp+   | TryTakeMVarOp+   | PutMVarOp+   | TryPutMVarOp+   | ReadMVarOp+   | TryReadMVarOp+   | SameMVarOp+   | IsEmptyMVarOp+   | DelayOp+   | WaitReadOp+   | WaitWriteOp+   | ForkOp+   | ForkOnOp+   | KillThreadOp+   | YieldOp+   | MyThreadIdOp+   | LabelThreadOp+   | IsCurrentThreadBoundOp+   | NoDuplicateOp+   | ThreadStatusOp+   | MkWeakOp+   | MkWeakNoFinalizerOp+   | AddCFinalizerToWeakOp+   | DeRefWeakOp+   | FinalizeWeakOp+   | TouchOp+   | MakeStablePtrOp+   | DeRefStablePtrOp+   | EqStablePtrOp+   | MakeStableNameOp+   | EqStableNameOp+   | StableNameToIntOp+   | CompactNewOp+   | CompactResizeOp+   | CompactContainsOp+   | CompactContainsAnyOp+   | CompactGetFirstBlockOp+   | CompactGetNextBlockOp+   | CompactAllocateBlockOp+   | CompactFixupPointersOp+   | CompactAdd+   | CompactAddWithSharing+   | CompactSize+   | ReallyUnsafePtrEqualityOp+   | ParOp+   | SparkOp+   | SeqOp+   | GetSparkOp+   | NumSparks+   | DataToTagOp+   | TagToEnumOp+   | AddrToAnyOp+   | AnyToAddrOp+   | MkApUpd0_Op+   | NewBCOOp+   | UnpackClosureOp+   | ClosureSizeOp+   | GetApStackValOp+   | GetCCSOfOp+   | GetCurrentCCSOp+   | ClearCCSOp+   | TraceEventOp+   | TraceEventBinaryOp+   | TraceMarkerOp+   | GetThreadAllocationCounter+   | SetThreadAllocationCounter+   | VecBroadcastOp PrimOpVecCat Length Width+   | VecPackOp PrimOpVecCat Length Width+   | VecUnpackOp PrimOpVecCat Length Width+   | VecInsertOp PrimOpVecCat Length Width+   | VecAddOp PrimOpVecCat Length Width+   | VecSubOp PrimOpVecCat Length Width+   | VecMulOp PrimOpVecCat Length Width+   | VecDivOp PrimOpVecCat Length Width+   | VecQuotOp PrimOpVecCat Length Width+   | VecRemOp PrimOpVecCat Length Width+   | VecNegOp PrimOpVecCat Length Width+   | VecIndexByteArrayOp PrimOpVecCat Length Width+   | VecReadByteArrayOp PrimOpVecCat Length Width+   | VecWriteByteArrayOp PrimOpVecCat Length Width+   | VecIndexOffAddrOp PrimOpVecCat Length Width+   | VecReadOffAddrOp PrimOpVecCat Length Width+   | VecWriteOffAddrOp PrimOpVecCat Length Width+   | VecIndexScalarByteArrayOp PrimOpVecCat Length Width+   | VecReadScalarByteArrayOp PrimOpVecCat Length Width+   | VecWriteScalarByteArrayOp PrimOpVecCat Length Width+   | VecIndexScalarOffAddrOp PrimOpVecCat Length Width+   | VecReadScalarOffAddrOp PrimOpVecCat Length Width+   | VecWriteScalarOffAddrOp PrimOpVecCat Length Width+   | PrefetchByteArrayOp3+   | PrefetchMutableByteArrayOp3+   | PrefetchAddrOp3+   | PrefetchValueOp3+   | PrefetchByteArrayOp2+   | PrefetchMutableByteArrayOp2+   | PrefetchAddrOp2+   | PrefetchValueOp2+   | PrefetchByteArrayOp1+   | PrefetchMutableByteArrayOp1+   | PrefetchAddrOp1+   | PrefetchValueOp1+   | PrefetchByteArrayOp0+   | PrefetchMutableByteArrayOp0+   | PrefetchAddrOp0+   | PrefetchValueOp0
+ ghc-lib/stage1/compiler/build/primop-fixity.hs-incl view
@@ -0,0 +1,20 @@+primOpFixity IntAddOp = Just (Fixity NoSourceText 6 InfixL)+primOpFixity IntSubOp = Just (Fixity NoSourceText 6 InfixL)+primOpFixity IntMulOp = Just (Fixity NoSourceText 7 InfixL)+primOpFixity IntGtOp = Just (Fixity NoSourceText 4 InfixN)+primOpFixity IntGeOp = Just (Fixity NoSourceText 4 InfixN)+primOpFixity IntEqOp = Just (Fixity NoSourceText 4 InfixN)+primOpFixity IntNeOp = Just (Fixity NoSourceText 4 InfixN)+primOpFixity IntLtOp = Just (Fixity NoSourceText 4 InfixN)+primOpFixity IntLeOp = Just (Fixity NoSourceText 4 InfixN)+primOpFixity DoubleGtOp = Just (Fixity NoSourceText 4 InfixN)+primOpFixity DoubleGeOp = Just (Fixity NoSourceText 4 InfixN)+primOpFixity DoubleEqOp = Just (Fixity NoSourceText 4 InfixN)+primOpFixity DoubleNeOp = Just (Fixity NoSourceText 4 InfixN)+primOpFixity DoubleLtOp = Just (Fixity NoSourceText 4 InfixN)+primOpFixity DoubleLeOp = Just (Fixity NoSourceText 4 InfixN)+primOpFixity DoubleAddOp = Just (Fixity NoSourceText 6 InfixL)+primOpFixity DoubleSubOp = Just (Fixity NoSourceText 6 InfixL)+primOpFixity DoubleMulOp = Just (Fixity NoSourceText 7 InfixL)+primOpFixity DoubleDivOp = Just (Fixity NoSourceText 7 InfixL)+primOpFixity _ = Nothing
+ ghc-lib/stage1/compiler/build/primop-has-side-effects.hs-incl view
@@ -0,0 +1,242 @@+primOpHasSideEffects NewArrayOp = True+primOpHasSideEffects ReadArrayOp = True+primOpHasSideEffects WriteArrayOp = True+primOpHasSideEffects UnsafeFreezeArrayOp = True+primOpHasSideEffects UnsafeThawArrayOp = True+primOpHasSideEffects CopyArrayOp = True+primOpHasSideEffects CopyMutableArrayOp = True+primOpHasSideEffects CloneArrayOp = True+primOpHasSideEffects CloneMutableArrayOp = True+primOpHasSideEffects FreezeArrayOp = True+primOpHasSideEffects ThawArrayOp = True+primOpHasSideEffects CasArrayOp = True+primOpHasSideEffects NewSmallArrayOp = True+primOpHasSideEffects ReadSmallArrayOp = True+primOpHasSideEffects WriteSmallArrayOp = True+primOpHasSideEffects UnsafeFreezeSmallArrayOp = True+primOpHasSideEffects UnsafeThawSmallArrayOp = True+primOpHasSideEffects CopySmallArrayOp = True+primOpHasSideEffects CopySmallMutableArrayOp = True+primOpHasSideEffects CloneSmallArrayOp = True+primOpHasSideEffects CloneSmallMutableArrayOp = True+primOpHasSideEffects FreezeSmallArrayOp = True+primOpHasSideEffects ThawSmallArrayOp = True+primOpHasSideEffects CasSmallArrayOp = True+primOpHasSideEffects NewByteArrayOp_Char = True+primOpHasSideEffects NewPinnedByteArrayOp_Char = True+primOpHasSideEffects NewAlignedPinnedByteArrayOp_Char = True+primOpHasSideEffects ShrinkMutableByteArrayOp_Char = True+primOpHasSideEffects ResizeMutableByteArrayOp_Char = True+primOpHasSideEffects UnsafeFreezeByteArrayOp = True+primOpHasSideEffects ReadByteArrayOp_Char = True+primOpHasSideEffects ReadByteArrayOp_WideChar = True+primOpHasSideEffects ReadByteArrayOp_Int = True+primOpHasSideEffects ReadByteArrayOp_Word = True+primOpHasSideEffects ReadByteArrayOp_Addr = True+primOpHasSideEffects ReadByteArrayOp_Float = True+primOpHasSideEffects ReadByteArrayOp_Double = True+primOpHasSideEffects ReadByteArrayOp_StablePtr = True+primOpHasSideEffects ReadByteArrayOp_Int8 = True+primOpHasSideEffects ReadByteArrayOp_Int16 = True+primOpHasSideEffects ReadByteArrayOp_Int32 = True+primOpHasSideEffects ReadByteArrayOp_Int64 = True+primOpHasSideEffects ReadByteArrayOp_Word8 = True+primOpHasSideEffects ReadByteArrayOp_Word16 = True+primOpHasSideEffects ReadByteArrayOp_Word32 = True+primOpHasSideEffects ReadByteArrayOp_Word64 = True+primOpHasSideEffects ReadByteArrayOp_Word8AsChar = True+primOpHasSideEffects ReadByteArrayOp_Word8AsWideChar = True+primOpHasSideEffects ReadByteArrayOp_Word8AsAddr = True+primOpHasSideEffects ReadByteArrayOp_Word8AsFloat = True+primOpHasSideEffects ReadByteArrayOp_Word8AsDouble = True+primOpHasSideEffects ReadByteArrayOp_Word8AsStablePtr = True+primOpHasSideEffects ReadByteArrayOp_Word8AsInt16 = True+primOpHasSideEffects ReadByteArrayOp_Word8AsInt32 = True+primOpHasSideEffects ReadByteArrayOp_Word8AsInt64 = True+primOpHasSideEffects ReadByteArrayOp_Word8AsInt = True+primOpHasSideEffects ReadByteArrayOp_Word8AsWord16 = True+primOpHasSideEffects ReadByteArrayOp_Word8AsWord32 = True+primOpHasSideEffects ReadByteArrayOp_Word8AsWord64 = True+primOpHasSideEffects ReadByteArrayOp_Word8AsWord = True+primOpHasSideEffects WriteByteArrayOp_Char = True+primOpHasSideEffects WriteByteArrayOp_WideChar = True+primOpHasSideEffects WriteByteArrayOp_Int = True+primOpHasSideEffects WriteByteArrayOp_Word = True+primOpHasSideEffects WriteByteArrayOp_Addr = True+primOpHasSideEffects WriteByteArrayOp_Float = True+primOpHasSideEffects WriteByteArrayOp_Double = True+primOpHasSideEffects WriteByteArrayOp_StablePtr = True+primOpHasSideEffects WriteByteArrayOp_Int8 = True+primOpHasSideEffects WriteByteArrayOp_Int16 = True+primOpHasSideEffects WriteByteArrayOp_Int32 = True+primOpHasSideEffects WriteByteArrayOp_Int64 = True+primOpHasSideEffects WriteByteArrayOp_Word8 = True+primOpHasSideEffects WriteByteArrayOp_Word16 = True+primOpHasSideEffects WriteByteArrayOp_Word32 = True+primOpHasSideEffects WriteByteArrayOp_Word64 = True+primOpHasSideEffects WriteByteArrayOp_Word8AsChar = True+primOpHasSideEffects WriteByteArrayOp_Word8AsWideChar = True+primOpHasSideEffects WriteByteArrayOp_Word8AsAddr = True+primOpHasSideEffects WriteByteArrayOp_Word8AsFloat = True+primOpHasSideEffects WriteByteArrayOp_Word8AsDouble = True+primOpHasSideEffects WriteByteArrayOp_Word8AsStablePtr = True+primOpHasSideEffects WriteByteArrayOp_Word8AsInt16 = True+primOpHasSideEffects WriteByteArrayOp_Word8AsInt32 = True+primOpHasSideEffects WriteByteArrayOp_Word8AsInt64 = True+primOpHasSideEffects WriteByteArrayOp_Word8AsInt = True+primOpHasSideEffects WriteByteArrayOp_Word8AsWord16 = True+primOpHasSideEffects WriteByteArrayOp_Word8AsWord32 = True+primOpHasSideEffects WriteByteArrayOp_Word8AsWord64 = True+primOpHasSideEffects WriteByteArrayOp_Word8AsWord = True+primOpHasSideEffects CopyByteArrayOp = True+primOpHasSideEffects CopyMutableByteArrayOp = True+primOpHasSideEffects CopyByteArrayToAddrOp = True+primOpHasSideEffects CopyMutableByteArrayToAddrOp = True+primOpHasSideEffects CopyAddrToByteArrayOp = True+primOpHasSideEffects SetByteArrayOp = True+primOpHasSideEffects AtomicReadByteArrayOp_Int = True+primOpHasSideEffects AtomicWriteByteArrayOp_Int = True+primOpHasSideEffects CasByteArrayOp_Int = True+primOpHasSideEffects FetchAddByteArrayOp_Int = True+primOpHasSideEffects FetchSubByteArrayOp_Int = True+primOpHasSideEffects FetchAndByteArrayOp_Int = True+primOpHasSideEffects FetchNandByteArrayOp_Int = True+primOpHasSideEffects FetchOrByteArrayOp_Int = True+primOpHasSideEffects FetchXorByteArrayOp_Int = True+primOpHasSideEffects NewArrayArrayOp = True+primOpHasSideEffects UnsafeFreezeArrayArrayOp = True+primOpHasSideEffects ReadArrayArrayOp_ByteArray = True+primOpHasSideEffects ReadArrayArrayOp_MutableByteArray = True+primOpHasSideEffects ReadArrayArrayOp_ArrayArray = True+primOpHasSideEffects ReadArrayArrayOp_MutableArrayArray = True+primOpHasSideEffects WriteArrayArrayOp_ByteArray = True+primOpHasSideEffects WriteArrayArrayOp_MutableByteArray = True+primOpHasSideEffects WriteArrayArrayOp_ArrayArray = True+primOpHasSideEffects WriteArrayArrayOp_MutableArrayArray = True+primOpHasSideEffects CopyArrayArrayOp = True+primOpHasSideEffects CopyMutableArrayArrayOp = True+primOpHasSideEffects ReadOffAddrOp_Char = True+primOpHasSideEffects ReadOffAddrOp_WideChar = True+primOpHasSideEffects ReadOffAddrOp_Int = True+primOpHasSideEffects ReadOffAddrOp_Word = True+primOpHasSideEffects ReadOffAddrOp_Addr = True+primOpHasSideEffects ReadOffAddrOp_Float = True+primOpHasSideEffects ReadOffAddrOp_Double = True+primOpHasSideEffects ReadOffAddrOp_StablePtr = True+primOpHasSideEffects ReadOffAddrOp_Int8 = True+primOpHasSideEffects ReadOffAddrOp_Int16 = True+primOpHasSideEffects ReadOffAddrOp_Int32 = True+primOpHasSideEffects ReadOffAddrOp_Int64 = True+primOpHasSideEffects ReadOffAddrOp_Word8 = True+primOpHasSideEffects ReadOffAddrOp_Word16 = True+primOpHasSideEffects ReadOffAddrOp_Word32 = True+primOpHasSideEffects ReadOffAddrOp_Word64 = True+primOpHasSideEffects WriteOffAddrOp_Char = True+primOpHasSideEffects WriteOffAddrOp_WideChar = True+primOpHasSideEffects WriteOffAddrOp_Int = True+primOpHasSideEffects WriteOffAddrOp_Word = True+primOpHasSideEffects WriteOffAddrOp_Addr = True+primOpHasSideEffects WriteOffAddrOp_Float = True+primOpHasSideEffects WriteOffAddrOp_Double = True+primOpHasSideEffects WriteOffAddrOp_StablePtr = True+primOpHasSideEffects WriteOffAddrOp_Int8 = True+primOpHasSideEffects WriteOffAddrOp_Int16 = True+primOpHasSideEffects WriteOffAddrOp_Int32 = True+primOpHasSideEffects WriteOffAddrOp_Int64 = True+primOpHasSideEffects WriteOffAddrOp_Word8 = True+primOpHasSideEffects WriteOffAddrOp_Word16 = True+primOpHasSideEffects WriteOffAddrOp_Word32 = True+primOpHasSideEffects WriteOffAddrOp_Word64 = True+primOpHasSideEffects NewMutVarOp = True+primOpHasSideEffects ReadMutVarOp = True+primOpHasSideEffects WriteMutVarOp = True+primOpHasSideEffects AtomicModifyMutVar2Op = True+primOpHasSideEffects AtomicModifyMutVar_Op = True+primOpHasSideEffects CasMutVarOp = True+primOpHasSideEffects CatchOp = True+primOpHasSideEffects RaiseOp = True+primOpHasSideEffects RaiseIOOp = True+primOpHasSideEffects MaskAsyncExceptionsOp = True+primOpHasSideEffects MaskUninterruptibleOp = True+primOpHasSideEffects UnmaskAsyncExceptionsOp = True+primOpHasSideEffects MaskStatus = True+primOpHasSideEffects AtomicallyOp = True+primOpHasSideEffects RetryOp = True+primOpHasSideEffects CatchRetryOp = True+primOpHasSideEffects CatchSTMOp = True+primOpHasSideEffects NewTVarOp = True+primOpHasSideEffects ReadTVarOp = True+primOpHasSideEffects ReadTVarIOOp = True+primOpHasSideEffects WriteTVarOp = True+primOpHasSideEffects NewMVarOp = True+primOpHasSideEffects TakeMVarOp = True+primOpHasSideEffects TryTakeMVarOp = True+primOpHasSideEffects PutMVarOp = True+primOpHasSideEffects TryPutMVarOp = True+primOpHasSideEffects ReadMVarOp = True+primOpHasSideEffects TryReadMVarOp = True+primOpHasSideEffects IsEmptyMVarOp = True+primOpHasSideEffects DelayOp = True+primOpHasSideEffects WaitReadOp = True+primOpHasSideEffects WaitWriteOp = True+primOpHasSideEffects ForkOp = True+primOpHasSideEffects ForkOnOp = True+primOpHasSideEffects KillThreadOp = True+primOpHasSideEffects YieldOp = True+primOpHasSideEffects MyThreadIdOp = True+primOpHasSideEffects LabelThreadOp = True+primOpHasSideEffects IsCurrentThreadBoundOp = True+primOpHasSideEffects NoDuplicateOp = True+primOpHasSideEffects ThreadStatusOp = True+primOpHasSideEffects MkWeakOp = True+primOpHasSideEffects MkWeakNoFinalizerOp = True+primOpHasSideEffects AddCFinalizerToWeakOp = True+primOpHasSideEffects DeRefWeakOp = True+primOpHasSideEffects FinalizeWeakOp = True+primOpHasSideEffects TouchOp = True+primOpHasSideEffects MakeStablePtrOp = True+primOpHasSideEffects DeRefStablePtrOp = True+primOpHasSideEffects EqStablePtrOp = True+primOpHasSideEffects MakeStableNameOp = True+primOpHasSideEffects CompactNewOp = True+primOpHasSideEffects CompactResizeOp = True+primOpHasSideEffects CompactAllocateBlockOp = True+primOpHasSideEffects CompactFixupPointersOp = True+primOpHasSideEffects CompactAdd = True+primOpHasSideEffects CompactAddWithSharing = True+primOpHasSideEffects CompactSize = True+primOpHasSideEffects ParOp = True+primOpHasSideEffects SparkOp = True+primOpHasSideEffects GetSparkOp = True+primOpHasSideEffects NumSparks = True+primOpHasSideEffects NewBCOOp = True+primOpHasSideEffects TraceEventOp = True+primOpHasSideEffects TraceEventBinaryOp = True+primOpHasSideEffects TraceMarkerOp = True+primOpHasSideEffects GetThreadAllocationCounter = True+primOpHasSideEffects SetThreadAllocationCounter = True+primOpHasSideEffects (VecReadByteArrayOp _ _ _) = True+primOpHasSideEffects (VecWriteByteArrayOp _ _ _) = True+primOpHasSideEffects (VecReadOffAddrOp _ _ _) = True+primOpHasSideEffects (VecWriteOffAddrOp _ _ _) = True+primOpHasSideEffects (VecReadScalarByteArrayOp _ _ _) = True+primOpHasSideEffects (VecWriteScalarByteArrayOp _ _ _) = True+primOpHasSideEffects (VecReadScalarOffAddrOp _ _ _) = True+primOpHasSideEffects (VecWriteScalarOffAddrOp _ _ _) = True+primOpHasSideEffects PrefetchByteArrayOp3 = True+primOpHasSideEffects PrefetchMutableByteArrayOp3 = True+primOpHasSideEffects PrefetchAddrOp3 = True+primOpHasSideEffects PrefetchValueOp3 = True+primOpHasSideEffects PrefetchByteArrayOp2 = True+primOpHasSideEffects PrefetchMutableByteArrayOp2 = True+primOpHasSideEffects PrefetchAddrOp2 = True+primOpHasSideEffects PrefetchValueOp2 = True+primOpHasSideEffects PrefetchByteArrayOp1 = True+primOpHasSideEffects PrefetchMutableByteArrayOp1 = True+primOpHasSideEffects PrefetchAddrOp1 = True+primOpHasSideEffects PrefetchValueOp1 = True+primOpHasSideEffects PrefetchByteArrayOp0 = True+primOpHasSideEffects PrefetchMutableByteArrayOp0 = True+primOpHasSideEffects PrefetchAddrOp0 = True+primOpHasSideEffects PrefetchValueOp0 = True+primOpHasSideEffects _ = False
+ ghc-lib/stage1/compiler/build/primop-list.hs-incl view
@@ -0,0 +1,1199 @@+   [CharGtOp+   , CharGeOp+   , CharEqOp+   , CharNeOp+   , CharLtOp+   , CharLeOp+   , OrdOp+   , IntAddOp+   , IntSubOp+   , IntMulOp+   , IntMulMayOfloOp+   , IntQuotOp+   , IntRemOp+   , IntQuotRemOp+   , AndIOp+   , OrIOp+   , XorIOp+   , NotIOp+   , IntNegOp+   , IntAddCOp+   , IntSubCOp+   , IntGtOp+   , IntGeOp+   , IntEqOp+   , IntNeOp+   , IntLtOp+   , IntLeOp+   , ChrOp+   , Int2WordOp+   , Int2FloatOp+   , Int2DoubleOp+   , Word2FloatOp+   , Word2DoubleOp+   , ISllOp+   , ISraOp+   , ISrlOp+   , Int8Extend+   , Int8Narrow+   , Int8NegOp+   , Int8AddOp+   , Int8SubOp+   , Int8MulOp+   , Int8QuotOp+   , Int8RemOp+   , Int8QuotRemOp+   , Int8EqOp+   , Int8GeOp+   , Int8GtOp+   , Int8LeOp+   , Int8LtOp+   , Int8NeOp+   , Word8Extend+   , Word8Narrow+   , Word8NotOp+   , Word8AddOp+   , Word8SubOp+   , Word8MulOp+   , Word8QuotOp+   , Word8RemOp+   , Word8QuotRemOp+   , Word8EqOp+   , Word8GeOp+   , Word8GtOp+   , Word8LeOp+   , Word8LtOp+   , Word8NeOp+   , Int16Extend+   , Int16Narrow+   , Int16NegOp+   , Int16AddOp+   , Int16SubOp+   , Int16MulOp+   , Int16QuotOp+   , Int16RemOp+   , Int16QuotRemOp+   , Int16EqOp+   , Int16GeOp+   , Int16GtOp+   , Int16LeOp+   , Int16LtOp+   , Int16NeOp+   , Word16Extend+   , Word16Narrow+   , Word16NotOp+   , Word16AddOp+   , Word16SubOp+   , Word16MulOp+   , Word16QuotOp+   , Word16RemOp+   , Word16QuotRemOp+   , Word16EqOp+   , Word16GeOp+   , Word16GtOp+   , Word16LeOp+   , Word16LtOp+   , Word16NeOp+   , WordAddOp+   , WordAddCOp+   , WordSubCOp+   , WordAdd2Op+   , WordSubOp+   , WordMulOp+   , WordMul2Op+   , WordQuotOp+   , WordRemOp+   , WordQuotRemOp+   , WordQuotRem2Op+   , AndOp+   , OrOp+   , XorOp+   , NotOp+   , SllOp+   , SrlOp+   , Word2IntOp+   , WordGtOp+   , WordGeOp+   , WordEqOp+   , WordNeOp+   , WordLtOp+   , WordLeOp+   , PopCnt8Op+   , PopCnt16Op+   , PopCnt32Op+   , PopCnt64Op+   , PopCntOp+   , Pdep8Op+   , Pdep16Op+   , Pdep32Op+   , Pdep64Op+   , PdepOp+   , Pext8Op+   , Pext16Op+   , Pext32Op+   , Pext64Op+   , PextOp+   , Clz8Op+   , Clz16Op+   , Clz32Op+   , Clz64Op+   , ClzOp+   , Ctz8Op+   , Ctz16Op+   , Ctz32Op+   , Ctz64Op+   , CtzOp+   , BSwap16Op+   , BSwap32Op+   , BSwap64Op+   , BSwapOp+   , BRev8Op+   , BRev16Op+   , BRev32Op+   , BRev64Op+   , BRevOp+   , Narrow8IntOp+   , Narrow16IntOp+   , Narrow32IntOp+   , Narrow8WordOp+   , Narrow16WordOp+   , Narrow32WordOp+   , DoubleGtOp+   , DoubleGeOp+   , DoubleEqOp+   , DoubleNeOp+   , DoubleLtOp+   , DoubleLeOp+   , DoubleAddOp+   , DoubleSubOp+   , DoubleMulOp+   , DoubleDivOp+   , DoubleNegOp+   , DoubleFabsOp+   , Double2IntOp+   , Double2FloatOp+   , DoubleExpOp+   , DoubleLogOp+   , DoubleSqrtOp+   , DoubleSinOp+   , DoubleCosOp+   , DoubleTanOp+   , DoubleAsinOp+   , DoubleAcosOp+   , DoubleAtanOp+   , DoubleSinhOp+   , DoubleCoshOp+   , DoubleTanhOp+   , DoubleAsinhOp+   , DoubleAcoshOp+   , DoubleAtanhOp+   , DoublePowerOp+   , DoubleDecode_2IntOp+   , DoubleDecode_Int64Op+   , FloatGtOp+   , FloatGeOp+   , FloatEqOp+   , FloatNeOp+   , FloatLtOp+   , FloatLeOp+   , FloatAddOp+   , FloatSubOp+   , FloatMulOp+   , FloatDivOp+   , FloatNegOp+   , FloatFabsOp+   , Float2IntOp+   , FloatExpOp+   , FloatLogOp+   , FloatSqrtOp+   , FloatSinOp+   , FloatCosOp+   , FloatTanOp+   , FloatAsinOp+   , FloatAcosOp+   , FloatAtanOp+   , FloatSinhOp+   , FloatCoshOp+   , FloatTanhOp+   , FloatAsinhOp+   , FloatAcoshOp+   , FloatAtanhOp+   , FloatPowerOp+   , Float2DoubleOp+   , FloatDecode_IntOp+   , NewArrayOp+   , SameMutableArrayOp+   , ReadArrayOp+   , WriteArrayOp+   , SizeofArrayOp+   , SizeofMutableArrayOp+   , IndexArrayOp+   , UnsafeFreezeArrayOp+   , UnsafeThawArrayOp+   , CopyArrayOp+   , CopyMutableArrayOp+   , CloneArrayOp+   , CloneMutableArrayOp+   , FreezeArrayOp+   , ThawArrayOp+   , CasArrayOp+   , NewSmallArrayOp+   , SameSmallMutableArrayOp+   , ReadSmallArrayOp+   , WriteSmallArrayOp+   , SizeofSmallArrayOp+   , SizeofSmallMutableArrayOp+   , IndexSmallArrayOp+   , UnsafeFreezeSmallArrayOp+   , UnsafeThawSmallArrayOp+   , CopySmallArrayOp+   , CopySmallMutableArrayOp+   , CloneSmallArrayOp+   , CloneSmallMutableArrayOp+   , FreezeSmallArrayOp+   , ThawSmallArrayOp+   , CasSmallArrayOp+   , NewByteArrayOp_Char+   , NewPinnedByteArrayOp_Char+   , NewAlignedPinnedByteArrayOp_Char+   , MutableByteArrayIsPinnedOp+   , ByteArrayIsPinnedOp+   , ByteArrayContents_Char+   , SameMutableByteArrayOp+   , ShrinkMutableByteArrayOp_Char+   , ResizeMutableByteArrayOp_Char+   , UnsafeFreezeByteArrayOp+   , SizeofByteArrayOp+   , SizeofMutableByteArrayOp+   , GetSizeofMutableByteArrayOp+   , IndexByteArrayOp_Char+   , IndexByteArrayOp_WideChar+   , IndexByteArrayOp_Int+   , IndexByteArrayOp_Word+   , IndexByteArrayOp_Addr+   , IndexByteArrayOp_Float+   , IndexByteArrayOp_Double+   , IndexByteArrayOp_StablePtr+   , IndexByteArrayOp_Int8+   , IndexByteArrayOp_Int16+   , IndexByteArrayOp_Int32+   , IndexByteArrayOp_Int64+   , IndexByteArrayOp_Word8+   , IndexByteArrayOp_Word16+   , IndexByteArrayOp_Word32+   , IndexByteArrayOp_Word64+   , IndexByteArrayOp_Word8AsChar+   , IndexByteArrayOp_Word8AsWideChar+   , IndexByteArrayOp_Word8AsAddr+   , IndexByteArrayOp_Word8AsFloat+   , IndexByteArrayOp_Word8AsDouble+   , IndexByteArrayOp_Word8AsStablePtr+   , IndexByteArrayOp_Word8AsInt16+   , IndexByteArrayOp_Word8AsInt32+   , IndexByteArrayOp_Word8AsInt64+   , IndexByteArrayOp_Word8AsInt+   , IndexByteArrayOp_Word8AsWord16+   , IndexByteArrayOp_Word8AsWord32+   , IndexByteArrayOp_Word8AsWord64+   , IndexByteArrayOp_Word8AsWord+   , ReadByteArrayOp_Char+   , ReadByteArrayOp_WideChar+   , ReadByteArrayOp_Int+   , ReadByteArrayOp_Word+   , ReadByteArrayOp_Addr+   , ReadByteArrayOp_Float+   , ReadByteArrayOp_Double+   , ReadByteArrayOp_StablePtr+   , ReadByteArrayOp_Int8+   , ReadByteArrayOp_Int16+   , ReadByteArrayOp_Int32+   , ReadByteArrayOp_Int64+   , ReadByteArrayOp_Word8+   , ReadByteArrayOp_Word16+   , ReadByteArrayOp_Word32+   , ReadByteArrayOp_Word64+   , ReadByteArrayOp_Word8AsChar+   , ReadByteArrayOp_Word8AsWideChar+   , ReadByteArrayOp_Word8AsAddr+   , ReadByteArrayOp_Word8AsFloat+   , ReadByteArrayOp_Word8AsDouble+   , ReadByteArrayOp_Word8AsStablePtr+   , ReadByteArrayOp_Word8AsInt16+   , ReadByteArrayOp_Word8AsInt32+   , ReadByteArrayOp_Word8AsInt64+   , ReadByteArrayOp_Word8AsInt+   , ReadByteArrayOp_Word8AsWord16+   , ReadByteArrayOp_Word8AsWord32+   , ReadByteArrayOp_Word8AsWord64+   , ReadByteArrayOp_Word8AsWord+   , WriteByteArrayOp_Char+   , WriteByteArrayOp_WideChar+   , WriteByteArrayOp_Int+   , WriteByteArrayOp_Word+   , WriteByteArrayOp_Addr+   , WriteByteArrayOp_Float+   , WriteByteArrayOp_Double+   , WriteByteArrayOp_StablePtr+   , WriteByteArrayOp_Int8+   , WriteByteArrayOp_Int16+   , WriteByteArrayOp_Int32+   , WriteByteArrayOp_Int64+   , WriteByteArrayOp_Word8+   , WriteByteArrayOp_Word16+   , WriteByteArrayOp_Word32+   , WriteByteArrayOp_Word64+   , WriteByteArrayOp_Word8AsChar+   , WriteByteArrayOp_Word8AsWideChar+   , WriteByteArrayOp_Word8AsAddr+   , WriteByteArrayOp_Word8AsFloat+   , WriteByteArrayOp_Word8AsDouble+   , WriteByteArrayOp_Word8AsStablePtr+   , WriteByteArrayOp_Word8AsInt16+   , WriteByteArrayOp_Word8AsInt32+   , WriteByteArrayOp_Word8AsInt64+   , WriteByteArrayOp_Word8AsInt+   , WriteByteArrayOp_Word8AsWord16+   , WriteByteArrayOp_Word8AsWord32+   , WriteByteArrayOp_Word8AsWord64+   , WriteByteArrayOp_Word8AsWord+   , CompareByteArraysOp+   , CopyByteArrayOp+   , CopyMutableByteArrayOp+   , CopyByteArrayToAddrOp+   , CopyMutableByteArrayToAddrOp+   , CopyAddrToByteArrayOp+   , SetByteArrayOp+   , AtomicReadByteArrayOp_Int+   , AtomicWriteByteArrayOp_Int+   , CasByteArrayOp_Int+   , FetchAddByteArrayOp_Int+   , FetchSubByteArrayOp_Int+   , FetchAndByteArrayOp_Int+   , FetchNandByteArrayOp_Int+   , FetchOrByteArrayOp_Int+   , FetchXorByteArrayOp_Int+   , NewArrayArrayOp+   , SameMutableArrayArrayOp+   , UnsafeFreezeArrayArrayOp+   , SizeofArrayArrayOp+   , SizeofMutableArrayArrayOp+   , IndexArrayArrayOp_ByteArray+   , IndexArrayArrayOp_ArrayArray+   , ReadArrayArrayOp_ByteArray+   , ReadArrayArrayOp_MutableByteArray+   , ReadArrayArrayOp_ArrayArray+   , ReadArrayArrayOp_MutableArrayArray+   , WriteArrayArrayOp_ByteArray+   , WriteArrayArrayOp_MutableByteArray+   , WriteArrayArrayOp_ArrayArray+   , WriteArrayArrayOp_MutableArrayArray+   , CopyArrayArrayOp+   , CopyMutableArrayArrayOp+   , AddrAddOp+   , AddrSubOp+   , AddrRemOp+   , Addr2IntOp+   , Int2AddrOp+   , AddrGtOp+   , AddrGeOp+   , AddrEqOp+   , AddrNeOp+   , AddrLtOp+   , AddrLeOp+   , IndexOffAddrOp_Char+   , IndexOffAddrOp_WideChar+   , IndexOffAddrOp_Int+   , IndexOffAddrOp_Word+   , IndexOffAddrOp_Addr+   , IndexOffAddrOp_Float+   , IndexOffAddrOp_Double+   , IndexOffAddrOp_StablePtr+   , IndexOffAddrOp_Int8+   , IndexOffAddrOp_Int16+   , IndexOffAddrOp_Int32+   , IndexOffAddrOp_Int64+   , IndexOffAddrOp_Word8+   , IndexOffAddrOp_Word16+   , IndexOffAddrOp_Word32+   , IndexOffAddrOp_Word64+   , ReadOffAddrOp_Char+   , ReadOffAddrOp_WideChar+   , ReadOffAddrOp_Int+   , ReadOffAddrOp_Word+   , ReadOffAddrOp_Addr+   , ReadOffAddrOp_Float+   , ReadOffAddrOp_Double+   , ReadOffAddrOp_StablePtr+   , ReadOffAddrOp_Int8+   , ReadOffAddrOp_Int16+   , ReadOffAddrOp_Int32+   , ReadOffAddrOp_Int64+   , ReadOffAddrOp_Word8+   , ReadOffAddrOp_Word16+   , ReadOffAddrOp_Word32+   , ReadOffAddrOp_Word64+   , WriteOffAddrOp_Char+   , WriteOffAddrOp_WideChar+   , WriteOffAddrOp_Int+   , WriteOffAddrOp_Word+   , WriteOffAddrOp_Addr+   , WriteOffAddrOp_Float+   , WriteOffAddrOp_Double+   , WriteOffAddrOp_StablePtr+   , WriteOffAddrOp_Int8+   , WriteOffAddrOp_Int16+   , WriteOffAddrOp_Int32+   , WriteOffAddrOp_Int64+   , WriteOffAddrOp_Word8+   , WriteOffAddrOp_Word16+   , WriteOffAddrOp_Word32+   , WriteOffAddrOp_Word64+   , NewMutVarOp+   , ReadMutVarOp+   , WriteMutVarOp+   , SameMutVarOp+   , AtomicModifyMutVar2Op+   , AtomicModifyMutVar_Op+   , CasMutVarOp+   , CatchOp+   , RaiseOp+   , RaiseIOOp+   , MaskAsyncExceptionsOp+   , MaskUninterruptibleOp+   , UnmaskAsyncExceptionsOp+   , MaskStatus+   , AtomicallyOp+   , RetryOp+   , CatchRetryOp+   , CatchSTMOp+   , NewTVarOp+   , ReadTVarOp+   , ReadTVarIOOp+   , WriteTVarOp+   , SameTVarOp+   , NewMVarOp+   , TakeMVarOp+   , TryTakeMVarOp+   , PutMVarOp+   , TryPutMVarOp+   , ReadMVarOp+   , TryReadMVarOp+   , SameMVarOp+   , IsEmptyMVarOp+   , DelayOp+   , WaitReadOp+   , WaitWriteOp+   , ForkOp+   , ForkOnOp+   , KillThreadOp+   , YieldOp+   , MyThreadIdOp+   , LabelThreadOp+   , IsCurrentThreadBoundOp+   , NoDuplicateOp+   , ThreadStatusOp+   , MkWeakOp+   , MkWeakNoFinalizerOp+   , AddCFinalizerToWeakOp+   , DeRefWeakOp+   , FinalizeWeakOp+   , TouchOp+   , MakeStablePtrOp+   , DeRefStablePtrOp+   , EqStablePtrOp+   , MakeStableNameOp+   , EqStableNameOp+   , StableNameToIntOp+   , CompactNewOp+   , CompactResizeOp+   , CompactContainsOp+   , CompactContainsAnyOp+   , CompactGetFirstBlockOp+   , CompactGetNextBlockOp+   , CompactAllocateBlockOp+   , CompactFixupPointersOp+   , CompactAdd+   , CompactAddWithSharing+   , CompactSize+   , ReallyUnsafePtrEqualityOp+   , ParOp+   , SparkOp+   , SeqOp+   , GetSparkOp+   , NumSparks+   , DataToTagOp+   , TagToEnumOp+   , AddrToAnyOp+   , AnyToAddrOp+   , MkApUpd0_Op+   , NewBCOOp+   , UnpackClosureOp+   , ClosureSizeOp+   , GetApStackValOp+   , GetCCSOfOp+   , GetCurrentCCSOp+   , ClearCCSOp+   , TraceEventOp+   , TraceEventBinaryOp+   , TraceMarkerOp+   , GetThreadAllocationCounter+   , SetThreadAllocationCounter+   , (VecBroadcastOp IntVec 16 W8)+   , (VecBroadcastOp IntVec 8 W16)+   , (VecBroadcastOp IntVec 4 W32)+   , (VecBroadcastOp IntVec 2 W64)+   , (VecBroadcastOp IntVec 32 W8)+   , (VecBroadcastOp IntVec 16 W16)+   , (VecBroadcastOp IntVec 8 W32)+   , (VecBroadcastOp IntVec 4 W64)+   , (VecBroadcastOp IntVec 64 W8)+   , (VecBroadcastOp IntVec 32 W16)+   , (VecBroadcastOp IntVec 16 W32)+   , (VecBroadcastOp IntVec 8 W64)+   , (VecBroadcastOp WordVec 16 W8)+   , (VecBroadcastOp WordVec 8 W16)+   , (VecBroadcastOp WordVec 4 W32)+   , (VecBroadcastOp WordVec 2 W64)+   , (VecBroadcastOp WordVec 32 W8)+   , (VecBroadcastOp WordVec 16 W16)+   , (VecBroadcastOp WordVec 8 W32)+   , (VecBroadcastOp WordVec 4 W64)+   , (VecBroadcastOp WordVec 64 W8)+   , (VecBroadcastOp WordVec 32 W16)+   , (VecBroadcastOp WordVec 16 W32)+   , (VecBroadcastOp WordVec 8 W64)+   , (VecBroadcastOp FloatVec 4 W32)+   , (VecBroadcastOp FloatVec 2 W64)+   , (VecBroadcastOp FloatVec 8 W32)+   , (VecBroadcastOp FloatVec 4 W64)+   , (VecBroadcastOp FloatVec 16 W32)+   , (VecBroadcastOp FloatVec 8 W64)+   , (VecPackOp IntVec 16 W8)+   , (VecPackOp IntVec 8 W16)+   , (VecPackOp IntVec 4 W32)+   , (VecPackOp IntVec 2 W64)+   , (VecPackOp IntVec 32 W8)+   , (VecPackOp IntVec 16 W16)+   , (VecPackOp IntVec 8 W32)+   , (VecPackOp IntVec 4 W64)+   , (VecPackOp IntVec 64 W8)+   , (VecPackOp IntVec 32 W16)+   , (VecPackOp IntVec 16 W32)+   , (VecPackOp IntVec 8 W64)+   , (VecPackOp WordVec 16 W8)+   , (VecPackOp WordVec 8 W16)+   , (VecPackOp WordVec 4 W32)+   , (VecPackOp WordVec 2 W64)+   , (VecPackOp WordVec 32 W8)+   , (VecPackOp WordVec 16 W16)+   , (VecPackOp WordVec 8 W32)+   , (VecPackOp WordVec 4 W64)+   , (VecPackOp WordVec 64 W8)+   , (VecPackOp WordVec 32 W16)+   , (VecPackOp WordVec 16 W32)+   , (VecPackOp WordVec 8 W64)+   , (VecPackOp FloatVec 4 W32)+   , (VecPackOp FloatVec 2 W64)+   , (VecPackOp FloatVec 8 W32)+   , (VecPackOp FloatVec 4 W64)+   , (VecPackOp FloatVec 16 W32)+   , (VecPackOp FloatVec 8 W64)+   , (VecUnpackOp IntVec 16 W8)+   , (VecUnpackOp IntVec 8 W16)+   , (VecUnpackOp IntVec 4 W32)+   , (VecUnpackOp IntVec 2 W64)+   , (VecUnpackOp IntVec 32 W8)+   , (VecUnpackOp IntVec 16 W16)+   , (VecUnpackOp IntVec 8 W32)+   , (VecUnpackOp IntVec 4 W64)+   , (VecUnpackOp IntVec 64 W8)+   , (VecUnpackOp IntVec 32 W16)+   , (VecUnpackOp IntVec 16 W32)+   , (VecUnpackOp IntVec 8 W64)+   , (VecUnpackOp WordVec 16 W8)+   , (VecUnpackOp WordVec 8 W16)+   , (VecUnpackOp WordVec 4 W32)+   , (VecUnpackOp WordVec 2 W64)+   , (VecUnpackOp WordVec 32 W8)+   , (VecUnpackOp WordVec 16 W16)+   , (VecUnpackOp WordVec 8 W32)+   , (VecUnpackOp WordVec 4 W64)+   , (VecUnpackOp WordVec 64 W8)+   , (VecUnpackOp WordVec 32 W16)+   , (VecUnpackOp WordVec 16 W32)+   , (VecUnpackOp WordVec 8 W64)+   , (VecUnpackOp FloatVec 4 W32)+   , (VecUnpackOp FloatVec 2 W64)+   , (VecUnpackOp FloatVec 8 W32)+   , (VecUnpackOp FloatVec 4 W64)+   , (VecUnpackOp FloatVec 16 W32)+   , (VecUnpackOp FloatVec 8 W64)+   , (VecInsertOp IntVec 16 W8)+   , (VecInsertOp IntVec 8 W16)+   , (VecInsertOp IntVec 4 W32)+   , (VecInsertOp IntVec 2 W64)+   , (VecInsertOp IntVec 32 W8)+   , (VecInsertOp IntVec 16 W16)+   , (VecInsertOp IntVec 8 W32)+   , (VecInsertOp IntVec 4 W64)+   , (VecInsertOp IntVec 64 W8)+   , (VecInsertOp IntVec 32 W16)+   , (VecInsertOp IntVec 16 W32)+   , (VecInsertOp IntVec 8 W64)+   , (VecInsertOp WordVec 16 W8)+   , (VecInsertOp WordVec 8 W16)+   , (VecInsertOp WordVec 4 W32)+   , (VecInsertOp WordVec 2 W64)+   , (VecInsertOp WordVec 32 W8)+   , (VecInsertOp WordVec 16 W16)+   , (VecInsertOp WordVec 8 W32)+   , (VecInsertOp WordVec 4 W64)+   , (VecInsertOp WordVec 64 W8)+   , (VecInsertOp WordVec 32 W16)+   , (VecInsertOp WordVec 16 W32)+   , (VecInsertOp WordVec 8 W64)+   , (VecInsertOp FloatVec 4 W32)+   , (VecInsertOp FloatVec 2 W64)+   , (VecInsertOp FloatVec 8 W32)+   , (VecInsertOp FloatVec 4 W64)+   , (VecInsertOp FloatVec 16 W32)+   , (VecInsertOp FloatVec 8 W64)+   , (VecAddOp IntVec 16 W8)+   , (VecAddOp IntVec 8 W16)+   , (VecAddOp IntVec 4 W32)+   , (VecAddOp IntVec 2 W64)+   , (VecAddOp IntVec 32 W8)+   , (VecAddOp IntVec 16 W16)+   , (VecAddOp IntVec 8 W32)+   , (VecAddOp IntVec 4 W64)+   , (VecAddOp IntVec 64 W8)+   , (VecAddOp IntVec 32 W16)+   , (VecAddOp IntVec 16 W32)+   , (VecAddOp IntVec 8 W64)+   , (VecAddOp WordVec 16 W8)+   , (VecAddOp WordVec 8 W16)+   , (VecAddOp WordVec 4 W32)+   , (VecAddOp WordVec 2 W64)+   , (VecAddOp WordVec 32 W8)+   , (VecAddOp WordVec 16 W16)+   , (VecAddOp WordVec 8 W32)+   , (VecAddOp WordVec 4 W64)+   , (VecAddOp WordVec 64 W8)+   , (VecAddOp WordVec 32 W16)+   , (VecAddOp WordVec 16 W32)+   , (VecAddOp WordVec 8 W64)+   , (VecAddOp FloatVec 4 W32)+   , (VecAddOp FloatVec 2 W64)+   , (VecAddOp FloatVec 8 W32)+   , (VecAddOp FloatVec 4 W64)+   , (VecAddOp FloatVec 16 W32)+   , (VecAddOp FloatVec 8 W64)+   , (VecSubOp IntVec 16 W8)+   , (VecSubOp IntVec 8 W16)+   , (VecSubOp IntVec 4 W32)+   , (VecSubOp IntVec 2 W64)+   , (VecSubOp IntVec 32 W8)+   , (VecSubOp IntVec 16 W16)+   , (VecSubOp IntVec 8 W32)+   , (VecSubOp IntVec 4 W64)+   , (VecSubOp IntVec 64 W8)+   , (VecSubOp IntVec 32 W16)+   , (VecSubOp IntVec 16 W32)+   , (VecSubOp IntVec 8 W64)+   , (VecSubOp WordVec 16 W8)+   , (VecSubOp WordVec 8 W16)+   , (VecSubOp WordVec 4 W32)+   , (VecSubOp WordVec 2 W64)+   , (VecSubOp WordVec 32 W8)+   , (VecSubOp WordVec 16 W16)+   , (VecSubOp WordVec 8 W32)+   , (VecSubOp WordVec 4 W64)+   , (VecSubOp WordVec 64 W8)+   , (VecSubOp WordVec 32 W16)+   , (VecSubOp WordVec 16 W32)+   , (VecSubOp WordVec 8 W64)+   , (VecSubOp FloatVec 4 W32)+   , (VecSubOp FloatVec 2 W64)+   , (VecSubOp FloatVec 8 W32)+   , (VecSubOp FloatVec 4 W64)+   , (VecSubOp FloatVec 16 W32)+   , (VecSubOp FloatVec 8 W64)+   , (VecMulOp IntVec 16 W8)+   , (VecMulOp IntVec 8 W16)+   , (VecMulOp IntVec 4 W32)+   , (VecMulOp IntVec 2 W64)+   , (VecMulOp IntVec 32 W8)+   , (VecMulOp IntVec 16 W16)+   , (VecMulOp IntVec 8 W32)+   , (VecMulOp IntVec 4 W64)+   , (VecMulOp IntVec 64 W8)+   , (VecMulOp IntVec 32 W16)+   , (VecMulOp IntVec 16 W32)+   , (VecMulOp IntVec 8 W64)+   , (VecMulOp WordVec 16 W8)+   , (VecMulOp WordVec 8 W16)+   , (VecMulOp WordVec 4 W32)+   , (VecMulOp WordVec 2 W64)+   , (VecMulOp WordVec 32 W8)+   , (VecMulOp WordVec 16 W16)+   , (VecMulOp WordVec 8 W32)+   , (VecMulOp WordVec 4 W64)+   , (VecMulOp WordVec 64 W8)+   , (VecMulOp WordVec 32 W16)+   , (VecMulOp WordVec 16 W32)+   , (VecMulOp WordVec 8 W64)+   , (VecMulOp FloatVec 4 W32)+   , (VecMulOp FloatVec 2 W64)+   , (VecMulOp FloatVec 8 W32)+   , (VecMulOp FloatVec 4 W64)+   , (VecMulOp FloatVec 16 W32)+   , (VecMulOp FloatVec 8 W64)+   , (VecDivOp FloatVec 4 W32)+   , (VecDivOp FloatVec 2 W64)+   , (VecDivOp FloatVec 8 W32)+   , (VecDivOp FloatVec 4 W64)+   , (VecDivOp FloatVec 16 W32)+   , (VecDivOp FloatVec 8 W64)+   , (VecQuotOp IntVec 16 W8)+   , (VecQuotOp IntVec 8 W16)+   , (VecQuotOp IntVec 4 W32)+   , (VecQuotOp IntVec 2 W64)+   , (VecQuotOp IntVec 32 W8)+   , (VecQuotOp IntVec 16 W16)+   , (VecQuotOp IntVec 8 W32)+   , (VecQuotOp IntVec 4 W64)+   , (VecQuotOp IntVec 64 W8)+   , (VecQuotOp IntVec 32 W16)+   , (VecQuotOp IntVec 16 W32)+   , (VecQuotOp IntVec 8 W64)+   , (VecQuotOp WordVec 16 W8)+   , (VecQuotOp WordVec 8 W16)+   , (VecQuotOp WordVec 4 W32)+   , (VecQuotOp WordVec 2 W64)+   , (VecQuotOp WordVec 32 W8)+   , (VecQuotOp WordVec 16 W16)+   , (VecQuotOp WordVec 8 W32)+   , (VecQuotOp WordVec 4 W64)+   , (VecQuotOp WordVec 64 W8)+   , (VecQuotOp WordVec 32 W16)+   , (VecQuotOp WordVec 16 W32)+   , (VecQuotOp WordVec 8 W64)+   , (VecRemOp IntVec 16 W8)+   , (VecRemOp IntVec 8 W16)+   , (VecRemOp IntVec 4 W32)+   , (VecRemOp IntVec 2 W64)+   , (VecRemOp IntVec 32 W8)+   , (VecRemOp IntVec 16 W16)+   , (VecRemOp IntVec 8 W32)+   , (VecRemOp IntVec 4 W64)+   , (VecRemOp IntVec 64 W8)+   , (VecRemOp IntVec 32 W16)+   , (VecRemOp IntVec 16 W32)+   , (VecRemOp IntVec 8 W64)+   , (VecRemOp WordVec 16 W8)+   , (VecRemOp WordVec 8 W16)+   , (VecRemOp WordVec 4 W32)+   , (VecRemOp WordVec 2 W64)+   , (VecRemOp WordVec 32 W8)+   , (VecRemOp WordVec 16 W16)+   , (VecRemOp WordVec 8 W32)+   , (VecRemOp WordVec 4 W64)+   , (VecRemOp WordVec 64 W8)+   , (VecRemOp WordVec 32 W16)+   , (VecRemOp WordVec 16 W32)+   , (VecRemOp WordVec 8 W64)+   , (VecNegOp IntVec 16 W8)+   , (VecNegOp IntVec 8 W16)+   , (VecNegOp IntVec 4 W32)+   , (VecNegOp IntVec 2 W64)+   , (VecNegOp IntVec 32 W8)+   , (VecNegOp IntVec 16 W16)+   , (VecNegOp IntVec 8 W32)+   , (VecNegOp IntVec 4 W64)+   , (VecNegOp IntVec 64 W8)+   , (VecNegOp IntVec 32 W16)+   , (VecNegOp IntVec 16 W32)+   , (VecNegOp IntVec 8 W64)+   , (VecNegOp FloatVec 4 W32)+   , (VecNegOp FloatVec 2 W64)+   , (VecNegOp FloatVec 8 W32)+   , (VecNegOp FloatVec 4 W64)+   , (VecNegOp FloatVec 16 W32)+   , (VecNegOp FloatVec 8 W64)+   , (VecIndexByteArrayOp IntVec 16 W8)+   , (VecIndexByteArrayOp IntVec 8 W16)+   , (VecIndexByteArrayOp IntVec 4 W32)+   , (VecIndexByteArrayOp IntVec 2 W64)+   , (VecIndexByteArrayOp IntVec 32 W8)+   , (VecIndexByteArrayOp IntVec 16 W16)+   , (VecIndexByteArrayOp IntVec 8 W32)+   , (VecIndexByteArrayOp IntVec 4 W64)+   , (VecIndexByteArrayOp IntVec 64 W8)+   , (VecIndexByteArrayOp IntVec 32 W16)+   , (VecIndexByteArrayOp IntVec 16 W32)+   , (VecIndexByteArrayOp IntVec 8 W64)+   , (VecIndexByteArrayOp WordVec 16 W8)+   , (VecIndexByteArrayOp WordVec 8 W16)+   , (VecIndexByteArrayOp WordVec 4 W32)+   , (VecIndexByteArrayOp WordVec 2 W64)+   , (VecIndexByteArrayOp WordVec 32 W8)+   , (VecIndexByteArrayOp WordVec 16 W16)+   , (VecIndexByteArrayOp WordVec 8 W32)+   , (VecIndexByteArrayOp WordVec 4 W64)+   , (VecIndexByteArrayOp WordVec 64 W8)+   , (VecIndexByteArrayOp WordVec 32 W16)+   , (VecIndexByteArrayOp WordVec 16 W32)+   , (VecIndexByteArrayOp WordVec 8 W64)+   , (VecIndexByteArrayOp FloatVec 4 W32)+   , (VecIndexByteArrayOp FloatVec 2 W64)+   , (VecIndexByteArrayOp FloatVec 8 W32)+   , (VecIndexByteArrayOp FloatVec 4 W64)+   , (VecIndexByteArrayOp FloatVec 16 W32)+   , (VecIndexByteArrayOp FloatVec 8 W64)+   , (VecReadByteArrayOp IntVec 16 W8)+   , (VecReadByteArrayOp IntVec 8 W16)+   , (VecReadByteArrayOp IntVec 4 W32)+   , (VecReadByteArrayOp IntVec 2 W64)+   , (VecReadByteArrayOp IntVec 32 W8)+   , (VecReadByteArrayOp IntVec 16 W16)+   , (VecReadByteArrayOp IntVec 8 W32)+   , (VecReadByteArrayOp IntVec 4 W64)+   , (VecReadByteArrayOp IntVec 64 W8)+   , (VecReadByteArrayOp IntVec 32 W16)+   , (VecReadByteArrayOp IntVec 16 W32)+   , (VecReadByteArrayOp IntVec 8 W64)+   , (VecReadByteArrayOp WordVec 16 W8)+   , (VecReadByteArrayOp WordVec 8 W16)+   , (VecReadByteArrayOp WordVec 4 W32)+   , (VecReadByteArrayOp WordVec 2 W64)+   , (VecReadByteArrayOp WordVec 32 W8)+   , (VecReadByteArrayOp WordVec 16 W16)+   , (VecReadByteArrayOp WordVec 8 W32)+   , (VecReadByteArrayOp WordVec 4 W64)+   , (VecReadByteArrayOp WordVec 64 W8)+   , (VecReadByteArrayOp WordVec 32 W16)+   , (VecReadByteArrayOp WordVec 16 W32)+   , (VecReadByteArrayOp WordVec 8 W64)+   , (VecReadByteArrayOp FloatVec 4 W32)+   , (VecReadByteArrayOp FloatVec 2 W64)+   , (VecReadByteArrayOp FloatVec 8 W32)+   , (VecReadByteArrayOp FloatVec 4 W64)+   , (VecReadByteArrayOp FloatVec 16 W32)+   , (VecReadByteArrayOp FloatVec 8 W64)+   , (VecWriteByteArrayOp IntVec 16 W8)+   , (VecWriteByteArrayOp IntVec 8 W16)+   , (VecWriteByteArrayOp IntVec 4 W32)+   , (VecWriteByteArrayOp IntVec 2 W64)+   , (VecWriteByteArrayOp IntVec 32 W8)+   , (VecWriteByteArrayOp IntVec 16 W16)+   , (VecWriteByteArrayOp IntVec 8 W32)+   , (VecWriteByteArrayOp IntVec 4 W64)+   , (VecWriteByteArrayOp IntVec 64 W8)+   , (VecWriteByteArrayOp IntVec 32 W16)+   , (VecWriteByteArrayOp IntVec 16 W32)+   , (VecWriteByteArrayOp IntVec 8 W64)+   , (VecWriteByteArrayOp WordVec 16 W8)+   , (VecWriteByteArrayOp WordVec 8 W16)+   , (VecWriteByteArrayOp WordVec 4 W32)+   , (VecWriteByteArrayOp WordVec 2 W64)+   , (VecWriteByteArrayOp WordVec 32 W8)+   , (VecWriteByteArrayOp WordVec 16 W16)+   , (VecWriteByteArrayOp WordVec 8 W32)+   , (VecWriteByteArrayOp WordVec 4 W64)+   , (VecWriteByteArrayOp WordVec 64 W8)+   , (VecWriteByteArrayOp WordVec 32 W16)+   , (VecWriteByteArrayOp WordVec 16 W32)+   , (VecWriteByteArrayOp WordVec 8 W64)+   , (VecWriteByteArrayOp FloatVec 4 W32)+   , (VecWriteByteArrayOp FloatVec 2 W64)+   , (VecWriteByteArrayOp FloatVec 8 W32)+   , (VecWriteByteArrayOp FloatVec 4 W64)+   , (VecWriteByteArrayOp FloatVec 16 W32)+   , (VecWriteByteArrayOp FloatVec 8 W64)+   , (VecIndexOffAddrOp IntVec 16 W8)+   , (VecIndexOffAddrOp IntVec 8 W16)+   , (VecIndexOffAddrOp IntVec 4 W32)+   , (VecIndexOffAddrOp IntVec 2 W64)+   , (VecIndexOffAddrOp IntVec 32 W8)+   , (VecIndexOffAddrOp IntVec 16 W16)+   , (VecIndexOffAddrOp IntVec 8 W32)+   , (VecIndexOffAddrOp IntVec 4 W64)+   , (VecIndexOffAddrOp IntVec 64 W8)+   , (VecIndexOffAddrOp IntVec 32 W16)+   , (VecIndexOffAddrOp IntVec 16 W32)+   , (VecIndexOffAddrOp IntVec 8 W64)+   , (VecIndexOffAddrOp WordVec 16 W8)+   , (VecIndexOffAddrOp WordVec 8 W16)+   , (VecIndexOffAddrOp WordVec 4 W32)+   , (VecIndexOffAddrOp WordVec 2 W64)+   , (VecIndexOffAddrOp WordVec 32 W8)+   , (VecIndexOffAddrOp WordVec 16 W16)+   , (VecIndexOffAddrOp WordVec 8 W32)+   , (VecIndexOffAddrOp WordVec 4 W64)+   , (VecIndexOffAddrOp WordVec 64 W8)+   , (VecIndexOffAddrOp WordVec 32 W16)+   , (VecIndexOffAddrOp WordVec 16 W32)+   , (VecIndexOffAddrOp WordVec 8 W64)+   , (VecIndexOffAddrOp FloatVec 4 W32)+   , (VecIndexOffAddrOp FloatVec 2 W64)+   , (VecIndexOffAddrOp FloatVec 8 W32)+   , (VecIndexOffAddrOp FloatVec 4 W64)+   , (VecIndexOffAddrOp FloatVec 16 W32)+   , (VecIndexOffAddrOp FloatVec 8 W64)+   , (VecReadOffAddrOp IntVec 16 W8)+   , (VecReadOffAddrOp IntVec 8 W16)+   , (VecReadOffAddrOp IntVec 4 W32)+   , (VecReadOffAddrOp IntVec 2 W64)+   , (VecReadOffAddrOp IntVec 32 W8)+   , (VecReadOffAddrOp IntVec 16 W16)+   , (VecReadOffAddrOp IntVec 8 W32)+   , (VecReadOffAddrOp IntVec 4 W64)+   , (VecReadOffAddrOp IntVec 64 W8)+   , (VecReadOffAddrOp IntVec 32 W16)+   , (VecReadOffAddrOp IntVec 16 W32)+   , (VecReadOffAddrOp IntVec 8 W64)+   , (VecReadOffAddrOp WordVec 16 W8)+   , (VecReadOffAddrOp WordVec 8 W16)+   , (VecReadOffAddrOp WordVec 4 W32)+   , (VecReadOffAddrOp WordVec 2 W64)+   , (VecReadOffAddrOp WordVec 32 W8)+   , (VecReadOffAddrOp WordVec 16 W16)+   , (VecReadOffAddrOp WordVec 8 W32)+   , (VecReadOffAddrOp WordVec 4 W64)+   , (VecReadOffAddrOp WordVec 64 W8)+   , (VecReadOffAddrOp WordVec 32 W16)+   , (VecReadOffAddrOp WordVec 16 W32)+   , (VecReadOffAddrOp WordVec 8 W64)+   , (VecReadOffAddrOp FloatVec 4 W32)+   , (VecReadOffAddrOp FloatVec 2 W64)+   , (VecReadOffAddrOp FloatVec 8 W32)+   , (VecReadOffAddrOp FloatVec 4 W64)+   , (VecReadOffAddrOp FloatVec 16 W32)+   , (VecReadOffAddrOp FloatVec 8 W64)+   , (VecWriteOffAddrOp IntVec 16 W8)+   , (VecWriteOffAddrOp IntVec 8 W16)+   , (VecWriteOffAddrOp IntVec 4 W32)+   , (VecWriteOffAddrOp IntVec 2 W64)+   , (VecWriteOffAddrOp IntVec 32 W8)+   , (VecWriteOffAddrOp IntVec 16 W16)+   , (VecWriteOffAddrOp IntVec 8 W32)+   , (VecWriteOffAddrOp IntVec 4 W64)+   , (VecWriteOffAddrOp IntVec 64 W8)+   , (VecWriteOffAddrOp IntVec 32 W16)+   , (VecWriteOffAddrOp IntVec 16 W32)+   , (VecWriteOffAddrOp IntVec 8 W64)+   , (VecWriteOffAddrOp WordVec 16 W8)+   , (VecWriteOffAddrOp WordVec 8 W16)+   , (VecWriteOffAddrOp WordVec 4 W32)+   , (VecWriteOffAddrOp WordVec 2 W64)+   , (VecWriteOffAddrOp WordVec 32 W8)+   , (VecWriteOffAddrOp WordVec 16 W16)+   , (VecWriteOffAddrOp WordVec 8 W32)+   , (VecWriteOffAddrOp WordVec 4 W64)+   , (VecWriteOffAddrOp WordVec 64 W8)+   , (VecWriteOffAddrOp WordVec 32 W16)+   , (VecWriteOffAddrOp WordVec 16 W32)+   , (VecWriteOffAddrOp WordVec 8 W64)+   , (VecWriteOffAddrOp FloatVec 4 W32)+   , (VecWriteOffAddrOp FloatVec 2 W64)+   , (VecWriteOffAddrOp FloatVec 8 W32)+   , (VecWriteOffAddrOp FloatVec 4 W64)+   , (VecWriteOffAddrOp FloatVec 16 W32)+   , (VecWriteOffAddrOp FloatVec 8 W64)+   , (VecIndexScalarByteArrayOp IntVec 16 W8)+   , (VecIndexScalarByteArrayOp IntVec 8 W16)+   , (VecIndexScalarByteArrayOp IntVec 4 W32)+   , (VecIndexScalarByteArrayOp IntVec 2 W64)+   , (VecIndexScalarByteArrayOp IntVec 32 W8)+   , (VecIndexScalarByteArrayOp IntVec 16 W16)+   , (VecIndexScalarByteArrayOp IntVec 8 W32)+   , (VecIndexScalarByteArrayOp IntVec 4 W64)+   , (VecIndexScalarByteArrayOp IntVec 64 W8)+   , (VecIndexScalarByteArrayOp IntVec 32 W16)+   , (VecIndexScalarByteArrayOp IntVec 16 W32)+   , (VecIndexScalarByteArrayOp IntVec 8 W64)+   , (VecIndexScalarByteArrayOp WordVec 16 W8)+   , (VecIndexScalarByteArrayOp WordVec 8 W16)+   , (VecIndexScalarByteArrayOp WordVec 4 W32)+   , (VecIndexScalarByteArrayOp WordVec 2 W64)+   , (VecIndexScalarByteArrayOp WordVec 32 W8)+   , (VecIndexScalarByteArrayOp WordVec 16 W16)+   , (VecIndexScalarByteArrayOp WordVec 8 W32)+   , (VecIndexScalarByteArrayOp WordVec 4 W64)+   , (VecIndexScalarByteArrayOp WordVec 64 W8)+   , (VecIndexScalarByteArrayOp WordVec 32 W16)+   , (VecIndexScalarByteArrayOp WordVec 16 W32)+   , (VecIndexScalarByteArrayOp WordVec 8 W64)+   , (VecIndexScalarByteArrayOp FloatVec 4 W32)+   , (VecIndexScalarByteArrayOp FloatVec 2 W64)+   , (VecIndexScalarByteArrayOp FloatVec 8 W32)+   , (VecIndexScalarByteArrayOp FloatVec 4 W64)+   , (VecIndexScalarByteArrayOp FloatVec 16 W32)+   , (VecIndexScalarByteArrayOp FloatVec 8 W64)+   , (VecReadScalarByteArrayOp IntVec 16 W8)+   , (VecReadScalarByteArrayOp IntVec 8 W16)+   , (VecReadScalarByteArrayOp IntVec 4 W32)+   , (VecReadScalarByteArrayOp IntVec 2 W64)+   , (VecReadScalarByteArrayOp IntVec 32 W8)+   , (VecReadScalarByteArrayOp IntVec 16 W16)+   , (VecReadScalarByteArrayOp IntVec 8 W32)+   , (VecReadScalarByteArrayOp IntVec 4 W64)+   , (VecReadScalarByteArrayOp IntVec 64 W8)+   , (VecReadScalarByteArrayOp IntVec 32 W16)+   , (VecReadScalarByteArrayOp IntVec 16 W32)+   , (VecReadScalarByteArrayOp IntVec 8 W64)+   , (VecReadScalarByteArrayOp WordVec 16 W8)+   , (VecReadScalarByteArrayOp WordVec 8 W16)+   , (VecReadScalarByteArrayOp WordVec 4 W32)+   , (VecReadScalarByteArrayOp WordVec 2 W64)+   , (VecReadScalarByteArrayOp WordVec 32 W8)+   , (VecReadScalarByteArrayOp WordVec 16 W16)+   , (VecReadScalarByteArrayOp WordVec 8 W32)+   , (VecReadScalarByteArrayOp WordVec 4 W64)+   , (VecReadScalarByteArrayOp WordVec 64 W8)+   , (VecReadScalarByteArrayOp WordVec 32 W16)+   , (VecReadScalarByteArrayOp WordVec 16 W32)+   , (VecReadScalarByteArrayOp WordVec 8 W64)+   , (VecReadScalarByteArrayOp FloatVec 4 W32)+   , (VecReadScalarByteArrayOp FloatVec 2 W64)+   , (VecReadScalarByteArrayOp FloatVec 8 W32)+   , (VecReadScalarByteArrayOp FloatVec 4 W64)+   , (VecReadScalarByteArrayOp FloatVec 16 W32)+   , (VecReadScalarByteArrayOp FloatVec 8 W64)+   , (VecWriteScalarByteArrayOp IntVec 16 W8)+   , (VecWriteScalarByteArrayOp IntVec 8 W16)+   , (VecWriteScalarByteArrayOp IntVec 4 W32)+   , (VecWriteScalarByteArrayOp IntVec 2 W64)+   , (VecWriteScalarByteArrayOp IntVec 32 W8)+   , (VecWriteScalarByteArrayOp IntVec 16 W16)+   , (VecWriteScalarByteArrayOp IntVec 8 W32)+   , (VecWriteScalarByteArrayOp IntVec 4 W64)+   , (VecWriteScalarByteArrayOp IntVec 64 W8)+   , (VecWriteScalarByteArrayOp IntVec 32 W16)+   , (VecWriteScalarByteArrayOp IntVec 16 W32)+   , (VecWriteScalarByteArrayOp IntVec 8 W64)+   , (VecWriteScalarByteArrayOp WordVec 16 W8)+   , (VecWriteScalarByteArrayOp WordVec 8 W16)+   , (VecWriteScalarByteArrayOp WordVec 4 W32)+   , (VecWriteScalarByteArrayOp WordVec 2 W64)+   , (VecWriteScalarByteArrayOp WordVec 32 W8)+   , (VecWriteScalarByteArrayOp WordVec 16 W16)+   , (VecWriteScalarByteArrayOp WordVec 8 W32)+   , (VecWriteScalarByteArrayOp WordVec 4 W64)+   , (VecWriteScalarByteArrayOp WordVec 64 W8)+   , (VecWriteScalarByteArrayOp WordVec 32 W16)+   , (VecWriteScalarByteArrayOp WordVec 16 W32)+   , (VecWriteScalarByteArrayOp WordVec 8 W64)+   , (VecWriteScalarByteArrayOp FloatVec 4 W32)+   , (VecWriteScalarByteArrayOp FloatVec 2 W64)+   , (VecWriteScalarByteArrayOp FloatVec 8 W32)+   , (VecWriteScalarByteArrayOp FloatVec 4 W64)+   , (VecWriteScalarByteArrayOp FloatVec 16 W32)+   , (VecWriteScalarByteArrayOp FloatVec 8 W64)+   , (VecIndexScalarOffAddrOp IntVec 16 W8)+   , (VecIndexScalarOffAddrOp IntVec 8 W16)+   , (VecIndexScalarOffAddrOp IntVec 4 W32)+   , (VecIndexScalarOffAddrOp IntVec 2 W64)+   , (VecIndexScalarOffAddrOp IntVec 32 W8)+   , (VecIndexScalarOffAddrOp IntVec 16 W16)+   , (VecIndexScalarOffAddrOp IntVec 8 W32)+   , (VecIndexScalarOffAddrOp IntVec 4 W64)+   , (VecIndexScalarOffAddrOp IntVec 64 W8)+   , (VecIndexScalarOffAddrOp IntVec 32 W16)+   , (VecIndexScalarOffAddrOp IntVec 16 W32)+   , (VecIndexScalarOffAddrOp IntVec 8 W64)+   , (VecIndexScalarOffAddrOp WordVec 16 W8)+   , (VecIndexScalarOffAddrOp WordVec 8 W16)+   , (VecIndexScalarOffAddrOp WordVec 4 W32)+   , (VecIndexScalarOffAddrOp WordVec 2 W64)+   , (VecIndexScalarOffAddrOp WordVec 32 W8)+   , (VecIndexScalarOffAddrOp WordVec 16 W16)+   , (VecIndexScalarOffAddrOp WordVec 8 W32)+   , (VecIndexScalarOffAddrOp WordVec 4 W64)+   , (VecIndexScalarOffAddrOp WordVec 64 W8)+   , (VecIndexScalarOffAddrOp WordVec 32 W16)+   , (VecIndexScalarOffAddrOp WordVec 16 W32)+   , (VecIndexScalarOffAddrOp WordVec 8 W64)+   , (VecIndexScalarOffAddrOp FloatVec 4 W32)+   , (VecIndexScalarOffAddrOp FloatVec 2 W64)+   , (VecIndexScalarOffAddrOp FloatVec 8 W32)+   , (VecIndexScalarOffAddrOp FloatVec 4 W64)+   , (VecIndexScalarOffAddrOp FloatVec 16 W32)+   , (VecIndexScalarOffAddrOp FloatVec 8 W64)+   , (VecReadScalarOffAddrOp IntVec 16 W8)+   , (VecReadScalarOffAddrOp IntVec 8 W16)+   , (VecReadScalarOffAddrOp IntVec 4 W32)+   , (VecReadScalarOffAddrOp IntVec 2 W64)+   , (VecReadScalarOffAddrOp IntVec 32 W8)+   , (VecReadScalarOffAddrOp IntVec 16 W16)+   , (VecReadScalarOffAddrOp IntVec 8 W32)+   , (VecReadScalarOffAddrOp IntVec 4 W64)+   , (VecReadScalarOffAddrOp IntVec 64 W8)+   , (VecReadScalarOffAddrOp IntVec 32 W16)+   , (VecReadScalarOffAddrOp IntVec 16 W32)+   , (VecReadScalarOffAddrOp IntVec 8 W64)+   , (VecReadScalarOffAddrOp WordVec 16 W8)+   , (VecReadScalarOffAddrOp WordVec 8 W16)+   , (VecReadScalarOffAddrOp WordVec 4 W32)+   , (VecReadScalarOffAddrOp WordVec 2 W64)+   , (VecReadScalarOffAddrOp WordVec 32 W8)+   , (VecReadScalarOffAddrOp WordVec 16 W16)+   , (VecReadScalarOffAddrOp WordVec 8 W32)+   , (VecReadScalarOffAddrOp WordVec 4 W64)+   , (VecReadScalarOffAddrOp WordVec 64 W8)+   , (VecReadScalarOffAddrOp WordVec 32 W16)+   , (VecReadScalarOffAddrOp WordVec 16 W32)+   , (VecReadScalarOffAddrOp WordVec 8 W64)+   , (VecReadScalarOffAddrOp FloatVec 4 W32)+   , (VecReadScalarOffAddrOp FloatVec 2 W64)+   , (VecReadScalarOffAddrOp FloatVec 8 W32)+   , (VecReadScalarOffAddrOp FloatVec 4 W64)+   , (VecReadScalarOffAddrOp FloatVec 16 W32)+   , (VecReadScalarOffAddrOp FloatVec 8 W64)+   , (VecWriteScalarOffAddrOp IntVec 16 W8)+   , (VecWriteScalarOffAddrOp IntVec 8 W16)+   , (VecWriteScalarOffAddrOp IntVec 4 W32)+   , (VecWriteScalarOffAddrOp IntVec 2 W64)+   , (VecWriteScalarOffAddrOp IntVec 32 W8)+   , (VecWriteScalarOffAddrOp IntVec 16 W16)+   , (VecWriteScalarOffAddrOp IntVec 8 W32)+   , (VecWriteScalarOffAddrOp IntVec 4 W64)+   , (VecWriteScalarOffAddrOp IntVec 64 W8)+   , (VecWriteScalarOffAddrOp IntVec 32 W16)+   , (VecWriteScalarOffAddrOp IntVec 16 W32)+   , (VecWriteScalarOffAddrOp IntVec 8 W64)+   , (VecWriteScalarOffAddrOp WordVec 16 W8)+   , (VecWriteScalarOffAddrOp WordVec 8 W16)+   , (VecWriteScalarOffAddrOp WordVec 4 W32)+   , (VecWriteScalarOffAddrOp WordVec 2 W64)+   , (VecWriteScalarOffAddrOp WordVec 32 W8)+   , (VecWriteScalarOffAddrOp WordVec 16 W16)+   , (VecWriteScalarOffAddrOp WordVec 8 W32)+   , (VecWriteScalarOffAddrOp WordVec 4 W64)+   , (VecWriteScalarOffAddrOp WordVec 64 W8)+   , (VecWriteScalarOffAddrOp WordVec 32 W16)+   , (VecWriteScalarOffAddrOp WordVec 16 W32)+   , (VecWriteScalarOffAddrOp WordVec 8 W64)+   , (VecWriteScalarOffAddrOp FloatVec 4 W32)+   , (VecWriteScalarOffAddrOp FloatVec 2 W64)+   , (VecWriteScalarOffAddrOp FloatVec 8 W32)+   , (VecWriteScalarOffAddrOp FloatVec 4 W64)+   , (VecWriteScalarOffAddrOp FloatVec 16 W32)+   , (VecWriteScalarOffAddrOp FloatVec 8 W64)+   , PrefetchByteArrayOp3+   , PrefetchMutableByteArrayOp3+   , PrefetchAddrOp3+   , PrefetchValueOp3+   , PrefetchByteArrayOp2+   , PrefetchMutableByteArrayOp2+   , PrefetchAddrOp2+   , PrefetchValueOp2+   , PrefetchByteArrayOp1+   , PrefetchMutableByteArrayOp1+   , PrefetchAddrOp1+   , PrefetchValueOp1+   , PrefetchByteArrayOp0+   , PrefetchMutableByteArrayOp0+   , PrefetchAddrOp0+   , PrefetchValueOp0+   ]
+ ghc-lib/stage1/compiler/build/primop-out-of-line.hs-incl view
@@ -0,0 +1,102 @@+primOpOutOfLine DoubleDecode_2IntOp = True+primOpOutOfLine DoubleDecode_Int64Op = True+primOpOutOfLine FloatDecode_IntOp = True+primOpOutOfLine NewArrayOp = True+primOpOutOfLine UnsafeThawArrayOp = True+primOpOutOfLine CopyArrayOp = True+primOpOutOfLine CopyMutableArrayOp = True+primOpOutOfLine CloneArrayOp = True+primOpOutOfLine CloneMutableArrayOp = True+primOpOutOfLine FreezeArrayOp = True+primOpOutOfLine ThawArrayOp = True+primOpOutOfLine CasArrayOp = True+primOpOutOfLine NewSmallArrayOp = True+primOpOutOfLine UnsafeThawSmallArrayOp = True+primOpOutOfLine CopySmallArrayOp = True+primOpOutOfLine CopySmallMutableArrayOp = True+primOpOutOfLine CloneSmallArrayOp = True+primOpOutOfLine CloneSmallMutableArrayOp = True+primOpOutOfLine FreezeSmallArrayOp = True+primOpOutOfLine ThawSmallArrayOp = True+primOpOutOfLine CasSmallArrayOp = True+primOpOutOfLine NewByteArrayOp_Char = True+primOpOutOfLine NewPinnedByteArrayOp_Char = True+primOpOutOfLine NewAlignedPinnedByteArrayOp_Char = True+primOpOutOfLine MutableByteArrayIsPinnedOp = True+primOpOutOfLine ByteArrayIsPinnedOp = True+primOpOutOfLine ShrinkMutableByteArrayOp_Char = True+primOpOutOfLine ResizeMutableByteArrayOp_Char = True+primOpOutOfLine NewArrayArrayOp = True+primOpOutOfLine CopyArrayArrayOp = True+primOpOutOfLine CopyMutableArrayArrayOp = True+primOpOutOfLine NewMutVarOp = True+primOpOutOfLine AtomicModifyMutVar2Op = True+primOpOutOfLine AtomicModifyMutVar_Op = True+primOpOutOfLine CasMutVarOp = True+primOpOutOfLine CatchOp = True+primOpOutOfLine RaiseOp = True+primOpOutOfLine RaiseIOOp = True+primOpOutOfLine MaskAsyncExceptionsOp = True+primOpOutOfLine MaskUninterruptibleOp = True+primOpOutOfLine UnmaskAsyncExceptionsOp = True+primOpOutOfLine MaskStatus = True+primOpOutOfLine AtomicallyOp = True+primOpOutOfLine RetryOp = True+primOpOutOfLine CatchRetryOp = True+primOpOutOfLine CatchSTMOp = True+primOpOutOfLine NewTVarOp = True+primOpOutOfLine ReadTVarOp = True+primOpOutOfLine ReadTVarIOOp = True+primOpOutOfLine WriteTVarOp = True+primOpOutOfLine NewMVarOp = True+primOpOutOfLine TakeMVarOp = True+primOpOutOfLine TryTakeMVarOp = True+primOpOutOfLine PutMVarOp = True+primOpOutOfLine TryPutMVarOp = True+primOpOutOfLine ReadMVarOp = True+primOpOutOfLine TryReadMVarOp = True+primOpOutOfLine IsEmptyMVarOp = True+primOpOutOfLine DelayOp = True+primOpOutOfLine WaitReadOp = True+primOpOutOfLine WaitWriteOp = True+primOpOutOfLine ForkOp = True+primOpOutOfLine ForkOnOp = True+primOpOutOfLine KillThreadOp = True+primOpOutOfLine YieldOp = True+primOpOutOfLine LabelThreadOp = True+primOpOutOfLine IsCurrentThreadBoundOp = True+primOpOutOfLine NoDuplicateOp = True+primOpOutOfLine ThreadStatusOp = True+primOpOutOfLine MkWeakOp = True+primOpOutOfLine MkWeakNoFinalizerOp = True+primOpOutOfLine AddCFinalizerToWeakOp = True+primOpOutOfLine DeRefWeakOp = True+primOpOutOfLine FinalizeWeakOp = True+primOpOutOfLine MakeStablePtrOp = True+primOpOutOfLine DeRefStablePtrOp = True+primOpOutOfLine MakeStableNameOp = True+primOpOutOfLine CompactNewOp = True+primOpOutOfLine CompactResizeOp = True+primOpOutOfLine CompactContainsOp = True+primOpOutOfLine CompactContainsAnyOp = True+primOpOutOfLine CompactGetFirstBlockOp = True+primOpOutOfLine CompactGetNextBlockOp = True+primOpOutOfLine CompactAllocateBlockOp = True+primOpOutOfLine CompactFixupPointersOp = True+primOpOutOfLine CompactAdd = True+primOpOutOfLine CompactAddWithSharing = True+primOpOutOfLine CompactSize = True+primOpOutOfLine GetSparkOp = True+primOpOutOfLine NumSparks = True+primOpOutOfLine MkApUpd0_Op = True+primOpOutOfLine NewBCOOp = True+primOpOutOfLine UnpackClosureOp = True+primOpOutOfLine ClosureSizeOp = True+primOpOutOfLine GetApStackValOp = True+primOpOutOfLine ClearCCSOp = True+primOpOutOfLine TraceEventOp = True+primOpOutOfLine TraceEventBinaryOp = True+primOpOutOfLine TraceMarkerOp = True+primOpOutOfLine GetThreadAllocationCounter = True+primOpOutOfLine SetThreadAllocationCounter = True+primOpOutOfLine _ = False
+ ghc-lib/stage1/compiler/build/primop-primop-info.hs-incl view
@@ -0,0 +1,1198 @@+primOpInfo CharGtOp = mkCompare (fsLit "gtChar#") charPrimTy+primOpInfo CharGeOp = mkCompare (fsLit "geChar#") charPrimTy+primOpInfo CharEqOp = mkCompare (fsLit "eqChar#") charPrimTy+primOpInfo CharNeOp = mkCompare (fsLit "neChar#") charPrimTy+primOpInfo CharLtOp = mkCompare (fsLit "ltChar#") charPrimTy+primOpInfo CharLeOp = mkCompare (fsLit "leChar#") charPrimTy+primOpInfo OrdOp = mkGenPrimOp (fsLit "ord#")  [] [charPrimTy] (intPrimTy)+primOpInfo IntAddOp = mkDyadic (fsLit "+#") intPrimTy+primOpInfo IntSubOp = mkDyadic (fsLit "-#") intPrimTy+primOpInfo IntMulOp = mkDyadic (fsLit "*#") intPrimTy+primOpInfo IntMulMayOfloOp = mkDyadic (fsLit "mulIntMayOflo#") intPrimTy+primOpInfo IntQuotOp = mkDyadic (fsLit "quotInt#") intPrimTy+primOpInfo IntRemOp = mkDyadic (fsLit "remInt#") intPrimTy+primOpInfo IntQuotRemOp = mkGenPrimOp (fsLit "quotRemInt#")  [] [intPrimTy, intPrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy]))+primOpInfo AndIOp = mkDyadic (fsLit "andI#") intPrimTy+primOpInfo OrIOp = mkDyadic (fsLit "orI#") intPrimTy+primOpInfo XorIOp = mkDyadic (fsLit "xorI#") intPrimTy+primOpInfo NotIOp = mkMonadic (fsLit "notI#") intPrimTy+primOpInfo IntNegOp = mkMonadic (fsLit "negateInt#") intPrimTy+primOpInfo IntAddCOp = mkGenPrimOp (fsLit "addIntC#")  [] [intPrimTy, intPrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy]))+primOpInfo IntSubCOp = mkGenPrimOp (fsLit "subIntC#")  [] [intPrimTy, intPrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy]))+primOpInfo IntGtOp = mkCompare (fsLit ">#") intPrimTy+primOpInfo IntGeOp = mkCompare (fsLit ">=#") intPrimTy+primOpInfo IntEqOp = mkCompare (fsLit "==#") intPrimTy+primOpInfo IntNeOp = mkCompare (fsLit "/=#") intPrimTy+primOpInfo IntLtOp = mkCompare (fsLit "<#") intPrimTy+primOpInfo IntLeOp = mkCompare (fsLit "<=#") intPrimTy+primOpInfo ChrOp = mkGenPrimOp (fsLit "chr#")  [] [intPrimTy] (charPrimTy)+primOpInfo Int2WordOp = mkGenPrimOp (fsLit "int2Word#")  [] [intPrimTy] (wordPrimTy)+primOpInfo Int2FloatOp = mkGenPrimOp (fsLit "int2Float#")  [] [intPrimTy] (floatPrimTy)+primOpInfo Int2DoubleOp = mkGenPrimOp (fsLit "int2Double#")  [] [intPrimTy] (doublePrimTy)+primOpInfo Word2FloatOp = mkGenPrimOp (fsLit "word2Float#")  [] [wordPrimTy] (floatPrimTy)+primOpInfo Word2DoubleOp = mkGenPrimOp (fsLit "word2Double#")  [] [wordPrimTy] (doublePrimTy)+primOpInfo ISllOp = mkGenPrimOp (fsLit "uncheckedIShiftL#")  [] [intPrimTy, intPrimTy] (intPrimTy)+primOpInfo ISraOp = mkGenPrimOp (fsLit "uncheckedIShiftRA#")  [] [intPrimTy, intPrimTy] (intPrimTy)+primOpInfo ISrlOp = mkGenPrimOp (fsLit "uncheckedIShiftRL#")  [] [intPrimTy, intPrimTy] (intPrimTy)+primOpInfo Int8Extend = mkGenPrimOp (fsLit "extendInt8#")  [] [int8PrimTy] (intPrimTy)+primOpInfo Int8Narrow = mkGenPrimOp (fsLit "narrowInt8#")  [] [intPrimTy] (int8PrimTy)+primOpInfo Int8NegOp = mkMonadic (fsLit "negateInt8#") int8PrimTy+primOpInfo Int8AddOp = mkDyadic (fsLit "plusInt8#") int8PrimTy+primOpInfo Int8SubOp = mkDyadic (fsLit "subInt8#") int8PrimTy+primOpInfo Int8MulOp = mkDyadic (fsLit "timesInt8#") int8PrimTy+primOpInfo Int8QuotOp = mkDyadic (fsLit "quotInt8#") int8PrimTy+primOpInfo Int8RemOp = mkDyadic (fsLit "remInt8#") int8PrimTy+primOpInfo Int8QuotRemOp = mkGenPrimOp (fsLit "quotRemInt8#")  [] [int8PrimTy, int8PrimTy] ((mkTupleTy Unboxed [int8PrimTy, int8PrimTy]))+primOpInfo Int8EqOp = mkCompare (fsLit "eqInt8#") int8PrimTy+primOpInfo Int8GeOp = mkCompare (fsLit "geInt8#") int8PrimTy+primOpInfo Int8GtOp = mkCompare (fsLit "gtInt8#") int8PrimTy+primOpInfo Int8LeOp = mkCompare (fsLit "leInt8#") int8PrimTy+primOpInfo Int8LtOp = mkCompare (fsLit "ltInt8#") int8PrimTy+primOpInfo Int8NeOp = mkCompare (fsLit "neInt8#") int8PrimTy+primOpInfo Word8Extend = mkGenPrimOp (fsLit "extendWord8#")  [] [word8PrimTy] (wordPrimTy)+primOpInfo Word8Narrow = mkGenPrimOp (fsLit "narrowWord8#")  [] [wordPrimTy] (word8PrimTy)+primOpInfo Word8NotOp = mkMonadic (fsLit "notWord8#") word8PrimTy+primOpInfo Word8AddOp = mkDyadic (fsLit "plusWord8#") word8PrimTy+primOpInfo Word8SubOp = mkDyadic (fsLit "subWord8#") word8PrimTy+primOpInfo Word8MulOp = mkDyadic (fsLit "timesWord8#") word8PrimTy+primOpInfo Word8QuotOp = mkDyadic (fsLit "quotWord8#") word8PrimTy+primOpInfo Word8RemOp = mkDyadic (fsLit "remWord8#") word8PrimTy+primOpInfo Word8QuotRemOp = mkGenPrimOp (fsLit "quotRemWord8#")  [] [word8PrimTy, word8PrimTy] ((mkTupleTy Unboxed [word8PrimTy, word8PrimTy]))+primOpInfo Word8EqOp = mkCompare (fsLit "eqWord8#") word8PrimTy+primOpInfo Word8GeOp = mkCompare (fsLit "geWord8#") word8PrimTy+primOpInfo Word8GtOp = mkCompare (fsLit "gtWord8#") word8PrimTy+primOpInfo Word8LeOp = mkCompare (fsLit "leWord8#") word8PrimTy+primOpInfo Word8LtOp = mkCompare (fsLit "ltWord8#") word8PrimTy+primOpInfo Word8NeOp = mkCompare (fsLit "neWord8#") word8PrimTy+primOpInfo Int16Extend = mkGenPrimOp (fsLit "extendInt16#")  [] [int16PrimTy] (intPrimTy)+primOpInfo Int16Narrow = mkGenPrimOp (fsLit "narrowInt16#")  [] [intPrimTy] (int16PrimTy)+primOpInfo Int16NegOp = mkMonadic (fsLit "negateInt16#") int16PrimTy+primOpInfo Int16AddOp = mkDyadic (fsLit "plusInt16#") int16PrimTy+primOpInfo Int16SubOp = mkDyadic (fsLit "subInt16#") int16PrimTy+primOpInfo Int16MulOp = mkDyadic (fsLit "timesInt16#") int16PrimTy+primOpInfo Int16QuotOp = mkDyadic (fsLit "quotInt16#") int16PrimTy+primOpInfo Int16RemOp = mkDyadic (fsLit "remInt16#") int16PrimTy+primOpInfo Int16QuotRemOp = mkGenPrimOp (fsLit "quotRemInt16#")  [] [int16PrimTy, int16PrimTy] ((mkTupleTy Unboxed [int16PrimTy, int16PrimTy]))+primOpInfo Int16EqOp = mkCompare (fsLit "eqInt16#") int16PrimTy+primOpInfo Int16GeOp = mkCompare (fsLit "geInt16#") int16PrimTy+primOpInfo Int16GtOp = mkCompare (fsLit "gtInt16#") int16PrimTy+primOpInfo Int16LeOp = mkCompare (fsLit "leInt16#") int16PrimTy+primOpInfo Int16LtOp = mkCompare (fsLit "ltInt16#") int16PrimTy+primOpInfo Int16NeOp = mkCompare (fsLit "neInt16#") int16PrimTy+primOpInfo Word16Extend = mkGenPrimOp (fsLit "extendWord16#")  [] [word16PrimTy] (wordPrimTy)+primOpInfo Word16Narrow = mkGenPrimOp (fsLit "narrowWord16#")  [] [wordPrimTy] (word16PrimTy)+primOpInfo Word16NotOp = mkMonadic (fsLit "notWord16#") word16PrimTy+primOpInfo Word16AddOp = mkDyadic (fsLit "plusWord16#") word16PrimTy+primOpInfo Word16SubOp = mkDyadic (fsLit "subWord16#") word16PrimTy+primOpInfo Word16MulOp = mkDyadic (fsLit "timesWord16#") word16PrimTy+primOpInfo Word16QuotOp = mkDyadic (fsLit "quotWord16#") word16PrimTy+primOpInfo Word16RemOp = mkDyadic (fsLit "remWord16#") word16PrimTy+primOpInfo Word16QuotRemOp = mkGenPrimOp (fsLit "quotRemWord16#")  [] [word16PrimTy, word16PrimTy] ((mkTupleTy Unboxed [word16PrimTy, word16PrimTy]))+primOpInfo Word16EqOp = mkCompare (fsLit "eqWord16#") word16PrimTy+primOpInfo Word16GeOp = mkCompare (fsLit "geWord16#") word16PrimTy+primOpInfo Word16GtOp = mkCompare (fsLit "gtWord16#") word16PrimTy+primOpInfo Word16LeOp = mkCompare (fsLit "leWord16#") word16PrimTy+primOpInfo Word16LtOp = mkCompare (fsLit "ltWord16#") word16PrimTy+primOpInfo Word16NeOp = mkCompare (fsLit "neWord16#") word16PrimTy+primOpInfo WordAddOp = mkDyadic (fsLit "plusWord#") wordPrimTy+primOpInfo WordAddCOp = mkGenPrimOp (fsLit "addWordC#")  [] [wordPrimTy, wordPrimTy] ((mkTupleTy Unboxed [wordPrimTy, intPrimTy]))+primOpInfo WordSubCOp = mkGenPrimOp (fsLit "subWordC#")  [] [wordPrimTy, wordPrimTy] ((mkTupleTy Unboxed [wordPrimTy, intPrimTy]))+primOpInfo WordAdd2Op = mkGenPrimOp (fsLit "plusWord2#")  [] [wordPrimTy, wordPrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy]))+primOpInfo WordSubOp = mkDyadic (fsLit "minusWord#") wordPrimTy+primOpInfo WordMulOp = mkDyadic (fsLit "timesWord#") wordPrimTy+primOpInfo WordMul2Op = mkGenPrimOp (fsLit "timesWord2#")  [] [wordPrimTy, wordPrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy]))+primOpInfo WordQuotOp = mkDyadic (fsLit "quotWord#") wordPrimTy+primOpInfo WordRemOp = mkDyadic (fsLit "remWord#") wordPrimTy+primOpInfo WordQuotRemOp = mkGenPrimOp (fsLit "quotRemWord#")  [] [wordPrimTy, wordPrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy]))+primOpInfo WordQuotRem2Op = mkGenPrimOp (fsLit "quotRemWord2#")  [] [wordPrimTy, wordPrimTy, wordPrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy]))+primOpInfo AndOp = mkDyadic (fsLit "and#") wordPrimTy+primOpInfo OrOp = mkDyadic (fsLit "or#") wordPrimTy+primOpInfo XorOp = mkDyadic (fsLit "xor#") wordPrimTy+primOpInfo NotOp = mkMonadic (fsLit "not#") wordPrimTy+primOpInfo SllOp = mkGenPrimOp (fsLit "uncheckedShiftL#")  [] [wordPrimTy, intPrimTy] (wordPrimTy)+primOpInfo SrlOp = mkGenPrimOp (fsLit "uncheckedShiftRL#")  [] [wordPrimTy, intPrimTy] (wordPrimTy)+primOpInfo Word2IntOp = mkGenPrimOp (fsLit "word2Int#")  [] [wordPrimTy] (intPrimTy)+primOpInfo WordGtOp = mkCompare (fsLit "gtWord#") wordPrimTy+primOpInfo WordGeOp = mkCompare (fsLit "geWord#") wordPrimTy+primOpInfo WordEqOp = mkCompare (fsLit "eqWord#") wordPrimTy+primOpInfo WordNeOp = mkCompare (fsLit "neWord#") wordPrimTy+primOpInfo WordLtOp = mkCompare (fsLit "ltWord#") wordPrimTy+primOpInfo WordLeOp = mkCompare (fsLit "leWord#") wordPrimTy+primOpInfo PopCnt8Op = mkMonadic (fsLit "popCnt8#") wordPrimTy+primOpInfo PopCnt16Op = mkMonadic (fsLit "popCnt16#") wordPrimTy+primOpInfo PopCnt32Op = mkMonadic (fsLit "popCnt32#") wordPrimTy+primOpInfo PopCnt64Op = mkGenPrimOp (fsLit "popCnt64#")  [] [wordPrimTy] (wordPrimTy)+primOpInfo PopCntOp = mkMonadic (fsLit "popCnt#") wordPrimTy+primOpInfo Pdep8Op = mkDyadic (fsLit "pdep8#") wordPrimTy+primOpInfo Pdep16Op = mkDyadic (fsLit "pdep16#") wordPrimTy+primOpInfo Pdep32Op = mkDyadic (fsLit "pdep32#") wordPrimTy+primOpInfo Pdep64Op = mkGenPrimOp (fsLit "pdep64#")  [] [wordPrimTy, wordPrimTy] (wordPrimTy)+primOpInfo PdepOp = mkDyadic (fsLit "pdep#") wordPrimTy+primOpInfo Pext8Op = mkDyadic (fsLit "pext8#") wordPrimTy+primOpInfo Pext16Op = mkDyadic (fsLit "pext16#") wordPrimTy+primOpInfo Pext32Op = mkDyadic (fsLit "pext32#") wordPrimTy+primOpInfo Pext64Op = mkGenPrimOp (fsLit "pext64#")  [] [wordPrimTy, wordPrimTy] (wordPrimTy)+primOpInfo PextOp = mkDyadic (fsLit "pext#") wordPrimTy+primOpInfo Clz8Op = mkMonadic (fsLit "clz8#") wordPrimTy+primOpInfo Clz16Op = mkMonadic (fsLit "clz16#") wordPrimTy+primOpInfo Clz32Op = mkMonadic (fsLit "clz32#") wordPrimTy+primOpInfo Clz64Op = mkGenPrimOp (fsLit "clz64#")  [] [wordPrimTy] (wordPrimTy)+primOpInfo ClzOp = mkMonadic (fsLit "clz#") wordPrimTy+primOpInfo Ctz8Op = mkMonadic (fsLit "ctz8#") wordPrimTy+primOpInfo Ctz16Op = mkMonadic (fsLit "ctz16#") wordPrimTy+primOpInfo Ctz32Op = mkMonadic (fsLit "ctz32#") wordPrimTy+primOpInfo Ctz64Op = mkGenPrimOp (fsLit "ctz64#")  [] [wordPrimTy] (wordPrimTy)+primOpInfo CtzOp = mkMonadic (fsLit "ctz#") wordPrimTy+primOpInfo BSwap16Op = mkMonadic (fsLit "byteSwap16#") wordPrimTy+primOpInfo BSwap32Op = mkMonadic (fsLit "byteSwap32#") wordPrimTy+primOpInfo BSwap64Op = mkMonadic (fsLit "byteSwap64#") wordPrimTy+primOpInfo BSwapOp = mkMonadic (fsLit "byteSwap#") wordPrimTy+primOpInfo BRev8Op = mkMonadic (fsLit "bitReverse8#") wordPrimTy+primOpInfo BRev16Op = mkMonadic (fsLit "bitReverse16#") wordPrimTy+primOpInfo BRev32Op = mkMonadic (fsLit "bitReverse32#") wordPrimTy+primOpInfo BRev64Op = mkMonadic (fsLit "bitReverse64#") wordPrimTy+primOpInfo BRevOp = mkMonadic (fsLit "bitReverse#") wordPrimTy+primOpInfo Narrow8IntOp = mkMonadic (fsLit "narrow8Int#") intPrimTy+primOpInfo Narrow16IntOp = mkMonadic (fsLit "narrow16Int#") intPrimTy+primOpInfo Narrow32IntOp = mkMonadic (fsLit "narrow32Int#") intPrimTy+primOpInfo Narrow8WordOp = mkMonadic (fsLit "narrow8Word#") wordPrimTy+primOpInfo Narrow16WordOp = mkMonadic (fsLit "narrow16Word#") wordPrimTy+primOpInfo Narrow32WordOp = mkMonadic (fsLit "narrow32Word#") wordPrimTy+primOpInfo DoubleGtOp = mkCompare (fsLit ">##") doublePrimTy+primOpInfo DoubleGeOp = mkCompare (fsLit ">=##") doublePrimTy+primOpInfo DoubleEqOp = mkCompare (fsLit "==##") doublePrimTy+primOpInfo DoubleNeOp = mkCompare (fsLit "/=##") doublePrimTy+primOpInfo DoubleLtOp = mkCompare (fsLit "<##") doublePrimTy+primOpInfo DoubleLeOp = mkCompare (fsLit "<=##") doublePrimTy+primOpInfo DoubleAddOp = mkDyadic (fsLit "+##") doublePrimTy+primOpInfo DoubleSubOp = mkDyadic (fsLit "-##") doublePrimTy+primOpInfo DoubleMulOp = mkDyadic (fsLit "*##") doublePrimTy+primOpInfo DoubleDivOp = mkDyadic (fsLit "/##") doublePrimTy+primOpInfo DoubleNegOp = mkMonadic (fsLit "negateDouble#") doublePrimTy+primOpInfo DoubleFabsOp = mkMonadic (fsLit "fabsDouble#") doublePrimTy+primOpInfo Double2IntOp = mkGenPrimOp (fsLit "double2Int#")  [] [doublePrimTy] (intPrimTy)+primOpInfo Double2FloatOp = mkGenPrimOp (fsLit "double2Float#")  [] [doublePrimTy] (floatPrimTy)+primOpInfo DoubleExpOp = mkMonadic (fsLit "expDouble#") doublePrimTy+primOpInfo DoubleLogOp = mkMonadic (fsLit "logDouble#") doublePrimTy+primOpInfo DoubleSqrtOp = mkMonadic (fsLit "sqrtDouble#") doublePrimTy+primOpInfo DoubleSinOp = mkMonadic (fsLit "sinDouble#") doublePrimTy+primOpInfo DoubleCosOp = mkMonadic (fsLit "cosDouble#") doublePrimTy+primOpInfo DoubleTanOp = mkMonadic (fsLit "tanDouble#") doublePrimTy+primOpInfo DoubleAsinOp = mkMonadic (fsLit "asinDouble#") doublePrimTy+primOpInfo DoubleAcosOp = mkMonadic (fsLit "acosDouble#") doublePrimTy+primOpInfo DoubleAtanOp = mkMonadic (fsLit "atanDouble#") doublePrimTy+primOpInfo DoubleSinhOp = mkMonadic (fsLit "sinhDouble#") doublePrimTy+primOpInfo DoubleCoshOp = mkMonadic (fsLit "coshDouble#") doublePrimTy+primOpInfo DoubleTanhOp = mkMonadic (fsLit "tanhDouble#") doublePrimTy+primOpInfo DoubleAsinhOp = mkMonadic (fsLit "asinhDouble#") doublePrimTy+primOpInfo DoubleAcoshOp = mkMonadic (fsLit "acoshDouble#") doublePrimTy+primOpInfo DoubleAtanhOp = mkMonadic (fsLit "atanhDouble#") doublePrimTy+primOpInfo DoublePowerOp = mkDyadic (fsLit "**##") doublePrimTy+primOpInfo DoubleDecode_2IntOp = mkGenPrimOp (fsLit "decodeDouble_2Int#")  [] [doublePrimTy] ((mkTupleTy Unboxed [intPrimTy, wordPrimTy, wordPrimTy, intPrimTy]))+primOpInfo DoubleDecode_Int64Op = mkGenPrimOp (fsLit "decodeDouble_Int64#")  [] [doublePrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy]))+primOpInfo FloatGtOp = mkCompare (fsLit "gtFloat#") floatPrimTy+primOpInfo FloatGeOp = mkCompare (fsLit "geFloat#") floatPrimTy+primOpInfo FloatEqOp = mkCompare (fsLit "eqFloat#") floatPrimTy+primOpInfo FloatNeOp = mkCompare (fsLit "neFloat#") floatPrimTy+primOpInfo FloatLtOp = mkCompare (fsLit "ltFloat#") floatPrimTy+primOpInfo FloatLeOp = mkCompare (fsLit "leFloat#") floatPrimTy+primOpInfo FloatAddOp = mkDyadic (fsLit "plusFloat#") floatPrimTy+primOpInfo FloatSubOp = mkDyadic (fsLit "minusFloat#") floatPrimTy+primOpInfo FloatMulOp = mkDyadic (fsLit "timesFloat#") floatPrimTy+primOpInfo FloatDivOp = mkDyadic (fsLit "divideFloat#") floatPrimTy+primOpInfo FloatNegOp = mkMonadic (fsLit "negateFloat#") floatPrimTy+primOpInfo FloatFabsOp = mkMonadic (fsLit "fabsFloat#") floatPrimTy+primOpInfo Float2IntOp = mkGenPrimOp (fsLit "float2Int#")  [] [floatPrimTy] (intPrimTy)+primOpInfo FloatExpOp = mkMonadic (fsLit "expFloat#") floatPrimTy+primOpInfo FloatLogOp = mkMonadic (fsLit "logFloat#") floatPrimTy+primOpInfo FloatSqrtOp = mkMonadic (fsLit "sqrtFloat#") floatPrimTy+primOpInfo FloatSinOp = mkMonadic (fsLit "sinFloat#") floatPrimTy+primOpInfo FloatCosOp = mkMonadic (fsLit "cosFloat#") floatPrimTy+primOpInfo FloatTanOp = mkMonadic (fsLit "tanFloat#") floatPrimTy+primOpInfo FloatAsinOp = mkMonadic (fsLit "asinFloat#") floatPrimTy+primOpInfo FloatAcosOp = mkMonadic (fsLit "acosFloat#") floatPrimTy+primOpInfo FloatAtanOp = mkMonadic (fsLit "atanFloat#") floatPrimTy+primOpInfo FloatSinhOp = mkMonadic (fsLit "sinhFloat#") floatPrimTy+primOpInfo FloatCoshOp = mkMonadic (fsLit "coshFloat#") floatPrimTy+primOpInfo FloatTanhOp = mkMonadic (fsLit "tanhFloat#") floatPrimTy+primOpInfo FloatAsinhOp = mkMonadic (fsLit "asinhFloat#") floatPrimTy+primOpInfo FloatAcoshOp = mkMonadic (fsLit "acoshFloat#") floatPrimTy+primOpInfo FloatAtanhOp = mkMonadic (fsLit "atanhFloat#") floatPrimTy+primOpInfo FloatPowerOp = mkDyadic (fsLit "powerFloat#") floatPrimTy+primOpInfo Float2DoubleOp = mkGenPrimOp (fsLit "float2Double#")  [] [floatPrimTy] (doublePrimTy)+primOpInfo FloatDecode_IntOp = mkGenPrimOp (fsLit "decodeFloat_Int#")  [] [floatPrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy]))+primOpInfo NewArrayOp = mkGenPrimOp (fsLit "newArray#")  [alphaTyVar, deltaTyVar] [intPrimTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy]))+primOpInfo SameMutableArrayOp = mkGenPrimOp (fsLit "sameMutableArray#")  [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, mkMutableArrayPrimTy deltaTy alphaTy] (intPrimTy)+primOpInfo ReadArrayOp = mkGenPrimOp (fsLit "readArray#")  [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy]))+primOpInfo WriteArrayOp = mkGenPrimOp (fsLit "writeArray#")  [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo SizeofArrayOp = mkGenPrimOp (fsLit "sizeofArray#")  [alphaTyVar] [mkArrayPrimTy alphaTy] (intPrimTy)+primOpInfo SizeofMutableArrayOp = mkGenPrimOp (fsLit "sizeofMutableArray#")  [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy] (intPrimTy)+primOpInfo IndexArrayOp = mkGenPrimOp (fsLit "indexArray#")  [alphaTyVar] [mkArrayPrimTy alphaTy, intPrimTy] ((mkTupleTy Unboxed [alphaTy]))+primOpInfo UnsafeFreezeArrayOp = mkGenPrimOp (fsLit "unsafeFreezeArray#")  [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkArrayPrimTy alphaTy]))+primOpInfo UnsafeThawArrayOp = mkGenPrimOp (fsLit "unsafeThawArray#")  [alphaTyVar, deltaTyVar] [mkArrayPrimTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy]))+primOpInfo CopyArrayOp = mkGenPrimOp (fsLit "copyArray#")  [alphaTyVar, deltaTyVar] [mkArrayPrimTy alphaTy, intPrimTy, mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo CopyMutableArrayOp = mkGenPrimOp (fsLit "copyMutableArray#")  [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo CloneArrayOp = mkGenPrimOp (fsLit "cloneArray#")  [alphaTyVar] [mkArrayPrimTy alphaTy, intPrimTy, intPrimTy] (mkArrayPrimTy alphaTy)+primOpInfo CloneMutableArrayOp = mkGenPrimOp (fsLit "cloneMutableArray#")  [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy]))+primOpInfo FreezeArrayOp = mkGenPrimOp (fsLit "freezeArray#")  [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkArrayPrimTy alphaTy]))+primOpInfo ThawArrayOp = mkGenPrimOp (fsLit "thawArray#")  [alphaTyVar, deltaTyVar] [mkArrayPrimTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy]))+primOpInfo CasArrayOp = mkGenPrimOp (fsLit "casArray#")  [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy]))+primOpInfo NewSmallArrayOp = mkGenPrimOp (fsLit "newSmallArray#")  [alphaTyVar, deltaTyVar] [intPrimTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkSmallMutableArrayPrimTy deltaTy alphaTy]))+primOpInfo SameSmallMutableArrayOp = mkGenPrimOp (fsLit "sameSmallMutableArray#")  [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, mkSmallMutableArrayPrimTy deltaTy alphaTy] (intPrimTy)+primOpInfo ReadSmallArrayOp = mkGenPrimOp (fsLit "readSmallArray#")  [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy]))+primOpInfo WriteSmallArrayOp = mkGenPrimOp (fsLit "writeSmallArray#")  [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo SizeofSmallArrayOp = mkGenPrimOp (fsLit "sizeofSmallArray#")  [alphaTyVar] [mkSmallArrayPrimTy alphaTy] (intPrimTy)+primOpInfo SizeofSmallMutableArrayOp = mkGenPrimOp (fsLit "sizeofSmallMutableArray#")  [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy] (intPrimTy)+primOpInfo IndexSmallArrayOp = mkGenPrimOp (fsLit "indexSmallArray#")  [alphaTyVar] [mkSmallArrayPrimTy alphaTy, intPrimTy] ((mkTupleTy Unboxed [alphaTy]))+primOpInfo UnsafeFreezeSmallArrayOp = mkGenPrimOp (fsLit "unsafeFreezeSmallArray#")  [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkSmallArrayPrimTy alphaTy]))+primOpInfo UnsafeThawSmallArrayOp = mkGenPrimOp (fsLit "unsafeThawSmallArray#")  [alphaTyVar, deltaTyVar] [mkSmallArrayPrimTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkSmallMutableArrayPrimTy deltaTy alphaTy]))+primOpInfo CopySmallArrayOp = mkGenPrimOp (fsLit "copySmallArray#")  [alphaTyVar, deltaTyVar] [mkSmallArrayPrimTy alphaTy, intPrimTy, mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo CopySmallMutableArrayOp = mkGenPrimOp (fsLit "copySmallMutableArray#")  [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo CloneSmallArrayOp = mkGenPrimOp (fsLit "cloneSmallArray#")  [alphaTyVar] [mkSmallArrayPrimTy alphaTy, intPrimTy, intPrimTy] (mkSmallArrayPrimTy alphaTy)+primOpInfo CloneSmallMutableArrayOp = mkGenPrimOp (fsLit "cloneSmallMutableArray#")  [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkSmallMutableArrayPrimTy deltaTy alphaTy]))+primOpInfo FreezeSmallArrayOp = mkGenPrimOp (fsLit "freezeSmallArray#")  [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkSmallArrayPrimTy alphaTy]))+primOpInfo ThawSmallArrayOp = mkGenPrimOp (fsLit "thawSmallArray#")  [alphaTyVar, deltaTyVar] [mkSmallArrayPrimTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkSmallMutableArrayPrimTy deltaTy alphaTy]))+primOpInfo CasSmallArrayOp = mkGenPrimOp (fsLit "casSmallArray#")  [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy]))+primOpInfo NewByteArrayOp_Char = mkGenPrimOp (fsLit "newByteArray#")  [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy]))+primOpInfo NewPinnedByteArrayOp_Char = mkGenPrimOp (fsLit "newPinnedByteArray#")  [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy]))+primOpInfo NewAlignedPinnedByteArrayOp_Char = mkGenPrimOp (fsLit "newAlignedPinnedByteArray#")  [deltaTyVar] [intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy]))+primOpInfo MutableByteArrayIsPinnedOp = mkGenPrimOp (fsLit "isMutableByteArrayPinned#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy] (intPrimTy)+primOpInfo ByteArrayIsPinnedOp = mkGenPrimOp (fsLit "isByteArrayPinned#")  [] [byteArrayPrimTy] (intPrimTy)+primOpInfo ByteArrayContents_Char = mkGenPrimOp (fsLit "byteArrayContents#")  [] [byteArrayPrimTy] (addrPrimTy)+primOpInfo SameMutableByteArrayOp = mkGenPrimOp (fsLit "sameMutableByteArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy] (intPrimTy)+primOpInfo ShrinkMutableByteArrayOp_Char = mkGenPrimOp (fsLit "shrinkMutableByteArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo ResizeMutableByteArrayOp_Char = mkGenPrimOp (fsLit "resizeMutableByteArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy]))+primOpInfo UnsafeFreezeByteArrayOp = mkGenPrimOp (fsLit "unsafeFreezeByteArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, byteArrayPrimTy]))+primOpInfo SizeofByteArrayOp = mkGenPrimOp (fsLit "sizeofByteArray#")  [] [byteArrayPrimTy] (intPrimTy)+primOpInfo SizeofMutableByteArrayOp = mkGenPrimOp (fsLit "sizeofMutableByteArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy] (intPrimTy)+primOpInfo GetSizeofMutableByteArrayOp = mkGenPrimOp (fsLit "getSizeofMutableByteArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo IndexByteArrayOp_Char = mkGenPrimOp (fsLit "indexCharArray#")  [] [byteArrayPrimTy, intPrimTy] (charPrimTy)+primOpInfo IndexByteArrayOp_WideChar = mkGenPrimOp (fsLit "indexWideCharArray#")  [] [byteArrayPrimTy, intPrimTy] (charPrimTy)+primOpInfo IndexByteArrayOp_Int = mkGenPrimOp (fsLit "indexIntArray#")  [] [byteArrayPrimTy, intPrimTy] (intPrimTy)+primOpInfo IndexByteArrayOp_Word = mkGenPrimOp (fsLit "indexWordArray#")  [] [byteArrayPrimTy, intPrimTy] (wordPrimTy)+primOpInfo IndexByteArrayOp_Addr = mkGenPrimOp (fsLit "indexAddrArray#")  [] [byteArrayPrimTy, intPrimTy] (addrPrimTy)+primOpInfo IndexByteArrayOp_Float = mkGenPrimOp (fsLit "indexFloatArray#")  [] [byteArrayPrimTy, intPrimTy] (floatPrimTy)+primOpInfo IndexByteArrayOp_Double = mkGenPrimOp (fsLit "indexDoubleArray#")  [] [byteArrayPrimTy, intPrimTy] (doublePrimTy)+primOpInfo IndexByteArrayOp_StablePtr = mkGenPrimOp (fsLit "indexStablePtrArray#")  [alphaTyVar] [byteArrayPrimTy, intPrimTy] (mkStablePtrPrimTy alphaTy)+primOpInfo IndexByteArrayOp_Int8 = mkGenPrimOp (fsLit "indexInt8Array#")  [] [byteArrayPrimTy, intPrimTy] (intPrimTy)+primOpInfo IndexByteArrayOp_Int16 = mkGenPrimOp (fsLit "indexInt16Array#")  [] [byteArrayPrimTy, intPrimTy] (intPrimTy)+primOpInfo IndexByteArrayOp_Int32 = mkGenPrimOp (fsLit "indexInt32Array#")  [] [byteArrayPrimTy, intPrimTy] (intPrimTy)+primOpInfo IndexByteArrayOp_Int64 = mkGenPrimOp (fsLit "indexInt64Array#")  [] [byteArrayPrimTy, intPrimTy] (intPrimTy)+primOpInfo IndexByteArrayOp_Word8 = mkGenPrimOp (fsLit "indexWord8Array#")  [] [byteArrayPrimTy, intPrimTy] (wordPrimTy)+primOpInfo IndexByteArrayOp_Word16 = mkGenPrimOp (fsLit "indexWord16Array#")  [] [byteArrayPrimTy, intPrimTy] (wordPrimTy)+primOpInfo IndexByteArrayOp_Word32 = mkGenPrimOp (fsLit "indexWord32Array#")  [] [byteArrayPrimTy, intPrimTy] (wordPrimTy)+primOpInfo IndexByteArrayOp_Word64 = mkGenPrimOp (fsLit "indexWord64Array#")  [] [byteArrayPrimTy, intPrimTy] (wordPrimTy)+primOpInfo IndexByteArrayOp_Word8AsChar = mkGenPrimOp (fsLit "indexWord8ArrayAsChar#")  [] [byteArrayPrimTy, intPrimTy] (charPrimTy)+primOpInfo IndexByteArrayOp_Word8AsWideChar = mkGenPrimOp (fsLit "indexWord8ArrayAsWideChar#")  [] [byteArrayPrimTy, intPrimTy] (charPrimTy)+primOpInfo IndexByteArrayOp_Word8AsAddr = mkGenPrimOp (fsLit "indexWord8ArrayAsAddr#")  [] [byteArrayPrimTy, intPrimTy] (addrPrimTy)+primOpInfo IndexByteArrayOp_Word8AsFloat = mkGenPrimOp (fsLit "indexWord8ArrayAsFloat#")  [] [byteArrayPrimTy, intPrimTy] (floatPrimTy)+primOpInfo IndexByteArrayOp_Word8AsDouble = mkGenPrimOp (fsLit "indexWord8ArrayAsDouble#")  [] [byteArrayPrimTy, intPrimTy] (doublePrimTy)+primOpInfo IndexByteArrayOp_Word8AsStablePtr = mkGenPrimOp (fsLit "indexWord8ArrayAsStablePtr#")  [alphaTyVar] [byteArrayPrimTy, intPrimTy] (mkStablePtrPrimTy alphaTy)+primOpInfo IndexByteArrayOp_Word8AsInt16 = mkGenPrimOp (fsLit "indexWord8ArrayAsInt16#")  [] [byteArrayPrimTy, intPrimTy] (intPrimTy)+primOpInfo IndexByteArrayOp_Word8AsInt32 = mkGenPrimOp (fsLit "indexWord8ArrayAsInt32#")  [] [byteArrayPrimTy, intPrimTy] (intPrimTy)+primOpInfo IndexByteArrayOp_Word8AsInt64 = mkGenPrimOp (fsLit "indexWord8ArrayAsInt64#")  [] [byteArrayPrimTy, intPrimTy] (intPrimTy)+primOpInfo IndexByteArrayOp_Word8AsInt = mkGenPrimOp (fsLit "indexWord8ArrayAsInt#")  [] [byteArrayPrimTy, intPrimTy] (intPrimTy)+primOpInfo IndexByteArrayOp_Word8AsWord16 = mkGenPrimOp (fsLit "indexWord8ArrayAsWord16#")  [] [byteArrayPrimTy, intPrimTy] (wordPrimTy)+primOpInfo IndexByteArrayOp_Word8AsWord32 = mkGenPrimOp (fsLit "indexWord8ArrayAsWord32#")  [] [byteArrayPrimTy, intPrimTy] (wordPrimTy)+primOpInfo IndexByteArrayOp_Word8AsWord64 = mkGenPrimOp (fsLit "indexWord8ArrayAsWord64#")  [] [byteArrayPrimTy, intPrimTy] (wordPrimTy)+primOpInfo IndexByteArrayOp_Word8AsWord = mkGenPrimOp (fsLit "indexWord8ArrayAsWord#")  [] [byteArrayPrimTy, intPrimTy] (wordPrimTy)+primOpInfo ReadByteArrayOp_Char = mkGenPrimOp (fsLit "readCharArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, charPrimTy]))+primOpInfo ReadByteArrayOp_WideChar = mkGenPrimOp (fsLit "readWideCharArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, charPrimTy]))+primOpInfo ReadByteArrayOp_Int = mkGenPrimOp (fsLit "readIntArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadByteArrayOp_Word = mkGenPrimOp (fsLit "readWordArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo ReadByteArrayOp_Addr = mkGenPrimOp (fsLit "readAddrArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, addrPrimTy]))+primOpInfo ReadByteArrayOp_Float = mkGenPrimOp (fsLit "readFloatArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatPrimTy]))+primOpInfo ReadByteArrayOp_Double = mkGenPrimOp (fsLit "readDoubleArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doublePrimTy]))+primOpInfo ReadByteArrayOp_StablePtr = mkGenPrimOp (fsLit "readStablePtrArray#")  [deltaTyVar, alphaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkStablePtrPrimTy alphaTy]))+primOpInfo ReadByteArrayOp_Int8 = mkGenPrimOp (fsLit "readInt8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadByteArrayOp_Int16 = mkGenPrimOp (fsLit "readInt16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadByteArrayOp_Int32 = mkGenPrimOp (fsLit "readInt32Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadByteArrayOp_Int64 = mkGenPrimOp (fsLit "readInt64Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadByteArrayOp_Word8 = mkGenPrimOp (fsLit "readWord8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo ReadByteArrayOp_Word16 = mkGenPrimOp (fsLit "readWord16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo ReadByteArrayOp_Word32 = mkGenPrimOp (fsLit "readWord32Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo ReadByteArrayOp_Word64 = mkGenPrimOp (fsLit "readWord64Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo ReadByteArrayOp_Word8AsChar = mkGenPrimOp (fsLit "readWord8ArrayAsChar#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, charPrimTy]))+primOpInfo ReadByteArrayOp_Word8AsWideChar = mkGenPrimOp (fsLit "readWord8ArrayAsWideChar#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, charPrimTy]))+primOpInfo ReadByteArrayOp_Word8AsAddr = mkGenPrimOp (fsLit "readWord8ArrayAsAddr#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, addrPrimTy]))+primOpInfo ReadByteArrayOp_Word8AsFloat = mkGenPrimOp (fsLit "readWord8ArrayAsFloat#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatPrimTy]))+primOpInfo ReadByteArrayOp_Word8AsDouble = mkGenPrimOp (fsLit "readWord8ArrayAsDouble#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doublePrimTy]))+primOpInfo ReadByteArrayOp_Word8AsStablePtr = mkGenPrimOp (fsLit "readWord8ArrayAsStablePtr#")  [deltaTyVar, alphaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkStablePtrPrimTy alphaTy]))+primOpInfo ReadByteArrayOp_Word8AsInt16 = mkGenPrimOp (fsLit "readWord8ArrayAsInt16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadByteArrayOp_Word8AsInt32 = mkGenPrimOp (fsLit "readWord8ArrayAsInt32#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadByteArrayOp_Word8AsInt64 = mkGenPrimOp (fsLit "readWord8ArrayAsInt64#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadByteArrayOp_Word8AsInt = mkGenPrimOp (fsLit "readWord8ArrayAsInt#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadByteArrayOp_Word8AsWord16 = mkGenPrimOp (fsLit "readWord8ArrayAsWord16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo ReadByteArrayOp_Word8AsWord32 = mkGenPrimOp (fsLit "readWord8ArrayAsWord32#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo ReadByteArrayOp_Word8AsWord64 = mkGenPrimOp (fsLit "readWord8ArrayAsWord64#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo ReadByteArrayOp_Word8AsWord = mkGenPrimOp (fsLit "readWord8ArrayAsWord#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo WriteByteArrayOp_Char = mkGenPrimOp (fsLit "writeCharArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, charPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_WideChar = mkGenPrimOp (fsLit "writeWideCharArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, charPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Int = mkGenPrimOp (fsLit "writeIntArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word = mkGenPrimOp (fsLit "writeWordArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Addr = mkGenPrimOp (fsLit "writeAddrArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, addrPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Float = mkGenPrimOp (fsLit "writeFloatArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Double = mkGenPrimOp (fsLit "writeDoubleArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doublePrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_StablePtr = mkGenPrimOp (fsLit "writeStablePtrArray#")  [deltaTyVar, alphaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStablePtrPrimTy alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Int8 = mkGenPrimOp (fsLit "writeInt8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Int16 = mkGenPrimOp (fsLit "writeInt16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Int32 = mkGenPrimOp (fsLit "writeInt32Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Int64 = mkGenPrimOp (fsLit "writeInt64Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8 = mkGenPrimOp (fsLit "writeWord8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word16 = mkGenPrimOp (fsLit "writeWord16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word32 = mkGenPrimOp (fsLit "writeWord32Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word64 = mkGenPrimOp (fsLit "writeWord64Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8AsChar = mkGenPrimOp (fsLit "writeWord8ArrayAsChar#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, charPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8AsWideChar = mkGenPrimOp (fsLit "writeWord8ArrayAsWideChar#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, charPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8AsAddr = mkGenPrimOp (fsLit "writeWord8ArrayAsAddr#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, addrPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8AsFloat = mkGenPrimOp (fsLit "writeWord8ArrayAsFloat#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8AsDouble = mkGenPrimOp (fsLit "writeWord8ArrayAsDouble#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doublePrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8AsStablePtr = mkGenPrimOp (fsLit "writeWord8ArrayAsStablePtr#")  [deltaTyVar, alphaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStablePtrPrimTy alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8AsInt16 = mkGenPrimOp (fsLit "writeWord8ArrayAsInt16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8AsInt32 = mkGenPrimOp (fsLit "writeWord8ArrayAsInt32#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8AsInt64 = mkGenPrimOp (fsLit "writeWord8ArrayAsInt64#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8AsInt = mkGenPrimOp (fsLit "writeWord8ArrayAsInt#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8AsWord16 = mkGenPrimOp (fsLit "writeWord8ArrayAsWord16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8AsWord32 = mkGenPrimOp (fsLit "writeWord8ArrayAsWord32#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8AsWord64 = mkGenPrimOp (fsLit "writeWord8ArrayAsWord64#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteByteArrayOp_Word8AsWord = mkGenPrimOp (fsLit "writeWord8ArrayAsWord#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo CompareByteArraysOp = mkGenPrimOp (fsLit "compareByteArrays#")  [] [byteArrayPrimTy, intPrimTy, byteArrayPrimTy, intPrimTy, intPrimTy] (intPrimTy)+primOpInfo CopyByteArrayOp = mkGenPrimOp (fsLit "copyByteArray#")  [deltaTyVar] [byteArrayPrimTy, intPrimTy, mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo CopyMutableByteArrayOp = mkGenPrimOp (fsLit "copyMutableByteArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo CopyByteArrayToAddrOp = mkGenPrimOp (fsLit "copyByteArrayToAddr#")  [deltaTyVar] [byteArrayPrimTy, intPrimTy, addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo CopyMutableByteArrayToAddrOp = mkGenPrimOp (fsLit "copyMutableByteArrayToAddr#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo CopyAddrToByteArrayOp = mkGenPrimOp (fsLit "copyAddrToByteArray#")  [deltaTyVar] [addrPrimTy, mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo SetByteArrayOp = mkGenPrimOp (fsLit "setByteArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo AtomicReadByteArrayOp_Int = mkGenPrimOp (fsLit "atomicReadIntArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo AtomicWriteByteArrayOp_Int = mkGenPrimOp (fsLit "atomicWriteIntArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo CasByteArrayOp_Int = mkGenPrimOp (fsLit "casIntArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo FetchAddByteArrayOp_Int = mkGenPrimOp (fsLit "fetchAddIntArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo FetchSubByteArrayOp_Int = mkGenPrimOp (fsLit "fetchSubIntArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo FetchAndByteArrayOp_Int = mkGenPrimOp (fsLit "fetchAndIntArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo FetchNandByteArrayOp_Int = mkGenPrimOp (fsLit "fetchNandIntArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo FetchOrByteArrayOp_Int = mkGenPrimOp (fsLit "fetchOrIntArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo FetchXorByteArrayOp_Int = mkGenPrimOp (fsLit "fetchXorIntArray#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo NewArrayArrayOp = mkGenPrimOp (fsLit "newArrayArray#")  [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableArrayArrayPrimTy deltaTy]))+primOpInfo SameMutableArrayArrayOp = mkGenPrimOp (fsLit "sameMutableArrayArray#")  [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, mkMutableArrayArrayPrimTy deltaTy] (intPrimTy)+primOpInfo UnsafeFreezeArrayArrayOp = mkGenPrimOp (fsLit "unsafeFreezeArrayArray#")  [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkArrayArrayPrimTy]))+primOpInfo SizeofArrayArrayOp = mkGenPrimOp (fsLit "sizeofArrayArray#")  [] [mkArrayArrayPrimTy] (intPrimTy)+primOpInfo SizeofMutableArrayArrayOp = mkGenPrimOp (fsLit "sizeofMutableArrayArray#")  [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy] (intPrimTy)+primOpInfo IndexArrayArrayOp_ByteArray = mkGenPrimOp (fsLit "indexByteArrayArray#")  [] [mkArrayArrayPrimTy, intPrimTy] (byteArrayPrimTy)+primOpInfo IndexArrayArrayOp_ArrayArray = mkGenPrimOp (fsLit "indexArrayArrayArray#")  [] [mkArrayArrayPrimTy, intPrimTy] (mkArrayArrayPrimTy)+primOpInfo ReadArrayArrayOp_ByteArray = mkGenPrimOp (fsLit "readByteArrayArray#")  [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, byteArrayPrimTy]))+primOpInfo ReadArrayArrayOp_MutableByteArray = mkGenPrimOp (fsLit "readMutableByteArrayArray#")  [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy]))+primOpInfo ReadArrayArrayOp_ArrayArray = mkGenPrimOp (fsLit "readArrayArrayArray#")  [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkArrayArrayPrimTy]))+primOpInfo ReadArrayArrayOp_MutableArrayArray = mkGenPrimOp (fsLit "readMutableArrayArrayArray#")  [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableArrayArrayPrimTy deltaTy]))+primOpInfo WriteArrayArrayOp_ByteArray = mkGenPrimOp (fsLit "writeByteArrayArray#")  [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, byteArrayPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteArrayArrayOp_MutableByteArray = mkGenPrimOp (fsLit "writeMutableByteArrayArray#")  [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkMutableByteArrayPrimTy deltaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteArrayArrayOp_ArrayArray = mkGenPrimOp (fsLit "writeArrayArrayArray#")  [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkArrayArrayPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteArrayArrayOp_MutableArrayArray = mkGenPrimOp (fsLit "writeMutableArrayArrayArray#")  [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkMutableArrayArrayPrimTy deltaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo CopyArrayArrayOp = mkGenPrimOp (fsLit "copyArrayArray#")  [deltaTyVar] [mkArrayArrayPrimTy, intPrimTy, mkMutableArrayArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo CopyMutableArrayArrayOp = mkGenPrimOp (fsLit "copyMutableArrayArray#")  [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkMutableArrayArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo AddrAddOp = mkGenPrimOp (fsLit "plusAddr#")  [] [addrPrimTy, intPrimTy] (addrPrimTy)+primOpInfo AddrSubOp = mkGenPrimOp (fsLit "minusAddr#")  [] [addrPrimTy, addrPrimTy] (intPrimTy)+primOpInfo AddrRemOp = mkGenPrimOp (fsLit "remAddr#")  [] [addrPrimTy, intPrimTy] (intPrimTy)+primOpInfo Addr2IntOp = mkGenPrimOp (fsLit "addr2Int#")  [] [addrPrimTy] (intPrimTy)+primOpInfo Int2AddrOp = mkGenPrimOp (fsLit "int2Addr#")  [] [intPrimTy] (addrPrimTy)+primOpInfo AddrGtOp = mkCompare (fsLit "gtAddr#") addrPrimTy+primOpInfo AddrGeOp = mkCompare (fsLit "geAddr#") addrPrimTy+primOpInfo AddrEqOp = mkCompare (fsLit "eqAddr#") addrPrimTy+primOpInfo AddrNeOp = mkCompare (fsLit "neAddr#") addrPrimTy+primOpInfo AddrLtOp = mkCompare (fsLit "ltAddr#") addrPrimTy+primOpInfo AddrLeOp = mkCompare (fsLit "leAddr#") addrPrimTy+primOpInfo IndexOffAddrOp_Char = mkGenPrimOp (fsLit "indexCharOffAddr#")  [] [addrPrimTy, intPrimTy] (charPrimTy)+primOpInfo IndexOffAddrOp_WideChar = mkGenPrimOp (fsLit "indexWideCharOffAddr#")  [] [addrPrimTy, intPrimTy] (charPrimTy)+primOpInfo IndexOffAddrOp_Int = mkGenPrimOp (fsLit "indexIntOffAddr#")  [] [addrPrimTy, intPrimTy] (intPrimTy)+primOpInfo IndexOffAddrOp_Word = mkGenPrimOp (fsLit "indexWordOffAddr#")  [] [addrPrimTy, intPrimTy] (wordPrimTy)+primOpInfo IndexOffAddrOp_Addr = mkGenPrimOp (fsLit "indexAddrOffAddr#")  [] [addrPrimTy, intPrimTy] (addrPrimTy)+primOpInfo IndexOffAddrOp_Float = mkGenPrimOp (fsLit "indexFloatOffAddr#")  [] [addrPrimTy, intPrimTy] (floatPrimTy)+primOpInfo IndexOffAddrOp_Double = mkGenPrimOp (fsLit "indexDoubleOffAddr#")  [] [addrPrimTy, intPrimTy] (doublePrimTy)+primOpInfo IndexOffAddrOp_StablePtr = mkGenPrimOp (fsLit "indexStablePtrOffAddr#")  [alphaTyVar] [addrPrimTy, intPrimTy] (mkStablePtrPrimTy alphaTy)+primOpInfo IndexOffAddrOp_Int8 = mkGenPrimOp (fsLit "indexInt8OffAddr#")  [] [addrPrimTy, intPrimTy] (intPrimTy)+primOpInfo IndexOffAddrOp_Int16 = mkGenPrimOp (fsLit "indexInt16OffAddr#")  [] [addrPrimTy, intPrimTy] (intPrimTy)+primOpInfo IndexOffAddrOp_Int32 = mkGenPrimOp (fsLit "indexInt32OffAddr#")  [] [addrPrimTy, intPrimTy] (intPrimTy)+primOpInfo IndexOffAddrOp_Int64 = mkGenPrimOp (fsLit "indexInt64OffAddr#")  [] [addrPrimTy, intPrimTy] (intPrimTy)+primOpInfo IndexOffAddrOp_Word8 = mkGenPrimOp (fsLit "indexWord8OffAddr#")  [] [addrPrimTy, intPrimTy] (wordPrimTy)+primOpInfo IndexOffAddrOp_Word16 = mkGenPrimOp (fsLit "indexWord16OffAddr#")  [] [addrPrimTy, intPrimTy] (wordPrimTy)+primOpInfo IndexOffAddrOp_Word32 = mkGenPrimOp (fsLit "indexWord32OffAddr#")  [] [addrPrimTy, intPrimTy] (wordPrimTy)+primOpInfo IndexOffAddrOp_Word64 = mkGenPrimOp (fsLit "indexWord64OffAddr#")  [] [addrPrimTy, intPrimTy] (wordPrimTy)+primOpInfo ReadOffAddrOp_Char = mkGenPrimOp (fsLit "readCharOffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, charPrimTy]))+primOpInfo ReadOffAddrOp_WideChar = mkGenPrimOp (fsLit "readWideCharOffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, charPrimTy]))+primOpInfo ReadOffAddrOp_Int = mkGenPrimOp (fsLit "readIntOffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadOffAddrOp_Word = mkGenPrimOp (fsLit "readWordOffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo ReadOffAddrOp_Addr = mkGenPrimOp (fsLit "readAddrOffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, addrPrimTy]))+primOpInfo ReadOffAddrOp_Float = mkGenPrimOp (fsLit "readFloatOffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatPrimTy]))+primOpInfo ReadOffAddrOp_Double = mkGenPrimOp (fsLit "readDoubleOffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doublePrimTy]))+primOpInfo ReadOffAddrOp_StablePtr = mkGenPrimOp (fsLit "readStablePtrOffAddr#")  [deltaTyVar, alphaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkStablePtrPrimTy alphaTy]))+primOpInfo ReadOffAddrOp_Int8 = mkGenPrimOp (fsLit "readInt8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadOffAddrOp_Int16 = mkGenPrimOp (fsLit "readInt16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadOffAddrOp_Int32 = mkGenPrimOp (fsLit "readInt32OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadOffAddrOp_Int64 = mkGenPrimOp (fsLit "readInt64OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadOffAddrOp_Word8 = mkGenPrimOp (fsLit "readWord8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo ReadOffAddrOp_Word16 = mkGenPrimOp (fsLit "readWord16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo ReadOffAddrOp_Word32 = mkGenPrimOp (fsLit "readWord32OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo ReadOffAddrOp_Word64 = mkGenPrimOp (fsLit "readWord64OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, wordPrimTy]))+primOpInfo WriteOffAddrOp_Char = mkGenPrimOp (fsLit "writeCharOffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, charPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_WideChar = mkGenPrimOp (fsLit "writeWideCharOffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, charPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_Int = mkGenPrimOp (fsLit "writeIntOffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_Word = mkGenPrimOp (fsLit "writeWordOffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_Addr = mkGenPrimOp (fsLit "writeAddrOffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, addrPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_Float = mkGenPrimOp (fsLit "writeFloatOffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, floatPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_Double = mkGenPrimOp (fsLit "writeDoubleOffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, doublePrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_StablePtr = mkGenPrimOp (fsLit "writeStablePtrOffAddr#")  [alphaTyVar, deltaTyVar] [addrPrimTy, intPrimTy, mkStablePtrPrimTy alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_Int8 = mkGenPrimOp (fsLit "writeInt8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_Int16 = mkGenPrimOp (fsLit "writeInt16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_Int32 = mkGenPrimOp (fsLit "writeInt32OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_Int64 = mkGenPrimOp (fsLit "writeInt64OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_Word8 = mkGenPrimOp (fsLit "writeWord8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_Word16 = mkGenPrimOp (fsLit "writeWord16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_Word32 = mkGenPrimOp (fsLit "writeWord32OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WriteOffAddrOp_Word64 = mkGenPrimOp (fsLit "writeWord64OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo NewMutVarOp = mkGenPrimOp (fsLit "newMutVar#")  [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutVarPrimTy deltaTy alphaTy]))+primOpInfo ReadMutVarOp = mkGenPrimOp (fsLit "readMutVar#")  [deltaTyVar, alphaTyVar] [mkMutVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy]))+primOpInfo WriteMutVarOp = mkGenPrimOp (fsLit "writeMutVar#")  [deltaTyVar, alphaTyVar] [mkMutVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo SameMutVarOp = mkGenPrimOp (fsLit "sameMutVar#")  [deltaTyVar, alphaTyVar] [mkMutVarPrimTy deltaTy alphaTy, mkMutVarPrimTy deltaTy alphaTy] (intPrimTy)+primOpInfo AtomicModifyMutVar2Op = mkGenPrimOp (fsLit "atomicModifyMutVar2#")  [deltaTyVar, alphaTyVar, gammaTyVar] [mkMutVarPrimTy deltaTy alphaTy, (mkVisFunTy (alphaTy) (gammaTy)), mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy, gammaTy]))+primOpInfo AtomicModifyMutVar_Op = mkGenPrimOp (fsLit "atomicModifyMutVar_#")  [deltaTyVar, alphaTyVar] [mkMutVarPrimTy deltaTy alphaTy, (mkVisFunTy (alphaTy) (alphaTy)), mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy, alphaTy]))+primOpInfo CasMutVarOp = mkGenPrimOp (fsLit "casMutVar#")  [deltaTyVar, alphaTyVar] [mkMutVarPrimTy deltaTy alphaTy, alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy]))+primOpInfo CatchOp = mkGenPrimOp (fsLit "catch#")  [alphaTyVar, betaTyVar] [(mkVisFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))), (mkVisFunTy (betaTy) ((mkVisFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))+primOpInfo RaiseOp = mkGenPrimOp (fsLit "raise#")  [betaTyVar, runtimeRep1TyVar, openAlphaTyVar] [betaTy] (openAlphaTy)+primOpInfo RaiseIOOp = mkGenPrimOp (fsLit "raiseIO#")  [alphaTyVar, betaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, betaTy]))+primOpInfo MaskAsyncExceptionsOp = mkGenPrimOp (fsLit "maskAsyncExceptions#")  [alphaTyVar] [(mkVisFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))+primOpInfo MaskUninterruptibleOp = mkGenPrimOp (fsLit "maskUninterruptible#")  [alphaTyVar] [(mkVisFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))+primOpInfo UnmaskAsyncExceptionsOp = mkGenPrimOp (fsLit "unmaskAsyncExceptions#")  [alphaTyVar] [(mkVisFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))+primOpInfo MaskStatus = mkGenPrimOp (fsLit "getMaskingState#")  [] [mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy]))+primOpInfo AtomicallyOp = mkGenPrimOp (fsLit "atomically#")  [alphaTyVar] [(mkVisFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))+primOpInfo RetryOp = mkGenPrimOp (fsLit "retry#")  [alphaTyVar] [mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))+primOpInfo CatchRetryOp = mkGenPrimOp (fsLit "catchRetry#")  [alphaTyVar] [(mkVisFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))), (mkVisFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))+primOpInfo CatchSTMOp = mkGenPrimOp (fsLit "catchSTM#")  [alphaTyVar, betaTyVar] [(mkVisFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))), (mkVisFunTy (betaTy) ((mkVisFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))+primOpInfo NewTVarOp = mkGenPrimOp (fsLit "newTVar#")  [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkTVarPrimTy deltaTy alphaTy]))+primOpInfo ReadTVarOp = mkGenPrimOp (fsLit "readTVar#")  [deltaTyVar, alphaTyVar] [mkTVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy]))+primOpInfo ReadTVarIOOp = mkGenPrimOp (fsLit "readTVarIO#")  [deltaTyVar, alphaTyVar] [mkTVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy]))+primOpInfo WriteTVarOp = mkGenPrimOp (fsLit "writeTVar#")  [deltaTyVar, alphaTyVar] [mkTVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo SameTVarOp = mkGenPrimOp (fsLit "sameTVar#")  [deltaTyVar, alphaTyVar] [mkTVarPrimTy deltaTy alphaTy, mkTVarPrimTy deltaTy alphaTy] (intPrimTy)+primOpInfo NewMVarOp = mkGenPrimOp (fsLit "newMVar#")  [deltaTyVar, alphaTyVar] [mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMVarPrimTy deltaTy alphaTy]))+primOpInfo TakeMVarOp = mkGenPrimOp (fsLit "takeMVar#")  [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy]))+primOpInfo TryTakeMVarOp = mkGenPrimOp (fsLit "tryTakeMVar#")  [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy]))+primOpInfo PutMVarOp = mkGenPrimOp (fsLit "putMVar#")  [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo TryPutMVarOp = mkGenPrimOp (fsLit "tryPutMVar#")  [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo ReadMVarOp = mkGenPrimOp (fsLit "readMVar#")  [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy]))+primOpInfo TryReadMVarOp = mkGenPrimOp (fsLit "tryReadMVar#")  [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy]))+primOpInfo SameMVarOp = mkGenPrimOp (fsLit "sameMVar#")  [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkMVarPrimTy deltaTy alphaTy] (intPrimTy)+primOpInfo IsEmptyMVarOp = mkGenPrimOp (fsLit "isEmptyMVar#")  [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo DelayOp = mkGenPrimOp (fsLit "delay#")  [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WaitReadOp = mkGenPrimOp (fsLit "waitRead#")  [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo WaitWriteOp = mkGenPrimOp (fsLit "waitWrite#")  [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo ForkOp = mkGenPrimOp (fsLit "fork#")  [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, threadIdPrimTy]))+primOpInfo ForkOnOp = mkGenPrimOp (fsLit "forkOn#")  [alphaTyVar] [intPrimTy, alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, threadIdPrimTy]))+primOpInfo KillThreadOp = mkGenPrimOp (fsLit "killThread#")  [alphaTyVar] [threadIdPrimTy, alphaTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy)+primOpInfo YieldOp = mkGenPrimOp (fsLit "yield#")  [] [mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy)+primOpInfo MyThreadIdOp = mkGenPrimOp (fsLit "myThreadId#")  [] [mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, threadIdPrimTy]))+primOpInfo LabelThreadOp = mkGenPrimOp (fsLit "labelThread#")  [] [threadIdPrimTy, addrPrimTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy)+primOpInfo IsCurrentThreadBoundOp = mkGenPrimOp (fsLit "isCurrentThreadBound#")  [] [mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy]))+primOpInfo NoDuplicateOp = mkGenPrimOp (fsLit "noDuplicate#")  [deltaTyVar] [mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo ThreadStatusOp = mkGenPrimOp (fsLit "threadStatus#")  [] [threadIdPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy, intPrimTy, intPrimTy]))+primOpInfo MkWeakOp = mkGenPrimOp (fsLit "mkWeak#")  [runtimeRep1TyVar, openAlphaTyVar, betaTyVar, gammaTyVar] [openAlphaTy, betaTy, (mkVisFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, gammaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy]))+primOpInfo MkWeakNoFinalizerOp = mkGenPrimOp (fsLit "mkWeakNoFinalizer#")  [runtimeRep1TyVar, openAlphaTyVar, betaTyVar] [openAlphaTy, betaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy]))+primOpInfo AddCFinalizerToWeakOp = mkGenPrimOp (fsLit "addCFinalizerToWeak#")  [betaTyVar] [addrPrimTy, addrPrimTy, intPrimTy, addrPrimTy, mkWeakPrimTy betaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy]))+primOpInfo DeRefWeakOp = mkGenPrimOp (fsLit "deRefWeak#")  [alphaTyVar] [mkWeakPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy, alphaTy]))+primOpInfo FinalizeWeakOp = mkGenPrimOp (fsLit "finalizeWeak#")  [alphaTyVar, betaTyVar] [mkWeakPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy, (mkVisFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, betaTy])))]))+primOpInfo TouchOp = mkGenPrimOp (fsLit "touch#")  [runtimeRep1TyVar, openAlphaTyVar] [openAlphaTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy)+primOpInfo MakeStablePtrOp = mkGenPrimOp (fsLit "makeStablePtr#")  [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkStablePtrPrimTy alphaTy]))+primOpInfo DeRefStablePtrOp = mkGenPrimOp (fsLit "deRefStablePtr#")  [alphaTyVar] [mkStablePtrPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))+primOpInfo EqStablePtrOp = mkGenPrimOp (fsLit "eqStablePtr#")  [alphaTyVar] [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy alphaTy] (intPrimTy)+primOpInfo MakeStableNameOp = mkGenPrimOp (fsLit "makeStableName#")  [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkStableNamePrimTy alphaTy]))+primOpInfo EqStableNameOp = mkGenPrimOp (fsLit "eqStableName#")  [alphaTyVar, betaTyVar] [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy] (intPrimTy)+primOpInfo StableNameToIntOp = mkGenPrimOp (fsLit "stableNameToInt#")  [alphaTyVar] [mkStableNamePrimTy alphaTy] (intPrimTy)+primOpInfo CompactNewOp = mkGenPrimOp (fsLit "compactNew#")  [] [wordPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, compactPrimTy]))+primOpInfo CompactResizeOp = mkGenPrimOp (fsLit "compactResize#")  [] [compactPrimTy, wordPrimTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy)+primOpInfo CompactContainsOp = mkGenPrimOp (fsLit "compactContains#")  [alphaTyVar] [compactPrimTy, alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy]))+primOpInfo CompactContainsAnyOp = mkGenPrimOp (fsLit "compactContainsAny#")  [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy]))+primOpInfo CompactGetFirstBlockOp = mkGenPrimOp (fsLit "compactGetFirstBlock#")  [] [compactPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, addrPrimTy, wordPrimTy]))+primOpInfo CompactGetNextBlockOp = mkGenPrimOp (fsLit "compactGetNextBlock#")  [] [compactPrimTy, addrPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, addrPrimTy, wordPrimTy]))+primOpInfo CompactAllocateBlockOp = mkGenPrimOp (fsLit "compactAllocateBlock#")  [] [wordPrimTy, addrPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, addrPrimTy]))+primOpInfo CompactFixupPointersOp = mkGenPrimOp (fsLit "compactFixupPointers#")  [] [addrPrimTy, addrPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, compactPrimTy, addrPrimTy]))+primOpInfo CompactAdd = mkGenPrimOp (fsLit "compactAdd#")  [alphaTyVar] [compactPrimTy, alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))+primOpInfo CompactAddWithSharing = mkGenPrimOp (fsLit "compactAddWithSharing#")  [alphaTyVar] [compactPrimTy, alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))+primOpInfo CompactSize = mkGenPrimOp (fsLit "compactSize#")  [] [compactPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, wordPrimTy]))+primOpInfo ReallyUnsafePtrEqualityOp = mkGenPrimOp (fsLit "reallyUnsafePtrEquality#")  [alphaTyVar] [alphaTy, alphaTy] (intPrimTy)+primOpInfo ParOp = mkGenPrimOp (fsLit "par#")  [alphaTyVar] [alphaTy] (intPrimTy)+primOpInfo SparkOp = mkGenPrimOp (fsLit "spark#")  [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy]))+primOpInfo SeqOp = mkGenPrimOp (fsLit "seq#")  [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy]))+primOpInfo GetSparkOp = mkGenPrimOp (fsLit "getSpark#")  [deltaTyVar, alphaTyVar] [mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy]))+primOpInfo NumSparks = mkGenPrimOp (fsLit "numSparks#")  [deltaTyVar] [mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy]))+primOpInfo DataToTagOp = mkGenPrimOp (fsLit "dataToTag#")  [alphaTyVar] [alphaTy] (intPrimTy)+primOpInfo TagToEnumOp = mkGenPrimOp (fsLit "tagToEnum#")  [alphaTyVar] [intPrimTy] (alphaTy)+primOpInfo AddrToAnyOp = mkGenPrimOp (fsLit "addrToAny#")  [alphaTyVar] [addrPrimTy] ((mkTupleTy Unboxed [alphaTy]))+primOpInfo AnyToAddrOp = mkGenPrimOp (fsLit "anyToAddr#")  [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, addrPrimTy]))+primOpInfo MkApUpd0_Op = mkGenPrimOp (fsLit "mkApUpd0#")  [alphaTyVar] [bcoPrimTy] ((mkTupleTy Unboxed [alphaTy]))+primOpInfo NewBCOOp = mkGenPrimOp (fsLit "newBCO#")  [alphaTyVar, deltaTyVar] [byteArrayPrimTy, byteArrayPrimTy, mkArrayPrimTy alphaTy, intPrimTy, byteArrayPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, bcoPrimTy]))+primOpInfo UnpackClosureOp = mkGenPrimOp (fsLit "unpackClosure#")  [alphaTyVar, betaTyVar] [alphaTy] ((mkTupleTy Unboxed [addrPrimTy, byteArrayPrimTy, mkArrayPrimTy betaTy]))+primOpInfo ClosureSizeOp = mkGenPrimOp (fsLit "closureSize#")  [alphaTyVar] [alphaTy] (intPrimTy)+primOpInfo GetApStackValOp = mkGenPrimOp (fsLit "getApStackVal#")  [alphaTyVar, betaTyVar] [alphaTy, intPrimTy] ((mkTupleTy Unboxed [intPrimTy, betaTy]))+primOpInfo GetCCSOfOp = mkGenPrimOp (fsLit "getCCSOf#")  [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, addrPrimTy]))+primOpInfo GetCurrentCCSOp = mkGenPrimOp (fsLit "getCurrentCCS#")  [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, addrPrimTy]))+primOpInfo ClearCCSOp = mkGenPrimOp (fsLit "clearCCS#")  [deltaTyVar, alphaTyVar] [(mkVisFunTy (mkStatePrimTy deltaTy) ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy]))), mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy]))+primOpInfo TraceEventOp = mkGenPrimOp (fsLit "traceEvent#")  [deltaTyVar] [addrPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo TraceEventBinaryOp = mkGenPrimOp (fsLit "traceBinaryEvent#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo TraceMarkerOp = mkGenPrimOp (fsLit "traceMarker#")  [deltaTyVar] [addrPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo GetThreadAllocationCounter = mkGenPrimOp (fsLit "getThreadAllocationCounter#")  [] [mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy]))+primOpInfo SetThreadAllocationCounter = mkGenPrimOp (fsLit "setThreadAllocationCounter#")  [] [intPrimTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy)+primOpInfo (VecBroadcastOp IntVec 16 W8) = mkGenPrimOp (fsLit "broadcastInt8X16#")  [] [intPrimTy] (int8X16PrimTy)+primOpInfo (VecBroadcastOp IntVec 8 W16) = mkGenPrimOp (fsLit "broadcastInt16X8#")  [] [intPrimTy] (int16X8PrimTy)+primOpInfo (VecBroadcastOp IntVec 4 W32) = mkGenPrimOp (fsLit "broadcastInt32X4#")  [] [intPrimTy] (int32X4PrimTy)+primOpInfo (VecBroadcastOp IntVec 2 W64) = mkGenPrimOp (fsLit "broadcastInt64X2#")  [] [intPrimTy] (int64X2PrimTy)+primOpInfo (VecBroadcastOp IntVec 32 W8) = mkGenPrimOp (fsLit "broadcastInt8X32#")  [] [intPrimTy] (int8X32PrimTy)+primOpInfo (VecBroadcastOp IntVec 16 W16) = mkGenPrimOp (fsLit "broadcastInt16X16#")  [] [intPrimTy] (int16X16PrimTy)+primOpInfo (VecBroadcastOp IntVec 8 W32) = mkGenPrimOp (fsLit "broadcastInt32X8#")  [] [intPrimTy] (int32X8PrimTy)+primOpInfo (VecBroadcastOp IntVec 4 W64) = mkGenPrimOp (fsLit "broadcastInt64X4#")  [] [intPrimTy] (int64X4PrimTy)+primOpInfo (VecBroadcastOp IntVec 64 W8) = mkGenPrimOp (fsLit "broadcastInt8X64#")  [] [intPrimTy] (int8X64PrimTy)+primOpInfo (VecBroadcastOp IntVec 32 W16) = mkGenPrimOp (fsLit "broadcastInt16X32#")  [] [intPrimTy] (int16X32PrimTy)+primOpInfo (VecBroadcastOp IntVec 16 W32) = mkGenPrimOp (fsLit "broadcastInt32X16#")  [] [intPrimTy] (int32X16PrimTy)+primOpInfo (VecBroadcastOp IntVec 8 W64) = mkGenPrimOp (fsLit "broadcastInt64X8#")  [] [intPrimTy] (int64X8PrimTy)+primOpInfo (VecBroadcastOp WordVec 16 W8) = mkGenPrimOp (fsLit "broadcastWord8X16#")  [] [wordPrimTy] (word8X16PrimTy)+primOpInfo (VecBroadcastOp WordVec 8 W16) = mkGenPrimOp (fsLit "broadcastWord16X8#")  [] [wordPrimTy] (word16X8PrimTy)+primOpInfo (VecBroadcastOp WordVec 4 W32) = mkGenPrimOp (fsLit "broadcastWord32X4#")  [] [wordPrimTy] (word32X4PrimTy)+primOpInfo (VecBroadcastOp WordVec 2 W64) = mkGenPrimOp (fsLit "broadcastWord64X2#")  [] [wordPrimTy] (word64X2PrimTy)+primOpInfo (VecBroadcastOp WordVec 32 W8) = mkGenPrimOp (fsLit "broadcastWord8X32#")  [] [wordPrimTy] (word8X32PrimTy)+primOpInfo (VecBroadcastOp WordVec 16 W16) = mkGenPrimOp (fsLit "broadcastWord16X16#")  [] [wordPrimTy] (word16X16PrimTy)+primOpInfo (VecBroadcastOp WordVec 8 W32) = mkGenPrimOp (fsLit "broadcastWord32X8#")  [] [wordPrimTy] (word32X8PrimTy)+primOpInfo (VecBroadcastOp WordVec 4 W64) = mkGenPrimOp (fsLit "broadcastWord64X4#")  [] [wordPrimTy] (word64X4PrimTy)+primOpInfo (VecBroadcastOp WordVec 64 W8) = mkGenPrimOp (fsLit "broadcastWord8X64#")  [] [wordPrimTy] (word8X64PrimTy)+primOpInfo (VecBroadcastOp WordVec 32 W16) = mkGenPrimOp (fsLit "broadcastWord16X32#")  [] [wordPrimTy] (word16X32PrimTy)+primOpInfo (VecBroadcastOp WordVec 16 W32) = mkGenPrimOp (fsLit "broadcastWord32X16#")  [] [wordPrimTy] (word32X16PrimTy)+primOpInfo (VecBroadcastOp WordVec 8 W64) = mkGenPrimOp (fsLit "broadcastWord64X8#")  [] [wordPrimTy] (word64X8PrimTy)+primOpInfo (VecBroadcastOp FloatVec 4 W32) = mkGenPrimOp (fsLit "broadcastFloatX4#")  [] [floatPrimTy] (floatX4PrimTy)+primOpInfo (VecBroadcastOp FloatVec 2 W64) = mkGenPrimOp (fsLit "broadcastDoubleX2#")  [] [doublePrimTy] (doubleX2PrimTy)+primOpInfo (VecBroadcastOp FloatVec 8 W32) = mkGenPrimOp (fsLit "broadcastFloatX8#")  [] [floatPrimTy] (floatX8PrimTy)+primOpInfo (VecBroadcastOp FloatVec 4 W64) = mkGenPrimOp (fsLit "broadcastDoubleX4#")  [] [doublePrimTy] (doubleX4PrimTy)+primOpInfo (VecBroadcastOp FloatVec 16 W32) = mkGenPrimOp (fsLit "broadcastFloatX16#")  [] [floatPrimTy] (floatX16PrimTy)+primOpInfo (VecBroadcastOp FloatVec 8 W64) = mkGenPrimOp (fsLit "broadcastDoubleX8#")  [] [doublePrimTy] (doubleX8PrimTy)+primOpInfo (VecPackOp IntVec 16 W8) = mkGenPrimOp (fsLit "packInt8X16#")  [] [(mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int8X16PrimTy)+primOpInfo (VecPackOp IntVec 8 W16) = mkGenPrimOp (fsLit "packInt16X8#")  [] [(mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int16X8PrimTy)+primOpInfo (VecPackOp IntVec 4 W32) = mkGenPrimOp (fsLit "packInt32X4#")  [] [(mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int32X4PrimTy)+primOpInfo (VecPackOp IntVec 2 W64) = mkGenPrimOp (fsLit "packInt64X2#")  [] [(mkTupleTy Unboxed [intPrimTy, intPrimTy])] (int64X2PrimTy)+primOpInfo (VecPackOp IntVec 32 W8) = mkGenPrimOp (fsLit "packInt8X32#")  [] [(mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int8X32PrimTy)+primOpInfo (VecPackOp IntVec 16 W16) = mkGenPrimOp (fsLit "packInt16X16#")  [] [(mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int16X16PrimTy)+primOpInfo (VecPackOp IntVec 8 W32) = mkGenPrimOp (fsLit "packInt32X8#")  [] [(mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int32X8PrimTy)+primOpInfo (VecPackOp IntVec 4 W64) = mkGenPrimOp (fsLit "packInt64X4#")  [] [(mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int64X4PrimTy)+primOpInfo (VecPackOp IntVec 64 W8) = mkGenPrimOp (fsLit "packInt8X64#")  [] [(mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int8X64PrimTy)+primOpInfo (VecPackOp IntVec 32 W16) = mkGenPrimOp (fsLit "packInt16X32#")  [] [(mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int16X32PrimTy)+primOpInfo (VecPackOp IntVec 16 W32) = mkGenPrimOp (fsLit "packInt32X16#")  [] [(mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int32X16PrimTy)+primOpInfo (VecPackOp IntVec 8 W64) = mkGenPrimOp (fsLit "packInt64X8#")  [] [(mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int64X8PrimTy)+primOpInfo (VecPackOp WordVec 16 W8) = mkGenPrimOp (fsLit "packWord8X16#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X16PrimTy)+primOpInfo (VecPackOp WordVec 8 W16) = mkGenPrimOp (fsLit "packWord16X8#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X8PrimTy)+primOpInfo (VecPackOp WordVec 4 W32) = mkGenPrimOp (fsLit "packWord32X4#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word32X4PrimTy)+primOpInfo (VecPackOp WordVec 2 W64) = mkGenPrimOp (fsLit "packWord64X2#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy])] (word64X2PrimTy)+primOpInfo (VecPackOp WordVec 32 W8) = mkGenPrimOp (fsLit "packWord8X32#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X32PrimTy)+primOpInfo (VecPackOp WordVec 16 W16) = mkGenPrimOp (fsLit "packWord16X16#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X16PrimTy)+primOpInfo (VecPackOp WordVec 8 W32) = mkGenPrimOp (fsLit "packWord32X8#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word32X8PrimTy)+primOpInfo (VecPackOp WordVec 4 W64) = mkGenPrimOp (fsLit "packWord64X4#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word64X4PrimTy)+primOpInfo (VecPackOp WordVec 64 W8) = mkGenPrimOp (fsLit "packWord8X64#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X64PrimTy)+primOpInfo (VecPackOp WordVec 32 W16) = mkGenPrimOp (fsLit "packWord16X32#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X32PrimTy)+primOpInfo (VecPackOp WordVec 16 W32) = mkGenPrimOp (fsLit "packWord32X16#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word32X16PrimTy)+primOpInfo (VecPackOp WordVec 8 W64) = mkGenPrimOp (fsLit "packWord64X8#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word64X8PrimTy)+primOpInfo (VecPackOp FloatVec 4 W32) = mkGenPrimOp (fsLit "packFloatX4#")  [] [(mkTupleTy Unboxed [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])] (floatX4PrimTy)+primOpInfo (VecPackOp FloatVec 2 W64) = mkGenPrimOp (fsLit "packDoubleX2#")  [] [(mkTupleTy Unboxed [doublePrimTy, doublePrimTy])] (doubleX2PrimTy)+primOpInfo (VecPackOp FloatVec 8 W32) = mkGenPrimOp (fsLit "packFloatX8#")  [] [(mkTupleTy Unboxed [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])] (floatX8PrimTy)+primOpInfo (VecPackOp FloatVec 4 W64) = mkGenPrimOp (fsLit "packDoubleX4#")  [] [(mkTupleTy Unboxed [doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy])] (doubleX4PrimTy)+primOpInfo (VecPackOp FloatVec 16 W32) = mkGenPrimOp (fsLit "packFloatX16#")  [] [(mkTupleTy Unboxed [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])] (floatX16PrimTy)+primOpInfo (VecPackOp FloatVec 8 W64) = mkGenPrimOp (fsLit "packDoubleX8#")  [] [(mkTupleTy Unboxed [doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy])] (doubleX8PrimTy)+primOpInfo (VecUnpackOp IntVec 16 W8) = mkGenPrimOp (fsLit "unpackInt8X16#")  [] [int8X16PrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy]))+primOpInfo (VecUnpackOp IntVec 8 W16) = mkGenPrimOp (fsLit "unpackInt16X8#")  [] [int16X8PrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy]))+primOpInfo (VecUnpackOp IntVec 4 W32) = mkGenPrimOp (fsLit "unpackInt32X4#")  [] [int32X4PrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy]))+primOpInfo (VecUnpackOp IntVec 2 W64) = mkGenPrimOp (fsLit "unpackInt64X2#")  [] [int64X2PrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy]))+primOpInfo (VecUnpackOp IntVec 32 W8) = mkGenPrimOp (fsLit "unpackInt8X32#")  [] [int8X32PrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy]))+primOpInfo (VecUnpackOp IntVec 16 W16) = mkGenPrimOp (fsLit "unpackInt16X16#")  [] [int16X16PrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy]))+primOpInfo (VecUnpackOp IntVec 8 W32) = mkGenPrimOp (fsLit "unpackInt32X8#")  [] [int32X8PrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy]))+primOpInfo (VecUnpackOp IntVec 4 W64) = mkGenPrimOp (fsLit "unpackInt64X4#")  [] [int64X4PrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy]))+primOpInfo (VecUnpackOp IntVec 64 W8) = mkGenPrimOp (fsLit "unpackInt8X64#")  [] [int8X64PrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy]))+primOpInfo (VecUnpackOp IntVec 32 W16) = mkGenPrimOp (fsLit "unpackInt16X32#")  [] [int16X32PrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy]))+primOpInfo (VecUnpackOp IntVec 16 W32) = mkGenPrimOp (fsLit "unpackInt32X16#")  [] [int32X16PrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy]))+primOpInfo (VecUnpackOp IntVec 8 W64) = mkGenPrimOp (fsLit "unpackInt64X8#")  [] [int64X8PrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy]))+primOpInfo (VecUnpackOp WordVec 16 W8) = mkGenPrimOp (fsLit "unpackWord8X16#")  [] [word8X16PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp WordVec 8 W16) = mkGenPrimOp (fsLit "unpackWord16X8#")  [] [word16X8PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp WordVec 4 W32) = mkGenPrimOp (fsLit "unpackWord32X4#")  [] [word32X4PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp WordVec 2 W64) = mkGenPrimOp (fsLit "unpackWord64X2#")  [] [word64X2PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp WordVec 32 W8) = mkGenPrimOp (fsLit "unpackWord8X32#")  [] [word8X32PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp WordVec 16 W16) = mkGenPrimOp (fsLit "unpackWord16X16#")  [] [word16X16PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp WordVec 8 W32) = mkGenPrimOp (fsLit "unpackWord32X8#")  [] [word32X8PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp WordVec 4 W64) = mkGenPrimOp (fsLit "unpackWord64X4#")  [] [word64X4PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp WordVec 64 W8) = mkGenPrimOp (fsLit "unpackWord8X64#")  [] [word8X64PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp WordVec 32 W16) = mkGenPrimOp (fsLit "unpackWord16X32#")  [] [word16X32PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp WordVec 16 W32) = mkGenPrimOp (fsLit "unpackWord32X16#")  [] [word32X16PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp WordVec 8 W64) = mkGenPrimOp (fsLit "unpackWord64X8#")  [] [word64X8PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp FloatVec 4 W32) = mkGenPrimOp (fsLit "unpackFloatX4#")  [] [floatX4PrimTy] ((mkTupleTy Unboxed [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy]))+primOpInfo (VecUnpackOp FloatVec 2 W64) = mkGenPrimOp (fsLit "unpackDoubleX2#")  [] [doubleX2PrimTy] ((mkTupleTy Unboxed [doublePrimTy, doublePrimTy]))+primOpInfo (VecUnpackOp FloatVec 8 W32) = mkGenPrimOp (fsLit "unpackFloatX8#")  [] [floatX8PrimTy] ((mkTupleTy Unboxed [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy]))+primOpInfo (VecUnpackOp FloatVec 4 W64) = mkGenPrimOp (fsLit "unpackDoubleX4#")  [] [doubleX4PrimTy] ((mkTupleTy Unboxed [doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy]))+primOpInfo (VecUnpackOp FloatVec 16 W32) = mkGenPrimOp (fsLit "unpackFloatX16#")  [] [floatX16PrimTy] ((mkTupleTy Unboxed [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy]))+primOpInfo (VecUnpackOp FloatVec 8 W64) = mkGenPrimOp (fsLit "unpackDoubleX8#")  [] [doubleX8PrimTy] ((mkTupleTy Unboxed [doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy]))+primOpInfo (VecInsertOp IntVec 16 W8) = mkGenPrimOp (fsLit "insertInt8X16#")  [] [int8X16PrimTy, intPrimTy, intPrimTy] (int8X16PrimTy)+primOpInfo (VecInsertOp IntVec 8 W16) = mkGenPrimOp (fsLit "insertInt16X8#")  [] [int16X8PrimTy, intPrimTy, intPrimTy] (int16X8PrimTy)+primOpInfo (VecInsertOp IntVec 4 W32) = mkGenPrimOp (fsLit "insertInt32X4#")  [] [int32X4PrimTy, intPrimTy, intPrimTy] (int32X4PrimTy)+primOpInfo (VecInsertOp IntVec 2 W64) = mkGenPrimOp (fsLit "insertInt64X2#")  [] [int64X2PrimTy, intPrimTy, intPrimTy] (int64X2PrimTy)+primOpInfo (VecInsertOp IntVec 32 W8) = mkGenPrimOp (fsLit "insertInt8X32#")  [] [int8X32PrimTy, intPrimTy, intPrimTy] (int8X32PrimTy)+primOpInfo (VecInsertOp IntVec 16 W16) = mkGenPrimOp (fsLit "insertInt16X16#")  [] [int16X16PrimTy, intPrimTy, intPrimTy] (int16X16PrimTy)+primOpInfo (VecInsertOp IntVec 8 W32) = mkGenPrimOp (fsLit "insertInt32X8#")  [] [int32X8PrimTy, intPrimTy, intPrimTy] (int32X8PrimTy)+primOpInfo (VecInsertOp IntVec 4 W64) = mkGenPrimOp (fsLit "insertInt64X4#")  [] [int64X4PrimTy, intPrimTy, intPrimTy] (int64X4PrimTy)+primOpInfo (VecInsertOp IntVec 64 W8) = mkGenPrimOp (fsLit "insertInt8X64#")  [] [int8X64PrimTy, intPrimTy, intPrimTy] (int8X64PrimTy)+primOpInfo (VecInsertOp IntVec 32 W16) = mkGenPrimOp (fsLit "insertInt16X32#")  [] [int16X32PrimTy, intPrimTy, intPrimTy] (int16X32PrimTy)+primOpInfo (VecInsertOp IntVec 16 W32) = mkGenPrimOp (fsLit "insertInt32X16#")  [] [int32X16PrimTy, intPrimTy, intPrimTy] (int32X16PrimTy)+primOpInfo (VecInsertOp IntVec 8 W64) = mkGenPrimOp (fsLit "insertInt64X8#")  [] [int64X8PrimTy, intPrimTy, intPrimTy] (int64X8PrimTy)+primOpInfo (VecInsertOp WordVec 16 W8) = mkGenPrimOp (fsLit "insertWord8X16#")  [] [word8X16PrimTy, wordPrimTy, intPrimTy] (word8X16PrimTy)+primOpInfo (VecInsertOp WordVec 8 W16) = mkGenPrimOp (fsLit "insertWord16X8#")  [] [word16X8PrimTy, wordPrimTy, intPrimTy] (word16X8PrimTy)+primOpInfo (VecInsertOp WordVec 4 W32) = mkGenPrimOp (fsLit "insertWord32X4#")  [] [word32X4PrimTy, wordPrimTy, intPrimTy] (word32X4PrimTy)+primOpInfo (VecInsertOp WordVec 2 W64) = mkGenPrimOp (fsLit "insertWord64X2#")  [] [word64X2PrimTy, wordPrimTy, intPrimTy] (word64X2PrimTy)+primOpInfo (VecInsertOp WordVec 32 W8) = mkGenPrimOp (fsLit "insertWord8X32#")  [] [word8X32PrimTy, wordPrimTy, intPrimTy] (word8X32PrimTy)+primOpInfo (VecInsertOp WordVec 16 W16) = mkGenPrimOp (fsLit "insertWord16X16#")  [] [word16X16PrimTy, wordPrimTy, intPrimTy] (word16X16PrimTy)+primOpInfo (VecInsertOp WordVec 8 W32) = mkGenPrimOp (fsLit "insertWord32X8#")  [] [word32X8PrimTy, wordPrimTy, intPrimTy] (word32X8PrimTy)+primOpInfo (VecInsertOp WordVec 4 W64) = mkGenPrimOp (fsLit "insertWord64X4#")  [] [word64X4PrimTy, wordPrimTy, intPrimTy] (word64X4PrimTy)+primOpInfo (VecInsertOp WordVec 64 W8) = mkGenPrimOp (fsLit "insertWord8X64#")  [] [word8X64PrimTy, wordPrimTy, intPrimTy] (word8X64PrimTy)+primOpInfo (VecInsertOp WordVec 32 W16) = mkGenPrimOp (fsLit "insertWord16X32#")  [] [word16X32PrimTy, wordPrimTy, intPrimTy] (word16X32PrimTy)+primOpInfo (VecInsertOp WordVec 16 W32) = mkGenPrimOp (fsLit "insertWord32X16#")  [] [word32X16PrimTy, wordPrimTy, intPrimTy] (word32X16PrimTy)+primOpInfo (VecInsertOp WordVec 8 W64) = mkGenPrimOp (fsLit "insertWord64X8#")  [] [word64X8PrimTy, wordPrimTy, intPrimTy] (word64X8PrimTy)+primOpInfo (VecInsertOp FloatVec 4 W32) = mkGenPrimOp (fsLit "insertFloatX4#")  [] [floatX4PrimTy, floatPrimTy, intPrimTy] (floatX4PrimTy)+primOpInfo (VecInsertOp FloatVec 2 W64) = mkGenPrimOp (fsLit "insertDoubleX2#")  [] [doubleX2PrimTy, doublePrimTy, intPrimTy] (doubleX2PrimTy)+primOpInfo (VecInsertOp FloatVec 8 W32) = mkGenPrimOp (fsLit "insertFloatX8#")  [] [floatX8PrimTy, floatPrimTy, intPrimTy] (floatX8PrimTy)+primOpInfo (VecInsertOp FloatVec 4 W64) = mkGenPrimOp (fsLit "insertDoubleX4#")  [] [doubleX4PrimTy, doublePrimTy, intPrimTy] (doubleX4PrimTy)+primOpInfo (VecInsertOp FloatVec 16 W32) = mkGenPrimOp (fsLit "insertFloatX16#")  [] [floatX16PrimTy, floatPrimTy, intPrimTy] (floatX16PrimTy)+primOpInfo (VecInsertOp FloatVec 8 W64) = mkGenPrimOp (fsLit "insertDoubleX8#")  [] [doubleX8PrimTy, doublePrimTy, intPrimTy] (doubleX8PrimTy)+primOpInfo (VecAddOp IntVec 16 W8) = mkDyadic (fsLit "plusInt8X16#") int8X16PrimTy+primOpInfo (VecAddOp IntVec 8 W16) = mkDyadic (fsLit "plusInt16X8#") int16X8PrimTy+primOpInfo (VecAddOp IntVec 4 W32) = mkDyadic (fsLit "plusInt32X4#") int32X4PrimTy+primOpInfo (VecAddOp IntVec 2 W64) = mkDyadic (fsLit "plusInt64X2#") int64X2PrimTy+primOpInfo (VecAddOp IntVec 32 W8) = mkDyadic (fsLit "plusInt8X32#") int8X32PrimTy+primOpInfo (VecAddOp IntVec 16 W16) = mkDyadic (fsLit "plusInt16X16#") int16X16PrimTy+primOpInfo (VecAddOp IntVec 8 W32) = mkDyadic (fsLit "plusInt32X8#") int32X8PrimTy+primOpInfo (VecAddOp IntVec 4 W64) = mkDyadic (fsLit "plusInt64X4#") int64X4PrimTy+primOpInfo (VecAddOp IntVec 64 W8) = mkDyadic (fsLit "plusInt8X64#") int8X64PrimTy+primOpInfo (VecAddOp IntVec 32 W16) = mkDyadic (fsLit "plusInt16X32#") int16X32PrimTy+primOpInfo (VecAddOp IntVec 16 W32) = mkDyadic (fsLit "plusInt32X16#") int32X16PrimTy+primOpInfo (VecAddOp IntVec 8 W64) = mkDyadic (fsLit "plusInt64X8#") int64X8PrimTy+primOpInfo (VecAddOp WordVec 16 W8) = mkDyadic (fsLit "plusWord8X16#") word8X16PrimTy+primOpInfo (VecAddOp WordVec 8 W16) = mkDyadic (fsLit "plusWord16X8#") word16X8PrimTy+primOpInfo (VecAddOp WordVec 4 W32) = mkDyadic (fsLit "plusWord32X4#") word32X4PrimTy+primOpInfo (VecAddOp WordVec 2 W64) = mkDyadic (fsLit "plusWord64X2#") word64X2PrimTy+primOpInfo (VecAddOp WordVec 32 W8) = mkDyadic (fsLit "plusWord8X32#") word8X32PrimTy+primOpInfo (VecAddOp WordVec 16 W16) = mkDyadic (fsLit "plusWord16X16#") word16X16PrimTy+primOpInfo (VecAddOp WordVec 8 W32) = mkDyadic (fsLit "plusWord32X8#") word32X8PrimTy+primOpInfo (VecAddOp WordVec 4 W64) = mkDyadic (fsLit "plusWord64X4#") word64X4PrimTy+primOpInfo (VecAddOp WordVec 64 W8) = mkDyadic (fsLit "plusWord8X64#") word8X64PrimTy+primOpInfo (VecAddOp WordVec 32 W16) = mkDyadic (fsLit "plusWord16X32#") word16X32PrimTy+primOpInfo (VecAddOp WordVec 16 W32) = mkDyadic (fsLit "plusWord32X16#") word32X16PrimTy+primOpInfo (VecAddOp WordVec 8 W64) = mkDyadic (fsLit "plusWord64X8#") word64X8PrimTy+primOpInfo (VecAddOp FloatVec 4 W32) = mkDyadic (fsLit "plusFloatX4#") floatX4PrimTy+primOpInfo (VecAddOp FloatVec 2 W64) = mkDyadic (fsLit "plusDoubleX2#") doubleX2PrimTy+primOpInfo (VecAddOp FloatVec 8 W32) = mkDyadic (fsLit "plusFloatX8#") floatX8PrimTy+primOpInfo (VecAddOp FloatVec 4 W64) = mkDyadic (fsLit "plusDoubleX4#") doubleX4PrimTy+primOpInfo (VecAddOp FloatVec 16 W32) = mkDyadic (fsLit "plusFloatX16#") floatX16PrimTy+primOpInfo (VecAddOp FloatVec 8 W64) = mkDyadic (fsLit "plusDoubleX8#") doubleX8PrimTy+primOpInfo (VecSubOp IntVec 16 W8) = mkDyadic (fsLit "minusInt8X16#") int8X16PrimTy+primOpInfo (VecSubOp IntVec 8 W16) = mkDyadic (fsLit "minusInt16X8#") int16X8PrimTy+primOpInfo (VecSubOp IntVec 4 W32) = mkDyadic (fsLit "minusInt32X4#") int32X4PrimTy+primOpInfo (VecSubOp IntVec 2 W64) = mkDyadic (fsLit "minusInt64X2#") int64X2PrimTy+primOpInfo (VecSubOp IntVec 32 W8) = mkDyadic (fsLit "minusInt8X32#") int8X32PrimTy+primOpInfo (VecSubOp IntVec 16 W16) = mkDyadic (fsLit "minusInt16X16#") int16X16PrimTy+primOpInfo (VecSubOp IntVec 8 W32) = mkDyadic (fsLit "minusInt32X8#") int32X8PrimTy+primOpInfo (VecSubOp IntVec 4 W64) = mkDyadic (fsLit "minusInt64X4#") int64X4PrimTy+primOpInfo (VecSubOp IntVec 64 W8) = mkDyadic (fsLit "minusInt8X64#") int8X64PrimTy+primOpInfo (VecSubOp IntVec 32 W16) = mkDyadic (fsLit "minusInt16X32#") int16X32PrimTy+primOpInfo (VecSubOp IntVec 16 W32) = mkDyadic (fsLit "minusInt32X16#") int32X16PrimTy+primOpInfo (VecSubOp IntVec 8 W64) = mkDyadic (fsLit "minusInt64X8#") int64X8PrimTy+primOpInfo (VecSubOp WordVec 16 W8) = mkDyadic (fsLit "minusWord8X16#") word8X16PrimTy+primOpInfo (VecSubOp WordVec 8 W16) = mkDyadic (fsLit "minusWord16X8#") word16X8PrimTy+primOpInfo (VecSubOp WordVec 4 W32) = mkDyadic (fsLit "minusWord32X4#") word32X4PrimTy+primOpInfo (VecSubOp WordVec 2 W64) = mkDyadic (fsLit "minusWord64X2#") word64X2PrimTy+primOpInfo (VecSubOp WordVec 32 W8) = mkDyadic (fsLit "minusWord8X32#") word8X32PrimTy+primOpInfo (VecSubOp WordVec 16 W16) = mkDyadic (fsLit "minusWord16X16#") word16X16PrimTy+primOpInfo (VecSubOp WordVec 8 W32) = mkDyadic (fsLit "minusWord32X8#") word32X8PrimTy+primOpInfo (VecSubOp WordVec 4 W64) = mkDyadic (fsLit "minusWord64X4#") word64X4PrimTy+primOpInfo (VecSubOp WordVec 64 W8) = mkDyadic (fsLit "minusWord8X64#") word8X64PrimTy+primOpInfo (VecSubOp WordVec 32 W16) = mkDyadic (fsLit "minusWord16X32#") word16X32PrimTy+primOpInfo (VecSubOp WordVec 16 W32) = mkDyadic (fsLit "minusWord32X16#") word32X16PrimTy+primOpInfo (VecSubOp WordVec 8 W64) = mkDyadic (fsLit "minusWord64X8#") word64X8PrimTy+primOpInfo (VecSubOp FloatVec 4 W32) = mkDyadic (fsLit "minusFloatX4#") floatX4PrimTy+primOpInfo (VecSubOp FloatVec 2 W64) = mkDyadic (fsLit "minusDoubleX2#") doubleX2PrimTy+primOpInfo (VecSubOp FloatVec 8 W32) = mkDyadic (fsLit "minusFloatX8#") floatX8PrimTy+primOpInfo (VecSubOp FloatVec 4 W64) = mkDyadic (fsLit "minusDoubleX4#") doubleX4PrimTy+primOpInfo (VecSubOp FloatVec 16 W32) = mkDyadic (fsLit "minusFloatX16#") floatX16PrimTy+primOpInfo (VecSubOp FloatVec 8 W64) = mkDyadic (fsLit "minusDoubleX8#") doubleX8PrimTy+primOpInfo (VecMulOp IntVec 16 W8) = mkDyadic (fsLit "timesInt8X16#") int8X16PrimTy+primOpInfo (VecMulOp IntVec 8 W16) = mkDyadic (fsLit "timesInt16X8#") int16X8PrimTy+primOpInfo (VecMulOp IntVec 4 W32) = mkDyadic (fsLit "timesInt32X4#") int32X4PrimTy+primOpInfo (VecMulOp IntVec 2 W64) = mkDyadic (fsLit "timesInt64X2#") int64X2PrimTy+primOpInfo (VecMulOp IntVec 32 W8) = mkDyadic (fsLit "timesInt8X32#") int8X32PrimTy+primOpInfo (VecMulOp IntVec 16 W16) = mkDyadic (fsLit "timesInt16X16#") int16X16PrimTy+primOpInfo (VecMulOp IntVec 8 W32) = mkDyadic (fsLit "timesInt32X8#") int32X8PrimTy+primOpInfo (VecMulOp IntVec 4 W64) = mkDyadic (fsLit "timesInt64X4#") int64X4PrimTy+primOpInfo (VecMulOp IntVec 64 W8) = mkDyadic (fsLit "timesInt8X64#") int8X64PrimTy+primOpInfo (VecMulOp IntVec 32 W16) = mkDyadic (fsLit "timesInt16X32#") int16X32PrimTy+primOpInfo (VecMulOp IntVec 16 W32) = mkDyadic (fsLit "timesInt32X16#") int32X16PrimTy+primOpInfo (VecMulOp IntVec 8 W64) = mkDyadic (fsLit "timesInt64X8#") int64X8PrimTy+primOpInfo (VecMulOp WordVec 16 W8) = mkDyadic (fsLit "timesWord8X16#") word8X16PrimTy+primOpInfo (VecMulOp WordVec 8 W16) = mkDyadic (fsLit "timesWord16X8#") word16X8PrimTy+primOpInfo (VecMulOp WordVec 4 W32) = mkDyadic (fsLit "timesWord32X4#") word32X4PrimTy+primOpInfo (VecMulOp WordVec 2 W64) = mkDyadic (fsLit "timesWord64X2#") word64X2PrimTy+primOpInfo (VecMulOp WordVec 32 W8) = mkDyadic (fsLit "timesWord8X32#") word8X32PrimTy+primOpInfo (VecMulOp WordVec 16 W16) = mkDyadic (fsLit "timesWord16X16#") word16X16PrimTy+primOpInfo (VecMulOp WordVec 8 W32) = mkDyadic (fsLit "timesWord32X8#") word32X8PrimTy+primOpInfo (VecMulOp WordVec 4 W64) = mkDyadic (fsLit "timesWord64X4#") word64X4PrimTy+primOpInfo (VecMulOp WordVec 64 W8) = mkDyadic (fsLit "timesWord8X64#") word8X64PrimTy+primOpInfo (VecMulOp WordVec 32 W16) = mkDyadic (fsLit "timesWord16X32#") word16X32PrimTy+primOpInfo (VecMulOp WordVec 16 W32) = mkDyadic (fsLit "timesWord32X16#") word32X16PrimTy+primOpInfo (VecMulOp WordVec 8 W64) = mkDyadic (fsLit "timesWord64X8#") word64X8PrimTy+primOpInfo (VecMulOp FloatVec 4 W32) = mkDyadic (fsLit "timesFloatX4#") floatX4PrimTy+primOpInfo (VecMulOp FloatVec 2 W64) = mkDyadic (fsLit "timesDoubleX2#") doubleX2PrimTy+primOpInfo (VecMulOp FloatVec 8 W32) = mkDyadic (fsLit "timesFloatX8#") floatX8PrimTy+primOpInfo (VecMulOp FloatVec 4 W64) = mkDyadic (fsLit "timesDoubleX4#") doubleX4PrimTy+primOpInfo (VecMulOp FloatVec 16 W32) = mkDyadic (fsLit "timesFloatX16#") floatX16PrimTy+primOpInfo (VecMulOp FloatVec 8 W64) = mkDyadic (fsLit "timesDoubleX8#") doubleX8PrimTy+primOpInfo (VecDivOp FloatVec 4 W32) = mkDyadic (fsLit "divideFloatX4#") floatX4PrimTy+primOpInfo (VecDivOp FloatVec 2 W64) = mkDyadic (fsLit "divideDoubleX2#") doubleX2PrimTy+primOpInfo (VecDivOp FloatVec 8 W32) = mkDyadic (fsLit "divideFloatX8#") floatX8PrimTy+primOpInfo (VecDivOp FloatVec 4 W64) = mkDyadic (fsLit "divideDoubleX4#") doubleX4PrimTy+primOpInfo (VecDivOp FloatVec 16 W32) = mkDyadic (fsLit "divideFloatX16#") floatX16PrimTy+primOpInfo (VecDivOp FloatVec 8 W64) = mkDyadic (fsLit "divideDoubleX8#") doubleX8PrimTy+primOpInfo (VecQuotOp IntVec 16 W8) = mkDyadic (fsLit "quotInt8X16#") int8X16PrimTy+primOpInfo (VecQuotOp IntVec 8 W16) = mkDyadic (fsLit "quotInt16X8#") int16X8PrimTy+primOpInfo (VecQuotOp IntVec 4 W32) = mkDyadic (fsLit "quotInt32X4#") int32X4PrimTy+primOpInfo (VecQuotOp IntVec 2 W64) = mkDyadic (fsLit "quotInt64X2#") int64X2PrimTy+primOpInfo (VecQuotOp IntVec 32 W8) = mkDyadic (fsLit "quotInt8X32#") int8X32PrimTy+primOpInfo (VecQuotOp IntVec 16 W16) = mkDyadic (fsLit "quotInt16X16#") int16X16PrimTy+primOpInfo (VecQuotOp IntVec 8 W32) = mkDyadic (fsLit "quotInt32X8#") int32X8PrimTy+primOpInfo (VecQuotOp IntVec 4 W64) = mkDyadic (fsLit "quotInt64X4#") int64X4PrimTy+primOpInfo (VecQuotOp IntVec 64 W8) = mkDyadic (fsLit "quotInt8X64#") int8X64PrimTy+primOpInfo (VecQuotOp IntVec 32 W16) = mkDyadic (fsLit "quotInt16X32#") int16X32PrimTy+primOpInfo (VecQuotOp IntVec 16 W32) = mkDyadic (fsLit "quotInt32X16#") int32X16PrimTy+primOpInfo (VecQuotOp IntVec 8 W64) = mkDyadic (fsLit "quotInt64X8#") int64X8PrimTy+primOpInfo (VecQuotOp WordVec 16 W8) = mkDyadic (fsLit "quotWord8X16#") word8X16PrimTy+primOpInfo (VecQuotOp WordVec 8 W16) = mkDyadic (fsLit "quotWord16X8#") word16X8PrimTy+primOpInfo (VecQuotOp WordVec 4 W32) = mkDyadic (fsLit "quotWord32X4#") word32X4PrimTy+primOpInfo (VecQuotOp WordVec 2 W64) = mkDyadic (fsLit "quotWord64X2#") word64X2PrimTy+primOpInfo (VecQuotOp WordVec 32 W8) = mkDyadic (fsLit "quotWord8X32#") word8X32PrimTy+primOpInfo (VecQuotOp WordVec 16 W16) = mkDyadic (fsLit "quotWord16X16#") word16X16PrimTy+primOpInfo (VecQuotOp WordVec 8 W32) = mkDyadic (fsLit "quotWord32X8#") word32X8PrimTy+primOpInfo (VecQuotOp WordVec 4 W64) = mkDyadic (fsLit "quotWord64X4#") word64X4PrimTy+primOpInfo (VecQuotOp WordVec 64 W8) = mkDyadic (fsLit "quotWord8X64#") word8X64PrimTy+primOpInfo (VecQuotOp WordVec 32 W16) = mkDyadic (fsLit "quotWord16X32#") word16X32PrimTy+primOpInfo (VecQuotOp WordVec 16 W32) = mkDyadic (fsLit "quotWord32X16#") word32X16PrimTy+primOpInfo (VecQuotOp WordVec 8 W64) = mkDyadic (fsLit "quotWord64X8#") word64X8PrimTy+primOpInfo (VecRemOp IntVec 16 W8) = mkDyadic (fsLit "remInt8X16#") int8X16PrimTy+primOpInfo (VecRemOp IntVec 8 W16) = mkDyadic (fsLit "remInt16X8#") int16X8PrimTy+primOpInfo (VecRemOp IntVec 4 W32) = mkDyadic (fsLit "remInt32X4#") int32X4PrimTy+primOpInfo (VecRemOp IntVec 2 W64) = mkDyadic (fsLit "remInt64X2#") int64X2PrimTy+primOpInfo (VecRemOp IntVec 32 W8) = mkDyadic (fsLit "remInt8X32#") int8X32PrimTy+primOpInfo (VecRemOp IntVec 16 W16) = mkDyadic (fsLit "remInt16X16#") int16X16PrimTy+primOpInfo (VecRemOp IntVec 8 W32) = mkDyadic (fsLit "remInt32X8#") int32X8PrimTy+primOpInfo (VecRemOp IntVec 4 W64) = mkDyadic (fsLit "remInt64X4#") int64X4PrimTy+primOpInfo (VecRemOp IntVec 64 W8) = mkDyadic (fsLit "remInt8X64#") int8X64PrimTy+primOpInfo (VecRemOp IntVec 32 W16) = mkDyadic (fsLit "remInt16X32#") int16X32PrimTy+primOpInfo (VecRemOp IntVec 16 W32) = mkDyadic (fsLit "remInt32X16#") int32X16PrimTy+primOpInfo (VecRemOp IntVec 8 W64) = mkDyadic (fsLit "remInt64X8#") int64X8PrimTy+primOpInfo (VecRemOp WordVec 16 W8) = mkDyadic (fsLit "remWord8X16#") word8X16PrimTy+primOpInfo (VecRemOp WordVec 8 W16) = mkDyadic (fsLit "remWord16X8#") word16X8PrimTy+primOpInfo (VecRemOp WordVec 4 W32) = mkDyadic (fsLit "remWord32X4#") word32X4PrimTy+primOpInfo (VecRemOp WordVec 2 W64) = mkDyadic (fsLit "remWord64X2#") word64X2PrimTy+primOpInfo (VecRemOp WordVec 32 W8) = mkDyadic (fsLit "remWord8X32#") word8X32PrimTy+primOpInfo (VecRemOp WordVec 16 W16) = mkDyadic (fsLit "remWord16X16#") word16X16PrimTy+primOpInfo (VecRemOp WordVec 8 W32) = mkDyadic (fsLit "remWord32X8#") word32X8PrimTy+primOpInfo (VecRemOp WordVec 4 W64) = mkDyadic (fsLit "remWord64X4#") word64X4PrimTy+primOpInfo (VecRemOp WordVec 64 W8) = mkDyadic (fsLit "remWord8X64#") word8X64PrimTy+primOpInfo (VecRemOp WordVec 32 W16) = mkDyadic (fsLit "remWord16X32#") word16X32PrimTy+primOpInfo (VecRemOp WordVec 16 W32) = mkDyadic (fsLit "remWord32X16#") word32X16PrimTy+primOpInfo (VecRemOp WordVec 8 W64) = mkDyadic (fsLit "remWord64X8#") word64X8PrimTy+primOpInfo (VecNegOp IntVec 16 W8) = mkMonadic (fsLit "negateInt8X16#") int8X16PrimTy+primOpInfo (VecNegOp IntVec 8 W16) = mkMonadic (fsLit "negateInt16X8#") int16X8PrimTy+primOpInfo (VecNegOp IntVec 4 W32) = mkMonadic (fsLit "negateInt32X4#") int32X4PrimTy+primOpInfo (VecNegOp IntVec 2 W64) = mkMonadic (fsLit "negateInt64X2#") int64X2PrimTy+primOpInfo (VecNegOp IntVec 32 W8) = mkMonadic (fsLit "negateInt8X32#") int8X32PrimTy+primOpInfo (VecNegOp IntVec 16 W16) = mkMonadic (fsLit "negateInt16X16#") int16X16PrimTy+primOpInfo (VecNegOp IntVec 8 W32) = mkMonadic (fsLit "negateInt32X8#") int32X8PrimTy+primOpInfo (VecNegOp IntVec 4 W64) = mkMonadic (fsLit "negateInt64X4#") int64X4PrimTy+primOpInfo (VecNegOp IntVec 64 W8) = mkMonadic (fsLit "negateInt8X64#") int8X64PrimTy+primOpInfo (VecNegOp IntVec 32 W16) = mkMonadic (fsLit "negateInt16X32#") int16X32PrimTy+primOpInfo (VecNegOp IntVec 16 W32) = mkMonadic (fsLit "negateInt32X16#") int32X16PrimTy+primOpInfo (VecNegOp IntVec 8 W64) = mkMonadic (fsLit "negateInt64X8#") int64X8PrimTy+primOpInfo (VecNegOp FloatVec 4 W32) = mkMonadic (fsLit "negateFloatX4#") floatX4PrimTy+primOpInfo (VecNegOp FloatVec 2 W64) = mkMonadic (fsLit "negateDoubleX2#") doubleX2PrimTy+primOpInfo (VecNegOp FloatVec 8 W32) = mkMonadic (fsLit "negateFloatX8#") floatX8PrimTy+primOpInfo (VecNegOp FloatVec 4 W64) = mkMonadic (fsLit "negateDoubleX4#") doubleX4PrimTy+primOpInfo (VecNegOp FloatVec 16 W32) = mkMonadic (fsLit "negateFloatX16#") floatX16PrimTy+primOpInfo (VecNegOp FloatVec 8 W64) = mkMonadic (fsLit "negateDoubleX8#") doubleX8PrimTy+primOpInfo (VecIndexByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "indexInt8X16Array#")  [] [byteArrayPrimTy, intPrimTy] (int8X16PrimTy)+primOpInfo (VecIndexByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "indexInt16X8Array#")  [] [byteArrayPrimTy, intPrimTy] (int16X8PrimTy)+primOpInfo (VecIndexByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "indexInt32X4Array#")  [] [byteArrayPrimTy, intPrimTy] (int32X4PrimTy)+primOpInfo (VecIndexByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "indexInt64X2Array#")  [] [byteArrayPrimTy, intPrimTy] (int64X2PrimTy)+primOpInfo (VecIndexByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "indexInt8X32Array#")  [] [byteArrayPrimTy, intPrimTy] (int8X32PrimTy)+primOpInfo (VecIndexByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "indexInt16X16Array#")  [] [byteArrayPrimTy, intPrimTy] (int16X16PrimTy)+primOpInfo (VecIndexByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "indexInt32X8Array#")  [] [byteArrayPrimTy, intPrimTy] (int32X8PrimTy)+primOpInfo (VecIndexByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "indexInt64X4Array#")  [] [byteArrayPrimTy, intPrimTy] (int64X4PrimTy)+primOpInfo (VecIndexByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "indexInt8X64Array#")  [] [byteArrayPrimTy, intPrimTy] (int8X64PrimTy)+primOpInfo (VecIndexByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "indexInt16X32Array#")  [] [byteArrayPrimTy, intPrimTy] (int16X32PrimTy)+primOpInfo (VecIndexByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "indexInt32X16Array#")  [] [byteArrayPrimTy, intPrimTy] (int32X16PrimTy)+primOpInfo (VecIndexByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "indexInt64X8Array#")  [] [byteArrayPrimTy, intPrimTy] (int64X8PrimTy)+primOpInfo (VecIndexByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "indexWord8X16Array#")  [] [byteArrayPrimTy, intPrimTy] (word8X16PrimTy)+primOpInfo (VecIndexByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "indexWord16X8Array#")  [] [byteArrayPrimTy, intPrimTy] (word16X8PrimTy)+primOpInfo (VecIndexByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "indexWord32X4Array#")  [] [byteArrayPrimTy, intPrimTy] (word32X4PrimTy)+primOpInfo (VecIndexByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "indexWord64X2Array#")  [] [byteArrayPrimTy, intPrimTy] (word64X2PrimTy)+primOpInfo (VecIndexByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "indexWord8X32Array#")  [] [byteArrayPrimTy, intPrimTy] (word8X32PrimTy)+primOpInfo (VecIndexByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "indexWord16X16Array#")  [] [byteArrayPrimTy, intPrimTy] (word16X16PrimTy)+primOpInfo (VecIndexByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "indexWord32X8Array#")  [] [byteArrayPrimTy, intPrimTy] (word32X8PrimTy)+primOpInfo (VecIndexByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "indexWord64X4Array#")  [] [byteArrayPrimTy, intPrimTy] (word64X4PrimTy)+primOpInfo (VecIndexByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "indexWord8X64Array#")  [] [byteArrayPrimTy, intPrimTy] (word8X64PrimTy)+primOpInfo (VecIndexByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "indexWord16X32Array#")  [] [byteArrayPrimTy, intPrimTy] (word16X32PrimTy)+primOpInfo (VecIndexByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "indexWord32X16Array#")  [] [byteArrayPrimTy, intPrimTy] (word32X16PrimTy)+primOpInfo (VecIndexByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "indexWord64X8Array#")  [] [byteArrayPrimTy, intPrimTy] (word64X8PrimTy)+primOpInfo (VecIndexByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "indexFloatX4Array#")  [] [byteArrayPrimTy, intPrimTy] (floatX4PrimTy)+primOpInfo (VecIndexByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "indexDoubleX2Array#")  [] [byteArrayPrimTy, intPrimTy] (doubleX2PrimTy)+primOpInfo (VecIndexByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "indexFloatX8Array#")  [] [byteArrayPrimTy, intPrimTy] (floatX8PrimTy)+primOpInfo (VecIndexByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "indexDoubleX4Array#")  [] [byteArrayPrimTy, intPrimTy] (doubleX4PrimTy)+primOpInfo (VecIndexByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "indexFloatX16Array#")  [] [byteArrayPrimTy, intPrimTy] (floatX16PrimTy)+primOpInfo (VecIndexByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "indexDoubleX8Array#")  [] [byteArrayPrimTy, intPrimTy] (doubleX8PrimTy)+primOpInfo (VecReadByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "readInt8X16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int8X16PrimTy]))+primOpInfo (VecReadByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "readInt16X8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int16X8PrimTy]))+primOpInfo (VecReadByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "readInt32X4Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int32X4PrimTy]))+primOpInfo (VecReadByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "readInt64X2Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int64X2PrimTy]))+primOpInfo (VecReadByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "readInt8X32Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int8X32PrimTy]))+primOpInfo (VecReadByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "readInt16X16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int16X16PrimTy]))+primOpInfo (VecReadByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "readInt32X8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int32X8PrimTy]))+primOpInfo (VecReadByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "readInt64X4Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int64X4PrimTy]))+primOpInfo (VecReadByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "readInt8X64Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int8X64PrimTy]))+primOpInfo (VecReadByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "readInt16X32Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int16X32PrimTy]))+primOpInfo (VecReadByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "readInt32X16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int32X16PrimTy]))+primOpInfo (VecReadByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "readInt64X8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int64X8PrimTy]))+primOpInfo (VecReadByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "readWord8X16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word8X16PrimTy]))+primOpInfo (VecReadByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "readWord16X8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word16X8PrimTy]))+primOpInfo (VecReadByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "readWord32X4Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word32X4PrimTy]))+primOpInfo (VecReadByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "readWord64X2Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word64X2PrimTy]))+primOpInfo (VecReadByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "readWord8X32Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word8X32PrimTy]))+primOpInfo (VecReadByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "readWord16X16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word16X16PrimTy]))+primOpInfo (VecReadByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "readWord32X8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word32X8PrimTy]))+primOpInfo (VecReadByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "readWord64X4Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word64X4PrimTy]))+primOpInfo (VecReadByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "readWord8X64Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word8X64PrimTy]))+primOpInfo (VecReadByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "readWord16X32Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word16X32PrimTy]))+primOpInfo (VecReadByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "readWord32X16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word32X16PrimTy]))+primOpInfo (VecReadByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "readWord64X8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word64X8PrimTy]))+primOpInfo (VecReadByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "readFloatX4Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatX4PrimTy]))+primOpInfo (VecReadByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "readDoubleX2Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doubleX2PrimTy]))+primOpInfo (VecReadByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "readFloatX8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatX8PrimTy]))+primOpInfo (VecReadByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "readDoubleX4Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doubleX4PrimTy]))+primOpInfo (VecReadByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "readFloatX16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatX16PrimTy]))+primOpInfo (VecReadByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "readDoubleX8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doubleX8PrimTy]))+primOpInfo (VecWriteByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "writeInt8X16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "writeInt16X8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "writeInt32X4Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "writeInt64X2Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "writeInt8X32Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "writeInt16X16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "writeInt32X8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "writeInt64X4Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "writeInt8X64Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "writeInt16X32Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "writeInt32X16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "writeInt64X8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "writeWord8X16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "writeWord16X8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "writeWord32X4Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "writeWord64X2Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "writeWord8X32Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "writeWord16X16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "writeWord32X8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "writeWord64X4Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "writeWord8X64Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "writeWord16X32Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "writeWord32X16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "writeWord64X8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "writeFloatX4Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "writeDoubleX2Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "writeFloatX8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "writeDoubleX4Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "writeFloatX16Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "writeDoubleX8Array#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecIndexOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "indexInt8X16OffAddr#")  [] [addrPrimTy, intPrimTy] (int8X16PrimTy)+primOpInfo (VecIndexOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "indexInt16X8OffAddr#")  [] [addrPrimTy, intPrimTy] (int16X8PrimTy)+primOpInfo (VecIndexOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "indexInt32X4OffAddr#")  [] [addrPrimTy, intPrimTy] (int32X4PrimTy)+primOpInfo (VecIndexOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "indexInt64X2OffAddr#")  [] [addrPrimTy, intPrimTy] (int64X2PrimTy)+primOpInfo (VecIndexOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "indexInt8X32OffAddr#")  [] [addrPrimTy, intPrimTy] (int8X32PrimTy)+primOpInfo (VecIndexOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "indexInt16X16OffAddr#")  [] [addrPrimTy, intPrimTy] (int16X16PrimTy)+primOpInfo (VecIndexOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "indexInt32X8OffAddr#")  [] [addrPrimTy, intPrimTy] (int32X8PrimTy)+primOpInfo (VecIndexOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "indexInt64X4OffAddr#")  [] [addrPrimTy, intPrimTy] (int64X4PrimTy)+primOpInfo (VecIndexOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "indexInt8X64OffAddr#")  [] [addrPrimTy, intPrimTy] (int8X64PrimTy)+primOpInfo (VecIndexOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "indexInt16X32OffAddr#")  [] [addrPrimTy, intPrimTy] (int16X32PrimTy)+primOpInfo (VecIndexOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "indexInt32X16OffAddr#")  [] [addrPrimTy, intPrimTy] (int32X16PrimTy)+primOpInfo (VecIndexOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "indexInt64X8OffAddr#")  [] [addrPrimTy, intPrimTy] (int64X8PrimTy)+primOpInfo (VecIndexOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "indexWord8X16OffAddr#")  [] [addrPrimTy, intPrimTy] (word8X16PrimTy)+primOpInfo (VecIndexOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "indexWord16X8OffAddr#")  [] [addrPrimTy, intPrimTy] (word16X8PrimTy)+primOpInfo (VecIndexOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "indexWord32X4OffAddr#")  [] [addrPrimTy, intPrimTy] (word32X4PrimTy)+primOpInfo (VecIndexOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "indexWord64X2OffAddr#")  [] [addrPrimTy, intPrimTy] (word64X2PrimTy)+primOpInfo (VecIndexOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "indexWord8X32OffAddr#")  [] [addrPrimTy, intPrimTy] (word8X32PrimTy)+primOpInfo (VecIndexOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "indexWord16X16OffAddr#")  [] [addrPrimTy, intPrimTy] (word16X16PrimTy)+primOpInfo (VecIndexOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "indexWord32X8OffAddr#")  [] [addrPrimTy, intPrimTy] (word32X8PrimTy)+primOpInfo (VecIndexOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "indexWord64X4OffAddr#")  [] [addrPrimTy, intPrimTy] (word64X4PrimTy)+primOpInfo (VecIndexOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "indexWord8X64OffAddr#")  [] [addrPrimTy, intPrimTy] (word8X64PrimTy)+primOpInfo (VecIndexOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "indexWord16X32OffAddr#")  [] [addrPrimTy, intPrimTy] (word16X32PrimTy)+primOpInfo (VecIndexOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "indexWord32X16OffAddr#")  [] [addrPrimTy, intPrimTy] (word32X16PrimTy)+primOpInfo (VecIndexOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "indexWord64X8OffAddr#")  [] [addrPrimTy, intPrimTy] (word64X8PrimTy)+primOpInfo (VecIndexOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "indexFloatX4OffAddr#")  [] [addrPrimTy, intPrimTy] (floatX4PrimTy)+primOpInfo (VecIndexOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "indexDoubleX2OffAddr#")  [] [addrPrimTy, intPrimTy] (doubleX2PrimTy)+primOpInfo (VecIndexOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "indexFloatX8OffAddr#")  [] [addrPrimTy, intPrimTy] (floatX8PrimTy)+primOpInfo (VecIndexOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "indexDoubleX4OffAddr#")  [] [addrPrimTy, intPrimTy] (doubleX4PrimTy)+primOpInfo (VecIndexOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "indexFloatX16OffAddr#")  [] [addrPrimTy, intPrimTy] (floatX16PrimTy)+primOpInfo (VecIndexOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "indexDoubleX8OffAddr#")  [] [addrPrimTy, intPrimTy] (doubleX8PrimTy)+primOpInfo (VecReadOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "readInt8X16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int8X16PrimTy]))+primOpInfo (VecReadOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "readInt16X8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int16X8PrimTy]))+primOpInfo (VecReadOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "readInt32X4OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int32X4PrimTy]))+primOpInfo (VecReadOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "readInt64X2OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int64X2PrimTy]))+primOpInfo (VecReadOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "readInt8X32OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int8X32PrimTy]))+primOpInfo (VecReadOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "readInt16X16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int16X16PrimTy]))+primOpInfo (VecReadOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "readInt32X8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int32X8PrimTy]))+primOpInfo (VecReadOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "readInt64X4OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int64X4PrimTy]))+primOpInfo (VecReadOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "readInt8X64OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int8X64PrimTy]))+primOpInfo (VecReadOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "readInt16X32OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int16X32PrimTy]))+primOpInfo (VecReadOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "readInt32X16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int32X16PrimTy]))+primOpInfo (VecReadOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "readInt64X8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int64X8PrimTy]))+primOpInfo (VecReadOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "readWord8X16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word8X16PrimTy]))+primOpInfo (VecReadOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "readWord16X8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word16X8PrimTy]))+primOpInfo (VecReadOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "readWord32X4OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word32X4PrimTy]))+primOpInfo (VecReadOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "readWord64X2OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word64X2PrimTy]))+primOpInfo (VecReadOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "readWord8X32OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word8X32PrimTy]))+primOpInfo (VecReadOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "readWord16X16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word16X16PrimTy]))+primOpInfo (VecReadOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "readWord32X8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word32X8PrimTy]))+primOpInfo (VecReadOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "readWord64X4OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word64X4PrimTy]))+primOpInfo (VecReadOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "readWord8X64OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word8X64PrimTy]))+primOpInfo (VecReadOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "readWord16X32OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word16X32PrimTy]))+primOpInfo (VecReadOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "readWord32X16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word32X16PrimTy]))+primOpInfo (VecReadOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "readWord64X8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word64X8PrimTy]))+primOpInfo (VecReadOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "readFloatX4OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatX4PrimTy]))+primOpInfo (VecReadOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "readDoubleX2OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doubleX2PrimTy]))+primOpInfo (VecReadOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "readFloatX8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatX8PrimTy]))+primOpInfo (VecReadOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "readDoubleX4OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doubleX4PrimTy]))+primOpInfo (VecReadOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "readFloatX16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatX16PrimTy]))+primOpInfo (VecReadOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "readDoubleX8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doubleX8PrimTy]))+primOpInfo (VecWriteOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "writeInt8X16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, int8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "writeInt16X8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, int16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "writeInt32X4OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, int32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "writeInt64X2OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, int64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "writeInt8X32OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, int8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "writeInt16X16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, int16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "writeInt32X8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, int32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "writeInt64X4OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, int64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "writeInt8X64OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, int8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "writeInt16X32OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, int16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "writeInt32X16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, int32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "writeInt64X8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, int64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "writeWord8X16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, word8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "writeWord16X8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, word16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "writeWord32X4OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, word32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "writeWord64X2OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, word64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "writeWord8X32OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, word8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "writeWord16X16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, word16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "writeWord32X8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, word32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "writeWord64X4OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, word64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "writeWord8X64OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, word8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "writeWord16X32OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, word16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "writeWord32X16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, word32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "writeWord64X8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, word64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "writeFloatX4OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, floatX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "writeDoubleX2OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, doubleX2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "writeFloatX8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, floatX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "writeDoubleX4OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, doubleX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "writeFloatX16OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, floatX16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "writeDoubleX8OffAddr#")  [deltaTyVar] [addrPrimTy, intPrimTy, doubleX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecIndexScalarByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "indexInt8ArrayAsInt8X16#")  [] [byteArrayPrimTy, intPrimTy] (int8X16PrimTy)+primOpInfo (VecIndexScalarByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "indexInt16ArrayAsInt16X8#")  [] [byteArrayPrimTy, intPrimTy] (int16X8PrimTy)+primOpInfo (VecIndexScalarByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "indexInt32ArrayAsInt32X4#")  [] [byteArrayPrimTy, intPrimTy] (int32X4PrimTy)+primOpInfo (VecIndexScalarByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "indexInt64ArrayAsInt64X2#")  [] [byteArrayPrimTy, intPrimTy] (int64X2PrimTy)+primOpInfo (VecIndexScalarByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "indexInt8ArrayAsInt8X32#")  [] [byteArrayPrimTy, intPrimTy] (int8X32PrimTy)+primOpInfo (VecIndexScalarByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "indexInt16ArrayAsInt16X16#")  [] [byteArrayPrimTy, intPrimTy] (int16X16PrimTy)+primOpInfo (VecIndexScalarByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "indexInt32ArrayAsInt32X8#")  [] [byteArrayPrimTy, intPrimTy] (int32X8PrimTy)+primOpInfo (VecIndexScalarByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "indexInt64ArrayAsInt64X4#")  [] [byteArrayPrimTy, intPrimTy] (int64X4PrimTy)+primOpInfo (VecIndexScalarByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "indexInt8ArrayAsInt8X64#")  [] [byteArrayPrimTy, intPrimTy] (int8X64PrimTy)+primOpInfo (VecIndexScalarByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "indexInt16ArrayAsInt16X32#")  [] [byteArrayPrimTy, intPrimTy] (int16X32PrimTy)+primOpInfo (VecIndexScalarByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "indexInt32ArrayAsInt32X16#")  [] [byteArrayPrimTy, intPrimTy] (int32X16PrimTy)+primOpInfo (VecIndexScalarByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "indexInt64ArrayAsInt64X8#")  [] [byteArrayPrimTy, intPrimTy] (int64X8PrimTy)+primOpInfo (VecIndexScalarByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "indexWord8ArrayAsWord8X16#")  [] [byteArrayPrimTy, intPrimTy] (word8X16PrimTy)+primOpInfo (VecIndexScalarByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "indexWord16ArrayAsWord16X8#")  [] [byteArrayPrimTy, intPrimTy] (word16X8PrimTy)+primOpInfo (VecIndexScalarByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "indexWord32ArrayAsWord32X4#")  [] [byteArrayPrimTy, intPrimTy] (word32X4PrimTy)+primOpInfo (VecIndexScalarByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "indexWord64ArrayAsWord64X2#")  [] [byteArrayPrimTy, intPrimTy] (word64X2PrimTy)+primOpInfo (VecIndexScalarByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "indexWord8ArrayAsWord8X32#")  [] [byteArrayPrimTy, intPrimTy] (word8X32PrimTy)+primOpInfo (VecIndexScalarByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "indexWord16ArrayAsWord16X16#")  [] [byteArrayPrimTy, intPrimTy] (word16X16PrimTy)+primOpInfo (VecIndexScalarByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "indexWord32ArrayAsWord32X8#")  [] [byteArrayPrimTy, intPrimTy] (word32X8PrimTy)+primOpInfo (VecIndexScalarByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "indexWord64ArrayAsWord64X4#")  [] [byteArrayPrimTy, intPrimTy] (word64X4PrimTy)+primOpInfo (VecIndexScalarByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "indexWord8ArrayAsWord8X64#")  [] [byteArrayPrimTy, intPrimTy] (word8X64PrimTy)+primOpInfo (VecIndexScalarByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "indexWord16ArrayAsWord16X32#")  [] [byteArrayPrimTy, intPrimTy] (word16X32PrimTy)+primOpInfo (VecIndexScalarByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "indexWord32ArrayAsWord32X16#")  [] [byteArrayPrimTy, intPrimTy] (word32X16PrimTy)+primOpInfo (VecIndexScalarByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "indexWord64ArrayAsWord64X8#")  [] [byteArrayPrimTy, intPrimTy] (word64X8PrimTy)+primOpInfo (VecIndexScalarByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "indexFloatArrayAsFloatX4#")  [] [byteArrayPrimTy, intPrimTy] (floatX4PrimTy)+primOpInfo (VecIndexScalarByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "indexDoubleArrayAsDoubleX2#")  [] [byteArrayPrimTy, intPrimTy] (doubleX2PrimTy)+primOpInfo (VecIndexScalarByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "indexFloatArrayAsFloatX8#")  [] [byteArrayPrimTy, intPrimTy] (floatX8PrimTy)+primOpInfo (VecIndexScalarByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "indexDoubleArrayAsDoubleX4#")  [] [byteArrayPrimTy, intPrimTy] (doubleX4PrimTy)+primOpInfo (VecIndexScalarByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "indexFloatArrayAsFloatX16#")  [] [byteArrayPrimTy, intPrimTy] (floatX16PrimTy)+primOpInfo (VecIndexScalarByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "indexDoubleArrayAsDoubleX8#")  [] [byteArrayPrimTy, intPrimTy] (doubleX8PrimTy)+primOpInfo (VecReadScalarByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "readInt8ArrayAsInt8X16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int8X16PrimTy]))+primOpInfo (VecReadScalarByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "readInt16ArrayAsInt16X8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int16X8PrimTy]))+primOpInfo (VecReadScalarByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "readInt32ArrayAsInt32X4#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int32X4PrimTy]))+primOpInfo (VecReadScalarByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "readInt64ArrayAsInt64X2#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int64X2PrimTy]))+primOpInfo (VecReadScalarByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "readInt8ArrayAsInt8X32#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int8X32PrimTy]))+primOpInfo (VecReadScalarByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "readInt16ArrayAsInt16X16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int16X16PrimTy]))+primOpInfo (VecReadScalarByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "readInt32ArrayAsInt32X8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int32X8PrimTy]))+primOpInfo (VecReadScalarByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "readInt64ArrayAsInt64X4#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int64X4PrimTy]))+primOpInfo (VecReadScalarByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "readInt8ArrayAsInt8X64#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int8X64PrimTy]))+primOpInfo (VecReadScalarByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "readInt16ArrayAsInt16X32#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int16X32PrimTy]))+primOpInfo (VecReadScalarByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "readInt32ArrayAsInt32X16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int32X16PrimTy]))+primOpInfo (VecReadScalarByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "readInt64ArrayAsInt64X8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int64X8PrimTy]))+primOpInfo (VecReadScalarByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "readWord8ArrayAsWord8X16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word8X16PrimTy]))+primOpInfo (VecReadScalarByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "readWord16ArrayAsWord16X8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word16X8PrimTy]))+primOpInfo (VecReadScalarByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "readWord32ArrayAsWord32X4#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word32X4PrimTy]))+primOpInfo (VecReadScalarByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "readWord64ArrayAsWord64X2#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word64X2PrimTy]))+primOpInfo (VecReadScalarByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "readWord8ArrayAsWord8X32#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word8X32PrimTy]))+primOpInfo (VecReadScalarByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "readWord16ArrayAsWord16X16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word16X16PrimTy]))+primOpInfo (VecReadScalarByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "readWord32ArrayAsWord32X8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word32X8PrimTy]))+primOpInfo (VecReadScalarByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "readWord64ArrayAsWord64X4#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word64X4PrimTy]))+primOpInfo (VecReadScalarByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "readWord8ArrayAsWord8X64#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word8X64PrimTy]))+primOpInfo (VecReadScalarByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "readWord16ArrayAsWord16X32#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word16X32PrimTy]))+primOpInfo (VecReadScalarByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "readWord32ArrayAsWord32X16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word32X16PrimTy]))+primOpInfo (VecReadScalarByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "readWord64ArrayAsWord64X8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word64X8PrimTy]))+primOpInfo (VecReadScalarByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "readFloatArrayAsFloatX4#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatX4PrimTy]))+primOpInfo (VecReadScalarByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "readDoubleArrayAsDoubleX2#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doubleX2PrimTy]))+primOpInfo (VecReadScalarByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "readFloatArrayAsFloatX8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatX8PrimTy]))+primOpInfo (VecReadScalarByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "readDoubleArrayAsDoubleX4#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doubleX4PrimTy]))+primOpInfo (VecReadScalarByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "readFloatArrayAsFloatX16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatX16PrimTy]))+primOpInfo (VecReadScalarByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "readDoubleArrayAsDoubleX8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doubleX8PrimTy]))+primOpInfo (VecWriteScalarByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "writeInt8ArrayAsInt8X16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "writeInt16ArrayAsInt16X8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "writeInt32ArrayAsInt32X4#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "writeInt64ArrayAsInt64X2#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "writeInt8ArrayAsInt8X32#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "writeInt16ArrayAsInt16X16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "writeInt32ArrayAsInt32X8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "writeInt64ArrayAsInt64X4#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "writeInt8ArrayAsInt8X64#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "writeInt16ArrayAsInt16X32#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "writeInt32ArrayAsInt32X16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "writeInt64ArrayAsInt64X8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "writeWord8ArrayAsWord8X16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "writeWord16ArrayAsWord16X8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "writeWord32ArrayAsWord32X4#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "writeWord64ArrayAsWord64X2#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "writeWord8ArrayAsWord8X32#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "writeWord16ArrayAsWord16X16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "writeWord32ArrayAsWord32X8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "writeWord64ArrayAsWord64X4#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "writeWord8ArrayAsWord8X64#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "writeWord16ArrayAsWord16X32#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "writeWord32ArrayAsWord32X16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "writeWord64ArrayAsWord64X8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "writeFloatArrayAsFloatX4#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "writeDoubleArrayAsDoubleX2#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "writeFloatArrayAsFloatX8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "writeDoubleArrayAsDoubleX4#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "writeFloatArrayAsFloatX16#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "writeDoubleArrayAsDoubleX8#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecIndexScalarOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "indexInt8OffAddrAsInt8X16#")  [] [addrPrimTy, intPrimTy] (int8X16PrimTy)+primOpInfo (VecIndexScalarOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "indexInt16OffAddrAsInt16X8#")  [] [addrPrimTy, intPrimTy] (int16X8PrimTy)+primOpInfo (VecIndexScalarOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "indexInt32OffAddrAsInt32X4#")  [] [addrPrimTy, intPrimTy] (int32X4PrimTy)+primOpInfo (VecIndexScalarOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "indexInt64OffAddrAsInt64X2#")  [] [addrPrimTy, intPrimTy] (int64X2PrimTy)+primOpInfo (VecIndexScalarOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "indexInt8OffAddrAsInt8X32#")  [] [addrPrimTy, intPrimTy] (int8X32PrimTy)+primOpInfo (VecIndexScalarOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "indexInt16OffAddrAsInt16X16#")  [] [addrPrimTy, intPrimTy] (int16X16PrimTy)+primOpInfo (VecIndexScalarOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "indexInt32OffAddrAsInt32X8#")  [] [addrPrimTy, intPrimTy] (int32X8PrimTy)+primOpInfo (VecIndexScalarOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "indexInt64OffAddrAsInt64X4#")  [] [addrPrimTy, intPrimTy] (int64X4PrimTy)+primOpInfo (VecIndexScalarOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "indexInt8OffAddrAsInt8X64#")  [] [addrPrimTy, intPrimTy] (int8X64PrimTy)+primOpInfo (VecIndexScalarOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "indexInt16OffAddrAsInt16X32#")  [] [addrPrimTy, intPrimTy] (int16X32PrimTy)+primOpInfo (VecIndexScalarOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "indexInt32OffAddrAsInt32X16#")  [] [addrPrimTy, intPrimTy] (int32X16PrimTy)+primOpInfo (VecIndexScalarOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "indexInt64OffAddrAsInt64X8#")  [] [addrPrimTy, intPrimTy] (int64X8PrimTy)+primOpInfo (VecIndexScalarOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "indexWord8OffAddrAsWord8X16#")  [] [addrPrimTy, intPrimTy] (word8X16PrimTy)+primOpInfo (VecIndexScalarOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "indexWord16OffAddrAsWord16X8#")  [] [addrPrimTy, intPrimTy] (word16X8PrimTy)+primOpInfo (VecIndexScalarOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "indexWord32OffAddrAsWord32X4#")  [] [addrPrimTy, intPrimTy] (word32X4PrimTy)+primOpInfo (VecIndexScalarOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "indexWord64OffAddrAsWord64X2#")  [] [addrPrimTy, intPrimTy] (word64X2PrimTy)+primOpInfo (VecIndexScalarOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "indexWord8OffAddrAsWord8X32#")  [] [addrPrimTy, intPrimTy] (word8X32PrimTy)+primOpInfo (VecIndexScalarOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "indexWord16OffAddrAsWord16X16#")  [] [addrPrimTy, intPrimTy] (word16X16PrimTy)+primOpInfo (VecIndexScalarOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "indexWord32OffAddrAsWord32X8#")  [] [addrPrimTy, intPrimTy] (word32X8PrimTy)+primOpInfo (VecIndexScalarOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "indexWord64OffAddrAsWord64X4#")  [] [addrPrimTy, intPrimTy] (word64X4PrimTy)+primOpInfo (VecIndexScalarOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "indexWord8OffAddrAsWord8X64#")  [] [addrPrimTy, intPrimTy] (word8X64PrimTy)+primOpInfo (VecIndexScalarOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "indexWord16OffAddrAsWord16X32#")  [] [addrPrimTy, intPrimTy] (word16X32PrimTy)+primOpInfo (VecIndexScalarOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "indexWord32OffAddrAsWord32X16#")  [] [addrPrimTy, intPrimTy] (word32X16PrimTy)+primOpInfo (VecIndexScalarOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "indexWord64OffAddrAsWord64X8#")  [] [addrPrimTy, intPrimTy] (word64X8PrimTy)+primOpInfo (VecIndexScalarOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "indexFloatOffAddrAsFloatX4#")  [] [addrPrimTy, intPrimTy] (floatX4PrimTy)+primOpInfo (VecIndexScalarOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "indexDoubleOffAddrAsDoubleX2#")  [] [addrPrimTy, intPrimTy] (doubleX2PrimTy)+primOpInfo (VecIndexScalarOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "indexFloatOffAddrAsFloatX8#")  [] [addrPrimTy, intPrimTy] (floatX8PrimTy)+primOpInfo (VecIndexScalarOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "indexDoubleOffAddrAsDoubleX4#")  [] [addrPrimTy, intPrimTy] (doubleX4PrimTy)+primOpInfo (VecIndexScalarOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "indexFloatOffAddrAsFloatX16#")  [] [addrPrimTy, intPrimTy] (floatX16PrimTy)+primOpInfo (VecIndexScalarOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "indexDoubleOffAddrAsDoubleX8#")  [] [addrPrimTy, intPrimTy] (doubleX8PrimTy)+primOpInfo (VecReadScalarOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "readInt8OffAddrAsInt8X16#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int8X16PrimTy]))+primOpInfo (VecReadScalarOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "readInt16OffAddrAsInt16X8#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int16X8PrimTy]))+primOpInfo (VecReadScalarOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "readInt32OffAddrAsInt32X4#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int32X4PrimTy]))+primOpInfo (VecReadScalarOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "readInt64OffAddrAsInt64X2#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int64X2PrimTy]))+primOpInfo (VecReadScalarOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "readInt8OffAddrAsInt8X32#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int8X32PrimTy]))+primOpInfo (VecReadScalarOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "readInt16OffAddrAsInt16X16#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int16X16PrimTy]))+primOpInfo (VecReadScalarOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "readInt32OffAddrAsInt32X8#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int32X8PrimTy]))+primOpInfo (VecReadScalarOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "readInt64OffAddrAsInt64X4#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int64X4PrimTy]))+primOpInfo (VecReadScalarOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "readInt8OffAddrAsInt8X64#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int8X64PrimTy]))+primOpInfo (VecReadScalarOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "readInt16OffAddrAsInt16X32#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int16X32PrimTy]))+primOpInfo (VecReadScalarOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "readInt32OffAddrAsInt32X16#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int32X16PrimTy]))+primOpInfo (VecReadScalarOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "readInt64OffAddrAsInt64X8#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, int64X8PrimTy]))+primOpInfo (VecReadScalarOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "readWord8OffAddrAsWord8X16#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word8X16PrimTy]))+primOpInfo (VecReadScalarOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "readWord16OffAddrAsWord16X8#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word16X8PrimTy]))+primOpInfo (VecReadScalarOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "readWord32OffAddrAsWord32X4#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word32X4PrimTy]))+primOpInfo (VecReadScalarOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "readWord64OffAddrAsWord64X2#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word64X2PrimTy]))+primOpInfo (VecReadScalarOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "readWord8OffAddrAsWord8X32#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word8X32PrimTy]))+primOpInfo (VecReadScalarOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "readWord16OffAddrAsWord16X16#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word16X16PrimTy]))+primOpInfo (VecReadScalarOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "readWord32OffAddrAsWord32X8#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word32X8PrimTy]))+primOpInfo (VecReadScalarOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "readWord64OffAddrAsWord64X4#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word64X4PrimTy]))+primOpInfo (VecReadScalarOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "readWord8OffAddrAsWord8X64#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word8X64PrimTy]))+primOpInfo (VecReadScalarOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "readWord16OffAddrAsWord16X32#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word16X32PrimTy]))+primOpInfo (VecReadScalarOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "readWord32OffAddrAsWord32X16#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word32X16PrimTy]))+primOpInfo (VecReadScalarOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "readWord64OffAddrAsWord64X8#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, word64X8PrimTy]))+primOpInfo (VecReadScalarOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "readFloatOffAddrAsFloatX4#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatX4PrimTy]))+primOpInfo (VecReadScalarOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "readDoubleOffAddrAsDoubleX2#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doubleX2PrimTy]))+primOpInfo (VecReadScalarOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "readFloatOffAddrAsFloatX8#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatX8PrimTy]))+primOpInfo (VecReadScalarOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "readDoubleOffAddrAsDoubleX4#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doubleX4PrimTy]))+primOpInfo (VecReadScalarOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "readFloatOffAddrAsFloatX16#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, floatX16PrimTy]))+primOpInfo (VecReadScalarOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "readDoubleOffAddrAsDoubleX8#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, doubleX8PrimTy]))+primOpInfo (VecWriteScalarOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "writeInt8OffAddrAsInt8X16#")  [deltaTyVar] [addrPrimTy, intPrimTy, int8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "writeInt16OffAddrAsInt16X8#")  [deltaTyVar] [addrPrimTy, intPrimTy, int16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "writeInt32OffAddrAsInt32X4#")  [deltaTyVar] [addrPrimTy, intPrimTy, int32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "writeInt64OffAddrAsInt64X2#")  [deltaTyVar] [addrPrimTy, intPrimTy, int64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "writeInt8OffAddrAsInt8X32#")  [deltaTyVar] [addrPrimTy, intPrimTy, int8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "writeInt16OffAddrAsInt16X16#")  [deltaTyVar] [addrPrimTy, intPrimTy, int16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "writeInt32OffAddrAsInt32X8#")  [deltaTyVar] [addrPrimTy, intPrimTy, int32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "writeInt64OffAddrAsInt64X4#")  [deltaTyVar] [addrPrimTy, intPrimTy, int64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "writeInt8OffAddrAsInt8X64#")  [deltaTyVar] [addrPrimTy, intPrimTy, int8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "writeInt16OffAddrAsInt16X32#")  [deltaTyVar] [addrPrimTy, intPrimTy, int16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "writeInt32OffAddrAsInt32X16#")  [deltaTyVar] [addrPrimTy, intPrimTy, int32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "writeInt64OffAddrAsInt64X8#")  [deltaTyVar] [addrPrimTy, intPrimTy, int64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "writeWord8OffAddrAsWord8X16#")  [deltaTyVar] [addrPrimTy, intPrimTy, word8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "writeWord16OffAddrAsWord16X8#")  [deltaTyVar] [addrPrimTy, intPrimTy, word16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "writeWord32OffAddrAsWord32X4#")  [deltaTyVar] [addrPrimTy, intPrimTy, word32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "writeWord64OffAddrAsWord64X2#")  [deltaTyVar] [addrPrimTy, intPrimTy, word64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "writeWord8OffAddrAsWord8X32#")  [deltaTyVar] [addrPrimTy, intPrimTy, word8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "writeWord16OffAddrAsWord16X16#")  [deltaTyVar] [addrPrimTy, intPrimTy, word16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "writeWord32OffAddrAsWord32X8#")  [deltaTyVar] [addrPrimTy, intPrimTy, word32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "writeWord64OffAddrAsWord64X4#")  [deltaTyVar] [addrPrimTy, intPrimTy, word64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "writeWord8OffAddrAsWord8X64#")  [deltaTyVar] [addrPrimTy, intPrimTy, word8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "writeWord16OffAddrAsWord16X32#")  [deltaTyVar] [addrPrimTy, intPrimTy, word16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "writeWord32OffAddrAsWord32X16#")  [deltaTyVar] [addrPrimTy, intPrimTy, word32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "writeWord64OffAddrAsWord64X8#")  [deltaTyVar] [addrPrimTy, intPrimTy, word64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "writeFloatOffAddrAsFloatX4#")  [deltaTyVar] [addrPrimTy, intPrimTy, floatX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "writeDoubleOffAddrAsDoubleX2#")  [deltaTyVar] [addrPrimTy, intPrimTy, doubleX2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "writeFloatOffAddrAsFloatX8#")  [deltaTyVar] [addrPrimTy, intPrimTy, floatX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "writeDoubleOffAddrAsDoubleX4#")  [deltaTyVar] [addrPrimTy, intPrimTy, doubleX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "writeFloatOffAddrAsFloatX16#")  [deltaTyVar] [addrPrimTy, intPrimTy, floatX16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo (VecWriteScalarOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "writeDoubleOffAddrAsDoubleX8#")  [deltaTyVar] [addrPrimTy, intPrimTy, doubleX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchByteArrayOp3 = mkGenPrimOp (fsLit "prefetchByteArray3#")  [deltaTyVar] [byteArrayPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchMutableByteArrayOp3 = mkGenPrimOp (fsLit "prefetchMutableByteArray3#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchAddrOp3 = mkGenPrimOp (fsLit "prefetchAddr3#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchValueOp3 = mkGenPrimOp (fsLit "prefetchValue3#")  [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchByteArrayOp2 = mkGenPrimOp (fsLit "prefetchByteArray2#")  [deltaTyVar] [byteArrayPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchMutableByteArrayOp2 = mkGenPrimOp (fsLit "prefetchMutableByteArray2#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchAddrOp2 = mkGenPrimOp (fsLit "prefetchAddr2#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchValueOp2 = mkGenPrimOp (fsLit "prefetchValue2#")  [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchByteArrayOp1 = mkGenPrimOp (fsLit "prefetchByteArray1#")  [deltaTyVar] [byteArrayPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchMutableByteArrayOp1 = mkGenPrimOp (fsLit "prefetchMutableByteArray1#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchAddrOp1 = mkGenPrimOp (fsLit "prefetchAddr1#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchValueOp1 = mkGenPrimOp (fsLit "prefetchValue1#")  [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchByteArrayOp0 = mkGenPrimOp (fsLit "prefetchByteArray0#")  [deltaTyVar] [byteArrayPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchMutableByteArrayOp0 = mkGenPrimOp (fsLit "prefetchMutableByteArray0#")  [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchAddrOp0 = mkGenPrimOp (fsLit "prefetchAddr0#")  [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)+primOpInfo PrefetchValueOp0 = mkGenPrimOp (fsLit "prefetchValue0#")  [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy)
+ ghc-lib/stage1/compiler/build/primop-strictness.hs-incl view
@@ -0,0 +1,22 @@+primOpStrictness CatchOp =  \ _arity -> mkClosedStrictSig [ lazyApply1Dmd+                                                 , lazyApply2Dmd+                                                 , topDmd] topRes +primOpStrictness RaiseOp =  \ _arity -> mkClosedStrictSig [topDmd] botRes +primOpStrictness RaiseIOOp =  \ _arity -> mkClosedStrictSig [topDmd, topDmd] botRes +primOpStrictness MaskAsyncExceptionsOp =  \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topRes +primOpStrictness MaskUninterruptibleOp =  \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topRes +primOpStrictness UnmaskAsyncExceptionsOp =  \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topRes +primOpStrictness AtomicallyOp =  \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topRes +primOpStrictness RetryOp =  \ _arity -> mkClosedStrictSig [topDmd] botRes +primOpStrictness CatchRetryOp =  \ _arity -> mkClosedStrictSig [ lazyApply1Dmd+                                                 , lazyApply1Dmd+                                                 , topDmd ] topRes +primOpStrictness CatchSTMOp =  \ _arity -> mkClosedStrictSig [ lazyApply1Dmd+                                                 , lazyApply2Dmd+                                                 , topDmd ] topRes +primOpStrictness DataToTagOp =  \ _arity -> mkClosedStrictSig [evalDmd] topRes +primOpStrictness PrefetchValueOp3 =  \ _arity -> mkClosedStrictSig [botDmd, topDmd] topRes +primOpStrictness PrefetchValueOp2 =  \ _arity -> mkClosedStrictSig [botDmd, topDmd] topRes +primOpStrictness PrefetchValueOp1 =  \ _arity -> mkClosedStrictSig [botDmd, topDmd] topRes +primOpStrictness PrefetchValueOp0 =  \ _arity -> mkClosedStrictSig [botDmd, topDmd] topRes +primOpStrictness _ =  \ arity -> mkClosedStrictSig (replicate arity topDmd) topRes
+ ghc-lib/stage1/compiler/build/primop-tag.hs-incl view
@@ -0,0 +1,1201 @@+maxPrimOpTag :: Int+maxPrimOpTag = 1198+primOpTag :: PrimOp -> Int+primOpTag CharGtOp = 1+primOpTag CharGeOp = 2+primOpTag CharEqOp = 3+primOpTag CharNeOp = 4+primOpTag CharLtOp = 5+primOpTag CharLeOp = 6+primOpTag OrdOp = 7+primOpTag IntAddOp = 8+primOpTag IntSubOp = 9+primOpTag IntMulOp = 10+primOpTag IntMulMayOfloOp = 11+primOpTag IntQuotOp = 12+primOpTag IntRemOp = 13+primOpTag IntQuotRemOp = 14+primOpTag AndIOp = 15+primOpTag OrIOp = 16+primOpTag XorIOp = 17+primOpTag NotIOp = 18+primOpTag IntNegOp = 19+primOpTag IntAddCOp = 20+primOpTag IntSubCOp = 21+primOpTag IntGtOp = 22+primOpTag IntGeOp = 23+primOpTag IntEqOp = 24+primOpTag IntNeOp = 25+primOpTag IntLtOp = 26+primOpTag IntLeOp = 27+primOpTag ChrOp = 28+primOpTag Int2WordOp = 29+primOpTag Int2FloatOp = 30+primOpTag Int2DoubleOp = 31+primOpTag Word2FloatOp = 32+primOpTag Word2DoubleOp = 33+primOpTag ISllOp = 34+primOpTag ISraOp = 35+primOpTag ISrlOp = 36+primOpTag Int8Extend = 37+primOpTag Int8Narrow = 38+primOpTag Int8NegOp = 39+primOpTag Int8AddOp = 40+primOpTag Int8SubOp = 41+primOpTag Int8MulOp = 42+primOpTag Int8QuotOp = 43+primOpTag Int8RemOp = 44+primOpTag Int8QuotRemOp = 45+primOpTag Int8EqOp = 46+primOpTag Int8GeOp = 47+primOpTag Int8GtOp = 48+primOpTag Int8LeOp = 49+primOpTag Int8LtOp = 50+primOpTag Int8NeOp = 51+primOpTag Word8Extend = 52+primOpTag Word8Narrow = 53+primOpTag Word8NotOp = 54+primOpTag Word8AddOp = 55+primOpTag Word8SubOp = 56+primOpTag Word8MulOp = 57+primOpTag Word8QuotOp = 58+primOpTag Word8RemOp = 59+primOpTag Word8QuotRemOp = 60+primOpTag Word8EqOp = 61+primOpTag Word8GeOp = 62+primOpTag Word8GtOp = 63+primOpTag Word8LeOp = 64+primOpTag Word8LtOp = 65+primOpTag Word8NeOp = 66+primOpTag Int16Extend = 67+primOpTag Int16Narrow = 68+primOpTag Int16NegOp = 69+primOpTag Int16AddOp = 70+primOpTag Int16SubOp = 71+primOpTag Int16MulOp = 72+primOpTag Int16QuotOp = 73+primOpTag Int16RemOp = 74+primOpTag Int16QuotRemOp = 75+primOpTag Int16EqOp = 76+primOpTag Int16GeOp = 77+primOpTag Int16GtOp = 78+primOpTag Int16LeOp = 79+primOpTag Int16LtOp = 80+primOpTag Int16NeOp = 81+primOpTag Word16Extend = 82+primOpTag Word16Narrow = 83+primOpTag Word16NotOp = 84+primOpTag Word16AddOp = 85+primOpTag Word16SubOp = 86+primOpTag Word16MulOp = 87+primOpTag Word16QuotOp = 88+primOpTag Word16RemOp = 89+primOpTag Word16QuotRemOp = 90+primOpTag Word16EqOp = 91+primOpTag Word16GeOp = 92+primOpTag Word16GtOp = 93+primOpTag Word16LeOp = 94+primOpTag Word16LtOp = 95+primOpTag Word16NeOp = 96+primOpTag WordAddOp = 97+primOpTag WordAddCOp = 98+primOpTag WordSubCOp = 99+primOpTag WordAdd2Op = 100+primOpTag WordSubOp = 101+primOpTag WordMulOp = 102+primOpTag WordMul2Op = 103+primOpTag WordQuotOp = 104+primOpTag WordRemOp = 105+primOpTag WordQuotRemOp = 106+primOpTag WordQuotRem2Op = 107+primOpTag AndOp = 108+primOpTag OrOp = 109+primOpTag XorOp = 110+primOpTag NotOp = 111+primOpTag SllOp = 112+primOpTag SrlOp = 113+primOpTag Word2IntOp = 114+primOpTag WordGtOp = 115+primOpTag WordGeOp = 116+primOpTag WordEqOp = 117+primOpTag WordNeOp = 118+primOpTag WordLtOp = 119+primOpTag WordLeOp = 120+primOpTag PopCnt8Op = 121+primOpTag PopCnt16Op = 122+primOpTag PopCnt32Op = 123+primOpTag PopCnt64Op = 124+primOpTag PopCntOp = 125+primOpTag Pdep8Op = 126+primOpTag Pdep16Op = 127+primOpTag Pdep32Op = 128+primOpTag Pdep64Op = 129+primOpTag PdepOp = 130+primOpTag Pext8Op = 131+primOpTag Pext16Op = 132+primOpTag Pext32Op = 133+primOpTag Pext64Op = 134+primOpTag PextOp = 135+primOpTag Clz8Op = 136+primOpTag Clz16Op = 137+primOpTag Clz32Op = 138+primOpTag Clz64Op = 139+primOpTag ClzOp = 140+primOpTag Ctz8Op = 141+primOpTag Ctz16Op = 142+primOpTag Ctz32Op = 143+primOpTag Ctz64Op = 144+primOpTag CtzOp = 145+primOpTag BSwap16Op = 146+primOpTag BSwap32Op = 147+primOpTag BSwap64Op = 148+primOpTag BSwapOp = 149+primOpTag BRev8Op = 150+primOpTag BRev16Op = 151+primOpTag BRev32Op = 152+primOpTag BRev64Op = 153+primOpTag BRevOp = 154+primOpTag Narrow8IntOp = 155+primOpTag Narrow16IntOp = 156+primOpTag Narrow32IntOp = 157+primOpTag Narrow8WordOp = 158+primOpTag Narrow16WordOp = 159+primOpTag Narrow32WordOp = 160+primOpTag DoubleGtOp = 161+primOpTag DoubleGeOp = 162+primOpTag DoubleEqOp = 163+primOpTag DoubleNeOp = 164+primOpTag DoubleLtOp = 165+primOpTag DoubleLeOp = 166+primOpTag DoubleAddOp = 167+primOpTag DoubleSubOp = 168+primOpTag DoubleMulOp = 169+primOpTag DoubleDivOp = 170+primOpTag DoubleNegOp = 171+primOpTag DoubleFabsOp = 172+primOpTag Double2IntOp = 173+primOpTag Double2FloatOp = 174+primOpTag DoubleExpOp = 175+primOpTag DoubleLogOp = 176+primOpTag DoubleSqrtOp = 177+primOpTag DoubleSinOp = 178+primOpTag DoubleCosOp = 179+primOpTag DoubleTanOp = 180+primOpTag DoubleAsinOp = 181+primOpTag DoubleAcosOp = 182+primOpTag DoubleAtanOp = 183+primOpTag DoubleSinhOp = 184+primOpTag DoubleCoshOp = 185+primOpTag DoubleTanhOp = 186+primOpTag DoubleAsinhOp = 187+primOpTag DoubleAcoshOp = 188+primOpTag DoubleAtanhOp = 189+primOpTag DoublePowerOp = 190+primOpTag DoubleDecode_2IntOp = 191+primOpTag DoubleDecode_Int64Op = 192+primOpTag FloatGtOp = 193+primOpTag FloatGeOp = 194+primOpTag FloatEqOp = 195+primOpTag FloatNeOp = 196+primOpTag FloatLtOp = 197+primOpTag FloatLeOp = 198+primOpTag FloatAddOp = 199+primOpTag FloatSubOp = 200+primOpTag FloatMulOp = 201+primOpTag FloatDivOp = 202+primOpTag FloatNegOp = 203+primOpTag FloatFabsOp = 204+primOpTag Float2IntOp = 205+primOpTag FloatExpOp = 206+primOpTag FloatLogOp = 207+primOpTag FloatSqrtOp = 208+primOpTag FloatSinOp = 209+primOpTag FloatCosOp = 210+primOpTag FloatTanOp = 211+primOpTag FloatAsinOp = 212+primOpTag FloatAcosOp = 213+primOpTag FloatAtanOp = 214+primOpTag FloatSinhOp = 215+primOpTag FloatCoshOp = 216+primOpTag FloatTanhOp = 217+primOpTag FloatAsinhOp = 218+primOpTag FloatAcoshOp = 219+primOpTag FloatAtanhOp = 220+primOpTag FloatPowerOp = 221+primOpTag Float2DoubleOp = 222+primOpTag FloatDecode_IntOp = 223+primOpTag NewArrayOp = 224+primOpTag SameMutableArrayOp = 225+primOpTag ReadArrayOp = 226+primOpTag WriteArrayOp = 227+primOpTag SizeofArrayOp = 228+primOpTag SizeofMutableArrayOp = 229+primOpTag IndexArrayOp = 230+primOpTag UnsafeFreezeArrayOp = 231+primOpTag UnsafeThawArrayOp = 232+primOpTag CopyArrayOp = 233+primOpTag CopyMutableArrayOp = 234+primOpTag CloneArrayOp = 235+primOpTag CloneMutableArrayOp = 236+primOpTag FreezeArrayOp = 237+primOpTag ThawArrayOp = 238+primOpTag CasArrayOp = 239+primOpTag NewSmallArrayOp = 240+primOpTag SameSmallMutableArrayOp = 241+primOpTag ReadSmallArrayOp = 242+primOpTag WriteSmallArrayOp = 243+primOpTag SizeofSmallArrayOp = 244+primOpTag SizeofSmallMutableArrayOp = 245+primOpTag IndexSmallArrayOp = 246+primOpTag UnsafeFreezeSmallArrayOp = 247+primOpTag UnsafeThawSmallArrayOp = 248+primOpTag CopySmallArrayOp = 249+primOpTag CopySmallMutableArrayOp = 250+primOpTag CloneSmallArrayOp = 251+primOpTag CloneSmallMutableArrayOp = 252+primOpTag FreezeSmallArrayOp = 253+primOpTag ThawSmallArrayOp = 254+primOpTag CasSmallArrayOp = 255+primOpTag NewByteArrayOp_Char = 256+primOpTag NewPinnedByteArrayOp_Char = 257+primOpTag NewAlignedPinnedByteArrayOp_Char = 258+primOpTag MutableByteArrayIsPinnedOp = 259+primOpTag ByteArrayIsPinnedOp = 260+primOpTag ByteArrayContents_Char = 261+primOpTag SameMutableByteArrayOp = 262+primOpTag ShrinkMutableByteArrayOp_Char = 263+primOpTag ResizeMutableByteArrayOp_Char = 264+primOpTag UnsafeFreezeByteArrayOp = 265+primOpTag SizeofByteArrayOp = 266+primOpTag SizeofMutableByteArrayOp = 267+primOpTag GetSizeofMutableByteArrayOp = 268+primOpTag IndexByteArrayOp_Char = 269+primOpTag IndexByteArrayOp_WideChar = 270+primOpTag IndexByteArrayOp_Int = 271+primOpTag IndexByteArrayOp_Word = 272+primOpTag IndexByteArrayOp_Addr = 273+primOpTag IndexByteArrayOp_Float = 274+primOpTag IndexByteArrayOp_Double = 275+primOpTag IndexByteArrayOp_StablePtr = 276+primOpTag IndexByteArrayOp_Int8 = 277+primOpTag IndexByteArrayOp_Int16 = 278+primOpTag IndexByteArrayOp_Int32 = 279+primOpTag IndexByteArrayOp_Int64 = 280+primOpTag IndexByteArrayOp_Word8 = 281+primOpTag IndexByteArrayOp_Word16 = 282+primOpTag IndexByteArrayOp_Word32 = 283+primOpTag IndexByteArrayOp_Word64 = 284+primOpTag IndexByteArrayOp_Word8AsChar = 285+primOpTag IndexByteArrayOp_Word8AsWideChar = 286+primOpTag IndexByteArrayOp_Word8AsAddr = 287+primOpTag IndexByteArrayOp_Word8AsFloat = 288+primOpTag IndexByteArrayOp_Word8AsDouble = 289+primOpTag IndexByteArrayOp_Word8AsStablePtr = 290+primOpTag IndexByteArrayOp_Word8AsInt16 = 291+primOpTag IndexByteArrayOp_Word8AsInt32 = 292+primOpTag IndexByteArrayOp_Word8AsInt64 = 293+primOpTag IndexByteArrayOp_Word8AsInt = 294+primOpTag IndexByteArrayOp_Word8AsWord16 = 295+primOpTag IndexByteArrayOp_Word8AsWord32 = 296+primOpTag IndexByteArrayOp_Word8AsWord64 = 297+primOpTag IndexByteArrayOp_Word8AsWord = 298+primOpTag ReadByteArrayOp_Char = 299+primOpTag ReadByteArrayOp_WideChar = 300+primOpTag ReadByteArrayOp_Int = 301+primOpTag ReadByteArrayOp_Word = 302+primOpTag ReadByteArrayOp_Addr = 303+primOpTag ReadByteArrayOp_Float = 304+primOpTag ReadByteArrayOp_Double = 305+primOpTag ReadByteArrayOp_StablePtr = 306+primOpTag ReadByteArrayOp_Int8 = 307+primOpTag ReadByteArrayOp_Int16 = 308+primOpTag ReadByteArrayOp_Int32 = 309+primOpTag ReadByteArrayOp_Int64 = 310+primOpTag ReadByteArrayOp_Word8 = 311+primOpTag ReadByteArrayOp_Word16 = 312+primOpTag ReadByteArrayOp_Word32 = 313+primOpTag ReadByteArrayOp_Word64 = 314+primOpTag ReadByteArrayOp_Word8AsChar = 315+primOpTag ReadByteArrayOp_Word8AsWideChar = 316+primOpTag ReadByteArrayOp_Word8AsAddr = 317+primOpTag ReadByteArrayOp_Word8AsFloat = 318+primOpTag ReadByteArrayOp_Word8AsDouble = 319+primOpTag ReadByteArrayOp_Word8AsStablePtr = 320+primOpTag ReadByteArrayOp_Word8AsInt16 = 321+primOpTag ReadByteArrayOp_Word8AsInt32 = 322+primOpTag ReadByteArrayOp_Word8AsInt64 = 323+primOpTag ReadByteArrayOp_Word8AsInt = 324+primOpTag ReadByteArrayOp_Word8AsWord16 = 325+primOpTag ReadByteArrayOp_Word8AsWord32 = 326+primOpTag ReadByteArrayOp_Word8AsWord64 = 327+primOpTag ReadByteArrayOp_Word8AsWord = 328+primOpTag WriteByteArrayOp_Char = 329+primOpTag WriteByteArrayOp_WideChar = 330+primOpTag WriteByteArrayOp_Int = 331+primOpTag WriteByteArrayOp_Word = 332+primOpTag WriteByteArrayOp_Addr = 333+primOpTag WriteByteArrayOp_Float = 334+primOpTag WriteByteArrayOp_Double = 335+primOpTag WriteByteArrayOp_StablePtr = 336+primOpTag WriteByteArrayOp_Int8 = 337+primOpTag WriteByteArrayOp_Int16 = 338+primOpTag WriteByteArrayOp_Int32 = 339+primOpTag WriteByteArrayOp_Int64 = 340+primOpTag WriteByteArrayOp_Word8 = 341+primOpTag WriteByteArrayOp_Word16 = 342+primOpTag WriteByteArrayOp_Word32 = 343+primOpTag WriteByteArrayOp_Word64 = 344+primOpTag WriteByteArrayOp_Word8AsChar = 345+primOpTag WriteByteArrayOp_Word8AsWideChar = 346+primOpTag WriteByteArrayOp_Word8AsAddr = 347+primOpTag WriteByteArrayOp_Word8AsFloat = 348+primOpTag WriteByteArrayOp_Word8AsDouble = 349+primOpTag WriteByteArrayOp_Word8AsStablePtr = 350+primOpTag WriteByteArrayOp_Word8AsInt16 = 351+primOpTag WriteByteArrayOp_Word8AsInt32 = 352+primOpTag WriteByteArrayOp_Word8AsInt64 = 353+primOpTag WriteByteArrayOp_Word8AsInt = 354+primOpTag WriteByteArrayOp_Word8AsWord16 = 355+primOpTag WriteByteArrayOp_Word8AsWord32 = 356+primOpTag WriteByteArrayOp_Word8AsWord64 = 357+primOpTag WriteByteArrayOp_Word8AsWord = 358+primOpTag CompareByteArraysOp = 359+primOpTag CopyByteArrayOp = 360+primOpTag CopyMutableByteArrayOp = 361+primOpTag CopyByteArrayToAddrOp = 362+primOpTag CopyMutableByteArrayToAddrOp = 363+primOpTag CopyAddrToByteArrayOp = 364+primOpTag SetByteArrayOp = 365+primOpTag AtomicReadByteArrayOp_Int = 366+primOpTag AtomicWriteByteArrayOp_Int = 367+primOpTag CasByteArrayOp_Int = 368+primOpTag FetchAddByteArrayOp_Int = 369+primOpTag FetchSubByteArrayOp_Int = 370+primOpTag FetchAndByteArrayOp_Int = 371+primOpTag FetchNandByteArrayOp_Int = 372+primOpTag FetchOrByteArrayOp_Int = 373+primOpTag FetchXorByteArrayOp_Int = 374+primOpTag NewArrayArrayOp = 375+primOpTag SameMutableArrayArrayOp = 376+primOpTag UnsafeFreezeArrayArrayOp = 377+primOpTag SizeofArrayArrayOp = 378+primOpTag SizeofMutableArrayArrayOp = 379+primOpTag IndexArrayArrayOp_ByteArray = 380+primOpTag IndexArrayArrayOp_ArrayArray = 381+primOpTag ReadArrayArrayOp_ByteArray = 382+primOpTag ReadArrayArrayOp_MutableByteArray = 383+primOpTag ReadArrayArrayOp_ArrayArray = 384+primOpTag ReadArrayArrayOp_MutableArrayArray = 385+primOpTag WriteArrayArrayOp_ByteArray = 386+primOpTag WriteArrayArrayOp_MutableByteArray = 387+primOpTag WriteArrayArrayOp_ArrayArray = 388+primOpTag WriteArrayArrayOp_MutableArrayArray = 389+primOpTag CopyArrayArrayOp = 390+primOpTag CopyMutableArrayArrayOp = 391+primOpTag AddrAddOp = 392+primOpTag AddrSubOp = 393+primOpTag AddrRemOp = 394+primOpTag Addr2IntOp = 395+primOpTag Int2AddrOp = 396+primOpTag AddrGtOp = 397+primOpTag AddrGeOp = 398+primOpTag AddrEqOp = 399+primOpTag AddrNeOp = 400+primOpTag AddrLtOp = 401+primOpTag AddrLeOp = 402+primOpTag IndexOffAddrOp_Char = 403+primOpTag IndexOffAddrOp_WideChar = 404+primOpTag IndexOffAddrOp_Int = 405+primOpTag IndexOffAddrOp_Word = 406+primOpTag IndexOffAddrOp_Addr = 407+primOpTag IndexOffAddrOp_Float = 408+primOpTag IndexOffAddrOp_Double = 409+primOpTag IndexOffAddrOp_StablePtr = 410+primOpTag IndexOffAddrOp_Int8 = 411+primOpTag IndexOffAddrOp_Int16 = 412+primOpTag IndexOffAddrOp_Int32 = 413+primOpTag IndexOffAddrOp_Int64 = 414+primOpTag IndexOffAddrOp_Word8 = 415+primOpTag IndexOffAddrOp_Word16 = 416+primOpTag IndexOffAddrOp_Word32 = 417+primOpTag IndexOffAddrOp_Word64 = 418+primOpTag ReadOffAddrOp_Char = 419+primOpTag ReadOffAddrOp_WideChar = 420+primOpTag ReadOffAddrOp_Int = 421+primOpTag ReadOffAddrOp_Word = 422+primOpTag ReadOffAddrOp_Addr = 423+primOpTag ReadOffAddrOp_Float = 424+primOpTag ReadOffAddrOp_Double = 425+primOpTag ReadOffAddrOp_StablePtr = 426+primOpTag ReadOffAddrOp_Int8 = 427+primOpTag ReadOffAddrOp_Int16 = 428+primOpTag ReadOffAddrOp_Int32 = 429+primOpTag ReadOffAddrOp_Int64 = 430+primOpTag ReadOffAddrOp_Word8 = 431+primOpTag ReadOffAddrOp_Word16 = 432+primOpTag ReadOffAddrOp_Word32 = 433+primOpTag ReadOffAddrOp_Word64 = 434+primOpTag WriteOffAddrOp_Char = 435+primOpTag WriteOffAddrOp_WideChar = 436+primOpTag WriteOffAddrOp_Int = 437+primOpTag WriteOffAddrOp_Word = 438+primOpTag WriteOffAddrOp_Addr = 439+primOpTag WriteOffAddrOp_Float = 440+primOpTag WriteOffAddrOp_Double = 441+primOpTag WriteOffAddrOp_StablePtr = 442+primOpTag WriteOffAddrOp_Int8 = 443+primOpTag WriteOffAddrOp_Int16 = 444+primOpTag WriteOffAddrOp_Int32 = 445+primOpTag WriteOffAddrOp_Int64 = 446+primOpTag WriteOffAddrOp_Word8 = 447+primOpTag WriteOffAddrOp_Word16 = 448+primOpTag WriteOffAddrOp_Word32 = 449+primOpTag WriteOffAddrOp_Word64 = 450+primOpTag NewMutVarOp = 451+primOpTag ReadMutVarOp = 452+primOpTag WriteMutVarOp = 453+primOpTag SameMutVarOp = 454+primOpTag AtomicModifyMutVar2Op = 455+primOpTag AtomicModifyMutVar_Op = 456+primOpTag CasMutVarOp = 457+primOpTag CatchOp = 458+primOpTag RaiseOp = 459+primOpTag RaiseIOOp = 460+primOpTag MaskAsyncExceptionsOp = 461+primOpTag MaskUninterruptibleOp = 462+primOpTag UnmaskAsyncExceptionsOp = 463+primOpTag MaskStatus = 464+primOpTag AtomicallyOp = 465+primOpTag RetryOp = 466+primOpTag CatchRetryOp = 467+primOpTag CatchSTMOp = 468+primOpTag NewTVarOp = 469+primOpTag ReadTVarOp = 470+primOpTag ReadTVarIOOp = 471+primOpTag WriteTVarOp = 472+primOpTag SameTVarOp = 473+primOpTag NewMVarOp = 474+primOpTag TakeMVarOp = 475+primOpTag TryTakeMVarOp = 476+primOpTag PutMVarOp = 477+primOpTag TryPutMVarOp = 478+primOpTag ReadMVarOp = 479+primOpTag TryReadMVarOp = 480+primOpTag SameMVarOp = 481+primOpTag IsEmptyMVarOp = 482+primOpTag DelayOp = 483+primOpTag WaitReadOp = 484+primOpTag WaitWriteOp = 485+primOpTag ForkOp = 486+primOpTag ForkOnOp = 487+primOpTag KillThreadOp = 488+primOpTag YieldOp = 489+primOpTag MyThreadIdOp = 490+primOpTag LabelThreadOp = 491+primOpTag IsCurrentThreadBoundOp = 492+primOpTag NoDuplicateOp = 493+primOpTag ThreadStatusOp = 494+primOpTag MkWeakOp = 495+primOpTag MkWeakNoFinalizerOp = 496+primOpTag AddCFinalizerToWeakOp = 497+primOpTag DeRefWeakOp = 498+primOpTag FinalizeWeakOp = 499+primOpTag TouchOp = 500+primOpTag MakeStablePtrOp = 501+primOpTag DeRefStablePtrOp = 502+primOpTag EqStablePtrOp = 503+primOpTag MakeStableNameOp = 504+primOpTag EqStableNameOp = 505+primOpTag StableNameToIntOp = 506+primOpTag CompactNewOp = 507+primOpTag CompactResizeOp = 508+primOpTag CompactContainsOp = 509+primOpTag CompactContainsAnyOp = 510+primOpTag CompactGetFirstBlockOp = 511+primOpTag CompactGetNextBlockOp = 512+primOpTag CompactAllocateBlockOp = 513+primOpTag CompactFixupPointersOp = 514+primOpTag CompactAdd = 515+primOpTag CompactAddWithSharing = 516+primOpTag CompactSize = 517+primOpTag ReallyUnsafePtrEqualityOp = 518+primOpTag ParOp = 519+primOpTag SparkOp = 520+primOpTag SeqOp = 521+primOpTag GetSparkOp = 522+primOpTag NumSparks = 523+primOpTag DataToTagOp = 524+primOpTag TagToEnumOp = 525+primOpTag AddrToAnyOp = 526+primOpTag AnyToAddrOp = 527+primOpTag MkApUpd0_Op = 528+primOpTag NewBCOOp = 529+primOpTag UnpackClosureOp = 530+primOpTag ClosureSizeOp = 531+primOpTag GetApStackValOp = 532+primOpTag GetCCSOfOp = 533+primOpTag GetCurrentCCSOp = 534+primOpTag ClearCCSOp = 535+primOpTag TraceEventOp = 536+primOpTag TraceEventBinaryOp = 537+primOpTag TraceMarkerOp = 538+primOpTag GetThreadAllocationCounter = 539+primOpTag SetThreadAllocationCounter = 540+primOpTag (VecBroadcastOp IntVec 16 W8) = 541+primOpTag (VecBroadcastOp IntVec 8 W16) = 542+primOpTag (VecBroadcastOp IntVec 4 W32) = 543+primOpTag (VecBroadcastOp IntVec 2 W64) = 544+primOpTag (VecBroadcastOp IntVec 32 W8) = 545+primOpTag (VecBroadcastOp IntVec 16 W16) = 546+primOpTag (VecBroadcastOp IntVec 8 W32) = 547+primOpTag (VecBroadcastOp IntVec 4 W64) = 548+primOpTag (VecBroadcastOp IntVec 64 W8) = 549+primOpTag (VecBroadcastOp IntVec 32 W16) = 550+primOpTag (VecBroadcastOp IntVec 16 W32) = 551+primOpTag (VecBroadcastOp IntVec 8 W64) = 552+primOpTag (VecBroadcastOp WordVec 16 W8) = 553+primOpTag (VecBroadcastOp WordVec 8 W16) = 554+primOpTag (VecBroadcastOp WordVec 4 W32) = 555+primOpTag (VecBroadcastOp WordVec 2 W64) = 556+primOpTag (VecBroadcastOp WordVec 32 W8) = 557+primOpTag (VecBroadcastOp WordVec 16 W16) = 558+primOpTag (VecBroadcastOp WordVec 8 W32) = 559+primOpTag (VecBroadcastOp WordVec 4 W64) = 560+primOpTag (VecBroadcastOp WordVec 64 W8) = 561+primOpTag (VecBroadcastOp WordVec 32 W16) = 562+primOpTag (VecBroadcastOp WordVec 16 W32) = 563+primOpTag (VecBroadcastOp WordVec 8 W64) = 564+primOpTag (VecBroadcastOp FloatVec 4 W32) = 565+primOpTag (VecBroadcastOp FloatVec 2 W64) = 566+primOpTag (VecBroadcastOp FloatVec 8 W32) = 567+primOpTag (VecBroadcastOp FloatVec 4 W64) = 568+primOpTag (VecBroadcastOp FloatVec 16 W32) = 569+primOpTag (VecBroadcastOp FloatVec 8 W64) = 570+primOpTag (VecPackOp IntVec 16 W8) = 571+primOpTag (VecPackOp IntVec 8 W16) = 572+primOpTag (VecPackOp IntVec 4 W32) = 573+primOpTag (VecPackOp IntVec 2 W64) = 574+primOpTag (VecPackOp IntVec 32 W8) = 575+primOpTag (VecPackOp IntVec 16 W16) = 576+primOpTag (VecPackOp IntVec 8 W32) = 577+primOpTag (VecPackOp IntVec 4 W64) = 578+primOpTag (VecPackOp IntVec 64 W8) = 579+primOpTag (VecPackOp IntVec 32 W16) = 580+primOpTag (VecPackOp IntVec 16 W32) = 581+primOpTag (VecPackOp IntVec 8 W64) = 582+primOpTag (VecPackOp WordVec 16 W8) = 583+primOpTag (VecPackOp WordVec 8 W16) = 584+primOpTag (VecPackOp WordVec 4 W32) = 585+primOpTag (VecPackOp WordVec 2 W64) = 586+primOpTag (VecPackOp WordVec 32 W8) = 587+primOpTag (VecPackOp WordVec 16 W16) = 588+primOpTag (VecPackOp WordVec 8 W32) = 589+primOpTag (VecPackOp WordVec 4 W64) = 590+primOpTag (VecPackOp WordVec 64 W8) = 591+primOpTag (VecPackOp WordVec 32 W16) = 592+primOpTag (VecPackOp WordVec 16 W32) = 593+primOpTag (VecPackOp WordVec 8 W64) = 594+primOpTag (VecPackOp FloatVec 4 W32) = 595+primOpTag (VecPackOp FloatVec 2 W64) = 596+primOpTag (VecPackOp FloatVec 8 W32) = 597+primOpTag (VecPackOp FloatVec 4 W64) = 598+primOpTag (VecPackOp FloatVec 16 W32) = 599+primOpTag (VecPackOp FloatVec 8 W64) = 600+primOpTag (VecUnpackOp IntVec 16 W8) = 601+primOpTag (VecUnpackOp IntVec 8 W16) = 602+primOpTag (VecUnpackOp IntVec 4 W32) = 603+primOpTag (VecUnpackOp IntVec 2 W64) = 604+primOpTag (VecUnpackOp IntVec 32 W8) = 605+primOpTag (VecUnpackOp IntVec 16 W16) = 606+primOpTag (VecUnpackOp IntVec 8 W32) = 607+primOpTag (VecUnpackOp IntVec 4 W64) = 608+primOpTag (VecUnpackOp IntVec 64 W8) = 609+primOpTag (VecUnpackOp IntVec 32 W16) = 610+primOpTag (VecUnpackOp IntVec 16 W32) = 611+primOpTag (VecUnpackOp IntVec 8 W64) = 612+primOpTag (VecUnpackOp WordVec 16 W8) = 613+primOpTag (VecUnpackOp WordVec 8 W16) = 614+primOpTag (VecUnpackOp WordVec 4 W32) = 615+primOpTag (VecUnpackOp WordVec 2 W64) = 616+primOpTag (VecUnpackOp WordVec 32 W8) = 617+primOpTag (VecUnpackOp WordVec 16 W16) = 618+primOpTag (VecUnpackOp WordVec 8 W32) = 619+primOpTag (VecUnpackOp WordVec 4 W64) = 620+primOpTag (VecUnpackOp WordVec 64 W8) = 621+primOpTag (VecUnpackOp WordVec 32 W16) = 622+primOpTag (VecUnpackOp WordVec 16 W32) = 623+primOpTag (VecUnpackOp WordVec 8 W64) = 624+primOpTag (VecUnpackOp FloatVec 4 W32) = 625+primOpTag (VecUnpackOp FloatVec 2 W64) = 626+primOpTag (VecUnpackOp FloatVec 8 W32) = 627+primOpTag (VecUnpackOp FloatVec 4 W64) = 628+primOpTag (VecUnpackOp FloatVec 16 W32) = 629+primOpTag (VecUnpackOp FloatVec 8 W64) = 630+primOpTag (VecInsertOp IntVec 16 W8) = 631+primOpTag (VecInsertOp IntVec 8 W16) = 632+primOpTag (VecInsertOp IntVec 4 W32) = 633+primOpTag (VecInsertOp IntVec 2 W64) = 634+primOpTag (VecInsertOp IntVec 32 W8) = 635+primOpTag (VecInsertOp IntVec 16 W16) = 636+primOpTag (VecInsertOp IntVec 8 W32) = 637+primOpTag (VecInsertOp IntVec 4 W64) = 638+primOpTag (VecInsertOp IntVec 64 W8) = 639+primOpTag (VecInsertOp IntVec 32 W16) = 640+primOpTag (VecInsertOp IntVec 16 W32) = 641+primOpTag (VecInsertOp IntVec 8 W64) = 642+primOpTag (VecInsertOp WordVec 16 W8) = 643+primOpTag (VecInsertOp WordVec 8 W16) = 644+primOpTag (VecInsertOp WordVec 4 W32) = 645+primOpTag (VecInsertOp WordVec 2 W64) = 646+primOpTag (VecInsertOp WordVec 32 W8) = 647+primOpTag (VecInsertOp WordVec 16 W16) = 648+primOpTag (VecInsertOp WordVec 8 W32) = 649+primOpTag (VecInsertOp WordVec 4 W64) = 650+primOpTag (VecInsertOp WordVec 64 W8) = 651+primOpTag (VecInsertOp WordVec 32 W16) = 652+primOpTag (VecInsertOp WordVec 16 W32) = 653+primOpTag (VecInsertOp WordVec 8 W64) = 654+primOpTag (VecInsertOp FloatVec 4 W32) = 655+primOpTag (VecInsertOp FloatVec 2 W64) = 656+primOpTag (VecInsertOp FloatVec 8 W32) = 657+primOpTag (VecInsertOp FloatVec 4 W64) = 658+primOpTag (VecInsertOp FloatVec 16 W32) = 659+primOpTag (VecInsertOp FloatVec 8 W64) = 660+primOpTag (VecAddOp IntVec 16 W8) = 661+primOpTag (VecAddOp IntVec 8 W16) = 662+primOpTag (VecAddOp IntVec 4 W32) = 663+primOpTag (VecAddOp IntVec 2 W64) = 664+primOpTag (VecAddOp IntVec 32 W8) = 665+primOpTag (VecAddOp IntVec 16 W16) = 666+primOpTag (VecAddOp IntVec 8 W32) = 667+primOpTag (VecAddOp IntVec 4 W64) = 668+primOpTag (VecAddOp IntVec 64 W8) = 669+primOpTag (VecAddOp IntVec 32 W16) = 670+primOpTag (VecAddOp IntVec 16 W32) = 671+primOpTag (VecAddOp IntVec 8 W64) = 672+primOpTag (VecAddOp WordVec 16 W8) = 673+primOpTag (VecAddOp WordVec 8 W16) = 674+primOpTag (VecAddOp WordVec 4 W32) = 675+primOpTag (VecAddOp WordVec 2 W64) = 676+primOpTag (VecAddOp WordVec 32 W8) = 677+primOpTag (VecAddOp WordVec 16 W16) = 678+primOpTag (VecAddOp WordVec 8 W32) = 679+primOpTag (VecAddOp WordVec 4 W64) = 680+primOpTag (VecAddOp WordVec 64 W8) = 681+primOpTag (VecAddOp WordVec 32 W16) = 682+primOpTag (VecAddOp WordVec 16 W32) = 683+primOpTag (VecAddOp WordVec 8 W64) = 684+primOpTag (VecAddOp FloatVec 4 W32) = 685+primOpTag (VecAddOp FloatVec 2 W64) = 686+primOpTag (VecAddOp FloatVec 8 W32) = 687+primOpTag (VecAddOp FloatVec 4 W64) = 688+primOpTag (VecAddOp FloatVec 16 W32) = 689+primOpTag (VecAddOp FloatVec 8 W64) = 690+primOpTag (VecSubOp IntVec 16 W8) = 691+primOpTag (VecSubOp IntVec 8 W16) = 692+primOpTag (VecSubOp IntVec 4 W32) = 693+primOpTag (VecSubOp IntVec 2 W64) = 694+primOpTag (VecSubOp IntVec 32 W8) = 695+primOpTag (VecSubOp IntVec 16 W16) = 696+primOpTag (VecSubOp IntVec 8 W32) = 697+primOpTag (VecSubOp IntVec 4 W64) = 698+primOpTag (VecSubOp IntVec 64 W8) = 699+primOpTag (VecSubOp IntVec 32 W16) = 700+primOpTag (VecSubOp IntVec 16 W32) = 701+primOpTag (VecSubOp IntVec 8 W64) = 702+primOpTag (VecSubOp WordVec 16 W8) = 703+primOpTag (VecSubOp WordVec 8 W16) = 704+primOpTag (VecSubOp WordVec 4 W32) = 705+primOpTag (VecSubOp WordVec 2 W64) = 706+primOpTag (VecSubOp WordVec 32 W8) = 707+primOpTag (VecSubOp WordVec 16 W16) = 708+primOpTag (VecSubOp WordVec 8 W32) = 709+primOpTag (VecSubOp WordVec 4 W64) = 710+primOpTag (VecSubOp WordVec 64 W8) = 711+primOpTag (VecSubOp WordVec 32 W16) = 712+primOpTag (VecSubOp WordVec 16 W32) = 713+primOpTag (VecSubOp WordVec 8 W64) = 714+primOpTag (VecSubOp FloatVec 4 W32) = 715+primOpTag (VecSubOp FloatVec 2 W64) = 716+primOpTag (VecSubOp FloatVec 8 W32) = 717+primOpTag (VecSubOp FloatVec 4 W64) = 718+primOpTag (VecSubOp FloatVec 16 W32) = 719+primOpTag (VecSubOp FloatVec 8 W64) = 720+primOpTag (VecMulOp IntVec 16 W8) = 721+primOpTag (VecMulOp IntVec 8 W16) = 722+primOpTag (VecMulOp IntVec 4 W32) = 723+primOpTag (VecMulOp IntVec 2 W64) = 724+primOpTag (VecMulOp IntVec 32 W8) = 725+primOpTag (VecMulOp IntVec 16 W16) = 726+primOpTag (VecMulOp IntVec 8 W32) = 727+primOpTag (VecMulOp IntVec 4 W64) = 728+primOpTag (VecMulOp IntVec 64 W8) = 729+primOpTag (VecMulOp IntVec 32 W16) = 730+primOpTag (VecMulOp IntVec 16 W32) = 731+primOpTag (VecMulOp IntVec 8 W64) = 732+primOpTag (VecMulOp WordVec 16 W8) = 733+primOpTag (VecMulOp WordVec 8 W16) = 734+primOpTag (VecMulOp WordVec 4 W32) = 735+primOpTag (VecMulOp WordVec 2 W64) = 736+primOpTag (VecMulOp WordVec 32 W8) = 737+primOpTag (VecMulOp WordVec 16 W16) = 738+primOpTag (VecMulOp WordVec 8 W32) = 739+primOpTag (VecMulOp WordVec 4 W64) = 740+primOpTag (VecMulOp WordVec 64 W8) = 741+primOpTag (VecMulOp WordVec 32 W16) = 742+primOpTag (VecMulOp WordVec 16 W32) = 743+primOpTag (VecMulOp WordVec 8 W64) = 744+primOpTag (VecMulOp FloatVec 4 W32) = 745+primOpTag (VecMulOp FloatVec 2 W64) = 746+primOpTag (VecMulOp FloatVec 8 W32) = 747+primOpTag (VecMulOp FloatVec 4 W64) = 748+primOpTag (VecMulOp FloatVec 16 W32) = 749+primOpTag (VecMulOp FloatVec 8 W64) = 750+primOpTag (VecDivOp FloatVec 4 W32) = 751+primOpTag (VecDivOp FloatVec 2 W64) = 752+primOpTag (VecDivOp FloatVec 8 W32) = 753+primOpTag (VecDivOp FloatVec 4 W64) = 754+primOpTag (VecDivOp FloatVec 16 W32) = 755+primOpTag (VecDivOp FloatVec 8 W64) = 756+primOpTag (VecQuotOp IntVec 16 W8) = 757+primOpTag (VecQuotOp IntVec 8 W16) = 758+primOpTag (VecQuotOp IntVec 4 W32) = 759+primOpTag (VecQuotOp IntVec 2 W64) = 760+primOpTag (VecQuotOp IntVec 32 W8) = 761+primOpTag (VecQuotOp IntVec 16 W16) = 762+primOpTag (VecQuotOp IntVec 8 W32) = 763+primOpTag (VecQuotOp IntVec 4 W64) = 764+primOpTag (VecQuotOp IntVec 64 W8) = 765+primOpTag (VecQuotOp IntVec 32 W16) = 766+primOpTag (VecQuotOp IntVec 16 W32) = 767+primOpTag (VecQuotOp IntVec 8 W64) = 768+primOpTag (VecQuotOp WordVec 16 W8) = 769+primOpTag (VecQuotOp WordVec 8 W16) = 770+primOpTag (VecQuotOp WordVec 4 W32) = 771+primOpTag (VecQuotOp WordVec 2 W64) = 772+primOpTag (VecQuotOp WordVec 32 W8) = 773+primOpTag (VecQuotOp WordVec 16 W16) = 774+primOpTag (VecQuotOp WordVec 8 W32) = 775+primOpTag (VecQuotOp WordVec 4 W64) = 776+primOpTag (VecQuotOp WordVec 64 W8) = 777+primOpTag (VecQuotOp WordVec 32 W16) = 778+primOpTag (VecQuotOp WordVec 16 W32) = 779+primOpTag (VecQuotOp WordVec 8 W64) = 780+primOpTag (VecRemOp IntVec 16 W8) = 781+primOpTag (VecRemOp IntVec 8 W16) = 782+primOpTag (VecRemOp IntVec 4 W32) = 783+primOpTag (VecRemOp IntVec 2 W64) = 784+primOpTag (VecRemOp IntVec 32 W8) = 785+primOpTag (VecRemOp IntVec 16 W16) = 786+primOpTag (VecRemOp IntVec 8 W32) = 787+primOpTag (VecRemOp IntVec 4 W64) = 788+primOpTag (VecRemOp IntVec 64 W8) = 789+primOpTag (VecRemOp IntVec 32 W16) = 790+primOpTag (VecRemOp IntVec 16 W32) = 791+primOpTag (VecRemOp IntVec 8 W64) = 792+primOpTag (VecRemOp WordVec 16 W8) = 793+primOpTag (VecRemOp WordVec 8 W16) = 794+primOpTag (VecRemOp WordVec 4 W32) = 795+primOpTag (VecRemOp WordVec 2 W64) = 796+primOpTag (VecRemOp WordVec 32 W8) = 797+primOpTag (VecRemOp WordVec 16 W16) = 798+primOpTag (VecRemOp WordVec 8 W32) = 799+primOpTag (VecRemOp WordVec 4 W64) = 800+primOpTag (VecRemOp WordVec 64 W8) = 801+primOpTag (VecRemOp WordVec 32 W16) = 802+primOpTag (VecRemOp WordVec 16 W32) = 803+primOpTag (VecRemOp WordVec 8 W64) = 804+primOpTag (VecNegOp IntVec 16 W8) = 805+primOpTag (VecNegOp IntVec 8 W16) = 806+primOpTag (VecNegOp IntVec 4 W32) = 807+primOpTag (VecNegOp IntVec 2 W64) = 808+primOpTag (VecNegOp IntVec 32 W8) = 809+primOpTag (VecNegOp IntVec 16 W16) = 810+primOpTag (VecNegOp IntVec 8 W32) = 811+primOpTag (VecNegOp IntVec 4 W64) = 812+primOpTag (VecNegOp IntVec 64 W8) = 813+primOpTag (VecNegOp IntVec 32 W16) = 814+primOpTag (VecNegOp IntVec 16 W32) = 815+primOpTag (VecNegOp IntVec 8 W64) = 816+primOpTag (VecNegOp FloatVec 4 W32) = 817+primOpTag (VecNegOp FloatVec 2 W64) = 818+primOpTag (VecNegOp FloatVec 8 W32) = 819+primOpTag (VecNegOp FloatVec 4 W64) = 820+primOpTag (VecNegOp FloatVec 16 W32) = 821+primOpTag (VecNegOp FloatVec 8 W64) = 822+primOpTag (VecIndexByteArrayOp IntVec 16 W8) = 823+primOpTag (VecIndexByteArrayOp IntVec 8 W16) = 824+primOpTag (VecIndexByteArrayOp IntVec 4 W32) = 825+primOpTag (VecIndexByteArrayOp IntVec 2 W64) = 826+primOpTag (VecIndexByteArrayOp IntVec 32 W8) = 827+primOpTag (VecIndexByteArrayOp IntVec 16 W16) = 828+primOpTag (VecIndexByteArrayOp IntVec 8 W32) = 829+primOpTag (VecIndexByteArrayOp IntVec 4 W64) = 830+primOpTag (VecIndexByteArrayOp IntVec 64 W8) = 831+primOpTag (VecIndexByteArrayOp IntVec 32 W16) = 832+primOpTag (VecIndexByteArrayOp IntVec 16 W32) = 833+primOpTag (VecIndexByteArrayOp IntVec 8 W64) = 834+primOpTag (VecIndexByteArrayOp WordVec 16 W8) = 835+primOpTag (VecIndexByteArrayOp WordVec 8 W16) = 836+primOpTag (VecIndexByteArrayOp WordVec 4 W32) = 837+primOpTag (VecIndexByteArrayOp WordVec 2 W64) = 838+primOpTag (VecIndexByteArrayOp WordVec 32 W8) = 839+primOpTag (VecIndexByteArrayOp WordVec 16 W16) = 840+primOpTag (VecIndexByteArrayOp WordVec 8 W32) = 841+primOpTag (VecIndexByteArrayOp WordVec 4 W64) = 842+primOpTag (VecIndexByteArrayOp WordVec 64 W8) = 843+primOpTag (VecIndexByteArrayOp WordVec 32 W16) = 844+primOpTag (VecIndexByteArrayOp WordVec 16 W32) = 845+primOpTag (VecIndexByteArrayOp WordVec 8 W64) = 846+primOpTag (VecIndexByteArrayOp FloatVec 4 W32) = 847+primOpTag (VecIndexByteArrayOp FloatVec 2 W64) = 848+primOpTag (VecIndexByteArrayOp FloatVec 8 W32) = 849+primOpTag (VecIndexByteArrayOp FloatVec 4 W64) = 850+primOpTag (VecIndexByteArrayOp FloatVec 16 W32) = 851+primOpTag (VecIndexByteArrayOp FloatVec 8 W64) = 852+primOpTag (VecReadByteArrayOp IntVec 16 W8) = 853+primOpTag (VecReadByteArrayOp IntVec 8 W16) = 854+primOpTag (VecReadByteArrayOp IntVec 4 W32) = 855+primOpTag (VecReadByteArrayOp IntVec 2 W64) = 856+primOpTag (VecReadByteArrayOp IntVec 32 W8) = 857+primOpTag (VecReadByteArrayOp IntVec 16 W16) = 858+primOpTag (VecReadByteArrayOp IntVec 8 W32) = 859+primOpTag (VecReadByteArrayOp IntVec 4 W64) = 860+primOpTag (VecReadByteArrayOp IntVec 64 W8) = 861+primOpTag (VecReadByteArrayOp IntVec 32 W16) = 862+primOpTag (VecReadByteArrayOp IntVec 16 W32) = 863+primOpTag (VecReadByteArrayOp IntVec 8 W64) = 864+primOpTag (VecReadByteArrayOp WordVec 16 W8) = 865+primOpTag (VecReadByteArrayOp WordVec 8 W16) = 866+primOpTag (VecReadByteArrayOp WordVec 4 W32) = 867+primOpTag (VecReadByteArrayOp WordVec 2 W64) = 868+primOpTag (VecReadByteArrayOp WordVec 32 W8) = 869+primOpTag (VecReadByteArrayOp WordVec 16 W16) = 870+primOpTag (VecReadByteArrayOp WordVec 8 W32) = 871+primOpTag (VecReadByteArrayOp WordVec 4 W64) = 872+primOpTag (VecReadByteArrayOp WordVec 64 W8) = 873+primOpTag (VecReadByteArrayOp WordVec 32 W16) = 874+primOpTag (VecReadByteArrayOp WordVec 16 W32) = 875+primOpTag (VecReadByteArrayOp WordVec 8 W64) = 876+primOpTag (VecReadByteArrayOp FloatVec 4 W32) = 877+primOpTag (VecReadByteArrayOp FloatVec 2 W64) = 878+primOpTag (VecReadByteArrayOp FloatVec 8 W32) = 879+primOpTag (VecReadByteArrayOp FloatVec 4 W64) = 880+primOpTag (VecReadByteArrayOp FloatVec 16 W32) = 881+primOpTag (VecReadByteArrayOp FloatVec 8 W64) = 882+primOpTag (VecWriteByteArrayOp IntVec 16 W8) = 883+primOpTag (VecWriteByteArrayOp IntVec 8 W16) = 884+primOpTag (VecWriteByteArrayOp IntVec 4 W32) = 885+primOpTag (VecWriteByteArrayOp IntVec 2 W64) = 886+primOpTag (VecWriteByteArrayOp IntVec 32 W8) = 887+primOpTag (VecWriteByteArrayOp IntVec 16 W16) = 888+primOpTag (VecWriteByteArrayOp IntVec 8 W32) = 889+primOpTag (VecWriteByteArrayOp IntVec 4 W64) = 890+primOpTag (VecWriteByteArrayOp IntVec 64 W8) = 891+primOpTag (VecWriteByteArrayOp IntVec 32 W16) = 892+primOpTag (VecWriteByteArrayOp IntVec 16 W32) = 893+primOpTag (VecWriteByteArrayOp IntVec 8 W64) = 894+primOpTag (VecWriteByteArrayOp WordVec 16 W8) = 895+primOpTag (VecWriteByteArrayOp WordVec 8 W16) = 896+primOpTag (VecWriteByteArrayOp WordVec 4 W32) = 897+primOpTag (VecWriteByteArrayOp WordVec 2 W64) = 898+primOpTag (VecWriteByteArrayOp WordVec 32 W8) = 899+primOpTag (VecWriteByteArrayOp WordVec 16 W16) = 900+primOpTag (VecWriteByteArrayOp WordVec 8 W32) = 901+primOpTag (VecWriteByteArrayOp WordVec 4 W64) = 902+primOpTag (VecWriteByteArrayOp WordVec 64 W8) = 903+primOpTag (VecWriteByteArrayOp WordVec 32 W16) = 904+primOpTag (VecWriteByteArrayOp WordVec 16 W32) = 905+primOpTag (VecWriteByteArrayOp WordVec 8 W64) = 906+primOpTag (VecWriteByteArrayOp FloatVec 4 W32) = 907+primOpTag (VecWriteByteArrayOp FloatVec 2 W64) = 908+primOpTag (VecWriteByteArrayOp FloatVec 8 W32) = 909+primOpTag (VecWriteByteArrayOp FloatVec 4 W64) = 910+primOpTag (VecWriteByteArrayOp FloatVec 16 W32) = 911+primOpTag (VecWriteByteArrayOp FloatVec 8 W64) = 912+primOpTag (VecIndexOffAddrOp IntVec 16 W8) = 913+primOpTag (VecIndexOffAddrOp IntVec 8 W16) = 914+primOpTag (VecIndexOffAddrOp IntVec 4 W32) = 915+primOpTag (VecIndexOffAddrOp IntVec 2 W64) = 916+primOpTag (VecIndexOffAddrOp IntVec 32 W8) = 917+primOpTag (VecIndexOffAddrOp IntVec 16 W16) = 918+primOpTag (VecIndexOffAddrOp IntVec 8 W32) = 919+primOpTag (VecIndexOffAddrOp IntVec 4 W64) = 920+primOpTag (VecIndexOffAddrOp IntVec 64 W8) = 921+primOpTag (VecIndexOffAddrOp IntVec 32 W16) = 922+primOpTag (VecIndexOffAddrOp IntVec 16 W32) = 923+primOpTag (VecIndexOffAddrOp IntVec 8 W64) = 924+primOpTag (VecIndexOffAddrOp WordVec 16 W8) = 925+primOpTag (VecIndexOffAddrOp WordVec 8 W16) = 926+primOpTag (VecIndexOffAddrOp WordVec 4 W32) = 927+primOpTag (VecIndexOffAddrOp WordVec 2 W64) = 928+primOpTag (VecIndexOffAddrOp WordVec 32 W8) = 929+primOpTag (VecIndexOffAddrOp WordVec 16 W16) = 930+primOpTag (VecIndexOffAddrOp WordVec 8 W32) = 931+primOpTag (VecIndexOffAddrOp WordVec 4 W64) = 932+primOpTag (VecIndexOffAddrOp WordVec 64 W8) = 933+primOpTag (VecIndexOffAddrOp WordVec 32 W16) = 934+primOpTag (VecIndexOffAddrOp WordVec 16 W32) = 935+primOpTag (VecIndexOffAddrOp WordVec 8 W64) = 936+primOpTag (VecIndexOffAddrOp FloatVec 4 W32) = 937+primOpTag (VecIndexOffAddrOp FloatVec 2 W64) = 938+primOpTag (VecIndexOffAddrOp FloatVec 8 W32) = 939+primOpTag (VecIndexOffAddrOp FloatVec 4 W64) = 940+primOpTag (VecIndexOffAddrOp FloatVec 16 W32) = 941+primOpTag (VecIndexOffAddrOp FloatVec 8 W64) = 942+primOpTag (VecReadOffAddrOp IntVec 16 W8) = 943+primOpTag (VecReadOffAddrOp IntVec 8 W16) = 944+primOpTag (VecReadOffAddrOp IntVec 4 W32) = 945+primOpTag (VecReadOffAddrOp IntVec 2 W64) = 946+primOpTag (VecReadOffAddrOp IntVec 32 W8) = 947+primOpTag (VecReadOffAddrOp IntVec 16 W16) = 948+primOpTag (VecReadOffAddrOp IntVec 8 W32) = 949+primOpTag (VecReadOffAddrOp IntVec 4 W64) = 950+primOpTag (VecReadOffAddrOp IntVec 64 W8) = 951+primOpTag (VecReadOffAddrOp IntVec 32 W16) = 952+primOpTag (VecReadOffAddrOp IntVec 16 W32) = 953+primOpTag (VecReadOffAddrOp IntVec 8 W64) = 954+primOpTag (VecReadOffAddrOp WordVec 16 W8) = 955+primOpTag (VecReadOffAddrOp WordVec 8 W16) = 956+primOpTag (VecReadOffAddrOp WordVec 4 W32) = 957+primOpTag (VecReadOffAddrOp WordVec 2 W64) = 958+primOpTag (VecReadOffAddrOp WordVec 32 W8) = 959+primOpTag (VecReadOffAddrOp WordVec 16 W16) = 960+primOpTag (VecReadOffAddrOp WordVec 8 W32) = 961+primOpTag (VecReadOffAddrOp WordVec 4 W64) = 962+primOpTag (VecReadOffAddrOp WordVec 64 W8) = 963+primOpTag (VecReadOffAddrOp WordVec 32 W16) = 964+primOpTag (VecReadOffAddrOp WordVec 16 W32) = 965+primOpTag (VecReadOffAddrOp WordVec 8 W64) = 966+primOpTag (VecReadOffAddrOp FloatVec 4 W32) = 967+primOpTag (VecReadOffAddrOp FloatVec 2 W64) = 968+primOpTag (VecReadOffAddrOp FloatVec 8 W32) = 969+primOpTag (VecReadOffAddrOp FloatVec 4 W64) = 970+primOpTag (VecReadOffAddrOp FloatVec 16 W32) = 971+primOpTag (VecReadOffAddrOp FloatVec 8 W64) = 972+primOpTag (VecWriteOffAddrOp IntVec 16 W8) = 973+primOpTag (VecWriteOffAddrOp IntVec 8 W16) = 974+primOpTag (VecWriteOffAddrOp IntVec 4 W32) = 975+primOpTag (VecWriteOffAddrOp IntVec 2 W64) = 976+primOpTag (VecWriteOffAddrOp IntVec 32 W8) = 977+primOpTag (VecWriteOffAddrOp IntVec 16 W16) = 978+primOpTag (VecWriteOffAddrOp IntVec 8 W32) = 979+primOpTag (VecWriteOffAddrOp IntVec 4 W64) = 980+primOpTag (VecWriteOffAddrOp IntVec 64 W8) = 981+primOpTag (VecWriteOffAddrOp IntVec 32 W16) = 982+primOpTag (VecWriteOffAddrOp IntVec 16 W32) = 983+primOpTag (VecWriteOffAddrOp IntVec 8 W64) = 984+primOpTag (VecWriteOffAddrOp WordVec 16 W8) = 985+primOpTag (VecWriteOffAddrOp WordVec 8 W16) = 986+primOpTag (VecWriteOffAddrOp WordVec 4 W32) = 987+primOpTag (VecWriteOffAddrOp WordVec 2 W64) = 988+primOpTag (VecWriteOffAddrOp WordVec 32 W8) = 989+primOpTag (VecWriteOffAddrOp WordVec 16 W16) = 990+primOpTag (VecWriteOffAddrOp WordVec 8 W32) = 991+primOpTag (VecWriteOffAddrOp WordVec 4 W64) = 992+primOpTag (VecWriteOffAddrOp WordVec 64 W8) = 993+primOpTag (VecWriteOffAddrOp WordVec 32 W16) = 994+primOpTag (VecWriteOffAddrOp WordVec 16 W32) = 995+primOpTag (VecWriteOffAddrOp WordVec 8 W64) = 996+primOpTag (VecWriteOffAddrOp FloatVec 4 W32) = 997+primOpTag (VecWriteOffAddrOp FloatVec 2 W64) = 998+primOpTag (VecWriteOffAddrOp FloatVec 8 W32) = 999+primOpTag (VecWriteOffAddrOp FloatVec 4 W64) = 1000+primOpTag (VecWriteOffAddrOp FloatVec 16 W32) = 1001+primOpTag (VecWriteOffAddrOp FloatVec 8 W64) = 1002+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W8) = 1003+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W16) = 1004+primOpTag (VecIndexScalarByteArrayOp IntVec 4 W32) = 1005+primOpTag (VecIndexScalarByteArrayOp IntVec 2 W64) = 1006+primOpTag (VecIndexScalarByteArrayOp IntVec 32 W8) = 1007+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W16) = 1008+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W32) = 1009+primOpTag (VecIndexScalarByteArrayOp IntVec 4 W64) = 1010+primOpTag (VecIndexScalarByteArrayOp IntVec 64 W8) = 1011+primOpTag (VecIndexScalarByteArrayOp IntVec 32 W16) = 1012+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W32) = 1013+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W64) = 1014+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W8) = 1015+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W16) = 1016+primOpTag (VecIndexScalarByteArrayOp WordVec 4 W32) = 1017+primOpTag (VecIndexScalarByteArrayOp WordVec 2 W64) = 1018+primOpTag (VecIndexScalarByteArrayOp WordVec 32 W8) = 1019+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W16) = 1020+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W32) = 1021+primOpTag (VecIndexScalarByteArrayOp WordVec 4 W64) = 1022+primOpTag (VecIndexScalarByteArrayOp WordVec 64 W8) = 1023+primOpTag (VecIndexScalarByteArrayOp WordVec 32 W16) = 1024+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W32) = 1025+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W64) = 1026+primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W32) = 1027+primOpTag (VecIndexScalarByteArrayOp FloatVec 2 W64) = 1028+primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W32) = 1029+primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W64) = 1030+primOpTag (VecIndexScalarByteArrayOp FloatVec 16 W32) = 1031+primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W64) = 1032+primOpTag (VecReadScalarByteArrayOp IntVec 16 W8) = 1033+primOpTag (VecReadScalarByteArrayOp IntVec 8 W16) = 1034+primOpTag (VecReadScalarByteArrayOp IntVec 4 W32) = 1035+primOpTag (VecReadScalarByteArrayOp IntVec 2 W64) = 1036+primOpTag (VecReadScalarByteArrayOp IntVec 32 W8) = 1037+primOpTag (VecReadScalarByteArrayOp IntVec 16 W16) = 1038+primOpTag (VecReadScalarByteArrayOp IntVec 8 W32) = 1039+primOpTag (VecReadScalarByteArrayOp IntVec 4 W64) = 1040+primOpTag (VecReadScalarByteArrayOp IntVec 64 W8) = 1041+primOpTag (VecReadScalarByteArrayOp IntVec 32 W16) = 1042+primOpTag (VecReadScalarByteArrayOp IntVec 16 W32) = 1043+primOpTag (VecReadScalarByteArrayOp IntVec 8 W64) = 1044+primOpTag (VecReadScalarByteArrayOp WordVec 16 W8) = 1045+primOpTag (VecReadScalarByteArrayOp WordVec 8 W16) = 1046+primOpTag (VecReadScalarByteArrayOp WordVec 4 W32) = 1047+primOpTag (VecReadScalarByteArrayOp WordVec 2 W64) = 1048+primOpTag (VecReadScalarByteArrayOp WordVec 32 W8) = 1049+primOpTag (VecReadScalarByteArrayOp WordVec 16 W16) = 1050+primOpTag (VecReadScalarByteArrayOp WordVec 8 W32) = 1051+primOpTag (VecReadScalarByteArrayOp WordVec 4 W64) = 1052+primOpTag (VecReadScalarByteArrayOp WordVec 64 W8) = 1053+primOpTag (VecReadScalarByteArrayOp WordVec 32 W16) = 1054+primOpTag (VecReadScalarByteArrayOp WordVec 16 W32) = 1055+primOpTag (VecReadScalarByteArrayOp WordVec 8 W64) = 1056+primOpTag (VecReadScalarByteArrayOp FloatVec 4 W32) = 1057+primOpTag (VecReadScalarByteArrayOp FloatVec 2 W64) = 1058+primOpTag (VecReadScalarByteArrayOp FloatVec 8 W32) = 1059+primOpTag (VecReadScalarByteArrayOp FloatVec 4 W64) = 1060+primOpTag (VecReadScalarByteArrayOp FloatVec 16 W32) = 1061+primOpTag (VecReadScalarByteArrayOp FloatVec 8 W64) = 1062+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W8) = 1063+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W16) = 1064+primOpTag (VecWriteScalarByteArrayOp IntVec 4 W32) = 1065+primOpTag (VecWriteScalarByteArrayOp IntVec 2 W64) = 1066+primOpTag (VecWriteScalarByteArrayOp IntVec 32 W8) = 1067+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W16) = 1068+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W32) = 1069+primOpTag (VecWriteScalarByteArrayOp IntVec 4 W64) = 1070+primOpTag (VecWriteScalarByteArrayOp IntVec 64 W8) = 1071+primOpTag (VecWriteScalarByteArrayOp IntVec 32 W16) = 1072+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W32) = 1073+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W64) = 1074+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W8) = 1075+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W16) = 1076+primOpTag (VecWriteScalarByteArrayOp WordVec 4 W32) = 1077+primOpTag (VecWriteScalarByteArrayOp WordVec 2 W64) = 1078+primOpTag (VecWriteScalarByteArrayOp WordVec 32 W8) = 1079+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W16) = 1080+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W32) = 1081+primOpTag (VecWriteScalarByteArrayOp WordVec 4 W64) = 1082+primOpTag (VecWriteScalarByteArrayOp WordVec 64 W8) = 1083+primOpTag (VecWriteScalarByteArrayOp WordVec 32 W16) = 1084+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W32) = 1085+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W64) = 1086+primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W32) = 1087+primOpTag (VecWriteScalarByteArrayOp FloatVec 2 W64) = 1088+primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W32) = 1089+primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W64) = 1090+primOpTag (VecWriteScalarByteArrayOp FloatVec 16 W32) = 1091+primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W64) = 1092+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W8) = 1093+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W16) = 1094+primOpTag (VecIndexScalarOffAddrOp IntVec 4 W32) = 1095+primOpTag (VecIndexScalarOffAddrOp IntVec 2 W64) = 1096+primOpTag (VecIndexScalarOffAddrOp IntVec 32 W8) = 1097+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W16) = 1098+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W32) = 1099+primOpTag (VecIndexScalarOffAddrOp IntVec 4 W64) = 1100+primOpTag (VecIndexScalarOffAddrOp IntVec 64 W8) = 1101+primOpTag (VecIndexScalarOffAddrOp IntVec 32 W16) = 1102+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W32) = 1103+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W64) = 1104+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W8) = 1105+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W16) = 1106+primOpTag (VecIndexScalarOffAddrOp WordVec 4 W32) = 1107+primOpTag (VecIndexScalarOffAddrOp WordVec 2 W64) = 1108+primOpTag (VecIndexScalarOffAddrOp WordVec 32 W8) = 1109+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W16) = 1110+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W32) = 1111+primOpTag (VecIndexScalarOffAddrOp WordVec 4 W64) = 1112+primOpTag (VecIndexScalarOffAddrOp WordVec 64 W8) = 1113+primOpTag (VecIndexScalarOffAddrOp WordVec 32 W16) = 1114+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W32) = 1115+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W64) = 1116+primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W32) = 1117+primOpTag (VecIndexScalarOffAddrOp FloatVec 2 W64) = 1118+primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W32) = 1119+primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W64) = 1120+primOpTag (VecIndexScalarOffAddrOp FloatVec 16 W32) = 1121+primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W64) = 1122+primOpTag (VecReadScalarOffAddrOp IntVec 16 W8) = 1123+primOpTag (VecReadScalarOffAddrOp IntVec 8 W16) = 1124+primOpTag (VecReadScalarOffAddrOp IntVec 4 W32) = 1125+primOpTag (VecReadScalarOffAddrOp IntVec 2 W64) = 1126+primOpTag (VecReadScalarOffAddrOp IntVec 32 W8) = 1127+primOpTag (VecReadScalarOffAddrOp IntVec 16 W16) = 1128+primOpTag (VecReadScalarOffAddrOp IntVec 8 W32) = 1129+primOpTag (VecReadScalarOffAddrOp IntVec 4 W64) = 1130+primOpTag (VecReadScalarOffAddrOp IntVec 64 W8) = 1131+primOpTag (VecReadScalarOffAddrOp IntVec 32 W16) = 1132+primOpTag (VecReadScalarOffAddrOp IntVec 16 W32) = 1133+primOpTag (VecReadScalarOffAddrOp IntVec 8 W64) = 1134+primOpTag (VecReadScalarOffAddrOp WordVec 16 W8) = 1135+primOpTag (VecReadScalarOffAddrOp WordVec 8 W16) = 1136+primOpTag (VecReadScalarOffAddrOp WordVec 4 W32) = 1137+primOpTag (VecReadScalarOffAddrOp WordVec 2 W64) = 1138+primOpTag (VecReadScalarOffAddrOp WordVec 32 W8) = 1139+primOpTag (VecReadScalarOffAddrOp WordVec 16 W16) = 1140+primOpTag (VecReadScalarOffAddrOp WordVec 8 W32) = 1141+primOpTag (VecReadScalarOffAddrOp WordVec 4 W64) = 1142+primOpTag (VecReadScalarOffAddrOp WordVec 64 W8) = 1143+primOpTag (VecReadScalarOffAddrOp WordVec 32 W16) = 1144+primOpTag (VecReadScalarOffAddrOp WordVec 16 W32) = 1145+primOpTag (VecReadScalarOffAddrOp WordVec 8 W64) = 1146+primOpTag (VecReadScalarOffAddrOp FloatVec 4 W32) = 1147+primOpTag (VecReadScalarOffAddrOp FloatVec 2 W64) = 1148+primOpTag (VecReadScalarOffAddrOp FloatVec 8 W32) = 1149+primOpTag (VecReadScalarOffAddrOp FloatVec 4 W64) = 1150+primOpTag (VecReadScalarOffAddrOp FloatVec 16 W32) = 1151+primOpTag (VecReadScalarOffAddrOp FloatVec 8 W64) = 1152+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W8) = 1153+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W16) = 1154+primOpTag (VecWriteScalarOffAddrOp IntVec 4 W32) = 1155+primOpTag (VecWriteScalarOffAddrOp IntVec 2 W64) = 1156+primOpTag (VecWriteScalarOffAddrOp IntVec 32 W8) = 1157+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W16) = 1158+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W32) = 1159+primOpTag (VecWriteScalarOffAddrOp IntVec 4 W64) = 1160+primOpTag (VecWriteScalarOffAddrOp IntVec 64 W8) = 1161+primOpTag (VecWriteScalarOffAddrOp IntVec 32 W16) = 1162+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W32) = 1163+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W64) = 1164+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W8) = 1165+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W16) = 1166+primOpTag (VecWriteScalarOffAddrOp WordVec 4 W32) = 1167+primOpTag (VecWriteScalarOffAddrOp WordVec 2 W64) = 1168+primOpTag (VecWriteScalarOffAddrOp WordVec 32 W8) = 1169+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W16) = 1170+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W32) = 1171+primOpTag (VecWriteScalarOffAddrOp WordVec 4 W64) = 1172+primOpTag (VecWriteScalarOffAddrOp WordVec 64 W8) = 1173+primOpTag (VecWriteScalarOffAddrOp WordVec 32 W16) = 1174+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W32) = 1175+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W64) = 1176+primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W32) = 1177+primOpTag (VecWriteScalarOffAddrOp FloatVec 2 W64) = 1178+primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W32) = 1179+primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W64) = 1180+primOpTag (VecWriteScalarOffAddrOp FloatVec 16 W32) = 1181+primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W64) = 1182+primOpTag PrefetchByteArrayOp3 = 1183+primOpTag PrefetchMutableByteArrayOp3 = 1184+primOpTag PrefetchAddrOp3 = 1185+primOpTag PrefetchValueOp3 = 1186+primOpTag PrefetchByteArrayOp2 = 1187+primOpTag PrefetchMutableByteArrayOp2 = 1188+primOpTag PrefetchAddrOp2 = 1189+primOpTag PrefetchValueOp2 = 1190+primOpTag PrefetchByteArrayOp1 = 1191+primOpTag PrefetchMutableByteArrayOp1 = 1192+primOpTag PrefetchAddrOp1 = 1193+primOpTag PrefetchValueOp1 = 1194+primOpTag PrefetchByteArrayOp0 = 1195+primOpTag PrefetchMutableByteArrayOp0 = 1196+primOpTag PrefetchAddrOp0 = 1197+primOpTag PrefetchValueOp0 = 1198
+ ghc-lib/stage1/compiler/build/primop-vector-tycons.hs-incl view
@@ -0,0 +1,30 @@+    , int8X16PrimTyCon+    , int16X8PrimTyCon+    , int32X4PrimTyCon+    , int64X2PrimTyCon+    , int8X32PrimTyCon+    , int16X16PrimTyCon+    , int32X8PrimTyCon+    , int64X4PrimTyCon+    , int8X64PrimTyCon+    , int16X32PrimTyCon+    , int32X16PrimTyCon+    , int64X8PrimTyCon+    , word8X16PrimTyCon+    , word16X8PrimTyCon+    , word32X4PrimTyCon+    , word64X2PrimTyCon+    , word8X32PrimTyCon+    , word16X16PrimTyCon+    , word32X8PrimTyCon+    , word64X4PrimTyCon+    , word8X64PrimTyCon+    , word16X32PrimTyCon+    , word32X16PrimTyCon+    , word64X8PrimTyCon+    , floatX4PrimTyCon+    , doubleX2PrimTyCon+    , floatX8PrimTyCon+    , doubleX4PrimTyCon+    , floatX16PrimTyCon+    , doubleX8PrimTyCon
+ ghc-lib/stage1/compiler/build/primop-vector-tys-exports.hs-incl view
@@ -0,0 +1,30 @@+        int8X16PrimTy, int8X16PrimTyCon,+        int16X8PrimTy, int16X8PrimTyCon,+        int32X4PrimTy, int32X4PrimTyCon,+        int64X2PrimTy, int64X2PrimTyCon,+        int8X32PrimTy, int8X32PrimTyCon,+        int16X16PrimTy, int16X16PrimTyCon,+        int32X8PrimTy, int32X8PrimTyCon,+        int64X4PrimTy, int64X4PrimTyCon,+        int8X64PrimTy, int8X64PrimTyCon,+        int16X32PrimTy, int16X32PrimTyCon,+        int32X16PrimTy, int32X16PrimTyCon,+        int64X8PrimTy, int64X8PrimTyCon,+        word8X16PrimTy, word8X16PrimTyCon,+        word16X8PrimTy, word16X8PrimTyCon,+        word32X4PrimTy, word32X4PrimTyCon,+        word64X2PrimTy, word64X2PrimTyCon,+        word8X32PrimTy, word8X32PrimTyCon,+        word16X16PrimTy, word16X16PrimTyCon,+        word32X8PrimTy, word32X8PrimTyCon,+        word64X4PrimTy, word64X4PrimTyCon,+        word8X64PrimTy, word8X64PrimTyCon,+        word16X32PrimTy, word16X32PrimTyCon,+        word32X16PrimTy, word32X16PrimTyCon,+        word64X8PrimTy, word64X8PrimTyCon,+        floatX4PrimTy, floatX4PrimTyCon,+        doubleX2PrimTy, doubleX2PrimTyCon,+        floatX8PrimTy, floatX8PrimTyCon,+        doubleX4PrimTy, doubleX4PrimTyCon,+        floatX16PrimTy, floatX16PrimTyCon,+        doubleX8PrimTy, doubleX8PrimTyCon,
+ ghc-lib/stage1/compiler/build/primop-vector-tys.hs-incl view
@@ -0,0 +1,180 @@+int8X16PrimTyConName :: Name+int8X16PrimTyConName = mkPrimTc (fsLit "Int8X16#") int8X16PrimTyConKey int8X16PrimTyCon+int8X16PrimTy :: Type+int8X16PrimTy = mkTyConTy int8X16PrimTyCon+int8X16PrimTyCon :: TyCon+int8X16PrimTyCon = pcPrimTyCon0 int8X16PrimTyConName (VecRep 16 Int8ElemRep)+int16X8PrimTyConName :: Name+int16X8PrimTyConName = mkPrimTc (fsLit "Int16X8#") int16X8PrimTyConKey int16X8PrimTyCon+int16X8PrimTy :: Type+int16X8PrimTy = mkTyConTy int16X8PrimTyCon+int16X8PrimTyCon :: TyCon+int16X8PrimTyCon = pcPrimTyCon0 int16X8PrimTyConName (VecRep 8 Int16ElemRep)+int32X4PrimTyConName :: Name+int32X4PrimTyConName = mkPrimTc (fsLit "Int32X4#") int32X4PrimTyConKey int32X4PrimTyCon+int32X4PrimTy :: Type+int32X4PrimTy = mkTyConTy int32X4PrimTyCon+int32X4PrimTyCon :: TyCon+int32X4PrimTyCon = pcPrimTyCon0 int32X4PrimTyConName (VecRep 4 Int32ElemRep)+int64X2PrimTyConName :: Name+int64X2PrimTyConName = mkPrimTc (fsLit "Int64X2#") int64X2PrimTyConKey int64X2PrimTyCon+int64X2PrimTy :: Type+int64X2PrimTy = mkTyConTy int64X2PrimTyCon+int64X2PrimTyCon :: TyCon+int64X2PrimTyCon = pcPrimTyCon0 int64X2PrimTyConName (VecRep 2 Int64ElemRep)+int8X32PrimTyConName :: Name+int8X32PrimTyConName = mkPrimTc (fsLit "Int8X32#") int8X32PrimTyConKey int8X32PrimTyCon+int8X32PrimTy :: Type+int8X32PrimTy = mkTyConTy int8X32PrimTyCon+int8X32PrimTyCon :: TyCon+int8X32PrimTyCon = pcPrimTyCon0 int8X32PrimTyConName (VecRep 32 Int8ElemRep)+int16X16PrimTyConName :: Name+int16X16PrimTyConName = mkPrimTc (fsLit "Int16X16#") int16X16PrimTyConKey int16X16PrimTyCon+int16X16PrimTy :: Type+int16X16PrimTy = mkTyConTy int16X16PrimTyCon+int16X16PrimTyCon :: TyCon+int16X16PrimTyCon = pcPrimTyCon0 int16X16PrimTyConName (VecRep 16 Int16ElemRep)+int32X8PrimTyConName :: Name+int32X8PrimTyConName = mkPrimTc (fsLit "Int32X8#") int32X8PrimTyConKey int32X8PrimTyCon+int32X8PrimTy :: Type+int32X8PrimTy = mkTyConTy int32X8PrimTyCon+int32X8PrimTyCon :: TyCon+int32X8PrimTyCon = pcPrimTyCon0 int32X8PrimTyConName (VecRep 8 Int32ElemRep)+int64X4PrimTyConName :: Name+int64X4PrimTyConName = mkPrimTc (fsLit "Int64X4#") int64X4PrimTyConKey int64X4PrimTyCon+int64X4PrimTy :: Type+int64X4PrimTy = mkTyConTy int64X4PrimTyCon+int64X4PrimTyCon :: TyCon+int64X4PrimTyCon = pcPrimTyCon0 int64X4PrimTyConName (VecRep 4 Int64ElemRep)+int8X64PrimTyConName :: Name+int8X64PrimTyConName = mkPrimTc (fsLit "Int8X64#") int8X64PrimTyConKey int8X64PrimTyCon+int8X64PrimTy :: Type+int8X64PrimTy = mkTyConTy int8X64PrimTyCon+int8X64PrimTyCon :: TyCon+int8X64PrimTyCon = pcPrimTyCon0 int8X64PrimTyConName (VecRep 64 Int8ElemRep)+int16X32PrimTyConName :: Name+int16X32PrimTyConName = mkPrimTc (fsLit "Int16X32#") int16X32PrimTyConKey int16X32PrimTyCon+int16X32PrimTy :: Type+int16X32PrimTy = mkTyConTy int16X32PrimTyCon+int16X32PrimTyCon :: TyCon+int16X32PrimTyCon = pcPrimTyCon0 int16X32PrimTyConName (VecRep 32 Int16ElemRep)+int32X16PrimTyConName :: Name+int32X16PrimTyConName = mkPrimTc (fsLit "Int32X16#") int32X16PrimTyConKey int32X16PrimTyCon+int32X16PrimTy :: Type+int32X16PrimTy = mkTyConTy int32X16PrimTyCon+int32X16PrimTyCon :: TyCon+int32X16PrimTyCon = pcPrimTyCon0 int32X16PrimTyConName (VecRep 16 Int32ElemRep)+int64X8PrimTyConName :: Name+int64X8PrimTyConName = mkPrimTc (fsLit "Int64X8#") int64X8PrimTyConKey int64X8PrimTyCon+int64X8PrimTy :: Type+int64X8PrimTy = mkTyConTy int64X8PrimTyCon+int64X8PrimTyCon :: TyCon+int64X8PrimTyCon = pcPrimTyCon0 int64X8PrimTyConName (VecRep 8 Int64ElemRep)+word8X16PrimTyConName :: Name+word8X16PrimTyConName = mkPrimTc (fsLit "Word8X16#") word8X16PrimTyConKey word8X16PrimTyCon+word8X16PrimTy :: Type+word8X16PrimTy = mkTyConTy word8X16PrimTyCon+word8X16PrimTyCon :: TyCon+word8X16PrimTyCon = pcPrimTyCon0 word8X16PrimTyConName (VecRep 16 Word8ElemRep)+word16X8PrimTyConName :: Name+word16X8PrimTyConName = mkPrimTc (fsLit "Word16X8#") word16X8PrimTyConKey word16X8PrimTyCon+word16X8PrimTy :: Type+word16X8PrimTy = mkTyConTy word16X8PrimTyCon+word16X8PrimTyCon :: TyCon+word16X8PrimTyCon = pcPrimTyCon0 word16X8PrimTyConName (VecRep 8 Word16ElemRep)+word32X4PrimTyConName :: Name+word32X4PrimTyConName = mkPrimTc (fsLit "Word32X4#") word32X4PrimTyConKey word32X4PrimTyCon+word32X4PrimTy :: Type+word32X4PrimTy = mkTyConTy word32X4PrimTyCon+word32X4PrimTyCon :: TyCon+word32X4PrimTyCon = pcPrimTyCon0 word32X4PrimTyConName (VecRep 4 Word32ElemRep)+word64X2PrimTyConName :: Name+word64X2PrimTyConName = mkPrimTc (fsLit "Word64X2#") word64X2PrimTyConKey word64X2PrimTyCon+word64X2PrimTy :: Type+word64X2PrimTy = mkTyConTy word64X2PrimTyCon+word64X2PrimTyCon :: TyCon+word64X2PrimTyCon = pcPrimTyCon0 word64X2PrimTyConName (VecRep 2 Word64ElemRep)+word8X32PrimTyConName :: Name+word8X32PrimTyConName = mkPrimTc (fsLit "Word8X32#") word8X32PrimTyConKey word8X32PrimTyCon+word8X32PrimTy :: Type+word8X32PrimTy = mkTyConTy word8X32PrimTyCon+word8X32PrimTyCon :: TyCon+word8X32PrimTyCon = pcPrimTyCon0 word8X32PrimTyConName (VecRep 32 Word8ElemRep)+word16X16PrimTyConName :: Name+word16X16PrimTyConName = mkPrimTc (fsLit "Word16X16#") word16X16PrimTyConKey word16X16PrimTyCon+word16X16PrimTy :: Type+word16X16PrimTy = mkTyConTy word16X16PrimTyCon+word16X16PrimTyCon :: TyCon+word16X16PrimTyCon = pcPrimTyCon0 word16X16PrimTyConName (VecRep 16 Word16ElemRep)+word32X8PrimTyConName :: Name+word32X8PrimTyConName = mkPrimTc (fsLit "Word32X8#") word32X8PrimTyConKey word32X8PrimTyCon+word32X8PrimTy :: Type+word32X8PrimTy = mkTyConTy word32X8PrimTyCon+word32X8PrimTyCon :: TyCon+word32X8PrimTyCon = pcPrimTyCon0 word32X8PrimTyConName (VecRep 8 Word32ElemRep)+word64X4PrimTyConName :: Name+word64X4PrimTyConName = mkPrimTc (fsLit "Word64X4#") word64X4PrimTyConKey word64X4PrimTyCon+word64X4PrimTy :: Type+word64X4PrimTy = mkTyConTy word64X4PrimTyCon+word64X4PrimTyCon :: TyCon+word64X4PrimTyCon = pcPrimTyCon0 word64X4PrimTyConName (VecRep 4 Word64ElemRep)+word8X64PrimTyConName :: Name+word8X64PrimTyConName = mkPrimTc (fsLit "Word8X64#") word8X64PrimTyConKey word8X64PrimTyCon+word8X64PrimTy :: Type+word8X64PrimTy = mkTyConTy word8X64PrimTyCon+word8X64PrimTyCon :: TyCon+word8X64PrimTyCon = pcPrimTyCon0 word8X64PrimTyConName (VecRep 64 Word8ElemRep)+word16X32PrimTyConName :: Name+word16X32PrimTyConName = mkPrimTc (fsLit "Word16X32#") word16X32PrimTyConKey word16X32PrimTyCon+word16X32PrimTy :: Type+word16X32PrimTy = mkTyConTy word16X32PrimTyCon+word16X32PrimTyCon :: TyCon+word16X32PrimTyCon = pcPrimTyCon0 word16X32PrimTyConName (VecRep 32 Word16ElemRep)+word32X16PrimTyConName :: Name+word32X16PrimTyConName = mkPrimTc (fsLit "Word32X16#") word32X16PrimTyConKey word32X16PrimTyCon+word32X16PrimTy :: Type+word32X16PrimTy = mkTyConTy word32X16PrimTyCon+word32X16PrimTyCon :: TyCon+word32X16PrimTyCon = pcPrimTyCon0 word32X16PrimTyConName (VecRep 16 Word32ElemRep)+word64X8PrimTyConName :: Name+word64X8PrimTyConName = mkPrimTc (fsLit "Word64X8#") word64X8PrimTyConKey word64X8PrimTyCon+word64X8PrimTy :: Type+word64X8PrimTy = mkTyConTy word64X8PrimTyCon+word64X8PrimTyCon :: TyCon+word64X8PrimTyCon = pcPrimTyCon0 word64X8PrimTyConName (VecRep 8 Word64ElemRep)+floatX4PrimTyConName :: Name+floatX4PrimTyConName = mkPrimTc (fsLit "FloatX4#") floatX4PrimTyConKey floatX4PrimTyCon+floatX4PrimTy :: Type+floatX4PrimTy = mkTyConTy floatX4PrimTyCon+floatX4PrimTyCon :: TyCon+floatX4PrimTyCon = pcPrimTyCon0 floatX4PrimTyConName (VecRep 4 FloatElemRep)+doubleX2PrimTyConName :: Name+doubleX2PrimTyConName = mkPrimTc (fsLit "DoubleX2#") doubleX2PrimTyConKey doubleX2PrimTyCon+doubleX2PrimTy :: Type+doubleX2PrimTy = mkTyConTy doubleX2PrimTyCon+doubleX2PrimTyCon :: TyCon+doubleX2PrimTyCon = pcPrimTyCon0 doubleX2PrimTyConName (VecRep 2 DoubleElemRep)+floatX8PrimTyConName :: Name+floatX8PrimTyConName = mkPrimTc (fsLit "FloatX8#") floatX8PrimTyConKey floatX8PrimTyCon+floatX8PrimTy :: Type+floatX8PrimTy = mkTyConTy floatX8PrimTyCon+floatX8PrimTyCon :: TyCon+floatX8PrimTyCon = pcPrimTyCon0 floatX8PrimTyConName (VecRep 8 FloatElemRep)+doubleX4PrimTyConName :: Name+doubleX4PrimTyConName = mkPrimTc (fsLit "DoubleX4#") doubleX4PrimTyConKey doubleX4PrimTyCon+doubleX4PrimTy :: Type+doubleX4PrimTy = mkTyConTy doubleX4PrimTyCon+doubleX4PrimTyCon :: TyCon+doubleX4PrimTyCon = pcPrimTyCon0 doubleX4PrimTyConName (VecRep 4 DoubleElemRep)+floatX16PrimTyConName :: Name+floatX16PrimTyConName = mkPrimTc (fsLit "FloatX16#") floatX16PrimTyConKey floatX16PrimTyCon+floatX16PrimTy :: Type+floatX16PrimTy = mkTyConTy floatX16PrimTyCon+floatX16PrimTyCon :: TyCon+floatX16PrimTyCon = pcPrimTyCon0 floatX16PrimTyConName (VecRep 16 FloatElemRep)+doubleX8PrimTyConName :: Name+doubleX8PrimTyConName = mkPrimTc (fsLit "DoubleX8#") doubleX8PrimTyConKey doubleX8PrimTyCon+doubleX8PrimTy :: Type+doubleX8PrimTy = mkTyConTy doubleX8PrimTyCon+doubleX8PrimTyCon :: TyCon+doubleX8PrimTyCon = pcPrimTyCon0 doubleX8PrimTyConName (VecRep 8 DoubleElemRep)
+ ghc-lib/stage1/compiler/build/primop-vector-uniques.hs-incl view
@@ -0,0 +1,60 @@+int8X16PrimTyConKey :: Unique+int8X16PrimTyConKey = mkPreludeTyConUnique 300+int16X8PrimTyConKey :: Unique+int16X8PrimTyConKey = mkPreludeTyConUnique 301+int32X4PrimTyConKey :: Unique+int32X4PrimTyConKey = mkPreludeTyConUnique 302+int64X2PrimTyConKey :: Unique+int64X2PrimTyConKey = mkPreludeTyConUnique 303+int8X32PrimTyConKey :: Unique+int8X32PrimTyConKey = mkPreludeTyConUnique 304+int16X16PrimTyConKey :: Unique+int16X16PrimTyConKey = mkPreludeTyConUnique 305+int32X8PrimTyConKey :: Unique+int32X8PrimTyConKey = mkPreludeTyConUnique 306+int64X4PrimTyConKey :: Unique+int64X4PrimTyConKey = mkPreludeTyConUnique 307+int8X64PrimTyConKey :: Unique+int8X64PrimTyConKey = mkPreludeTyConUnique 308+int16X32PrimTyConKey :: Unique+int16X32PrimTyConKey = mkPreludeTyConUnique 309+int32X16PrimTyConKey :: Unique+int32X16PrimTyConKey = mkPreludeTyConUnique 310+int64X8PrimTyConKey :: Unique+int64X8PrimTyConKey = mkPreludeTyConUnique 311+word8X16PrimTyConKey :: Unique+word8X16PrimTyConKey = mkPreludeTyConUnique 312+word16X8PrimTyConKey :: Unique+word16X8PrimTyConKey = mkPreludeTyConUnique 313+word32X4PrimTyConKey :: Unique+word32X4PrimTyConKey = mkPreludeTyConUnique 314+word64X2PrimTyConKey :: Unique+word64X2PrimTyConKey = mkPreludeTyConUnique 315+word8X32PrimTyConKey :: Unique+word8X32PrimTyConKey = mkPreludeTyConUnique 316+word16X16PrimTyConKey :: Unique+word16X16PrimTyConKey = mkPreludeTyConUnique 317+word32X8PrimTyConKey :: Unique+word32X8PrimTyConKey = mkPreludeTyConUnique 318+word64X4PrimTyConKey :: Unique+word64X4PrimTyConKey = mkPreludeTyConUnique 319+word8X64PrimTyConKey :: Unique+word8X64PrimTyConKey = mkPreludeTyConUnique 320+word16X32PrimTyConKey :: Unique+word16X32PrimTyConKey = mkPreludeTyConUnique 321+word32X16PrimTyConKey :: Unique+word32X16PrimTyConKey = mkPreludeTyConUnique 322+word64X8PrimTyConKey :: Unique+word64X8PrimTyConKey = mkPreludeTyConUnique 323+floatX4PrimTyConKey :: Unique+floatX4PrimTyConKey = mkPreludeTyConUnique 324+doubleX2PrimTyConKey :: Unique+doubleX2PrimTyConKey = mkPreludeTyConUnique 325+floatX8PrimTyConKey :: Unique+floatX8PrimTyConKey = mkPreludeTyConUnique 326+doubleX4PrimTyConKey :: Unique+doubleX4PrimTyConKey = mkPreludeTyConUnique 327+floatX16PrimTyConKey :: Unique+floatX16PrimTyConKey = mkPreludeTyConUnique 328+doubleX8PrimTyConKey :: Unique+doubleX8PrimTyConKey = mkPreludeTyConUnique 329
+ ghc-lib/stage1/lib/llvm-passes view
@@ -0,0 +1,5 @@+[+(0, "-mem2reg -globalopt"),+(1, "-O1 -globalopt"),+(2, "-O2")+]
+ ghc-lib/stage1/lib/llvm-targets view
@@ -0,0 +1,31 @@+[("i386-unknown-windows", ("e-m:x-p:32:32-i64:64-f80:32-n8:16:32-a:0:32-S32", "pentium4", ""))+,("i686-unknown-windows", ("e-m:x-p:32:32-i64:64-f80:32-n8:16:32-a:0:32-S32", "pentium4", ""))+,("x86_64-unknown-windows", ("e-m:w-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))+,("arm-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align"))+,("armv6-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm1136jf-s", "+strict-align"))+,("armv6l-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align"))+,("armv7-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", ""))+,("armv7a-unknown-linux-gnueabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", ""))+,("armv7l-unknown-linux-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", ""))+,("aarch64-unknown-linux-gnu", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon"))+,("aarch64-unknown-linux", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon"))+,("i386-unknown-linux-gnu", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", ""))+,("i386-unknown-linux", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", ""))+,("x86_64-unknown-linux-gnu", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))+,("x86_64-unknown-linux", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))+,("armv7-unknown-linux-androideabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", ""))+,("aarch64-unknown-linux-android", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon"))+,("powerpc64le-unknown-linux", ("e-m:e-i64:64-n32:64", "ppc64le", ""))+,("amd64-portbld-freebsd", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))+,("x86_64-unknown-freebsd", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))+,("arm-unknown-nto-qnx-eabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm7tdmi", "+strict-align"))+,("i386-apple-darwin", ("e-m:o-p:32:32-f64:32:64-f80:128-n8:16:32-S128", "yonah", ""))+,("x86_64-apple-darwin", ("e-m:o-i64:64-f80:128-n8:16:32:64-S128", "core2", ""))+,("armv7-apple-ios", ("e-m:o-p:32:32-f64:32:64-v64:32:64-v128:32:128-a:0:32-n32-S32", "generic", ""))+,("aarch64-apple-ios", ("e-m:o-i64:64-i128:128-n32:64-S128", "generic", "+neon"))+,("i386-apple-ios", ("e-m:o-p:32:32-f64:32:64-f80:128-n8:16:32-S128", "yonah", ""))+,("x86_64-apple-ios", ("e-m:o-i64:64-f80:128-n8:16:32:64-S128", "core2", ""))+,("aarch64-unknown-freebsd", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon"))+,("armv6-unknown-freebsd-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align"))+,("armv7-unknown-freebsd-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "+strict-align"))+]
+ ghc-lib/stage1/lib/platformConstants view
@@ -0,0 +1,134 @@+PlatformConstants {+    pc_platformConstants = ()+    , pc_CONTROL_GROUP_CONST_291 = 291+    , pc_STD_HDR_SIZE = 1+    , pc_PROF_HDR_SIZE = 2+    , pc_BLOCK_SIZE = 4096+    , pc_BLOCKS_PER_MBLOCK = 252+    , pc_TICKY_BIN_COUNT = 9+    , pc_OFFSET_StgRegTable_rR1 = 0+    , pc_OFFSET_StgRegTable_rR2 = 8+    , pc_OFFSET_StgRegTable_rR3 = 16+    , pc_OFFSET_StgRegTable_rR4 = 24+    , pc_OFFSET_StgRegTable_rR5 = 32+    , pc_OFFSET_StgRegTable_rR6 = 40+    , pc_OFFSET_StgRegTable_rR7 = 48+    , pc_OFFSET_StgRegTable_rR8 = 56+    , pc_OFFSET_StgRegTable_rR9 = 64+    , pc_OFFSET_StgRegTable_rR10 = 72+    , pc_OFFSET_StgRegTable_rF1 = 80+    , pc_OFFSET_StgRegTable_rF2 = 84+    , pc_OFFSET_StgRegTable_rF3 = 88+    , pc_OFFSET_StgRegTable_rF4 = 92+    , pc_OFFSET_StgRegTable_rF5 = 96+    , pc_OFFSET_StgRegTable_rF6 = 100+    , pc_OFFSET_StgRegTable_rD1 = 104+    , pc_OFFSET_StgRegTable_rD2 = 112+    , pc_OFFSET_StgRegTable_rD3 = 120+    , pc_OFFSET_StgRegTable_rD4 = 128+    , pc_OFFSET_StgRegTable_rD5 = 136+    , pc_OFFSET_StgRegTable_rD6 = 144+    , pc_OFFSET_StgRegTable_rXMM1 = 152+    , pc_OFFSET_StgRegTable_rXMM2 = 168+    , pc_OFFSET_StgRegTable_rXMM3 = 184+    , pc_OFFSET_StgRegTable_rXMM4 = 200+    , pc_OFFSET_StgRegTable_rXMM5 = 216+    , pc_OFFSET_StgRegTable_rXMM6 = 232+    , pc_OFFSET_StgRegTable_rYMM1 = 248+    , pc_OFFSET_StgRegTable_rYMM2 = 280+    , pc_OFFSET_StgRegTable_rYMM3 = 312+    , pc_OFFSET_StgRegTable_rYMM4 = 344+    , pc_OFFSET_StgRegTable_rYMM5 = 376+    , pc_OFFSET_StgRegTable_rYMM6 = 408+    , pc_OFFSET_StgRegTable_rZMM1 = 440+    , pc_OFFSET_StgRegTable_rZMM2 = 504+    , pc_OFFSET_StgRegTable_rZMM3 = 568+    , pc_OFFSET_StgRegTable_rZMM4 = 632+    , pc_OFFSET_StgRegTable_rZMM5 = 696+    , pc_OFFSET_StgRegTable_rZMM6 = 760+    , pc_OFFSET_StgRegTable_rL1 = 824+    , pc_OFFSET_StgRegTable_rSp = 832+    , pc_OFFSET_StgRegTable_rSpLim = 840+    , pc_OFFSET_StgRegTable_rHp = 848+    , pc_OFFSET_StgRegTable_rHpLim = 856+    , pc_OFFSET_StgRegTable_rCCCS = 864+    , pc_OFFSET_StgRegTable_rCurrentTSO = 872+    , pc_OFFSET_StgRegTable_rCurrentNursery = 888+    , pc_OFFSET_StgRegTable_rHpAlloc = 904+    , pc_OFFSET_stgEagerBlackholeInfo = -24+    , pc_OFFSET_stgGCEnter1 = -16+    , pc_OFFSET_stgGCFun = -8+    , pc_OFFSET_Capability_r = 24+    , pc_OFFSET_bdescr_start = 0+    , pc_OFFSET_bdescr_free = 8+    , pc_OFFSET_bdescr_blocks = 48+    , pc_OFFSET_bdescr_flags = 46+    , pc_SIZEOF_CostCentreStack = 96+    , pc_OFFSET_CostCentreStack_mem_alloc = 72+    , pc_REP_CostCentreStack_mem_alloc = 8+    , pc_OFFSET_CostCentreStack_scc_count = 48+    , pc_REP_CostCentreStack_scc_count = 8+    , pc_OFFSET_StgHeader_ccs = 8+    , pc_OFFSET_StgHeader_ldvw = 16+    , pc_SIZEOF_StgSMPThunkHeader = 8+    , pc_OFFSET_StgEntCounter_allocs = 48+    , pc_REP_StgEntCounter_allocs = 8+    , pc_OFFSET_StgEntCounter_allocd = 16+    , pc_REP_StgEntCounter_allocd = 8+    , pc_OFFSET_StgEntCounter_registeredp = 0+    , pc_OFFSET_StgEntCounter_link = 56+    , pc_OFFSET_StgEntCounter_entry_count = 40+    , pc_SIZEOF_StgUpdateFrame_NoHdr = 8+    , pc_SIZEOF_StgMutArrPtrs_NoHdr = 16+    , pc_OFFSET_StgMutArrPtrs_ptrs = 0+    , pc_OFFSET_StgMutArrPtrs_size = 8+    , pc_SIZEOF_StgSmallMutArrPtrs_NoHdr = 8+    , pc_OFFSET_StgSmallMutArrPtrs_ptrs = 0+    , pc_SIZEOF_StgArrBytes_NoHdr = 8+    , pc_OFFSET_StgArrBytes_bytes = 0+    , pc_OFFSET_StgTSO_alloc_limit = 96+    , pc_OFFSET_StgTSO_cccs = 112+    , pc_OFFSET_StgTSO_stackobj = 16+    , pc_OFFSET_StgStack_sp = 8+    , pc_OFFSET_StgStack_stack = 16+    , pc_OFFSET_StgUpdateFrame_updatee = 0+    , pc_OFFSET_StgFunInfoExtraFwd_arity = 4+    , pc_REP_StgFunInfoExtraFwd_arity = 4+    , pc_SIZEOF_StgFunInfoExtraRev = 24+    , pc_OFFSET_StgFunInfoExtraRev_arity = 20+    , pc_REP_StgFunInfoExtraRev_arity = 4+    , pc_MAX_SPEC_SELECTEE_SIZE = 15+    , pc_MAX_SPEC_AP_SIZE = 7+    , pc_MIN_PAYLOAD_SIZE = 1+    , pc_MIN_INTLIKE = -16+    , pc_MAX_INTLIKE = 16+    , pc_MIN_CHARLIKE = 0+    , pc_MAX_CHARLIKE = 255+    , pc_MUT_ARR_PTRS_CARD_BITS = 7+    , pc_MAX_Vanilla_REG = 10+    , pc_MAX_Float_REG = 6+    , pc_MAX_Double_REG = 6+    , pc_MAX_Long_REG = 1+    , pc_MAX_XMM_REG = 6+    , pc_MAX_Real_Vanilla_REG = 6+    , pc_MAX_Real_Float_REG = 6+    , pc_MAX_Real_Double_REG = 6+    , pc_MAX_Real_XMM_REG = 6+    , pc_MAX_Real_Long_REG = 0+    , pc_RESERVED_C_STACK_BYTES = 16384+    , pc_RESERVED_STACK_WORDS = 21+    , pc_AP_STACK_SPLIM = 1024+    , pc_WORD_SIZE = 8+    , pc_DOUBLE_SIZE = 8+    , pc_CINT_SIZE = 4+    , pc_CLONG_SIZE = 8+    , pc_CLONG_LONG_SIZE = 8+    , pc_BITMAP_BITS_SHIFT = 6+    , pc_TAG_BITS = 3+    , pc_WORDS_BIGENDIAN = False+    , pc_DYNAMIC_BY_DEFAULT = False+    , pc_LDV_SHIFT = 30+    , pc_ILDV_CREATE_MASK = 1152921503533105152+    , pc_ILDV_STATE_CREATE = 0+    , pc_ILDV_STATE_USE = 1152921504606846976+  }
+ ghc-lib/stage1/lib/settings view
@@ -0,0 +1,35 @@+[("GCC extra via C opts", " -fwrapv -fno-builtin"),+ ("C compiler command", "gcc"),+ ("C compiler flags", ""),+ ("C compiler link flags", " "),+ ("C compiler supports -no-pie", "NO"),+ ("Haskell CPP command","gcc"),+ ("Haskell CPP flags","-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs"),+ ("ld command", "ld"),+ ("ld flags", ""),+ ("ld supports compact unwind", "YES"),+ ("ld supports build-id", "NO"),+ ("ld supports filelist", "YES"),+ ("ld is GNU ld", "NO"),+ ("ar command", "ar"),+ ("ar flags", "qcls"),+ ("ar supports at file", "NO"),+ ("ranlib command", "ranlib"),+ ("touch command", "touch"),+ ("dllwrap command", "/bin/false"),+ ("windres command", "/bin/false"),+ ("libtool command", "libtool"),+ ("cross compiling", "NO"),+ ("target os", "OSDarwin"),+ ("target arch", "ArchX86_64"),+ ("target word size", "8"),+ ("target has GNU nonexec stack", "False"),+ ("target has .ident directive", "True"),+ ("target has subsections via symbols", "True"),+ ("target has RTS linker", "YES"),+ ("Unregisterised", "NO"),+ ("LLVM llc command", "llc"),+ ("LLVM opt command", "opt"),+ ("LLVM clang command", "clang")+ ]+
+ includes/Cmm.h view
@@ -0,0 +1,931 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The University of Glasgow 2004-2013+ *+ * This file is included at the top of all .cmm source files (and+ * *only* .cmm files).  It defines a collection of useful macros for+ * making .cmm code a bit less error-prone to write, and a bit easier+ * on the eye for the reader.+ *+ * For the syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.+ *+ * Accessing fields of structures defined in the RTS header files is+ * done via automatically-generated macros in DerivedConstants.h.  For+ * example, where previously we used+ *+ *          CurrentTSO->what_next = x+ *+ * in C-- we now use+ *+ *          StgTSO_what_next(CurrentTSO) = x+ *+ * where the StgTSO_what_next() macro is automatically generated by+ * mkDerivedConstants.c.  If you need to access a field that doesn't+ * already have a macro, edit that file (it's pretty self-explanatory).+ *+ * -------------------------------------------------------------------------- */++#pragma once++/*+ * In files that are included into both C and C-- (and perhaps+ * Haskell) sources, we sometimes need to conditionally compile bits+ * depending on the language.  CMINUSMINUS==1 in .cmm sources:+ */+#define CMINUSMINUS 1++#include "ghcconfig.h"++/* -----------------------------------------------------------------------------+   Types++   The following synonyms for C-- types are declared here:++     I8, I16, I32, I64    MachRep-style names for convenience++     W_                   is shorthand for the word type (== StgWord)+     F_                   shorthand for float  (F_ == StgFloat == C's float)+     D_                   shorthand for double (D_ == StgDouble == C's double)++     CInt                 has the same size as an int in C on this platform+     CLong                has the same size as a long in C on this platform+     CBool                has the same size as a bool in C on this platform++  --------------------------------------------------------------------------- */++#define I8  bits8+#define I16 bits16+#define I32 bits32+#define I64 bits64+#define P_  gcptr++#if SIZEOF_VOID_P == 4+#define W_ bits32+/* Maybe it's better to include MachDeps.h */+#define TAG_BITS                2+#elif SIZEOF_VOID_P == 8+#define W_ bits64+/* Maybe it's better to include MachDeps.h */+#define TAG_BITS                3+#else+#error Unknown word size+#endif++/*+ * The RTS must sometimes UNTAG a pointer before dereferencing it.+ * See the wiki page commentary/rts/haskell-execution/pointer-tagging+ */+#define TAG_MASK ((1 << TAG_BITS) - 1)+#define UNTAG(p) (p & ~TAG_MASK)+#define GETTAG(p) (p & TAG_MASK)++#if SIZEOF_INT == 4+#define CInt bits32+#elif SIZEOF_INT == 8+#define CInt bits64+#else+#error Unknown int size+#endif++#if SIZEOF_LONG == 4+#define CLong bits32+#elif SIZEOF_LONG == 8+#define CLong bits64+#else+#error Unknown long size+#endif++#define CBool bits8++#define F_   float32+#define D_   float64+#define L_   bits64+#define V16_ bits128+#define V32_ bits256+#define V64_ bits512++#define SIZEOF_StgDouble 8+#define SIZEOF_StgWord64 8++/* -----------------------------------------------------------------------------+   Misc useful stuff+   -------------------------------------------------------------------------- */++#define ccall foreign "C"++#define NULL (0::W_)++#define STRING(name,str)                        \+  section "rodata" {                            \+        name : bits8[] str;                     \+  }                                             \++#if defined(TABLES_NEXT_TO_CODE)+#define RET_LBL(f) f##_info+#else+#define RET_LBL(f) f##_ret+#endif++#if defined(TABLES_NEXT_TO_CODE)+#define ENTRY_LBL(f) f##_info+#else+#define ENTRY_LBL(f) f##_entry+#endif++/* -----------------------------------------------------------------------------+   Byte/word macros++   Everything in C-- is in byte offsets (well, most things).  We use+   some macros to allow us to express offsets in words and to try to+   avoid byte/word confusion.+   -------------------------------------------------------------------------- */++#define SIZEOF_W  SIZEOF_VOID_P+#define W_MASK    (SIZEOF_W-1)++#if SIZEOF_W == 4+#define W_SHIFT 2+#elif SIZEOF_W == 8+#define W_SHIFT 3+#endif++/* Converting quantities of words to bytes */+#define WDS(n) ((n)*SIZEOF_W)++/*+ * Converting quantities of bytes to words+ * NB. these work on *unsigned* values only+ */+#define BYTES_TO_WDS(n) ((n) / SIZEOF_W)+#define ROUNDUP_BYTES_TO_WDS(n) (((n) + SIZEOF_W - 1) / SIZEOF_W)++/* TO_W_(n) converts n to W_ type from a smaller type */+#if SIZEOF_W == 4+#define TO_I64(x) %sx64(x)+#define TO_W_(x) %sx32(x)+#define HALF_W_(x) %lobits16(x)+#elif SIZEOF_W == 8+#define TO_I64(x) (x)+#define TO_W_(x) %sx64(x)+#define HALF_W_(x) %lobits32(x)+#endif++#if SIZEOF_INT == 4 && SIZEOF_W == 8+#define W_TO_INT(x) %lobits32(x)+#elif SIZEOF_INT == SIZEOF_W+#define W_TO_INT(x) (x)+#endif++#if SIZEOF_LONG == 4 && SIZEOF_W == 8+#define W_TO_LONG(x) %lobits32(x)+#elif SIZEOF_LONG == SIZEOF_W+#define W_TO_LONG(x) (x)+#endif++/* -----------------------------------------------------------------------------+   Atomic memory operations.+   -------------------------------------------------------------------------- */++#if SIZEOF_W == 4+#define cmpxchgW cmpxchg32+#elif SIZEOF_W == 8+#define cmpxchgW cmpxchg64+#endif++/* -----------------------------------------------------------------------------+   Heap/stack access, and adjusting the heap/stack pointers.+   -------------------------------------------------------------------------- */++#define Sp(n)  W_[Sp + WDS(n)]+#define Hp(n)  W_[Hp + WDS(n)]++#define Sp_adj(n) Sp = Sp + WDS(n)  /* pronounced "spadge" */+#define Hp_adj(n) Hp = Hp + WDS(n)++/* -----------------------------------------------------------------------------+   Assertions and Debuggery+   -------------------------------------------------------------------------- */++#if defined(DEBUG)+#define ASSERT(predicate)                       \+        if (predicate) {                        \+            /*null*/;                           \+        } else {                                \+            foreign "C" _assertFail(__FILE__, __LINE__) never returns; \+        }+#else+#define ASSERT(p) /* nothing */+#endif++#if defined(DEBUG)+#define DEBUG_ONLY(s) s+#else+#define DEBUG_ONLY(s) /* nothing */+#endif++/*+ * The IF_DEBUG macro is useful for debug messages that depend on one+ * of the RTS debug options.  For example:+ *+ *   IF_DEBUG(RtsFlags_DebugFlags_apply,+ *      foreign "C" fprintf(stderr, stg_ap_0_ret_str));+ *+ * Note the syntax is slightly different to the C version of this macro.+ */+#if defined(DEBUG)+#define IF_DEBUG(c,s)  if (RtsFlags_DebugFlags_##c(RtsFlags) != 0::CBool) { s; }+#else+#define IF_DEBUG(c,s)  /* nothing */+#endif++/* -----------------------------------------------------------------------------+   Entering++   It isn't safe to "enter" every closure.  Functions in particular+   have no entry code as such; their entry point contains the code to+   apply the function.++   ToDo: range should end in N_CLOSURE_TYPES-1, not N_CLOSURE_TYPES,+   but switch doesn't allow us to use exprs there yet.++   If R1 points to a tagged object it points either to+   * A constructor.+   * A function with arity <= TAG_MASK.+   In both cases the right thing to do is to return.+   Note: it is rather lucky that we can use the tag bits to do this+         for both objects. Maybe it points to a brittle design?++   Indirections can contain tagged pointers, so their tag is checked.+   -------------------------------------------------------------------------- */++#if defined(PROFILING)++// When profiling, we cannot shortcut ENTER() by checking the tag,+// because LDV profiling relies on entering closures to mark them as+// "used".++#define LOAD_INFO(ret,x)                        \+    info = %INFO_PTR(UNTAG(x));++#define UNTAG_IF_PROF(x) UNTAG(x)++#else++#define LOAD_INFO(ret,x)                        \+  if (GETTAG(x) != 0) {                         \+      ret(x);                                   \+  }                                             \+  info = %INFO_PTR(x);++#define UNTAG_IF_PROF(x) (x) /* already untagged */++#endif++// We need two versions of ENTER():+//  - ENTER(x) takes the closure as an argument and uses return(),+//    for use in civilized code where the stack is handled by GHC+//+//  - ENTER_NOSTACK() where the closure is in R1, and returns are+//    explicit jumps, for use when we are doing the stack management+//    ourselves.++#if defined(PROFILING)+// See Note [Evaluating functions with profiling] in rts/Apply.cmm+#define ENTER(x) jump stg_ap_0_fast(x);+#else+#define ENTER(x) ENTER_(return,x)+#endif++#define ENTER_R1() ENTER_(RET_R1,R1)++#define RET_R1(x) jump %ENTRY_CODE(Sp(0)) [R1]++#define ENTER_(ret,x)                                   \+ again:                                                 \+  W_ info;                                              \+  LOAD_INFO(ret,x)                                       \+  switch [INVALID_OBJECT .. N_CLOSURE_TYPES]            \+         (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) {       \+  case                                                  \+    IND,                                                \+    IND_STATIC:                                         \+   {                                                    \+      x = StgInd_indirectee(x);                         \+      goto again;                                       \+   }                                                    \+  case                                                  \+    FUN,                                                \+    FUN_1_0,                                            \+    FUN_0_1,                                            \+    FUN_2_0,                                            \+    FUN_1_1,                                            \+    FUN_0_2,                                            \+    FUN_STATIC,                                         \+    BCO,                                                \+    PAP:                                                \+   {                                                    \+       ret(x);                                          \+   }                                                    \+  default:                                              \+   {                                                    \+       x = UNTAG_IF_PROF(x);                            \+       jump %ENTRY_CODE(info) (x);                      \+   }                                                    \+  }++// The FUN cases almost never happen: a pointer to a non-static FUN+// should always be tagged.  This unfortunately isn't true for the+// interpreter right now, which leaves untagged FUNs on the stack.++/* -----------------------------------------------------------------------------+   Constants.+   -------------------------------------------------------------------------- */++#include "rts/Constants.h"+#include "DerivedConstants.h"+#include "rts/storage/ClosureTypes.h"+#include "rts/storage/FunTypes.h"+#include "rts/OSThreads.h"++/*+ * Need MachRegs, because some of the RTS code is conditionally+ * compiled based on REG_R1, REG_R2, etc.+ */+#include "stg/RtsMachRegs.h"++#include "rts/prof/LDV.h"++#undef BLOCK_SIZE+#undef MBLOCK_SIZE+#include "rts/storage/Block.h"  /* For Bdescr() */+++#define MyCapability()  (BaseReg - OFFSET_Capability_r)++/* -------------------------------------------------------------------------+   Info tables+   ------------------------------------------------------------------------- */++#if defined(PROFILING)+#define PROF_HDR_FIELDS(w_,hdr1,hdr2)          \+  w_ hdr1,                                     \+  w_ hdr2,+#else+#define PROF_HDR_FIELDS(w_,hdr1,hdr2) /* nothing */+#endif++/* -------------------------------------------------------------------------+   Allocation and garbage collection+   ------------------------------------------------------------------------- */++/*+ * ALLOC_PRIM is for allocating memory on the heap for a primitive+ * object.  It is used all over PrimOps.cmm.+ *+ * We make the simplifying assumption that the "admin" part of a+ * primitive closure is just the header when calculating sizes for+ * ticky-ticky.  It's not clear whether eg. the size field of an array+ * should be counted as "admin", or the various fields of a BCO.+ */+#define ALLOC_PRIM(bytes)                                       \+   HP_CHK_GEN_TICKY(bytes);                                     \+   TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0);  \+   CCCS_ALLOC(bytes);++#define HEAP_CHECK(bytes,failure)                       \+    TICK_BUMP(HEAP_CHK_ctr);                            \+    Hp = Hp + (bytes);                                  \+    if (Hp > HpLim) { HpAlloc = (bytes); failure; }     \+    TICK_ALLOC_HEAP_NOCTR(bytes);++#define ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,failure)           \+    HEAP_CHECK(bytes,failure)                                   \+    TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0); \+    CCCS_ALLOC(bytes);++#define ALLOC_PRIM_(bytes,fun)                                  \+    ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM(fun));++#define ALLOC_PRIM_P(bytes,fun,arg)                             \+    ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM_P(fun,arg));++#define ALLOC_PRIM_N(bytes,fun,arg)                             \+    ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM_N(fun,arg));++/* CCS_ALLOC wants the size in words, because ccs->mem_alloc is in words */+#define CCCS_ALLOC(__alloc) CCS_ALLOC(BYTES_TO_WDS(__alloc), CCCS)++#define HP_CHK_GEN_TICKY(bytes)                 \+   HP_CHK_GEN(bytes);                           \+   TICK_ALLOC_HEAP_NOCTR(bytes);++#define HP_CHK_P(bytes, fun, arg)               \+   HEAP_CHECK(bytes, GC_PRIM_P(fun,arg))++// TODO I'm not seeing where ALLOC_P_TICKY is used; can it be removed?+//         -NSF March 2013+#define ALLOC_P_TICKY(bytes, fun, arg)          \+   HP_CHK_P(bytes);                             \+   TICK_ALLOC_HEAP_NOCTR(bytes);++#define CHECK_GC()                                                      \+  (bdescr_link(CurrentNursery) == NULL ||                               \+   generation_n_new_large_words(W_[g0]) >= TO_W_(CLong[large_alloc_lim]))++// allocate() allocates from the nursery, so we check to see+// whether the nursery is nearly empty in any function that uses+// allocate() - this includes many of the primops.+//+// HACK alert: the __L__ stuff is here to coax the common-block+// eliminator into commoning up the call stg_gc_noregs() with the same+// code that gets generated by a STK_CHK_GEN() in the same proc.  We+// also need an if (0) { goto __L__; } so that the __L__ label isn't+// optimised away by the control-flow optimiser prior to common-block+// elimination (it will be optimised away later).+//+// This saves some code in gmp-wrappers.cmm where we have lots of+// MAYBE_GC() in the same proc as STK_CHK_GEN().+//+#define MAYBE_GC(retry)                         \+    if (CHECK_GC()) {                           \+        HpAlloc = 0;                            \+        goto __L__;                             \+  __L__:                                        \+        call stg_gc_noregs();                   \+        goto retry;                             \+   }                                            \+   if (0) { goto __L__; }++#define GC_PRIM(fun)                            \+        jump stg_gc_prim(fun);++// Version of GC_PRIM for use in low-level Cmm.  We can call+// stg_gc_prim, because it takes one argument and therefore has a+// platform-independent calling convention (Note [Syntax of .cmm+// files] in CmmParse.y).+#define GC_PRIM_LL(fun)                         \+        R1 = fun;                               \+        jump stg_gc_prim [R1];++// We pass the fun as the second argument, because the arg is+// usually already in the first argument position (R1), so this+// avoids moving it to a different register / stack slot.+#define GC_PRIM_N(fun,arg)                      \+        jump stg_gc_prim_n(arg,fun);++#define GC_PRIM_P(fun,arg)                      \+        jump stg_gc_prim_p(arg,fun);++#define GC_PRIM_P_LL(fun,arg)                   \+        R1 = arg;                               \+        R2 = fun;                               \+        jump stg_gc_prim_p_ll [R1,R2];++#define GC_PRIM_PP(fun,arg1,arg2)               \+        jump stg_gc_prim_pp(arg1,arg2,fun);++#define MAYBE_GC_(fun)                          \+    if (CHECK_GC()) {                           \+        HpAlloc = 0;                            \+        GC_PRIM(fun)                            \+   }++#define MAYBE_GC_N(fun,arg)                     \+    if (CHECK_GC()) {                           \+        HpAlloc = 0;                            \+        GC_PRIM_N(fun,arg)                      \+   }++#define MAYBE_GC_P(fun,arg)                     \+    if (CHECK_GC()) {                           \+        HpAlloc = 0;                            \+        GC_PRIM_P(fun,arg)                      \+   }++#define MAYBE_GC_PP(fun,arg1,arg2)              \+    if (CHECK_GC()) {                           \+        HpAlloc = 0;                            \+        GC_PRIM_PP(fun,arg1,arg2)               \+   }++#define STK_CHK_LL(n, fun)                      \+    TICK_BUMP(STK_CHK_ctr);                     \+    if (Sp - (n) < SpLim) {                     \+        GC_PRIM_LL(fun)                         \+    }++#define STK_CHK_P_LL(n, fun, arg)               \+    TICK_BUMP(STK_CHK_ctr);                     \+    if (Sp - (n) < SpLim) {                     \+        GC_PRIM_P_LL(fun,arg)                   \+    }++#define STK_CHK_PP(n, fun, arg1, arg2)          \+    TICK_BUMP(STK_CHK_ctr);                     \+    if (Sp - (n) < SpLim) {                     \+        GC_PRIM_PP(fun,arg1,arg2)               \+    }++#define STK_CHK_ENTER(n, closure)               \+    TICK_BUMP(STK_CHK_ctr);                     \+    if (Sp - (n) < SpLim) {                     \+        jump __stg_gc_enter_1(closure);         \+    }++// A funky heap check used by AutoApply.cmm++#define HP_CHK_NP_ASSIGN_SP0(size,f)                    \+    HEAP_CHECK(size, Sp(0) = f; jump __stg_gc_enter_1 [R1];)++/* -----------------------------------------------------------------------------+   Closure headers+   -------------------------------------------------------------------------- */++/*+ * This is really ugly, since we don't do the rest of StgHeader this+ * way.  The problem is that values from DerivedConstants.h cannot be+ * dependent on the way (SMP, PROF etc.).  For SIZEOF_StgHeader we get+ * the value from GHC, but it seems like too much trouble to do that+ * for StgThunkHeader.+ */+#define SIZEOF_StgThunkHeader SIZEOF_StgHeader+SIZEOF_StgSMPThunkHeader++#define StgThunk_payload(__ptr__,__ix__) \+    W_[__ptr__+SIZEOF_StgThunkHeader+ WDS(__ix__)]++/* -----------------------------------------------------------------------------+   Closures+   -------------------------------------------------------------------------- */++/* The offset of the payload of an array */+#define BYTE_ARR_CTS(arr)  ((arr) + SIZEOF_StgArrBytes)++/* The number of words allocated in an array payload */+#define BYTE_ARR_WDS(arr) ROUNDUP_BYTES_TO_WDS(StgArrBytes_bytes(arr))++/* Getting/setting the info pointer of a closure */+#define SET_INFO(p,info) StgHeader_info(p) = info+#define GET_INFO(p) StgHeader_info(p)++/* Determine the size of an ordinary closure from its info table */+#define sizeW_fromITBL(itbl) \+  SIZEOF_StgHeader + WDS(%INFO_PTRS(itbl)) + WDS(%INFO_NPTRS(itbl))++/* NB. duplicated from InfoTables.h! */+#define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK)+#define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT)++/* Debugging macros */+#define LOOKS_LIKE_INFO_PTR(p)                                  \+   ((p) != NULL &&                                              \+    LOOKS_LIKE_INFO_PTR_NOT_NULL(p))++#define LOOKS_LIKE_INFO_PTR_NOT_NULL(p)                         \+   ( (TO_W_(%INFO_TYPE(%STD_INFO(p))) != INVALID_OBJECT) &&     \+     (TO_W_(%INFO_TYPE(%STD_INFO(p))) <  N_CLOSURE_TYPES))++#define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p))))++/*+ * The layout of the StgFunInfoExtra part of an info table changes+ * depending on TABLES_NEXT_TO_CODE.  So we define field access+ * macros which use the appropriate version here:+ */+#if defined(TABLES_NEXT_TO_CODE)+/*+ * when TABLES_NEXT_TO_CODE, slow_apply is stored as an offset+ * instead of the normal pointer.+ */++#define StgFunInfoExtra_slow_apply(fun_info)    \+        (TO_W_(StgFunInfoExtraRev_slow_apply_offset(fun_info))    \+               + (fun_info) + SIZEOF_StgFunInfoExtraRev + SIZEOF_StgInfoTable)++#define StgFunInfoExtra_fun_type(i)   StgFunInfoExtraRev_fun_type(i)+#define StgFunInfoExtra_arity(i)      StgFunInfoExtraRev_arity(i)+#define StgFunInfoExtra_bitmap(i)     StgFunInfoExtraRev_bitmap(i)+#else+#define StgFunInfoExtra_slow_apply(i) StgFunInfoExtraFwd_slow_apply(i)+#define StgFunInfoExtra_fun_type(i)   StgFunInfoExtraFwd_fun_type(i)+#define StgFunInfoExtra_arity(i)      StgFunInfoExtraFwd_arity(i)+#define StgFunInfoExtra_bitmap(i)     StgFunInfoExtraFwd_bitmap(i)+#endif++#define mutArrCardMask ((1 << MUT_ARR_PTRS_CARD_BITS) - 1)+#define mutArrPtrCardDown(i) ((i) >> MUT_ARR_PTRS_CARD_BITS)+#define mutArrPtrCardUp(i)   (((i) + mutArrCardMask) >> MUT_ARR_PTRS_CARD_BITS)+#define mutArrPtrsCardWords(n) ROUNDUP_BYTES_TO_WDS(mutArrPtrCardUp(n))++#if defined(PROFILING) || (!defined(THREADED_RTS) && defined(DEBUG))+#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" overwritingClosureSize(c "ptr", size)+#define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr")+#define OVERWRITING_CLOSURE_OFS(c,n) foreign "C" overwritingClosureOfs(c "ptr", n)+#else+#define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */+#define OVERWRITING_CLOSURE(c) /* nothing */+#define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */+#endif++#if defined(THREADED_RTS)+#define prim_write_barrier prim %write_barrier()+#else+#define prim_write_barrier /* nothing */+#endif++/* -----------------------------------------------------------------------------+   Ticky macros+   -------------------------------------------------------------------------- */++#if defined(TICKY_TICKY)+#define TICK_BUMP_BY(ctr,n) CLong[ctr] = CLong[ctr] + n+#else+#define TICK_BUMP_BY(ctr,n) /* nothing */+#endif++#define TICK_BUMP(ctr)      TICK_BUMP_BY(ctr,1)++#define TICK_ENT_DYN_IND()              TICK_BUMP(ENT_DYN_IND_ctr)+#define TICK_ENT_DYN_THK()              TICK_BUMP(ENT_DYN_THK_ctr)+#define TICK_ENT_VIA_NODE()             TICK_BUMP(ENT_VIA_NODE_ctr)+#define TICK_ENT_STATIC_IND()           TICK_BUMP(ENT_STATIC_IND_ctr)+#define TICK_ENT_PERM_IND()             TICK_BUMP(ENT_PERM_IND_ctr)+#define TICK_ENT_PAP()                  TICK_BUMP(ENT_PAP_ctr)+#define TICK_ENT_AP()                   TICK_BUMP(ENT_AP_ctr)+#define TICK_ENT_AP_STACK()             TICK_BUMP(ENT_AP_STACK_ctr)+#define TICK_ENT_BH()                   TICK_BUMP(ENT_BH_ctr)+#define TICK_ENT_LNE()                  TICK_BUMP(ENT_LNE_ctr)+#define TICK_UNKNOWN_CALL()             TICK_BUMP(UNKNOWN_CALL_ctr)+#define TICK_UPDF_PUSHED()              TICK_BUMP(UPDF_PUSHED_ctr)+#define TICK_CATCHF_PUSHED()            TICK_BUMP(CATCHF_PUSHED_ctr)+#define TICK_UPDF_OMITTED()             TICK_BUMP(UPDF_OMITTED_ctr)+#define TICK_UPD_NEW_IND()              TICK_BUMP(UPD_NEW_IND_ctr)+#define TICK_UPD_NEW_PERM_IND()         TICK_BUMP(UPD_NEW_PERM_IND_ctr)+#define TICK_UPD_OLD_IND()              TICK_BUMP(UPD_OLD_IND_ctr)+#define TICK_UPD_OLD_PERM_IND()         TICK_BUMP(UPD_OLD_PERM_IND_ctr)++#define TICK_SLOW_CALL_FUN_TOO_FEW()    TICK_BUMP(SLOW_CALL_FUN_TOO_FEW_ctr)+#define TICK_SLOW_CALL_FUN_CORRECT()    TICK_BUMP(SLOW_CALL_FUN_CORRECT_ctr)+#define TICK_SLOW_CALL_FUN_TOO_MANY()   TICK_BUMP(SLOW_CALL_FUN_TOO_MANY_ctr)+#define TICK_SLOW_CALL_PAP_TOO_FEW()    TICK_BUMP(SLOW_CALL_PAP_TOO_FEW_ctr)+#define TICK_SLOW_CALL_PAP_CORRECT()    TICK_BUMP(SLOW_CALL_PAP_CORRECT_ctr)+#define TICK_SLOW_CALL_PAP_TOO_MANY()   TICK_BUMP(SLOW_CALL_PAP_TOO_MANY_ctr)++#define TICK_SLOW_CALL_fast_v16()       TICK_BUMP(SLOW_CALL_fast_v16_ctr)+#define TICK_SLOW_CALL_fast_v()         TICK_BUMP(SLOW_CALL_fast_v_ctr)+#define TICK_SLOW_CALL_fast_p()         TICK_BUMP(SLOW_CALL_fast_p_ctr)+#define TICK_SLOW_CALL_fast_pv()        TICK_BUMP(SLOW_CALL_fast_pv_ctr)+#define TICK_SLOW_CALL_fast_pp()        TICK_BUMP(SLOW_CALL_fast_pp_ctr)+#define TICK_SLOW_CALL_fast_ppv()       TICK_BUMP(SLOW_CALL_fast_ppv_ctr)+#define TICK_SLOW_CALL_fast_ppp()       TICK_BUMP(SLOW_CALL_fast_ppp_ctr)+#define TICK_SLOW_CALL_fast_pppv()      TICK_BUMP(SLOW_CALL_fast_pppv_ctr)+#define TICK_SLOW_CALL_fast_pppp()      TICK_BUMP(SLOW_CALL_fast_pppp_ctr)+#define TICK_SLOW_CALL_fast_ppppp()     TICK_BUMP(SLOW_CALL_fast_ppppp_ctr)+#define TICK_SLOW_CALL_fast_pppppp()    TICK_BUMP(SLOW_CALL_fast_pppppp_ctr)+#define TICK_VERY_SLOW_CALL()           TICK_BUMP(VERY_SLOW_CALL_ctr)++/* NOTE: TICK_HISTO_BY and TICK_HISTO+   currently have no effect.+   The old code for it didn't typecheck and I+   just commented it out to get ticky to work.+   - krc 1/2007 */++#define TICK_HISTO_BY(histo,n,i) /* nothing */++#define TICK_HISTO(histo,n) TICK_HISTO_BY(histo,n,1)++/* An unboxed tuple with n components. */+#define TICK_RET_UNBOXED_TUP(n)                 \+  TICK_BUMP(RET_UNBOXED_TUP_ctr++);             \+  TICK_HISTO(RET_UNBOXED_TUP,n)++/*+ * A slow call with n arguments.  In the unevald case, this call has+ * already been counted once, so don't count it again.+ */+#define TICK_SLOW_CALL(n)                       \+  TICK_BUMP(SLOW_CALL_ctr);                     \+  TICK_HISTO(SLOW_CALL,n)++/*+ * This slow call was found to be to an unevaluated function; undo the+ * ticks we did in TICK_SLOW_CALL.+ */+#define TICK_SLOW_CALL_UNEVALD(n)               \+  TICK_BUMP(SLOW_CALL_UNEVALD_ctr);             \+  TICK_BUMP_BY(SLOW_CALL_ctr,-1);               \+  TICK_HISTO_BY(SLOW_CALL,n,-1);++/* Updating a closure with a new CON */+#define TICK_UPD_CON_IN_NEW(n)                  \+  TICK_BUMP(UPD_CON_IN_NEW_ctr);                \+  TICK_HISTO(UPD_CON_IN_NEW,n)++#define TICK_ALLOC_HEAP_NOCTR(bytes)            \+    TICK_BUMP(ALLOC_RTS_ctr);                   \+    TICK_BUMP_BY(ALLOC_RTS_tot,bytes)++/* -----------------------------------------------------------------------------+   Saving and restoring STG registers++   STG registers must be saved around a C call, just in case the STG+   register is mapped to a caller-saves machine register.  Normally we+   don't need to worry about this the code generator has already+   loaded any live STG registers into variables for us, but in+   hand-written low-level Cmm code where we don't know which registers+   are live, we might have to save them all.+   -------------------------------------------------------------------------- */++#define SAVE_STGREGS                            \+    W_ r1, r2, r3,  r4,  r5,  r6,  r7,  r8;     \+    F_ f1, f2, f3, f4, f5, f6;                  \+    D_ d1, d2, d3, d4, d5, d6;                  \+    L_ l1;                                      \+                                                \+    r1 = R1;                                    \+    r2 = R2;                                    \+    r3 = R3;                                    \+    r4 = R4;                                    \+    r5 = R5;                                    \+    r6 = R6;                                    \+    r7 = R7;                                    \+    r8 = R8;                                    \+                                                \+    f1 = F1;                                    \+    f2 = F2;                                    \+    f3 = F3;                                    \+    f4 = F4;                                    \+    f5 = F5;                                    \+    f6 = F6;                                    \+                                                \+    d1 = D1;                                    \+    d2 = D2;                                    \+    d3 = D3;                                    \+    d4 = D4;                                    \+    d5 = D5;                                    \+    d6 = D6;                                    \+                                                \+    l1 = L1;+++#define RESTORE_STGREGS                         \+    R1 = r1;                                    \+    R2 = r2;                                    \+    R3 = r3;                                    \+    R4 = r4;                                    \+    R5 = r5;                                    \+    R6 = r6;                                    \+    R7 = r7;                                    \+    R8 = r8;                                    \+                                                \+    F1 = f1;                                    \+    F2 = f2;                                    \+    F3 = f3;                                    \+    F4 = f4;                                    \+    F5 = f5;                                    \+    F6 = f6;                                    \+                                                \+    D1 = d1;                                    \+    D2 = d2;                                    \+    D3 = d3;                                    \+    D4 = d4;                                    \+    D5 = d5;                                    \+    D6 = d6;                                    \+                                                \+    L1 = l1;++/* -----------------------------------------------------------------------------+   Misc junk+   -------------------------------------------------------------------------- */++#define NO_TREC                   stg_NO_TREC_closure+#define END_TSO_QUEUE             stg_END_TSO_QUEUE_closure+#define STM_AWOKEN                stg_STM_AWOKEN_closure++#define recordMutableCap(p, gen)                                        \+  W_ __bd;                                                              \+  W_ mut_list;                                                          \+  mut_list = Capability_mut_lists(MyCapability()) + WDS(gen);           \+ __bd = W_[mut_list];                                                   \+  if (bdescr_free(__bd) >= bdescr_start(__bd) + BLOCK_SIZE) {           \+      W_ __new_bd;                                                      \+      ("ptr" __new_bd) = foreign "C" allocBlock_lock();                 \+      bdescr_link(__new_bd) = __bd;                                     \+      __bd = __new_bd;                                                  \+      W_[mut_list] = __bd;                                              \+  }                                                                     \+  W_ free;                                                              \+  free = bdescr_free(__bd);                                             \+  W_[free] = p;                                                         \+  bdescr_free(__bd) = free + WDS(1);++#define recordMutable(p)                                        \+      P_ __p;                                                   \+      W_ __bd;                                                  \+      W_ __gen;                                                 \+      __p = p;                                                  \+      __bd = Bdescr(__p);                                       \+      __gen = TO_W_(bdescr_gen_no(__bd));                       \+      if (__gen > 0) { recordMutableCap(__p, __gen); }++/* -----------------------------------------------------------------------------+   Arrays+   -------------------------------------------------------------------------- */++/* Complete function body for the clone family of (mutable) array ops.+   Defined as a macro to avoid function call overhead or code+   duplication. */+#define cloneArray(info, src, offset, n)                       \+    W_ words, size;                                            \+    gcptr dst, dst_p, src_p;                                   \+                                                               \+    again: MAYBE_GC(again);                                    \+                                                               \+    size = n + mutArrPtrsCardWords(n);                         \+    words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + size;         \+    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); \+    TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0);       \+                                                               \+    SET_HDR(dst, info, CCCS);                                  \+    StgMutArrPtrs_ptrs(dst) = n;                               \+    StgMutArrPtrs_size(dst) = size;                            \+                                                               \+    dst_p = dst + SIZEOF_StgMutArrPtrs;                        \+    src_p = src + SIZEOF_StgMutArrPtrs + WDS(offset);          \+    prim %memcpy(dst_p, src_p, n * SIZEOF_W, SIZEOF_W);        \+                                                               \+    return (dst);++#define copyArray(src, src_off, dst, dst_off, n)                  \+  W_ dst_elems_p, dst_p, src_p, dst_cards_p, bytes;               \+                                                                  \+    if ((n) != 0) {                                               \+        SET_HDR(dst, stg_MUT_ARR_PTRS_DIRTY_info, CCCS);          \+                                                                  \+        dst_elems_p = (dst) + SIZEOF_StgMutArrPtrs;               \+        dst_p = dst_elems_p + WDS(dst_off);                       \+        src_p = (src) + SIZEOF_StgMutArrPtrs + WDS(src_off);      \+        bytes = WDS(n);                                           \+                                                                  \+        prim %memcpy(dst_p, src_p, bytes, SIZEOF_W);              \+                                                                  \+        dst_cards_p = dst_elems_p + WDS(StgMutArrPtrs_ptrs(dst)); \+        setCards(dst_cards_p, dst_off, n);                        \+    }                                                             \+                                                                  \+    return ();++#define copyMutableArray(src, src_off, dst, dst_off, n)           \+  W_ dst_elems_p, dst_p, src_p, dst_cards_p, bytes;               \+                                                                  \+    if ((n) != 0) {                                               \+        SET_HDR(dst, stg_MUT_ARR_PTRS_DIRTY_info, CCCS);          \+                                                                  \+        dst_elems_p = (dst) + SIZEOF_StgMutArrPtrs;               \+        dst_p = dst_elems_p + WDS(dst_off);                       \+        src_p = (src) + SIZEOF_StgMutArrPtrs + WDS(src_off);      \+        bytes = WDS(n);                                           \+                                                                  \+        if ((src) == (dst)) {                                     \+            prim %memmove(dst_p, src_p, bytes, SIZEOF_W);         \+        } else {                                                  \+            prim %memcpy(dst_p, src_p, bytes, SIZEOF_W);          \+        }                                                         \+                                                                  \+        dst_cards_p = dst_elems_p + WDS(StgMutArrPtrs_ptrs(dst)); \+        setCards(dst_cards_p, dst_off, n);                        \+    }                                                             \+                                                                  \+    return ();++/*+ * Set the cards in the cards table pointed to by dst_cards_p for an+ * update to n elements, starting at element dst_off.+ */+#define setCards(dst_cards_p, dst_off, n)                      \+    W_ __start_card, __end_card, __cards;                      \+    __start_card = mutArrPtrCardDown(dst_off);                 \+    __end_card = mutArrPtrCardDown((dst_off) + (n) - 1);       \+    __cards = __end_card - __start_card + 1;                   \+    prim %memset((dst_cards_p) + __start_card, 1, __cards, 1);++/* Complete function body for the clone family of small (mutable)+   array ops. Defined as a macro to avoid function call overhead or+   code duplication. */+#define cloneSmallArray(info, src, offset, n)                  \+    W_ words, size;                                            \+    gcptr dst, dst_p, src_p;                                   \+                                                               \+    again: MAYBE_GC(again);                                    \+                                                               \+    words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + n;       \+    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); \+    TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(n), 0);     \+                                                               \+    SET_HDR(dst, info, CCCS);                                  \+    StgSmallMutArrPtrs_ptrs(dst) = n;                          \+                                                               \+    dst_p = dst + SIZEOF_StgSmallMutArrPtrs;                   \+    src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(offset);     \+    prim %memcpy(dst_p, src_p, n * SIZEOF_W, SIZEOF_W);        \+                                                               \+    return (dst);
+ includes/CodeGen.Platform.hs view
@@ -0,0 +1,1069 @@++import CmmExpr+#if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \+    || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc))+import Panic+#endif+import Reg++#include "ghcautoconf.h"+#include "stg/MachRegs.h"++#if defined(MACHREGS_i386) || defined(MACHREGS_x86_64)++# if defined(MACHREGS_i386)+#  define eax 0+#  define ebx 1+#  define ecx 2+#  define edx 3+#  define esi 4+#  define edi 5+#  define ebp 6+#  define esp 7+# endif++# if defined(MACHREGS_x86_64)+#  define rax   0+#  define rbx   1+#  define rcx   2+#  define rdx   3+#  define rsi   4+#  define rdi   5+#  define rbp   6+#  define rsp   7+#  define r8    8+#  define r9    9+#  define r10   10+#  define r11   11+#  define r12   12+#  define r13   13+#  define r14   14+#  define r15   15+# endif++# define fake0 16+# define fake1 17+# define fake2 18+# define fake3 19+# define fake4 20+# define fake5 21++-- N.B. XMM, YMM, and ZMM are all aliased to the same hardware registers hence+-- being assigned the same RegNos.+# define xmm0  24+# define xmm1  25+# define xmm2  26+# define xmm3  27+# define xmm4  28+# define xmm5  29+# define xmm6  30+# define xmm7  31+# define xmm8  32+# define xmm9  33+# define xmm10 34+# define xmm11 35+# define xmm12 36+# define xmm13 37+# define xmm14 38+# define xmm15 39++# define ymm0  24+# define ymm1  25+# define ymm2  26+# define ymm3  27+# define ymm4  28+# define ymm5  29+# define ymm6  30+# define ymm7  31+# define ymm8  32+# define ymm9  33+# define ymm10 34+# define ymm11 35+# define ymm12 36+# define ymm13 37+# define ymm14 38+# define ymm15 39++# define zmm0  24+# define zmm1  25+# define zmm2  26+# define zmm3  27+# define zmm4  28+# define zmm5  29+# define zmm6  30+# define zmm7  31+# define zmm8  32+# define zmm9  33+# define zmm10 34+# define zmm11 35+# define zmm12 36+# define zmm13 37+# define zmm14 38+# define zmm15 39++-- Note: these are only needed for ARM/ARM64 because globalRegMaybe is now used in CmmSink.hs.+-- Since it's only used to check 'isJust', the actual values don't matter, thus+-- I'm not sure if these are the correct numberings.+-- Normally, the register names are just stringified as part of the REG() macro++#elif defined(MACHREGS_powerpc) || defined(MACHREGS_arm) \+    || defined(MACHREGS_aarch64)++# define r0 0+# define r1 1+# define r2 2+# define r3 3+# define r4 4+# define r5 5+# define r6 6+# define r7 7+# define r8 8+# define r9 9+# define r10 10+# define r11 11+# define r12 12+# define r13 13+# define r14 14+# define r15 15+# define r16 16+# define r17 17+# define r18 18+# define r19 19+# define r20 20+# define r21 21+# define r22 22+# define r23 23+# define r24 24+# define r25 25+# define r26 26+# define r27 27+# define r28 28+# define r29 29+# define r30 30+# define r31 31++-- See note above. These aren't actually used for anything except satisfying the compiler for globalRegMaybe+-- so I'm unsure if they're the correct numberings, should they ever be attempted to be used in the NCG.+#if defined(MACHREGS_aarch64) || defined(MACHREGS_arm)+# define s0 32+# define s1 33+# define s2 34+# define s3 35+# define s4 36+# define s5 37+# define s6 38+# define s7 39+# define s8 40+# define s9 41+# define s10 42+# define s11 43+# define s12 44+# define s13 45+# define s14 46+# define s15 47+# define s16 48+# define s17 49+# define s18 50+# define s19 51+# define s20 52+# define s21 53+# define s22 54+# define s23 55+# define s24 56+# define s25 57+# define s26 58+# define s27 59+# define s28 60+# define s29 61+# define s30 62+# define s31 63++# define d0 32+# define d1 33+# define d2 34+# define d3 35+# define d4 36+# define d5 37+# define d6 38+# define d7 39+# define d8 40+# define d9 41+# define d10 42+# define d11 43+# define d12 44+# define d13 45+# define d14 46+# define d15 47+# define d16 48+# define d17 49+# define d18 50+# define d19 51+# define d20 52+# define d21 53+# define d22 54+# define d23 55+# define d24 56+# define d25 57+# define d26 58+# define d27 59+# define d28 60+# define d29 61+# define d30 62+# define d31 63+#endif++# if defined(MACHREGS_darwin)+#  define f0  32+#  define f1  33+#  define f2  34+#  define f3  35+#  define f4  36+#  define f5  37+#  define f6  38+#  define f7  39+#  define f8  40+#  define f9  41+#  define f10 42+#  define f11 43+#  define f12 44+#  define f13 45+#  define f14 46+#  define f15 47+#  define f16 48+#  define f17 49+#  define f18 50+#  define f19 51+#  define f20 52+#  define f21 53+#  define f22 54+#  define f23 55+#  define f24 56+#  define f25 57+#  define f26 58+#  define f27 59+#  define f28 60+#  define f29 61+#  define f30 62+#  define f31 63+# else+#  define fr0  32+#  define fr1  33+#  define fr2  34+#  define fr3  35+#  define fr4  36+#  define fr5  37+#  define fr6  38+#  define fr7  39+#  define fr8  40+#  define fr9  41+#  define fr10 42+#  define fr11 43+#  define fr12 44+#  define fr13 45+#  define fr14 46+#  define fr15 47+#  define fr16 48+#  define fr17 49+#  define fr18 50+#  define fr19 51+#  define fr20 52+#  define fr21 53+#  define fr22 54+#  define fr23 55+#  define fr24 56+#  define fr25 57+#  define fr26 58+#  define fr27 59+#  define fr28 60+#  define fr29 61+#  define fr30 62+#  define fr31 63+# endif++#elif defined(MACHREGS_sparc)++# define g0  0+# define g1  1+# define g2  2+# define g3  3+# define g4  4+# define g5  5+# define g6  6+# define g7  7++# define o0  8+# define o1  9+# define o2  10+# define o3  11+# define o4  12+# define o5  13+# define o6  14+# define o7  15++# define l0  16+# define l1  17+# define l2  18+# define l3  19+# define l4  20+# define l5  21+# define l6  22+# define l7  23++# define i0  24+# define i1  25+# define i2  26+# define i3  27+# define i4  28+# define i5  29+# define i6  30+# define i7  31++# define f0  32+# define f1  33+# define f2  34+# define f3  35+# define f4  36+# define f5  37+# define f6  38+# define f7  39+# define f8  40+# define f9  41+# define f10 42+# define f11 43+# define f12 44+# define f13 45+# define f14 46+# define f15 47+# define f16 48+# define f17 49+# define f18 50+# define f19 51+# define f20 52+# define f21 53+# define f22 54+# define f23 55+# define f24 56+# define f25 57+# define f26 58+# define f27 59+# define f28 60+# define f29 61+# define f30 62+# define f31 63++#endif++callerSaves :: GlobalReg -> Bool+#if defined(CALLER_SAVES_Base)+callerSaves BaseReg           = True+#endif+#if defined(CALLER_SAVES_R1)+callerSaves (VanillaReg 1 _)  = True+#endif+#if defined(CALLER_SAVES_R2)+callerSaves (VanillaReg 2 _)  = True+#endif+#if defined(CALLER_SAVES_R3)+callerSaves (VanillaReg 3 _)  = True+#endif+#if defined(CALLER_SAVES_R4)+callerSaves (VanillaReg 4 _)  = True+#endif+#if defined(CALLER_SAVES_R5)+callerSaves (VanillaReg 5 _)  = True+#endif+#if defined(CALLER_SAVES_R6)+callerSaves (VanillaReg 6 _)  = True+#endif+#if defined(CALLER_SAVES_R7)+callerSaves (VanillaReg 7 _)  = True+#endif+#if defined(CALLER_SAVES_R8)+callerSaves (VanillaReg 8 _)  = True+#endif+#if defined(CALLER_SAVES_R9)+callerSaves (VanillaReg 9 _)  = True+#endif+#if defined(CALLER_SAVES_R10)+callerSaves (VanillaReg 10 _) = True+#endif+#if defined(CALLER_SAVES_F1)+callerSaves (FloatReg 1)      = True+#endif+#if defined(CALLER_SAVES_F2)+callerSaves (FloatReg 2)      = True+#endif+#if defined(CALLER_SAVES_F3)+callerSaves (FloatReg 3)      = True+#endif+#if defined(CALLER_SAVES_F4)+callerSaves (FloatReg 4)      = True+#endif+#if defined(CALLER_SAVES_F5)+callerSaves (FloatReg 5)      = True+#endif+#if defined(CALLER_SAVES_F6)+callerSaves (FloatReg 6)      = True+#endif+#if defined(CALLER_SAVES_D1)+callerSaves (DoubleReg 1)     = True+#endif+#if defined(CALLER_SAVES_D2)+callerSaves (DoubleReg 2)     = True+#endif+#if defined(CALLER_SAVES_D3)+callerSaves (DoubleReg 3)     = True+#endif+#if defined(CALLER_SAVES_D4)+callerSaves (DoubleReg 4)     = True+#endif+#if defined(CALLER_SAVES_D5)+callerSaves (DoubleReg 5)     = True+#endif+#if defined(CALLER_SAVES_D6)+callerSaves (DoubleReg 6)     = True+#endif+#if defined(CALLER_SAVES_L1)+callerSaves (LongReg 1)       = True+#endif+#if defined(CALLER_SAVES_Sp)+callerSaves Sp                = True+#endif+#if defined(CALLER_SAVES_SpLim)+callerSaves SpLim             = True+#endif+#if defined(CALLER_SAVES_Hp)+callerSaves Hp                = True+#endif+#if defined(CALLER_SAVES_HpLim)+callerSaves HpLim             = True+#endif+#if defined(CALLER_SAVES_CCCS)+callerSaves CCCS              = True+#endif+#if defined(CALLER_SAVES_CurrentTSO)+callerSaves CurrentTSO        = True+#endif+#if defined(CALLER_SAVES_CurrentNursery)+callerSaves CurrentNursery    = True+#endif+callerSaves _                 = False++activeStgRegs :: [GlobalReg]+activeStgRegs = [+#if defined(REG_Base)+    BaseReg+#endif+#if defined(REG_Sp)+    ,Sp+#endif+#if defined(REG_Hp)+    ,Hp+#endif+#if defined(REG_R1)+    ,VanillaReg 1 VGcPtr+#endif+#if defined(REG_R2)+    ,VanillaReg 2 VGcPtr+#endif+#if defined(REG_R3)+    ,VanillaReg 3 VGcPtr+#endif+#if defined(REG_R4)+    ,VanillaReg 4 VGcPtr+#endif+#if defined(REG_R5)+    ,VanillaReg 5 VGcPtr+#endif+#if defined(REG_R6)+    ,VanillaReg 6 VGcPtr+#endif+#if defined(REG_R7)+    ,VanillaReg 7 VGcPtr+#endif+#if defined(REG_R8)+    ,VanillaReg 8 VGcPtr+#endif+#if defined(REG_R9)+    ,VanillaReg 9 VGcPtr+#endif+#if defined(REG_R10)+    ,VanillaReg 10 VGcPtr+#endif+#if defined(REG_SpLim)+    ,SpLim+#endif+#if MAX_REAL_XMM_REG != 0+#if defined(REG_F1)+    ,FloatReg 1+#endif+#if defined(REG_D1)+    ,DoubleReg 1+#endif+#if defined(REG_XMM1)+    ,XmmReg 1+#endif+#if defined(REG_YMM1)+    ,YmmReg 1+#endif+#if defined(REG_ZMM1)+    ,ZmmReg 1+#endif+#if defined(REG_F2)+    ,FloatReg 2+#endif+#if defined(REG_D2)+    ,DoubleReg 2+#endif+#if defined(REG_XMM2)+    ,XmmReg 2+#endif+#if defined(REG_YMM2)+    ,YmmReg 2+#endif+#if defined(REG_ZMM2)+    ,ZmmReg 2+#endif+#if defined(REG_F3)+    ,FloatReg 3+#endif+#if defined(REG_D3)+    ,DoubleReg 3+#endif+#if defined(REG_XMM3)+    ,XmmReg 3+#endif+#if defined(REG_YMM3)+    ,YmmReg 3+#endif+#if defined(REG_ZMM3)+    ,ZmmReg 3+#endif+#if defined(REG_F4)+    ,FloatReg 4+#endif+#if defined(REG_D4)+    ,DoubleReg 4+#endif+#if defined(REG_XMM4)+    ,XmmReg 4+#endif+#if defined(REG_YMM4)+    ,YmmReg 4+#endif+#if defined(REG_ZMM4)+    ,ZmmReg 4+#endif+#if defined(REG_F5)+    ,FloatReg 5+#endif+#if defined(REG_D5)+    ,DoubleReg 5+#endif+#if defined(REG_XMM5)+    ,XmmReg 5+#endif+#if defined(REG_YMM5)+    ,YmmReg 5+#endif+#if defined(REG_ZMM5)+    ,ZmmReg 5+#endif+#if defined(REG_F6)+    ,FloatReg 6+#endif+#if defined(REG_D6)+    ,DoubleReg 6+#endif+#if defined(REG_XMM6)+    ,XmmReg 6+#endif+#if defined(REG_YMM6)+    ,YmmReg 6+#endif+#if defined(REG_ZMM6)+    ,ZmmReg 6+#endif+#else /* MAX_REAL_XMM_REG == 0 */+#if defined(REG_F1)+    ,FloatReg 1+#endif+#if defined(REG_F2)+    ,FloatReg 2+#endif+#if defined(REG_F3)+    ,FloatReg 3+#endif+#if defined(REG_F4)+    ,FloatReg 4+#endif+#if defined(REG_F5)+    ,FloatReg 5+#endif+#if defined(REG_F6)+    ,FloatReg 6+#endif+#if defined(REG_D1)+    ,DoubleReg 1+#endif+#if defined(REG_D2)+    ,DoubleReg 2+#endif+#if defined(REG_D3)+    ,DoubleReg 3+#endif+#if defined(REG_D4)+    ,DoubleReg 4+#endif+#if defined(REG_D5)+    ,DoubleReg 5+#endif+#if defined(REG_D6)+    ,DoubleReg 6+#endif+#endif /* MAX_REAL_XMM_REG == 0 */+    ]++haveRegBase :: Bool+#if defined(REG_Base)+haveRegBase = True+#else+haveRegBase = False+#endif++--  | Returns 'Nothing' if this global register is not stored+-- in a real machine register, otherwise returns @'Just' reg@, where+-- reg is the machine register it is stored in.+globalRegMaybe :: GlobalReg -> Maybe RealReg+#if defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \+    || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc) \+    || defined(MACHREGS_arm) || defined(MACHREGS_aarch64)+# if defined(REG_Base)+globalRegMaybe BaseReg                  = Just (RealRegSingle REG_Base)+# endif+# if defined(REG_R1)+globalRegMaybe (VanillaReg 1 _)         = Just (RealRegSingle REG_R1)+# endif+# if defined(REG_R2)+globalRegMaybe (VanillaReg 2 _)         = Just (RealRegSingle REG_R2)+# endif+# if defined(REG_R3)+globalRegMaybe (VanillaReg 3 _)         = Just (RealRegSingle REG_R3)+# endif+# if defined(REG_R4)+globalRegMaybe (VanillaReg 4 _)         = Just (RealRegSingle REG_R4)+# endif+# if defined(REG_R5)+globalRegMaybe (VanillaReg 5 _)         = Just (RealRegSingle REG_R5)+# endif+# if defined(REG_R6)+globalRegMaybe (VanillaReg 6 _)         = Just (RealRegSingle REG_R6)+# endif+# if defined(REG_R7)+globalRegMaybe (VanillaReg 7 _)         = Just (RealRegSingle REG_R7)+# endif+# if defined(REG_R8)+globalRegMaybe (VanillaReg 8 _)         = Just (RealRegSingle REG_R8)+# endif+# if defined(REG_R9)+globalRegMaybe (VanillaReg 9 _)         = Just (RealRegSingle REG_R9)+# endif+# if defined(REG_R10)+globalRegMaybe (VanillaReg 10 _)        = Just (RealRegSingle REG_R10)+# endif+# if defined(REG_F1)+globalRegMaybe (FloatReg 1)             = Just (RealRegSingle REG_F1)+# endif+# if defined(REG_F2)+globalRegMaybe (FloatReg 2)             = Just (RealRegSingle REG_F2)+# endif+# if defined(REG_F3)+globalRegMaybe (FloatReg 3)             = Just (RealRegSingle REG_F3)+# endif+# if defined(REG_F4)+globalRegMaybe (FloatReg 4)             = Just (RealRegSingle REG_F4)+# endif+# if defined(REG_F5)+globalRegMaybe (FloatReg 5)             = Just (RealRegSingle REG_F5)+# endif+# if defined(REG_F6)+globalRegMaybe (FloatReg 6)             = Just (RealRegSingle REG_F6)+# endif+# if defined(REG_D1)+globalRegMaybe (DoubleReg 1)            =+#  if defined(MACHREGS_sparc)+                                          Just (RealRegPair REG_D1 (REG_D1 + 1))+#  else+                                          Just (RealRegSingle REG_D1)+#  endif+# endif+# if defined(REG_D2)+globalRegMaybe (DoubleReg 2)            =+#  if defined(MACHREGS_sparc)+                                          Just (RealRegPair REG_D2 (REG_D2 + 1))+#  else+                                          Just (RealRegSingle REG_D2)+#  endif+# endif+# if defined(REG_D3)+globalRegMaybe (DoubleReg 3)            =+#  if defined(MACHREGS_sparc)+                                          Just (RealRegPair REG_D3 (REG_D3 + 1))+#  else+                                          Just (RealRegSingle REG_D3)+#  endif+# endif+# if defined(REG_D4)+globalRegMaybe (DoubleReg 4)            =+#  if defined(MACHREGS_sparc)+                                          Just (RealRegPair REG_D4 (REG_D4 + 1))+#  else+                                          Just (RealRegSingle REG_D4)+#  endif+# endif+# if defined(REG_D5)+globalRegMaybe (DoubleReg 5)            =+#  if defined(MACHREGS_sparc)+                                          Just (RealRegPair REG_D5 (REG_D5 + 1))+#  else+                                          Just (RealRegSingle REG_D5)+#  endif+# endif+# if defined(REG_D6)+globalRegMaybe (DoubleReg 6)            =+#  if defined(MACHREGS_sparc)+                                          Just (RealRegPair REG_D6 (REG_D6 + 1))+#  else+                                          Just (RealRegSingle REG_D6)+#  endif+# endif+# if MAX_REAL_XMM_REG != 0+#  if defined(REG_XMM1)+globalRegMaybe (XmmReg 1)               = Just (RealRegSingle REG_XMM1)+#  endif+#  if defined(REG_XMM2)+globalRegMaybe (XmmReg 2)               = Just (RealRegSingle REG_XMM2)+#  endif+#  if defined(REG_XMM3)+globalRegMaybe (XmmReg 3)               = Just (RealRegSingle REG_XMM3)+#  endif+#  if defined(REG_XMM4)+globalRegMaybe (XmmReg 4)               = Just (RealRegSingle REG_XMM4)+#  endif+#  if defined(REG_XMM5)+globalRegMaybe (XmmReg 5)               = Just (RealRegSingle REG_XMM5)+#  endif+#  if defined(REG_XMM6)+globalRegMaybe (XmmReg 6)               = Just (RealRegSingle REG_XMM6)+#  endif+# endif+# if defined(MAX_REAL_YMM_REG) && MAX_REAL_YMM_REG != 0+#  if defined(REG_YMM1)+globalRegMaybe (YmmReg 1)               = Just (RealRegSingle REG_YMM1)+#  endif+#  if defined(REG_YMM2)+globalRegMaybe (YmmReg 2)               = Just (RealRegSingle REG_YMM2)+#  endif+#  if defined(REG_YMM3)+globalRegMaybe (YmmReg 3)               = Just (RealRegSingle REG_YMM3)+#  endif+#  if defined(REG_YMM4)+globalRegMaybe (YmmReg 4)               = Just (RealRegSingle REG_YMM4)+#  endif+#  if defined(REG_YMM5)+globalRegMaybe (YmmReg 5)               = Just (RealRegSingle REG_YMM5)+#  endif+#  if defined(REG_YMM6)+globalRegMaybe (YmmReg 6)               = Just (RealRegSingle REG_YMM6)+#  endif+# endif+# if defined(MAX_REAL_ZMM_REG) && MAX_REAL_ZMM_REG != 0+#  if defined(REG_ZMM1)+globalRegMaybe (ZmmReg 1)               = Just (RealRegSingle REG_ZMM1)+#  endif+#  if defined(REG_ZMM2)+globalRegMaybe (ZmmReg 2)               = Just (RealRegSingle REG_ZMM2)+#  endif+#  if defined(REG_ZMM3)+globalRegMaybe (ZmmReg 3)               = Just (RealRegSingle REG_ZMM3)+#  endif+#  if defined(REG_ZMM4)+globalRegMaybe (ZmmReg 4)               = Just (RealRegSingle REG_ZMM4)+#  endif+#  if defined(REG_ZMM5)+globalRegMaybe (ZmmReg 5)               = Just (RealRegSingle REG_ZMM5)+#  endif+#  if defined(REG_ZMM6)+globalRegMaybe (ZmmReg 6)               = Just (RealRegSingle REG_ZMM6)+#  endif+# endif+# if defined(REG_Sp)+globalRegMaybe Sp                       = Just (RealRegSingle REG_Sp)+# endif+# if defined(REG_Lng1)+globalRegMaybe (LongReg 1)              = Just (RealRegSingle REG_Lng1)+# endif+# if defined(REG_Lng2)+globalRegMaybe (LongReg 2)              = Just (RealRegSingle REG_Lng2)+# endif+# if defined(REG_SpLim)+globalRegMaybe SpLim                    = Just (RealRegSingle REG_SpLim)+# endif+# if defined(REG_Hp)+globalRegMaybe Hp                       = Just (RealRegSingle REG_Hp)+# endif+# if defined(REG_HpLim)+globalRegMaybe HpLim                    = Just (RealRegSingle REG_HpLim)+# endif+# if defined(REG_CurrentTSO)+globalRegMaybe CurrentTSO               = Just (RealRegSingle REG_CurrentTSO)+# endif+# if defined(REG_CurrentNursery)+globalRegMaybe CurrentNursery           = Just (RealRegSingle REG_CurrentNursery)+# endif+# if defined(REG_MachSp)+globalRegMaybe MachSp                   = Just (RealRegSingle REG_MachSp)+# endif+globalRegMaybe _                        = Nothing+#elif defined(MACHREGS_NO_REGS)+globalRegMaybe _ = Nothing+#else+globalRegMaybe = panic "globalRegMaybe not defined for this platform"+#endif++freeReg :: RegNo -> Bool++#if defined(MACHREGS_i386) || defined(MACHREGS_x86_64)++# if defined(MACHREGS_i386)+freeReg esp = False -- %esp is the C stack pointer+freeReg esi = False -- Note [esi/edi/ebp not allocatable]+freeReg edi = False+freeReg ebp = False+# endif+# if defined(MACHREGS_x86_64)+freeReg rsp = False  --        %rsp is the C stack pointer+# endif++{-+Note [esi/edi/ebp not allocatable]++%esi is mapped to R1, so %esi would normally be allocatable while it+is not being used for R1.  However, %esi has no 8-bit version on x86,+and the linear register allocator is not sophisticated enough to+handle this irregularity (we need more RegClasses).  The+graph-colouring allocator also cannot handle this - it was designed+with more flexibility in mind, but the current implementation is+restricted to the same set of classes as the linear allocator.++Hence, on x86 esi, edi and ebp are treated as not allocatable.+-}++-- split patterns in two functions to prevent overlaps+freeReg r         = freeRegBase r++freeRegBase :: RegNo -> Bool+# if defined(REG_Base)+freeRegBase REG_Base  = False+# endif+# if defined(REG_Sp)+freeRegBase REG_Sp    = False+# endif+# if defined(REG_SpLim)+freeRegBase REG_SpLim = False+# endif+# if defined(REG_Hp)+freeRegBase REG_Hp    = False+# endif+# if defined(REG_HpLim)+freeRegBase REG_HpLim = False+# endif+-- All other regs are considered to be "free", because we can track+-- their liveness accurately.+freeRegBase _ = True++#elif defined(MACHREGS_powerpc)++freeReg 0 = False -- Used by code setting the back chain pointer+                  -- in stack reallocations on Linux.+                  -- Moreover r0 is not usable in all insns.+freeReg 1 = False -- The Stack Pointer+-- most ELF PowerPC OSes use r2 as a TOC pointer+freeReg 2 = False+freeReg 13 = False -- reserved for system thread ID on 64 bit+-- at least linux in -fPIC relies on r30 in PLT stubs+freeReg 30 = False+{- TODO: reserve r13 on 64 bit systems only and r30 on 32 bit respectively.+   For now we use r30 on 64 bit and r13 on 32 bit as a temporary register+   in stack handling code. See compiler/nativeGen/PPC/Instr.hs.++   Later we might want to reserve r13 and r30 only where it is required.+   Then use r12 as temporary register, which is also what the C ABI does.+-}++# if defined(REG_Base)+freeReg REG_Base  = False+# endif+# if defined(REG_Sp)+freeReg REG_Sp    = False+# endif+# if defined(REG_SpLim)+freeReg REG_SpLim = False+# endif+# if defined(REG_Hp)+freeReg REG_Hp    = False+# endif+# if defined(REG_HpLim)+freeReg REG_HpLim = False+# endif+freeReg _ = True++#elif defined(MACHREGS_sparc)++-- SPARC regs used by the OS / ABI+-- %g0(r0) is always zero+freeReg g0  = False++-- %g5(r5) - %g7(r7)+--  are reserved for the OS+freeReg g5  = False+freeReg g6  = False+freeReg g7  = False++-- %o6(r14)+--  is the C stack pointer+freeReg o6  = False++-- %o7(r15)+--  holds the C return address+freeReg o7  = False++-- %i6(r30)+--  is the C frame pointer+freeReg i6  = False++-- %i7(r31)+--  is used for C return addresses+freeReg i7  = False++-- %f0(r32) - %f1(r32)+--  are C floating point return regs+freeReg f0  = False+freeReg f1  = False++{-+freeReg regNo+    -- don't release high half of double regs+    | regNo >= f0+    , regNo <  NCG_FirstFloatReg+    , regNo `mod` 2 /= 0+    = False+-}++# if defined(REG_Base)+freeReg REG_Base  = False+# endif+# if defined(REG_R1)+freeReg REG_R1    = False+# endif+# if defined(REG_R2)+freeReg REG_R2    = False+# endif+# if defined(REG_R3)+freeReg REG_R3    = False+# endif+# if defined(REG_R4)+freeReg REG_R4    = False+# endif+# if defined(REG_R5)+freeReg REG_R5    = False+# endif+# if defined(REG_R6)+freeReg REG_R6    = False+# endif+# if defined(REG_R7)+freeReg REG_R7    = False+# endif+# if defined(REG_R8)+freeReg REG_R8    = False+# endif+# if defined(REG_R9)+freeReg REG_R9    = False+# endif+# if defined(REG_R10)+freeReg REG_R10   = False+# endif+# if defined(REG_F1)+freeReg REG_F1    = False+# endif+# if defined(REG_F2)+freeReg REG_F2    = False+# endif+# if defined(REG_F3)+freeReg REG_F3    = False+# endif+# if defined(REG_F4)+freeReg REG_F4    = False+# endif+# if defined(REG_F5)+freeReg REG_F5    = False+# endif+# if defined(REG_F6)+freeReg REG_F6    = False+# endif+# if defined(REG_D1)+freeReg REG_D1    = False+# endif+# if defined(REG_D1_2)+freeReg REG_D1_2  = False+# endif+# if defined(REG_D2)+freeReg REG_D2    = False+# endif+# if defined(REG_D2_2)+freeReg REG_D2_2  = False+# endif+# if defined(REG_D3)+freeReg REG_D3    = False+# endif+# if defined(REG_D3_2)+freeReg REG_D3_2  = False+# endif+# if defined(REG_D4)+freeReg REG_D4    = False+# endif+# if defined(REG_D4_2)+freeReg REG_D4_2  = False+# endif+# if defined(REG_D5)+freeReg REG_D5    = False+# endif+# if defined(REG_D5_2)+freeReg REG_D5_2  = False+# endif+# if defined(REG_D6)+freeReg REG_D6    = False+# endif+# if defined(REG_D6_2)+freeReg REG_D6_2  = False+# endif+# if defined(REG_Sp)+freeReg REG_Sp    = False+# endif+# if defined(REG_SpLim)+freeReg REG_SpLim = False+# endif+# if defined(REG_Hp)+freeReg REG_Hp    = False+# endif+# if defined(REG_HpLim)+freeReg REG_HpLim = False+# endif+freeReg _ = True++#else++freeReg = panic "freeReg not defined for this platform"++#endif+
+ includes/HsFFI.h view
@@ -0,0 +1,141 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2000+ *+ * A mapping for Haskell types to C types, including the corresponding bounds.+ * Intended to be used in conjuction with the FFI.+ *+ * WARNING: Keep this file and StgTypes.h in synch!+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#if defined(__cplusplus)+extern "C" {+#endif++/* get types from GHC's runtime system */+#include "ghcconfig.h"+#include "stg/Types.h"++/* get limits for floating point types */+#include <float.h>++typedef StgChar                 HsChar;+typedef StgInt                  HsInt;+typedef StgInt8                 HsInt8;+typedef StgInt16                HsInt16;+typedef StgInt32                HsInt32;+typedef StgInt64                HsInt64;+typedef StgWord                 HsWord;+typedef StgWord8                HsWord8;+typedef StgWord16               HsWord16;+typedef StgWord32               HsWord32;+typedef StgWord64               HsWord64;+typedef StgFloat                HsFloat;+typedef StgDouble               HsDouble;+typedef StgInt                  HsBool;+typedef void*                   HsPtr;          /* this should better match StgAddr */+typedef void                    (*HsFunPtr)(void); /* this should better match StgAddr */+typedef void*                   HsStablePtr;++/* this should correspond to the type of StgChar in StgTypes.h */+#define HS_CHAR_MIN             0+#define HS_CHAR_MAX             0x10FFFF++/* is it true or not?  */+#define HS_BOOL_FALSE           0+#define HS_BOOL_TRUE            1++#define HS_BOOL_MIN             HS_BOOL_FALSE+#define HS_BOOL_MAX             HS_BOOL_TRUE+++#define HS_INT_MIN              STG_INT_MIN+#define HS_INT_MAX              STG_INT_MAX+#define HS_WORD_MAX             STG_WORD_MAX++#define HS_INT8_MIN             STG_INT8_MIN+#define HS_INT8_MAX             STG_INT8_MAX+#define HS_INT16_MIN            STG_INT16_MIN+#define HS_INT16_MAX            STG_INT16_MAX+#define HS_INT32_MIN            STG_INT32_MIN+#define HS_INT32_MAX            STG_INT32_MAX+#define HS_INT64_MIN            STG_INT64_MIN+#define HS_INT64_MAX            STG_INT64_MAX+#define HS_WORD8_MAX            STG_WORD8_MAX+#define HS_WORD16_MAX           STG_WORD16_MAX+#define HS_WORD32_MAX           STG_WORD32_MAX+#define HS_WORD64_MAX           STG_WORD64_MAX++#define HS_FLOAT_RADIX          FLT_RADIX+#define HS_FLOAT_ROUNDS         FLT_ROUNDS+#define HS_FLOAT_EPSILON        FLT_EPSILON+#define HS_FLOAT_DIG            FLT_DIG+#define HS_FLOAT_MANT_DIG       FLT_MANT_DIG+#define HS_FLOAT_MIN            FLT_MIN+#define HS_FLOAT_MIN_EXP        FLT_MIN_EXP+#define HS_FLOAT_MIN_10_EXP     FLT_MIN_10_EXP+#define HS_FLOAT_MAX            FLT_MAX+#define HS_FLOAT_MAX_EXP        FLT_MAX_EXP+#define HS_FLOAT_MAX_10_EXP     FLT_MAX_10_EXP++#define HS_DOUBLE_RADIX         DBL_RADIX+#define HS_DOUBLE_ROUNDS        DBL_ROUNDS+#define HS_DOUBLE_EPSILON       DBL_EPSILON+#define HS_DOUBLE_DIG           DBL_DIG+#define HS_DOUBLE_MANT_DIG      DBL_MANT_DIG+#define HS_DOUBLE_MIN           DBL_MIN+#define HS_DOUBLE_MIN_EXP       DBL_MIN_EXP+#define HS_DOUBLE_MIN_10_EXP    DBL_MIN_10_EXP+#define HS_DOUBLE_MAX           DBL_MAX+#define HS_DOUBLE_MAX_EXP       DBL_MAX_EXP+#define HS_DOUBLE_MAX_10_EXP    DBL_MAX_10_EXP++extern void hs_init     (int *argc, char **argv[]);+extern void hs_exit     (void);+extern void hs_exit_nowait(void);+extern void hs_set_argv (int argc, char *argv[]);+extern void hs_thread_done (void);++extern void hs_perform_gc (void);++// Lock the stable pointer table. The table must be unlocked+// again before calling any Haskell functions, even if those+// functions do not manipulate stable pointers. The Haskell+// garbage collector will not be able to run until this lock+// is released! It is also forbidden to call hs_free_fun_ptr+// or any stable pointer-related FFI functions other than+// hs_free_stable_ptr_unsafe while the table is locked.+extern void hs_lock_stable_ptr_table (void);++// A deprecated synonym.+extern void hs_lock_stable_tables (void);++// Unlock the stable pointer table.+extern void hs_unlock_stable_ptr_table (void);++// A deprecated synonym.+extern void hs_unlock_stable_tables (void);++// Free a stable pointer assuming that the stable pointer+// table is already locked.+extern void hs_free_stable_ptr_unsafe (HsStablePtr sp);++extern void hs_free_stable_ptr (HsStablePtr sp);+extern void hs_free_fun_ptr    (HsFunPtr fp);++extern StgPtr hs_spt_lookup(StgWord64 key1, StgWord64 key2);+extern int hs_spt_keys(StgPtr keys[], int szKeys);+extern int hs_spt_key_count (void);++extern void hs_try_putmvar (int capability, HsStablePtr sp);++/* -------------------------------------------------------------------------- */++++#if defined(__cplusplus)+}+#endif
+ includes/MachDeps.h view
@@ -0,0 +1,123 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The University of Glasgow 2002+ *+ * Definitions that characterise machine specific properties of basic+ * types (C & Haskell) of a target platform.+ *+ * NB: Keep in sync with HsFFI.h and StgTypes.h.+ * NB: THIS FILE IS INCLUDED IN HASKELL SOURCE!+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++/* Don't allow stage1 (cross-)compiler embed assumptions about target+ * platform. When ghc-stage1 is being built by ghc-stage0 is should not+ * refer to target defines. A few past examples:+ *  - https://gitlab.haskell.org/ghc/ghc/issues/13491+ *  - https://phabricator.haskell.org/D3122+ *  - https://phabricator.haskell.org/D3405+ *+ * In those cases code change assumed target defines like SIZEOF_HSINT+ * are applied to host platform, not target platform.+ *+ * So what should be used instead in STAGE=1?+ *+ * To get host's equivalent of SIZEOF_HSINT you can use Bits instances:+ *    Data.Bits.finiteBitSize (0 :: Int)+ *+ * To get target's values it is preferred to use runtime target+ * configuration from 'targetPlatform :: DynFlags -> Platform'+ * record. A few wrappers are already defined and used throughout GHC:+ *    wORD_SIZE :: DynFlags -> Int+ *    wORD_SIZE dflags = pc_WORD_SIZE (sPlatformConstants (settings dflags))+ *+ * Hence we hide these macros from -DSTAGE=1+ */+#if !defined(STAGE) || STAGE >= 2++/* Sizes of C types come from here... */+#include "ghcautoconf.h"++/* Sizes of Haskell types follow.  These sizes correspond to:+ *   - the number of bytes in the primitive type (eg. Int#)+ *   - the number of bytes in the external representation (eg. HsInt)+ *   - the scale offset used by writeFooOffAddr#+ *+ * In the heap, the type may take up more space: eg. SIZEOF_INT8 == 1,+ * but it takes up SIZEOF_HSWORD (4 or 8) bytes in the heap.+ */++#define SIZEOF_HSCHAR           SIZEOF_WORD32+#define ALIGNMENT_HSCHAR        ALIGNMENT_WORD32++#define SIZEOF_HSINT            SIZEOF_VOID_P+#define ALIGNMENT_HSINT         ALIGNMENT_VOID_P++#define SIZEOF_HSWORD           SIZEOF_VOID_P+#define ALIGNMENT_HSWORD        ALIGNMENT_VOID_P++#define SIZEOF_HSDOUBLE         SIZEOF_DOUBLE+#define ALIGNMENT_HSDOUBLE      ALIGNMENT_DOUBLE++#define SIZEOF_HSFLOAT          SIZEOF_FLOAT+#define ALIGNMENT_HSFLOAT       ALIGNMENT_FLOAT++#define SIZEOF_HSPTR            SIZEOF_VOID_P+#define ALIGNMENT_HSPTR         ALIGNMENT_VOID_P++#define SIZEOF_HSFUNPTR         SIZEOF_VOID_P+#define ALIGNMENT_HSFUNPTR      ALIGNMENT_VOID_P++#define SIZEOF_HSSTABLEPTR      SIZEOF_VOID_P+#define ALIGNMENT_HSSTABLEPTR   ALIGNMENT_VOID_P++#define SIZEOF_INT8             SIZEOF_INT8_T+#define ALIGNMENT_INT8          ALIGNMENT_INT8_T++#define SIZEOF_WORD8            SIZEOF_UINT8_T+#define ALIGNMENT_WORD8         ALIGNMENT_UINT8_T++#define SIZEOF_INT16            SIZEOF_INT16_T+#define ALIGNMENT_INT16         ALIGNMENT_INT16_T++#define SIZEOF_WORD16           SIZEOF_UINT16_T+#define ALIGNMENT_WORD16        ALIGNMENT_UINT16_T++#define SIZEOF_INT32            SIZEOF_INT32_T+#define ALIGNMENT_INT32         ALIGNMENT_INT32_T++#define SIZEOF_WORD32           SIZEOF_UINT32_T+#define ALIGNMENT_WORD32        ALIGNMENT_UINT32_T++#define SIZEOF_INT64            SIZEOF_INT64_T+#define ALIGNMENT_INT64         ALIGNMENT_INT64_T++#define SIZEOF_WORD64           SIZEOF_UINT64_T+#define ALIGNMENT_WORD64        ALIGNMENT_UINT64_T++#if !defined(WORD_SIZE_IN_BITS)+#if SIZEOF_HSWORD == 4+#define WORD_SIZE_IN_BITS       32+#define WORD_SIZE_IN_BITS_FLOAT 32.0+#else+#define WORD_SIZE_IN_BITS       64+#define WORD_SIZE_IN_BITS_FLOAT 64.0+#endif+#endif++#if !defined(TAG_BITS)+#if SIZEOF_HSWORD == 4+#define TAG_BITS                2+#else+#define TAG_BITS                3+#endif+#endif++#define TAG_MASK ((1 << TAG_BITS) - 1)++#endif /* !defined(STAGE) || STAGE >= 2 */
+ includes/Rts.h view
@@ -0,0 +1,317 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * RTS external APIs.  This file declares everything that the GHC RTS+ * exposes externally.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#if defined(__cplusplus)+extern "C" {+#endif++/* We include windows.h very early, as on Win64 the CONTEXT type has+   fields "R8", "R9" and "R10", which goes bad if we've already+   #define'd those names for our own purposes (in stg/Regs.h) */+#if defined(HAVE_WINDOWS_H)+#include <windows.h>+#endif++#if !defined(IN_STG_CODE)+#define IN_STG_CODE 0+#endif+#include "Stg.h"++#include "HsFFI.h"+#include "RtsAPI.h"++// Turn off inlining when debugging - it obfuscates things+#if defined(DEBUG)+# undef  STATIC_INLINE+# define STATIC_INLINE static+#endif++#include "rts/Types.h"+#include "rts/Time.h"++#if __GNUC__ >= 3+#define ATTRIBUTE_ALIGNED(n) __attribute__((aligned(n)))+#else+#define ATTRIBUTE_ALIGNED(n) /*nothing*/+#endif++// Symbols that are extern, but private to the RTS, are declared+// with visibility "hidden" to hide them outside the RTS shared+// library.+#if defined(HAS_VISIBILITY_HIDDEN)+#define RTS_PRIVATE  GNUC3_ATTRIBUTE(visibility("hidden"))+#else+#define RTS_PRIVATE  /* disabled: RTS_PRIVATE */+#endif++#if __GNUC__ >= 4+#define RTS_UNLIKELY(p) __builtin_expect((p),0)+#else+#define RTS_UNLIKELY(p) (p)+#endif++#if __GNUC__ >= 4+#define RTS_LIKELY(p) __builtin_expect(!!(p), 1)+#else+#define RTS_LIKELY(p) (p)+#endif++/* __builtin_unreachable is supported since GNU C 4.5 */+#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5)+#define RTS_UNREACHABLE __builtin_unreachable()+#else+#define RTS_UNREACHABLE abort()+#endif++/* Fix for mingw stat problem (done here so it's early enough) */+#if defined(mingw32_HOST_OS)+#define __MSVCRT__ 1+#endif++/* Needed to get the macro version of errno on some OSs, and also to+   get prototypes for the _r versions of C library functions. */+#if !defined(_REENTRANT)+#define _REENTRANT 1+#endif++/*+ * We often want to know the size of something in units of an+ * StgWord... (rounded up, of course!)+ */+#define ROUNDUP_BYTES_TO_WDS(n) (((n) + sizeof(W_) - 1) / sizeof(W_))++#define sizeofW(t) ROUNDUP_BYTES_TO_WDS(sizeof(t))++/* -----------------------------------------------------------------------------+   Assertions and Debuggery++   CHECK(p)   evaluates p and terminates with an error if p is false+   ASSERT(p)  like CHECK(p) if DEBUG is on, otherwise a no-op+   -------------------------------------------------------------------------- */++void _assertFail(const char *filename, unsigned int linenum)+   GNUC3_ATTRIBUTE(__noreturn__);++#define CHECK(predicate)                        \+        if (predicate)                          \+            /*null*/;                           \+        else                                    \+            _assertFail(__FILE__, __LINE__)++#define CHECKM(predicate, msg, ...)             \+        if (predicate)                          \+            /*null*/;                           \+        else                                    \+            barf(msg, ##__VA_ARGS__)++#if !defined(DEBUG)+#define ASSERT(predicate) /* nothing */+#define ASSERTM(predicate,msg,...) /* nothing */+#else+#define ASSERT(predicate) CHECK(predicate)+#define ASSERTM(predicate,msg,...) CHECKM(predicate,msg,##__VA_ARGS__)+#endif /* DEBUG */++/*+ * Use this on the RHS of macros which expand to nothing+ * to make sure that the macro can be used in a context which+ * demands a non-empty statement.+ */++#define doNothing() do { } while (0)++#if defined(DEBUG)+#define USED_IF_DEBUG+#define USED_IF_NOT_DEBUG STG_UNUSED+#else+#define USED_IF_DEBUG STG_UNUSED+#define USED_IF_NOT_DEBUG+#endif++#if defined(THREADED_RTS)+#define USED_IF_THREADS+#define USED_IF_NOT_THREADS STG_UNUSED+#else+#define USED_IF_THREADS STG_UNUSED+#define USED_IF_NOT_THREADS+#endif++#define FMT_SizeT    "zu"+#define FMT_HexSizeT "zx"++/* -----------------------------------------------------------------------------+   Include everything STG-ish+   -------------------------------------------------------------------------- */++/* System headers: stdlib.h is needed so that we can use NULL.  It must+ * come after MachRegs.h, because stdlib.h might define some inline+ * functions which may only be defined after register variables have+ * been declared.+ */+#include <stdlib.h>++#include "rts/Config.h"++/* Global constraints */+#include "rts/Constants.h"++/* Profiling information */+#include "rts/prof/CCS.h"+#include "rts/prof/LDV.h"++/* Parallel information */+#include "rts/OSThreads.h"+#include "rts/SpinLock.h"++#include "rts/Messages.h"+#include "rts/Threads.h"++/* Storage format definitions */+#include "rts/storage/FunTypes.h"+#include "rts/storage/InfoTables.h"+#include "rts/storage/Closures.h"+#include "rts/storage/Heap.h"+#include "rts/storage/ClosureTypes.h"+#include "rts/storage/TSO.h"+#include "stg/MiscClosures.h" /* InfoTables, closures etc. defined in the RTS */+#include "rts/storage/Block.h"+#include "rts/storage/ClosureMacros.h"+#include "rts/storage/MBlock.h"+#include "rts/storage/GC.h"++/* Other RTS external APIs */+#include "rts/Parallel.h"+#include "rts/Signals.h"+#include "rts/BlockSignals.h"+#include "rts/Hpc.h"+#include "rts/Flags.h"+#include "rts/Adjustor.h"+#include "rts/FileLock.h"+#include "rts/GetTime.h"+#include "rts/Globals.h"+#include "rts/IOManager.h"+#include "rts/Linker.h"+#include "rts/Ticky.h"+#include "rts/Timer.h"+#include "rts/StablePtr.h"+#include "rts/StableName.h"+#include "rts/TTY.h"+#include "rts/Utils.h"+#include "rts/PrimFloat.h"+#include "rts/Main.h"+#include "rts/Profiling.h"+#include "rts/StaticPtrTable.h"+#include "rts/Libdw.h"+#include "rts/LibdwPool.h"++/* Misc stuff without a home */+DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell */+DLL_IMPORT_RTS extern int    prog_argc;+DLL_IMPORT_RTS extern char  *prog_name;++void reportStackOverflow(StgTSO* tso);+void reportHeapOverflow(void);++void stg_exit(int n) GNU_ATTRIBUTE(__noreturn__);++#if !defined(mingw32_HOST_OS)+int stg_sig_install (int, int, void *);+#endif++/* -----------------------------------------------------------------------------+   Ways+   -------------------------------------------------------------------------- */++// Returns non-zero if the RTS is a profiling version+int rts_isProfiled(void);++// Returns non-zero if the RTS is a dynamically-linked version+int rts_isDynamic(void);++/* -----------------------------------------------------------------------------+   RTS Exit codes+   -------------------------------------------------------------------------- */++/* 255 is allegedly used by dynamic linkers to report linking failure */+#define EXIT_INTERNAL_ERROR 254+#define EXIT_DEADLOCK       253+#define EXIT_INTERRUPTED    252+#define EXIT_HEAPOVERFLOW   251+#define EXIT_KILLED         250++/* -----------------------------------------------------------------------------+   Miscellaneous garbage+   -------------------------------------------------------------------------- */++#if defined(DEBUG)+#define TICK_VAR(arity) \+  extern StgInt SLOW_CALLS_##arity; \+  extern StgInt RIGHT_ARITY_##arity; \+  extern StgInt TAGGED_PTR_##arity;++extern StgInt TOTAL_CALLS;++TICK_VAR(1)+TICK_VAR(2)+#endif++/* -----------------------------------------------------------------------------+   Assertions and Debuggery+   -------------------------------------------------------------------------- */++#define IF_RTSFLAGS(c,s)  if (RtsFlags.c) { s; } doNothing()++#if defined(DEBUG)+#if IN_STG_CODE+#define IF_DEBUG(c,s)  if (RtsFlags[0].DebugFlags.c) { s; } doNothing()+#else+#define IF_DEBUG(c,s)  if (RtsFlags.DebugFlags.c) { s; } doNothing()+#endif+#else+#define IF_DEBUG(c,s)  doNothing()+#endif++#if defined(DEBUG)+#define DEBUG_ONLY(s) s+#else+#define DEBUG_ONLY(s) doNothing()+#endif++#if defined(DEBUG)+#define DEBUG_IS_ON   1+#else+#define DEBUG_IS_ON   0+#endif++/* -----------------------------------------------------------------------------+   Useful macros and inline functions+   -------------------------------------------------------------------------- */++#if defined(__GNUC__)+#define SUPPORTS_TYPEOF+#endif++#if defined(SUPPORTS_TYPEOF)+#define stg_min(a,b) ({typeof(a) _a = (a), _b = (b); _a <= _b ? _a : _b; })+#define stg_max(a,b) ({typeof(a) _a = (a), _b = (b); _a <= _b ? _b : _a; })+#else+#define stg_min(a,b) ((a) <= (b) ? (a) : (b))+#define stg_max(a,b) ((a) <= (b) ? (b) : (a))+#endif++/* -------------------------------------------------------------------------- */++#if defined(__cplusplus)+}+#endif
+ includes/RtsAPI.h view
@@ -0,0 +1,487 @@+/* ----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2004+ *+ * API for invoking Haskell functions via the RTS+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * --------------------------------------------------------------------------*/++#pragma once++#if defined(__cplusplus)+extern "C" {+#endif++#include "HsFFI.h"+#include "rts/Time.h"+#include "rts/EventLogWriter.h"++/*+ * Running the scheduler+ */+typedef enum {+    NoStatus,    /* not finished yet */+    Success,     /* completed successfully */+    Killed,      /* uncaught exception */+    Interrupted, /* stopped in response to a call to interruptStgRts */+    HeapExhausted /* out of memory */+} SchedulerStatus;++typedef struct StgClosure_ *HaskellObj;++/*+ * An abstract type representing the token returned by rts_lock() and+ * used when allocating objects and threads in the RTS.+ */+typedef struct Capability_ Capability;++/*+ * The public view of a Capability: we can be sure it starts with+ * these two components (but it may have more private fields).+ */+typedef struct CapabilityPublic_ {+    StgFunTable f;+    StgRegTable r;+} CapabilityPublic;++/* ----------------------------------------------------------------------------+   RTS configuration settings, for passing to hs_init_ghc()+   ------------------------------------------------------------------------- */++typedef enum {+    RtsOptsNone,         // +RTS causes an error+    RtsOptsIgnore,       // Ignore command line arguments+    RtsOptsIgnoreAll,    // Ignore command line and Environment arguments+    RtsOptsSafeOnly,     // safe RTS options allowed; others cause an error+    RtsOptsAll           // all RTS options allowed+  } RtsOptsEnabledEnum;++struct GCDetails_;++// The RtsConfig struct is passed (by value) to hs_init_ghc().  The+// reason for using a struct is extensibility: we can add more+// fields to this later without breaking existing client code.+typedef struct {++    // Whether to interpret +RTS options on the command line+    RtsOptsEnabledEnum rts_opts_enabled;++    // Whether to give RTS flag suggestions+    HsBool rts_opts_suggestions;++    // additional RTS options+    const char *rts_opts;++    // True if GHC was not passed -no-hs-main+    HsBool rts_hs_main;++    // Whether to retain CAFs (default: false)+    HsBool keep_cafs;++    // Writer a for eventlog.+    const EventLogWriter *eventlog_writer;++    // Called before processing command-line flags, so that default+    // settings for RtsFlags can be provided.+    void (* defaultsHook) (void);++    // Called just before exiting+    void (* onExitHook) (void);++    // Called on a stack overflow, before exiting+    void (* stackOverflowHook) (W_ stack_size);++    // Called on heap overflow, before exiting+    void (* outOfHeapHook) (W_ request_size, W_ heap_size);++    // Called when malloc() fails, before exiting+    void (* mallocFailHook) (W_ request_size /* in bytes */, const char *msg);++    // Called for every GC+    void (* gcDoneHook) (const struct GCDetails_ *stats);++    // Called when GC sync takes too long (+RTS --long-gc-sync=<time>)+    void (* longGCSync) (uint32_t this_cap, Time time_ns);+    void (* longGCSyncEnd) (Time time_ns);+} RtsConfig;++// Clients should start with defaultRtsConfig and then customise it.+// Bah, I really wanted this to be a const struct value, but it seems+// you can't do that in C (it generates code).+extern const RtsConfig defaultRtsConfig;++/* -----------------------------------------------------------------------------+   Statistics+   -------------------------------------------------------------------------- */++//+// Stats about a single GC+//+typedef struct GCDetails_ {+    // The generation number of this GC+  uint32_t gen;+    // Number of threads used in this GC+  uint32_t threads;+    // Number of bytes allocated since the previous GC+  uint64_t allocated_bytes;+    // Total amount of live data in the heap (incliudes large + compact data).+    // Updated after every GC. Data in uncollected generations (in minor GCs)+    // are considered live.+  uint64_t live_bytes;+    // Total amount of live data in large objects+  uint64_t large_objects_bytes;+    // Total amount of live data in compact regions+  uint64_t compact_bytes;+    // Total amount of slop (wasted memory)+  uint64_t slop_bytes;+    // Total amount of memory in use by the RTS+  uint64_t mem_in_use_bytes;+    // Total amount of data copied during this GC+  uint64_t copied_bytes;+    // In parallel GC, the max amount of data copied by any one thread+  uint64_t par_max_copied_bytes;+  // In parallel GC, the amount of balanced data copied by all threads+  uint64_t par_balanced_copied_bytes;+    // The time elapsed during synchronisation before GC+  Time sync_elapsed_ns;+    // The CPU time used during GC itself+  Time cpu_ns;+    // The time elapsed during GC itself+  Time elapsed_ns;+} GCDetails;++//+// Stats about the RTS currently, and since the start of execution+//+typedef struct _RTSStats {++  // -----------------------------------+  // Cumulative stats about memory use++    // Total number of GCs+  uint32_t gcs;+    // Total number of major (oldest generation) GCs+  uint32_t major_gcs;+    // Total bytes allocated+  uint64_t allocated_bytes;+    // Maximum live data (including large objects + compact regions) in the+    // heap. Updated after a major GC.+  uint64_t max_live_bytes;+    // Maximum live data in large objects+  uint64_t max_large_objects_bytes;+    // Maximum live data in compact regions+  uint64_t max_compact_bytes;+    // Maximum slop+  uint64_t max_slop_bytes;+    // Maximum memory in use by the RTS+  uint64_t max_mem_in_use_bytes;+    // Sum of live bytes across all major GCs.  Divided by major_gcs+    // gives the average live data over the lifetime of the program.+  uint64_t cumulative_live_bytes;+    // Sum of copied_bytes across all GCs+  uint64_t copied_bytes;+    // Sum of copied_bytes across all parallel GCs+  uint64_t par_copied_bytes;+    // Sum of par_max_copied_bytes across all parallel GCs+  uint64_t cumulative_par_max_copied_bytes;+    // Sum of par_balanced_copied_byes across all parallel GCs.+  uint64_t cumulative_par_balanced_copied_bytes;++  // -----------------------------------+  // Cumulative stats about time use+  // (we use signed values here because due to inaccuracies in timers+  // the values can occasionally go slightly negative)++    // Total CPU time used by the init phase+  Time init_cpu_ns;+    // Total elapsed time used by the init phase+  Time init_elapsed_ns;+    // Total CPU time used by the mutator+  Time mutator_cpu_ns;+    // Total elapsed time used by the mutator+  Time mutator_elapsed_ns;+    // Total CPU time used by the GC+  Time gc_cpu_ns;+    // Total elapsed time used by the GC+  Time gc_elapsed_ns;+    // Total CPU time (at the previous GC)+  Time cpu_ns;+    // Total elapsed time (at the previous GC)+  Time elapsed_ns;++  // -----------------------------------+  // Stats about the most recent GC++  GCDetails gc;++  // -----------------------------------+  // Internal Counters++    // The number of times a GC thread spun on its 'gc_spin' lock.+    // Will be zero if the rts was not built with PROF_SPIN+  uint64_t gc_spin_spin;+    // The number of times a GC thread yielded on its 'gc_spin' lock.+    // Will be zero if the rts was not built with PROF_SPIN+  uint64_t gc_spin_yield;+    // The number of times a GC thread spun on its 'mut_spin' lock.+    // Will be zero if the rts was not built with PROF_SPIN+  uint64_t mut_spin_spin;+    // The number of times a GC thread yielded on its 'mut_spin' lock.+    // Will be zero if the rts was not built with PROF_SPIN+  uint64_t mut_spin_yield;+    // The number of times a GC thread has checked for work across all parallel+    // GCs+  uint64_t any_work;+    // The number of times a GC thread has checked for work and found none+    // across all parallel GCs+  uint64_t no_work;+    // The number of times a GC thread has iterated it's outer loop across all+    // parallel GCs+  uint64_t scav_find_work;+} RTSStats;++void getRTSStats (RTSStats *s);+int getRTSStatsEnabled (void);++// Returns the total number of bytes allocated since the start of the program.+// TODO: can we remove this?+uint64_t getAllocations (void);++/* ----------------------------------------------------------------------------+   Starting up and shutting down the Haskell RTS.+   ------------------------------------------------------------------------- */++/* DEPRECATED, use hs_init() or hs_init_ghc() instead  */+extern void startupHaskell         ( int argc, char *argv[],+                                     void (*init_root)(void) );++/* DEPRECATED, use hs_exit() instead  */+extern void shutdownHaskell        ( void );++/* Like hs_init(), but allows rtsopts. For more complicated usage,+ * use hs_init_ghc. */+extern void hs_init_with_rtsopts (int *argc, char **argv[]);++/*+ * GHC-specific version of hs_init() that allows specifying whether+ * +RTS ... -RTS options are allowed or not (default: only "safe"+ * options are allowed), and allows passing an option string that is+ * to be interpreted by the RTS only, not passed to the program.+ */+extern void hs_init_ghc (int *argc, char **argv[],   // program arguments+                         RtsConfig rts_config);      // RTS configuration++extern void shutdownHaskellAndExit (int exitCode, int fastExit)+    GNUC3_ATTRIBUTE(__noreturn__);++#if !defined(mingw32_HOST_OS)+extern void shutdownHaskellAndSignal (int sig, int fastExit)+     GNUC3_ATTRIBUTE(__noreturn__);+#endif++extern void getProgArgv            ( int *argc, char **argv[] );+extern void setProgArgv            ( int argc, char *argv[] );+extern void getFullProgArgv        ( int *argc, char **argv[] );+extern void setFullProgArgv        ( int argc, char *argv[] );+extern void freeFullProgArgv       ( void ) ;++/* exit() override */+extern void (*exitFn)(int);++/* ----------------------------------------------------------------------------+   Locking.++   You have to surround all access to the RtsAPI with these calls.+   ------------------------------------------------------------------------- */++// acquires a token which may be used to create new objects and+// evaluate them.+Capability *rts_lock (void);++// releases the token acquired with rts_lock().+void rts_unlock (Capability *token);++// If you are in a context where you know you have a current capability but+// do not know what it is, then use this to get it. Basically this only+// applies to "unsafe" foreign calls (as unsafe foreign calls are made with+// the capability held).+//+// WARNING: There is *no* guarantee this returns anything sensible (eg NULL)+// when there is no current capability.+Capability *rts_unsafeGetMyCapability (void);++/* ----------------------------------------------------------------------------+   Which cpu should the OS thread and Haskell thread run on?++   1. Run the current thread on the given capability:+     rts_setInCallCapability(cap, 0);++   2. Run the current thread on the given capability and set the cpu affinity+      for this thread:+     rts_setInCallCapability(cap, 1);++   3. Run the current thread on the given numa node:+     rts_pinThreadToNumaNode(node);++   4. Run the current thread on the given capability and on the given numa node:+     rts_setInCallCapability(cap, 0);+     rts_pinThreadToNumaNode(cap);+   ------------------------------------------------------------------------- */++// Specify the Capability that the current OS thread should run on when it calls+// into Haskell.  The actual capability will be calculated as the supplied+// value modulo the number of enabled Capabilities.+//+// Note that the thread may still be migrated by the RTS scheduler, but that+// will only happen if there are multiple threads running on one Capability and+// another Capability is free.+//+// If affinity is non-zero, the current thread will be bound to+// specific CPUs according to the prevailing affinity policy for the+// specified capability, set by either +RTS -qa or +RTS --numa.+void rts_setInCallCapability (int preferred_capability, int affinity);++// Specify the CPU Node that the current OS thread should run on when it calls+// into Haskell. The argument can be either a node number or capability number.+// The actual node will be calculated as the supplied value modulo the number+// of numa nodes.+void rts_pinThreadToNumaNode (int node);++/* ----------------------------------------------------------------------------+   Building Haskell objects from C datatypes.+   ------------------------------------------------------------------------- */+HaskellObj   rts_mkChar       ( Capability *, HsChar   c );+HaskellObj   rts_mkInt        ( Capability *, HsInt    i );+HaskellObj   rts_mkInt8       ( Capability *, HsInt8   i );+HaskellObj   rts_mkInt16      ( Capability *, HsInt16  i );+HaskellObj   rts_mkInt32      ( Capability *, HsInt32  i );+HaskellObj   rts_mkInt64      ( Capability *, HsInt64  i );+HaskellObj   rts_mkWord       ( Capability *, HsWord   w );+HaskellObj   rts_mkWord8      ( Capability *, HsWord8  w );+HaskellObj   rts_mkWord16     ( Capability *, HsWord16 w );+HaskellObj   rts_mkWord32     ( Capability *, HsWord32 w );+HaskellObj   rts_mkWord64     ( Capability *, HsWord64 w );+HaskellObj   rts_mkPtr        ( Capability *, HsPtr    a );+HaskellObj   rts_mkFunPtr     ( Capability *, HsFunPtr a );+HaskellObj   rts_mkFloat      ( Capability *, HsFloat  f );+HaskellObj   rts_mkDouble     ( Capability *, HsDouble f );+HaskellObj   rts_mkStablePtr  ( Capability *, HsStablePtr s );+HaskellObj   rts_mkBool       ( Capability *, HsBool   b );+HaskellObj   rts_mkString     ( Capability *, char    *s );++HaskellObj   rts_apply        ( Capability *, HaskellObj, HaskellObj );++/* ----------------------------------------------------------------------------+   Deconstructing Haskell objects+   ------------------------------------------------------------------------- */+HsChar       rts_getChar      ( HaskellObj );+HsInt        rts_getInt       ( HaskellObj );+HsInt8       rts_getInt8      ( HaskellObj );+HsInt16      rts_getInt16     ( HaskellObj );+HsInt32      rts_getInt32     ( HaskellObj );+HsInt64      rts_getInt64     ( HaskellObj );+HsWord       rts_getWord      ( HaskellObj );+HsWord8      rts_getWord8     ( HaskellObj );+HsWord16     rts_getWord16    ( HaskellObj );+HsWord32     rts_getWord32    ( HaskellObj );+HsWord64     rts_getWord64    ( HaskellObj );+HsPtr        rts_getPtr       ( HaskellObj );+HsFunPtr     rts_getFunPtr    ( HaskellObj );+HsFloat      rts_getFloat     ( HaskellObj );+HsDouble     rts_getDouble    ( HaskellObj );+HsStablePtr  rts_getStablePtr ( HaskellObj );+HsBool       rts_getBool      ( HaskellObj );++/* ----------------------------------------------------------------------------+   Evaluating Haskell expressions++   The versions ending in '_' allow you to specify an initial stack size.+   Note that these calls may cause Garbage Collection, so all HaskellObj+   references are rendered invalid by these calls.++   All of these functions take a (Capability **) - there is a+   Capability pointer both input and output.  We use an inout+   parameter because this is less error-prone for the client than a+   return value - the client could easily forget to use the return+   value, whereas incorrectly using an inout parameter will usually+   result in a type error.+   ------------------------------------------------------------------------- */++void rts_eval (/* inout */ Capability **,+               /* in    */ HaskellObj p,+               /* out */   HaskellObj *ret);++void rts_eval_ (/* inout */ Capability **,+                /* in    */ HaskellObj p,+                /* in    */ unsigned int stack_size,+                /* out   */ HaskellObj *ret);++void rts_evalIO (/* inout */ Capability **,+                 /* in    */ HaskellObj p,+                 /* out */   HaskellObj *ret);++void rts_evalStableIOMain (/* inout */ Capability **,+                           /* in    */ HsStablePtr s,+                           /* out */   HsStablePtr *ret);++void rts_evalStableIO (/* inout */ Capability **,+                       /* in    */ HsStablePtr s,+                       /* out */   HsStablePtr *ret);++void rts_evalLazyIO (/* inout */ Capability **,+                     /* in    */ HaskellObj p,+                     /* out */   HaskellObj *ret);++void rts_evalLazyIO_ (/* inout */ Capability **,+                      /* in    */ HaskellObj p,+                      /* in    */ unsigned int stack_size,+                      /* out   */ HaskellObj *ret);++void rts_checkSchedStatus (char* site, Capability *);++SchedulerStatus rts_getSchedStatus (Capability *cap);++/*+ * The RTS allocates some thread-local data when you make a call into+ * Haskell using one of the rts_eval() functions.  This data is not+ * normally freed until hs_exit().  If you want to free it earlier+ * than this, perhaps because the thread is about to exit, then call+ * rts_done() from the thread.+ *+ * It is safe to make more rts_eval() calls after calling rts_done(),+ * but the next one will cause allocation of the thread-local memory+ * again.+ */+void rts_done (void);++/* --------------------------------------------------------------------------+   Wrapper closures++   These are used by foreign export and foreign import "wrapper" stubs.+   ----------------------------------------------------------------------- */++// When producing Windows DLLs the we need to know which symbols are in the+//      local package/DLL vs external ones.+//+//      Note that RtsAPI.h is also included by foreign export stubs in+//      the base package itself.+//+#if defined(COMPILING_WINDOWS_DLL) && !defined(COMPILING_BASE_PACKAGE)+__declspec(dllimport) extern StgWord base_GHCziTopHandler_runIO_closure[];+__declspec(dllimport) extern StgWord base_GHCziTopHandler_runNonIO_closure[];+#else+extern StgWord base_GHCziTopHandler_runIO_closure[];+extern StgWord base_GHCziTopHandler_runNonIO_closure[];+#endif++#define runIO_closure     base_GHCziTopHandler_runIO_closure+#define runNonIO_closure  base_GHCziTopHandler_runNonIO_closure++/* ------------------------------------------------------------------------ */++#if defined(__cplusplus)+}+#endif
+ includes/Stg.h view
@@ -0,0 +1,599 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * Top-level include file for everything required when compiling .hc+ * code.  NOTE: in .hc files, Stg.h must be included *before* any+ * other headers, because we define some register variables which must+ * be done before any inline functions are defined (some system+ * headers have been known to define the odd inline function).+ *+ * We generally try to keep as little visible as possible when+ * compiling .hc files.  So for example the definitions of the+ * InfoTable structs, closure structs and other RTS types are not+ * visible here.  The compiler knows enough about the representations+ * of these types to generate code which manipulates them directly+ * with pointer arithmetic.+ *+ * In ordinary C code, do not #include this file directly: #include+ * "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#if !(__STDC_VERSION__ >= 199901L) && !(__cplusplus >= 201103L)+# error __STDC_VERSION__ does not advertise C99, C++11 or later+#endif++/*+ * If we are compiling a .hc file, then we want all the register+ * variables.  This is the what happens if you #include "Stg.h" first:+ * we assume this is a .hc file, and set IN_STG_CODE==1, which later+ * causes the register variables to be enabled in stg/Regs.h.+ *+ * If instead "Rts.h" is included first, then we are compiling a+ * vanilla C file.  Everything from Stg.h is provided, except that+ * IN_STG_CODE is not defined, and the register variables will not be+ * active.+ */+#if !defined(IN_STG_CODE)+# define IN_STG_CODE 1++// Turn on C99 for .hc code.  This gives us the INFINITY and NAN+// constants from math.h, which we occasionally need to use in .hc (#1861)+# define _ISOC99_SOURCE++// We need _BSD_SOURCE so that math.h defines things like gamma+// on Linux+# define _BSD_SOURCE++// On AIX we need _BSD defined, otherwise <math.h> includes <stdlib.h>+# if defined(_AIX)+#  define _BSD 1+# endif++// '_BSD_SOURCE' is deprecated since glibc-2.20+// in favour of '_DEFAULT_SOURCE'+# define _DEFAULT_SOURCE+#endif++#if IN_STG_CODE == 0 || defined(llvm_CC_FLAVOR)+// C compilers that use an LLVM back end (clang or llvm-gcc) do not+// correctly support global register variables so we make sure that+// we do not declare them for these compilers.+# define NO_GLOBAL_REG_DECLS    /* don't define fixed registers */+#endif++/* Configuration */+#include "ghcconfig.h"++/* The code generator calls the math functions directly in .hc code.+   NB. after configuration stuff above, because this sets #defines+   that depend on config info, such as __USE_FILE_OFFSET64 */+#include <math.h>++// On Solaris, we don't get the INFINITY and NAN constants unless we+// #define _STDC_C99, and we can't do that unless we also use -std=c99,+// because _STDC_C99 causes the headers to use C99 syntax (e.g. restrict).+// We aren't ready for -std=c99 yet, so define INFINITY/NAN by hand using+// the gcc builtins.+#if !defined(INFINITY)+#if defined(__GNUC__)+#define INFINITY __builtin_inf()+#else+#error No definition for INFINITY+#endif+#endif++#if !defined(NAN)+#if defined(__GNUC__)+#define NAN __builtin_nan("")+#else+#error No definition for NAN+#endif+#endif++/* -----------------------------------------------------------------------------+   Useful definitions+   -------------------------------------------------------------------------- */++/*+ * The C backend likes to refer to labels by just mentioning their+ * names.  However, when a symbol is declared as a variable in C, the+ * C compiler will implicitly dereference it when it occurs in source.+ * So we must subvert this behaviour for .hc files by declaring+ * variables as arrays, which eliminates the implicit dereference.+ */+#if IN_STG_CODE+#define RTS_VAR(x) (x)[]+#define RTS_DEREF(x) (*(x))+#else+#define RTS_VAR(x) x+#define RTS_DEREF(x) x+#endif++/* bit macros+ */+#define BITS_PER_BYTE 8+#define BITS_IN(x) (BITS_PER_BYTE * sizeof(x))++/* Compute offsets of struct fields+ */+#define STG_FIELD_OFFSET(s_type, field) ((StgWord)&(((s_type*)0)->field))++/*+ * 'Portable' inlining:+ * INLINE_HEADER is for inline functions in header files (macros)+ * STATIC_INLINE is for inline functions in source files+ * EXTERN_INLINE is for functions that we want to inline sometimes+ * (we also compile a static version of the function; see Inlines.c)+ */++// We generally assume C99 semantics albeit these two definitions work fine even+// when gnu90 semantics are active (i.e. when __GNUC_GNU_INLINE__ is defined or+// when a GCC older than 4.2 is used)+//+// The problem, however, is with 'extern inline' whose semantics significantly+// differs between gnu90 and C99+#define INLINE_HEADER static inline+#define STATIC_INLINE static inline++// Figure out whether `__attributes__((gnu_inline))` is needed+// to force gnu90-style 'external inline' semantics.+#if defined(FORCE_GNU_INLINE)+// disable auto-detection since HAVE_GNU_INLINE has been defined externally+#elif defined(__GNUC_GNU_INLINE__) && __GNUC__ == 4 && __GNUC_MINOR__ == 2+// GCC 4.2.x didn't properly support C99 inline semantics (GCC 4.3 was the first+// release to properly support C99 inline semantics), and therefore warned when+// using 'extern inline' while in C99 mode unless `__attributes__((gnu_inline))`+// was explicitly set.+# define FORCE_GNU_INLINE 1+#endif++#if defined(FORCE_GNU_INLINE)+// Force compiler into gnu90 semantics+# if defined(KEEP_INLINES)+#  define EXTERN_INLINE inline __attribute__((gnu_inline))+# else+#  define EXTERN_INLINE extern inline __attribute__((gnu_inline))+# endif+#elif defined(__GNUC_GNU_INLINE__)+// we're currently in gnu90 inline mode by default and+// __attribute__((gnu_inline)) may not be supported, so better leave it off+# if defined(KEEP_INLINES)+#  define EXTERN_INLINE inline+# else+#  define EXTERN_INLINE extern inline+# endif+#else+// Assume C99 semantics (yes, this curiously results in swapped definitions!)+// This is the preferred branch, and at some point we may drop support for+// compilers not supporting C99 semantics altogether.+# if defined(KEEP_INLINES)+#  define EXTERN_INLINE extern inline+# else+#  define EXTERN_INLINE inline+# endif+#endif+++/*+ * GCC attributes+ */+#if defined(__GNUC__)+#define GNU_ATTRIBUTE(at) __attribute__((at))+#else+#define GNU_ATTRIBUTE(at)+#endif++#if __GNUC__ >= 3+#define GNUC3_ATTRIBUTE(at) __attribute__((at))+#else+#define GNUC3_ATTRIBUTE(at)+#endif++/* Used to mark a switch case that falls-through */+#if (defined(__GNUC__) && __GNUC__ >= 7)+// N.B. Don't enable fallthrough annotations when compiling with Clang.+// Apparently clang doesn't enable implicitly fallthrough warnings by default+// http://llvm.org/viewvc/llvm-project?revision=167655&view=revision+// when compiling C and the attribute cause warnings of their own (#16019).+#define FALLTHROUGH GNU_ATTRIBUTE(fallthrough)+#else+#define FALLTHROUGH ((void)0)+#endif /* __GNUC__ >= 7 */++#if !defined(DEBUG) && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3))+#define GNUC_ATTR_HOT __attribute__((hot))+#else+#define GNUC_ATTR_HOT /* nothing */+#endif++#define STG_UNUSED    GNUC3_ATTRIBUTE(__unused__)++/* Prevent functions from being optimized.+   See Note [Windows Stack allocations] */+#if defined(__clang__)+#define STG_NO_OPTIMIZE __attribute__((optnone))+#elif defined(__GNUC__) || defined(__GNUG__)+#define STG_NO_OPTIMIZE __attribute__((optimize("O0")))+#else+#define STG_NO_OPTIMIZE /* nothing */+#endif++/* -----------------------------------------------------------------------------+   Global type definitions+   -------------------------------------------------------------------------- */++#include "MachDeps.h"+#include "stg/Types.h"++/* -----------------------------------------------------------------------------+   Shorthand forms+   -------------------------------------------------------------------------- */++typedef StgChar      C_;+typedef StgWord      W_;+typedef StgWord*  P_;+typedef StgInt    I_;+typedef StgWord StgWordArray[];+typedef StgFunPtr       F_;++/* byte arrays (and strings): */+#define EB_(X)    extern const char X[]+#define IB_(X)    static const char X[]+/* static (non-heap) closures (requires alignment for pointer tagging): */+#define EC_(X)    extern       StgWordArray (X) GNU_ATTRIBUTE(aligned (8))+#define IC_(X)    static       StgWordArray (X) GNU_ATTRIBUTE(aligned (8))+/* writable data (does not require alignment): */+#define ERW_(X)   extern       StgWordArray (X)+#define IRW_(X)   static       StgWordArray (X)+/* read-only data (does not require alignment): */+#define ERO_(X)   extern const StgWordArray (X)+#define IRO_(X)   static const StgWordArray (X)+/* stg-native functions: */+#define IF_(f)    static StgFunPtr GNUC3_ATTRIBUTE(used) f(void)+#define FN_(f)           StgFunPtr f(void)+#define EF_(f)           StgFunPtr f(void) /* External Cmm functions */+/* foreign functions: */+#define EFF_(f)   void f() /* See Note [External function prototypes] */++/* Note [External function prototypes]  See #8965, #11395+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In generated C code we need to distinct between two types+of external symbols:+1.  Cmm functions declared by 'EF_' macro (External Functions)+2.    C functions declared by 'EFF_' macro (External Foreign Functions)++Cmm functions are simple as they are internal to GHC.++C functions are trickier:++The external-function macro EFF_(F) used to be defined as+    extern StgFunPtr f(void)+i.e a function of zero arguments.  On most platforms this doesn't+matter very much: calls to these functions put the parameters in the+usual places anyway, and (with the exception of varargs) things just+work.++However, the ELFv2 ABI on ppc64 optimises stack allocation+(http://gcc.gnu.org/ml/gcc-patches/2013-11/msg01149.html): a call to a+function that has a prototype, is not varargs, and receives all parameters+in registers rather than on the stack does not require the caller to+allocate an argument save area.  The incorrect prototypes cause GCC to+believe that all functions declared this way can be called without an+argument save area, but if the callee has sufficiently many arguments then+it will expect that area to be present, and will thus corrupt the caller's+stack.  This happens in particular with calls to runInteractiveProcess in+libraries/process/cbits/runProcess.c, and led to #8965.++The simplest fix appears to be to declare these external functions with an+unspecified argument list rather than a void argument list.  This is no+worse for platforms that don't care either way, and allows a successful+bootstrap of GHC 7.8 on little-endian Linux ppc64 (which uses the ELFv2+ABI).++Another case is m68k ABI where 'void*' return type is returned by 'a0'+register while 'long' return type is returned by 'd0'. Thus we trick+external prototype return neither of these types to workaround #11395.+*/+++/* -----------------------------------------------------------------------------+   Tail calls+   -------------------------------------------------------------------------- */++#define JMP_(cont) return((StgFunPtr)(cont))++/* -----------------------------------------------------------------------------+   Other Stg stuff...+   -------------------------------------------------------------------------- */++#include "stg/DLL.h"+#include "stg/RtsMachRegs.h"+#include "stg/Regs.h"+#include "stg/Ticky.h"++#if IN_STG_CODE+/*+ * This is included later for RTS sources, after definitions of+ * StgInfoTable, StgClosure and so on.+ */+#include "stg/MiscClosures.h"+#endif++#include "stg/Prim.h" /* ghc-prim fallbacks */+#include "stg/SMP.h" // write_barrier() inline is required++/* -----------------------------------------------------------------------------+   Moving Floats and Doubles++   ASSIGN_FLT is for assigning a float to memory (usually the+              stack/heap).  The memory address is guaranteed to be+         StgWord aligned (currently == sizeof(void *)).++   PK_FLT     is for pulling a float out of memory.  The memory is+              guaranteed to be StgWord aligned.+   -------------------------------------------------------------------------- */++INLINE_HEADER void     ASSIGN_FLT (W_ [], StgFloat);+INLINE_HEADER StgFloat    PK_FLT     (W_ []);++#if ALIGNMENT_FLOAT <= ALIGNMENT_VOID_P++INLINE_HEADER void     ASSIGN_FLT(W_ p_dest[], StgFloat src) { *(StgFloat *)p_dest = src; }+INLINE_HEADER StgFloat PK_FLT    (W_ p_src[])                { return *(StgFloat *)p_src; }++#else  /* ALIGNMENT_FLOAT > ALIGNMENT_UNSIGNED_INT */++INLINE_HEADER void ASSIGN_FLT(W_ p_dest[], StgFloat src)+{+    float_thing y;+    y.f = src;+    *p_dest = y.fu;+}++INLINE_HEADER StgFloat PK_FLT(W_ p_src[])+{+    float_thing y;+    y.fu = *p_src;+    return(y.f);+}++#endif /* ALIGNMENT_FLOAT > ALIGNMENT_VOID_P */++#if ALIGNMENT_DOUBLE <= ALIGNMENT_VOID_P++INLINE_HEADER void     ASSIGN_DBL (W_ [], StgDouble);+INLINE_HEADER StgDouble   PK_DBL     (W_ []);++INLINE_HEADER void      ASSIGN_DBL(W_ p_dest[], StgDouble src) { *(StgDouble *)p_dest = src; }+INLINE_HEADER StgDouble PK_DBL    (W_ p_src[])                 { return *(StgDouble *)p_src; }++#else /* ALIGNMENT_DOUBLE > ALIGNMENT_VOID_P */++/* Sparc uses two floating point registers to hold a double.  We can+ * write ASSIGN_DBL and PK_DBL by directly accessing the registers+ * independently - unfortunately this code isn't writable in C, we+ * have to use inline assembler.+ */+#if defined(sparc_HOST_ARCH)++#define ASSIGN_DBL(dst0,src) \+    { StgPtr dst = (StgPtr)(dst0); \+      __asm__("st %2,%0\n\tst %R2,%1" : "=m" (((P_)(dst))[0]), \+   "=m" (((P_)(dst))[1]) : "f" (src)); \+    }++#define PK_DBL(src0) \+    ( { StgPtr src = (StgPtr)(src0); \+        register double d; \+      __asm__("ld %1,%0\n\tld %2,%R0" : "=f" (d) : \+   "m" (((P_)(src))[0]), "m" (((P_)(src))[1])); d; \+    } )++#else /* ! sparc_HOST_ARCH */++INLINE_HEADER void     ASSIGN_DBL (W_ [], StgDouble);+INLINE_HEADER StgDouble   PK_DBL     (W_ []);++typedef struct+  { StgWord dhi;+    StgWord dlo;+  } unpacked_double;++typedef union+  { StgDouble d;+    unpacked_double du;+  } double_thing;++INLINE_HEADER void ASSIGN_DBL(W_ p_dest[], StgDouble src)+{+    double_thing y;+    y.d = src;+    p_dest[0] = y.du.dhi;+    p_dest[1] = y.du.dlo;+}++/* GCC also works with this version, but it generates+   the same code as the previous one, and is not ANSI++#define ASSIGN_DBL( p_dest, src ) \+   *p_dest = ((double_thing) src).du.dhi; \+   *(p_dest+1) = ((double_thing) src).du.dlo \+*/++INLINE_HEADER StgDouble PK_DBL(W_ p_src[])+{+    double_thing y;+    y.du.dhi = p_src[0];+    y.du.dlo = p_src[1];+    return(y.d);+}++#endif /* ! sparc_HOST_ARCH */++#endif /* ALIGNMENT_DOUBLE > ALIGNMENT_UNSIGNED_INT */+++/* -----------------------------------------------------------------------------+   Moving 64-bit quantities around++   ASSIGN_Word64      assign an StgWord64/StgInt64 to a memory location+   PK_Word64          load an StgWord64/StgInt64 from a amemory location++   In both cases the memory location might not be 64-bit aligned.+   -------------------------------------------------------------------------- */++#if SIZEOF_HSWORD == 4++typedef struct+  { StgWord dhi;+    StgWord dlo;+  } unpacked_double_word;++typedef union+  { StgInt64 i;+    unpacked_double_word iu;+  } int64_thing;++typedef union+  { StgWord64 w;+    unpacked_double_word wu;+  } word64_thing;++INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src)+{+    word64_thing y;+    y.w = src;+    p_dest[0] = y.wu.dhi;+    p_dest[1] = y.wu.dlo;+}++INLINE_HEADER StgWord64 PK_Word64(W_ p_src[])+{+    word64_thing y;+    y.wu.dhi = p_src[0];+    y.wu.dlo = p_src[1];+    return(y.w);+}++INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src)+{+    int64_thing y;+    y.i = src;+    p_dest[0] = y.iu.dhi;+    p_dest[1] = y.iu.dlo;+}++INLINE_HEADER StgInt64 PK_Int64(W_ p_src[])+{+    int64_thing y;+    y.iu.dhi = p_src[0];+    y.iu.dlo = p_src[1];+    return(y.i);+}++#elif SIZEOF_VOID_P == 8++INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src)+{+   p_dest[0] = src;+}++INLINE_HEADER StgWord64 PK_Word64(W_ p_src[])+{+    return p_src[0];+}++INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src)+{+    p_dest[0] = src;+}++INLINE_HEADER StgInt64 PK_Int64(W_ p_src[])+{+    return p_src[0];+}++#endif /* SIZEOF_HSWORD == 4 */++/* -----------------------------------------------------------------------------+   Integer multiply with overflow+   -------------------------------------------------------------------------- */++/* Multiply with overflow checking.+ *+ * This is tricky - the usual sign rules for add/subtract don't apply.+ *+ * On 32-bit machines we use gcc's 'long long' types, finding+ * overflow with some careful bit-twiddling.+ *+ * On 64-bit machines where gcc's 'long long' type is also 64-bits,+ * we use a crude approximation, testing whether either operand is+ * larger than 32-bits; if neither is, then we go ahead with the+ * multiplication.+ *+ * Return non-zero if there is any possibility that the signed multiply+ * of a and b might overflow.  Return zero only if you are absolutely sure+ * that it won't overflow.  If in doubt, return non-zero.+ */++#if SIZEOF_VOID_P == 4++#if defined(WORDS_BIGENDIAN)+#define RTS_CARRY_IDX__ 0+#define RTS_REM_IDX__  1+#else+#define RTS_CARRY_IDX__ 1+#define RTS_REM_IDX__ 0+#endif++typedef union {+    StgInt64 l;+    StgInt32 i[2];+} long_long_u ;++#define mulIntMayOflo(a,b)       \+({                                              \+  StgInt32 r, c;           \+  long_long_u z;           \+  z.l = (StgInt64)a * (StgInt64)b;     \+  r = z.i[RTS_REM_IDX__];        \+  c = z.i[RTS_CARRY_IDX__];         \+  if (c == 0 || c == -1) {       \+    c = ((StgWord)((a^b) ^ r))         \+      >> (BITS_IN (I_) - 1);        \+  }                  \+  c;                                            \+})++/* Careful: the carry calculation above is extremely delicate.  Make sure+ * you test it thoroughly after changing it.+ */++#else++/* Approximate version when we don't have long arithmetic (on 64-bit archs) */++/* If we have n-bit words then we have n-1 bits after accounting for the+ * sign bit, so we can fit the result of multiplying 2 (n-1)/2-bit numbers */+#define HALF_POS_INT  (((I_)1) << ((BITS_IN (I_) - 1) / 2))+#define HALF_NEG_INT  (-HALF_POS_INT)++#define mulIntMayOflo(a,b)       \+({                                              \+  I_ c;              \+  if ((I_)a <= HALF_NEG_INT || a >= HALF_POS_INT    \+      || (I_)b <= HALF_NEG_INT || b >= HALF_POS_INT) {\+    c = 1;              \+  } else {              \+    c = 0;              \+  }                  \+  c;                                            \+})+#endif
+ includes/ghcconfig.h view
@@ -0,0 +1,4 @@+#pragma once++#include "ghcautoconf.h"+#include "ghcplatform.h"
+ includes/rts/Adjustor.h view
@@ -0,0 +1,22 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * Adjustor API+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * -------------------------------------------------------------------------- */++#pragma once++/* Creating and destroying an adjustor thunk */+void* createAdjustor (int cconv, +                      StgStablePtr hptr,+                      StgFunPtr wptr,+                      char *typeString);++void freeHaskellFunctionPtr (void* ptr);
+ includes/rts/BlockSignals.h view
@@ -0,0 +1,34 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * RTS signal handling + *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++/* Used by runProcess() in the process package+ */++/*+ * Function: blockUserSignals()+ *+ * Temporarily block the delivery of further console events. Needed to+ * avoid race conditions when GCing the queue of outstanding handlers or+ * when emptying the queue by running the handlers.+ * + */+void blockUserSignals(void);++/*+ * Function: unblockUserSignals()+ *+ * The inverse of blockUserSignals(); re-enable the deliver of console events.+ */+void unblockUserSignals(void);
+ includes/rts/Bytecodes.h view
@@ -0,0 +1,106 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * Bytecode definitions.+ *+ * ---------------------------------------------------------------------------*/++/* --------------------------------------------------------------------------+ * Instructions+ *+ * Notes:+ * o CASEFAIL is generated by the compiler whenever it tests an "irrefutable"+ *   pattern which fails.  If we don't see too many of these, we could+ *   optimise out the redundant test.+ * ------------------------------------------------------------------------*/++/* NOTE:++   THIS FILE IS INCLUDED IN HASKELL SOURCES (ghc/compiler/ghci/ByteCodeAsm.hs).+   DO NOT PUT C-SPECIFIC STUFF IN HERE!++   I hope that's clear :-)+*/++#define bci_STKCHECK  			1+#define bci_PUSH_L    			2+#define bci_PUSH_LL   			3+#define bci_PUSH_LLL  			4+#define bci_PUSH8                       5+#define bci_PUSH16                      6+#define bci_PUSH32                      7+#define bci_PUSH8_W                     8+#define bci_PUSH16_W                    9+#define bci_PUSH32_W                    10+#define bci_PUSH_G    			11+#define bci_PUSH_ALTS  			12+#define bci_PUSH_ALTS_P			13+#define bci_PUSH_ALTS_N			14+#define bci_PUSH_ALTS_F			15+#define bci_PUSH_ALTS_D			16+#define bci_PUSH_ALTS_L			17+#define bci_PUSH_ALTS_V			18+#define bci_PUSH_PAD8                   19+#define bci_PUSH_PAD16                  20+#define bci_PUSH_PAD32                  21+#define bci_PUSH_UBX8                   22+#define bci_PUSH_UBX16                  23+#define bci_PUSH_UBX32                  24+#define bci_PUSH_UBX  			25+#define bci_PUSH_APPLY_N		26+#define bci_PUSH_APPLY_F		27+#define bci_PUSH_APPLY_D		28+#define bci_PUSH_APPLY_L		29+#define bci_PUSH_APPLY_V		30+#define bci_PUSH_APPLY_P		31+#define bci_PUSH_APPLY_PP		32+#define bci_PUSH_APPLY_PPP		33+#define bci_PUSH_APPLY_PPPP		34+#define bci_PUSH_APPLY_PPPPP		35+#define bci_PUSH_APPLY_PPPPPP		36+/* #define bci_PUSH_APPLY_PPPPPPP		37 */+#define bci_SLIDE     			38+#define bci_ALLOC_AP   			39+#define bci_ALLOC_AP_NOUPD		40+#define bci_ALLOC_PAP  			41+#define bci_MKAP      			42+#define bci_MKPAP      			43+#define bci_UNPACK    			44+#define bci_PACK      			45+#define bci_TESTLT_I   			46+#define bci_TESTEQ_I  			47+#define bci_TESTLT_F  			48+#define bci_TESTEQ_F  			49+#define bci_TESTLT_D  			50+#define bci_TESTEQ_D  			51+#define bci_TESTLT_P  			52+#define bci_TESTEQ_P  			53+#define bci_CASEFAIL  			54+#define bci_JMP       			55+#define bci_CCALL     			56+#define bci_SWIZZLE   			57+#define bci_ENTER     			58+#define bci_RETURN    			59+#define bci_RETURN_P 			60+#define bci_RETURN_N 			61+#define bci_RETURN_F 			62+#define bci_RETURN_D 			63+#define bci_RETURN_L 			64+#define bci_RETURN_V 			65+#define bci_BRK_FUN			66+#define bci_TESTLT_W   			67+#define bci_TESTEQ_W  			68+/* If you need to go past 255 then you will run into the flags */++/* If you need to go below 0x0100 then you will run into the instructions */+#define bci_FLAG_LARGE_ARGS     0x8000++/* If a BCO definitely requires less than this many words of stack,+   don't include an explicit STKCHECK insn in it.  The interpreter+   will check for this many words of stack before running each BCO,+   rendering an explicit check unnecessary in the majority of+   cases. */+#define INTERP_STACK_CHECK_THRESH  50++/*-------------------------------------------------------------------------*/
+ includes/rts/Config.h view
@@ -0,0 +1,48 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * Rts settings.+ *+ * NOTE: assumes #include "ghcconfig.h"+ * + * NB: THIS FILE IS INCLUDED IN NON-C CODE AND DATA!  #defines only please.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#if defined(TICKY_TICKY) && defined(THREADED_RTS)+#error TICKY_TICKY is incompatible with THREADED_RTS+#endif++/*+ * Whether the runtime system will use libbfd for debugging purposes.+ */+#if defined(DEBUG) && defined(HAVE_BFD_H) && defined(HAVE_LIBBFD) && !defined(_WIN32)+#define USING_LIBBFD 1+#endif++/* DEBUG implies TRACING and TICKY_TICKY  */+#if defined(DEBUG)+#if !defined(TRACING)+#define TRACING+#endif+#if !defined(TICKY_TICKY)+#define TICKY_TICKY+#endif+#endif+++/* -----------------------------------------------------------------------------+   Signals - supported on non-PAR versions of the runtime.  See RtsSignals.h.+   -------------------------------------------------------------------------- */++#define RTS_USER_SIGNALS 1++/* Profile spin locks */++#define PROF_SPIN
+ includes/rts/Constants.h view
@@ -0,0 +1,332 @@+/* ----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * Constants+ *+ * NOTE: this information is used by both the compiler and the RTS.+ * Some of it is tweakable, and some of it must be kept up to date+ * with various other parts of the system.+ *+ * Constants which are derived automatically from other definitions in+ * the system (eg. structure sizes) are generated into the file+ * DerivedConstants.h by a C program (mkDerivedConstantsHdr).+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * -------------------------------------------------------------------------- */++#pragma once++/* -----------------------------------------------------------------------------+   Minimum closure sizes++   This is the minimum number of words in the payload of a+   heap-allocated closure, so that the closure has enough room to be+   overwritten with a forwarding pointer during garbage collection.+   -------------------------------------------------------------------------- */++#define MIN_PAYLOAD_SIZE 1++/* -----------------------------------------------------------------------------+   Constants to do with specialised closure types.+   -------------------------------------------------------------------------- */++/* We have some pre-compiled selector thunks defined in rts/StgStdThunks.hc.+ * This constant defines the highest selectee index that we can replace with a+ * reference to the pre-compiled code.+ */++#define MAX_SPEC_SELECTEE_SIZE 15++/* Vector-apply thunks.  These thunks just push their free variables+ * on the stack and enter the first one.  They're a bit like PAPs, but+ * don't have a dynamic size.  We've pre-compiled a few to save+ * space.+ */++#define MAX_SPEC_AP_SIZE       7++/* Specialised FUN/THUNK/CONSTR closure types */++#define MAX_SPEC_THUNK_SIZE    2+#define MAX_SPEC_FUN_SIZE      2+#define MAX_SPEC_CONSTR_SIZE   2++/* Range of built-in table of static small int-like and char-like closures.+ *+ *   NB. This corresponds with the number of actual INTLIKE/CHARLIKE+ *   closures defined in rts/StgMiscClosures.cmm.+ */+#define MAX_INTLIKE             16+#define MIN_INTLIKE             (-16)++#define MAX_CHARLIKE            255+#define MIN_CHARLIKE            0++/* Each byte in the card table for an StgMutaArrPtrs covers+ * (1<<MUT_ARR_PTRS_CARD_BITS) elements in the array.  To find a good+ * value for this, I used the benchmarks nofib/gc/hash,+ * nofib/gc/graph, and nofib/gc/gc_bench.+ */+#define MUT_ARR_PTRS_CARD_BITS 7++/* -----------------------------------------------------------------------------+   STG Registers.++   Note that in MachRegs.h we define how many of these registers are+   *real* machine registers, and not just offsets in the Register Table.+   -------------------------------------------------------------------------- */++#define MAX_VANILLA_REG 10+#define MAX_FLOAT_REG   6+#define MAX_DOUBLE_REG  6+#define MAX_LONG_REG    1+#define MAX_XMM_REG     6++/* -----------------------------------------------------------------------------+   Semi-Tagging constants++   Old Comments about this stuff:++   Tags for indirection nodes and ``other'' (probably unevaluated) nodes;+   normal-form values of algebraic data types will have tags 0, 1, ...++   @INFO_IND_TAG@ is different from @INFO_OTHER_TAG@ just so we can count+   how often we bang into indirection nodes; that's all.  (WDP 95/11)++   ToDo: find out if we need any of this.+   -------------------------------------------------------------------------- */++#define INFO_OTHER_TAG          (-1)+#define INFO_IND_TAG            (-2)+#define INFO_FIRST_TAG          0++/* -----------------------------------------------------------------------------+   How much C stack to reserve for local temporaries when in the STG+   world.  Used in StgCRun.c.+   -------------------------------------------------------------------------- */++#define RESERVED_C_STACK_BYTES (2048 * SIZEOF_LONG)++/* -----------------------------------------------------------------------------+   How large is the stack frame saved by StgRun?+   world.  Used in StgCRun.c.++   The size has to be enough to save the registers (see StgCRun)+   plus padding if the result is not 16 byte aligned.+   See the Note [Stack Alignment on X86] in StgCRun.c for details.++   -------------------------------------------------------------------------- */+#if defined(x86_64_HOST_ARCH)+#  if defined(mingw32_HOST_OS)+#    define STG_RUN_STACK_FRAME_SIZE 144+#  else+#    define STG_RUN_STACK_FRAME_SIZE 48+#  endif+#endif++/* -----------------------------------------------------------------------------+   StgRun related labels shared between StgCRun.c and StgStartup.cmm.+   -------------------------------------------------------------------------- */++#if defined(LEADING_UNDERSCORE)+#define STG_RUN "_StgRun"+#define STG_RUN_JMP _StgRunJmp+#define STG_RETURN "_StgReturn"+#else+#define STG_RUN "StgRun"+#define STG_RUN_JMP StgRunJmp+#define STG_RETURN "StgReturn"+#endif++/* -----------------------------------------------------------------------------+   How much Haskell stack space to reserve for the saving of registers+   etc. in the case of a stack/heap overflow.++   This must be large enough to accommodate the largest stack frame+   pushed in one of the heap check fragments in HeapStackCheck.hc+   (ie. currently the generic heap checks - 3 words for StgRetDyn,+   18 words for the saved registers, see StgMacros.h).+   -------------------------------------------------------------------------- */++#define RESERVED_STACK_WORDS 21++/* -----------------------------------------------------------------------------+   The limit on the size of the stack check performed when we enter an+   AP_STACK, in words.  See raiseAsync() and bug #1466.+   -------------------------------------------------------------------------- */++#define AP_STACK_SPLIM 1024++/* -----------------------------------------------------------------------------+   Storage manager constants+   -------------------------------------------------------------------------- */++/* The size of a block (2^BLOCK_SHIFT bytes) */+#define BLOCK_SHIFT  12++/* The size of a megablock (2^MBLOCK_SHIFT bytes) */+#define MBLOCK_SHIFT   20++/* -----------------------------------------------------------------------------+   Bitmap/size fields (used in info tables)+   -------------------------------------------------------------------------- */++/* In a 32-bit bitmap field, we use 5 bits for the size, and 27 bits+ * for the bitmap.  If the bitmap requires more than 27 bits, then we+ * store it in a separate array, and leave a pointer in the bitmap+ * field.  On a 64-bit machine, the sizes are extended accordingly.+ */+#if SIZEOF_VOID_P == 4+#define BITMAP_SIZE_MASK     0x1f+#define BITMAP_BITS_SHIFT    5+#elif SIZEOF_VOID_P == 8+#define BITMAP_SIZE_MASK     0x3f+#define BITMAP_BITS_SHIFT    6+#else+#error unknown SIZEOF_VOID_P+#endif++/* -----------------------------------------------------------------------------+   Lag/Drag/Void constants+   -------------------------------------------------------------------------- */++/*+  An LDV word is divided into 3 parts: state bits (LDV_STATE_MASK), creation+  time bits (LDV_CREATE_MASK), and last use time bits (LDV_LAST_MASK).+ */+#if SIZEOF_VOID_P == 8+#define LDV_SHIFT               30+#define LDV_STATE_MASK          0x1000000000000000+#define LDV_CREATE_MASK         0x0FFFFFFFC0000000+#define LDV_LAST_MASK           0x000000003FFFFFFF+#define LDV_STATE_CREATE        0x0000000000000000+#define LDV_STATE_USE           0x1000000000000000+#else+#define LDV_SHIFT               15+#define LDV_STATE_MASK          0x40000000+#define LDV_CREATE_MASK         0x3FFF8000+#define LDV_LAST_MASK           0x00007FFF+#define LDV_STATE_CREATE        0x00000000+#define LDV_STATE_USE           0x40000000+#endif /* SIZEOF_VOID_P */++/* -----------------------------------------------------------------------------+   TSO related constants+   -------------------------------------------------------------------------- */++/*+ * Constants for the what_next field of a TSO, which indicates how it+ * is to be run.+ */+#define ThreadRunGHC    1       /* return to address on top of stack */+#define ThreadInterpret 2       /* interpret this thread */+#define ThreadKilled    3       /* thread has died, don't run it */+#define ThreadComplete  4       /* thread has finished */++/*+ * Constants for the why_blocked field of a TSO+ * NB. keep these in sync with GHC/Conc/Sync.hs: threadStatus+ */+#define NotBlocked          0+#define BlockedOnMVar       1+#define BlockedOnMVarRead   14 /* TODO: renumber me, see #9003 */+#define BlockedOnBlackHole  2+#define BlockedOnRead       3+#define BlockedOnWrite      4+#define BlockedOnDelay      5+#define BlockedOnSTM        6++/* Win32 only: */+#define BlockedOnDoProc     7++/* Only relevant for THREADED_RTS: */+#define BlockedOnCCall      10+#define BlockedOnCCall_Interruptible 11+   /* same as above but permit killing the worker thread */++/* Involved in a message sent to tso->msg_cap */+#define BlockedOnMsgThrowTo 12++/* The thread is not on any run queues, but can be woken up+   by tryWakeupThread() */+#define ThreadMigrating     13++/* WARNING WARNING top number is BlockedOnMVarRead 14, not 13!! */++/*+ * These constants are returned to the scheduler by a thread that has+ * stopped for one reason or another.  See typedef StgThreadReturnCode+ * in TSO.h.+ */+#define HeapOverflow   1                /* might also be StackOverflow */+#define StackOverflow  2+#define ThreadYielding 3+#define ThreadBlocked  4+#define ThreadFinished 5++/*+ * Flags for the tso->flags field.+ */++/*+ * TSO_LOCKED is set when a TSO is locked to a particular Capability.+ */+#define TSO_LOCKED  2++/*+ * TSO_BLOCKEX: the TSO is blocking exceptions+ *+ * TSO_INTERRUPTIBLE: the TSO can be interrupted if it blocks+ * interruptibly (eg. with BlockedOnMVar).+ *+ * TSO_STOPPED_ON_BREAKPOINT: the thread is currently stopped in a breakpoint+ */+#define TSO_BLOCKEX       4+#define TSO_INTERRUPTIBLE 8+#define TSO_STOPPED_ON_BREAKPOINT 16++/*+ * Used by the sanity checker to check whether TSOs are on the correct+ * mutable list.+ */+#define TSO_MARKED 64++/*+ * Used to communicate between stackSqueeze() and+ * threadStackOverflow() that a thread's stack was squeezed and the+ * stack may not need to be expanded.+ */+#define TSO_SQUEEZED 128++/*+ * Enables the AllocationLimitExceeded exception when the thread's+ * allocation limit goes negative.+ */+#define TSO_ALLOC_LIMIT 256++/*+ * The number of times we spin in a spin lock before yielding (see+ * #3758).  To tune this value, use the benchmark in #3758: run the+ * server with -N2 and the client both on a dual-core.  Also make sure+ * that the chosen value doesn't slow down any of the parallel+ * benchmarks in nofib/parallel.+ */+#define SPIN_COUNT 1000++/* -----------------------------------------------------------------------------+   Spare workers per Capability in the threaded RTS++   No more than MAX_SPARE_WORKERS will be kept in the thread pool+   associated with each Capability.+   -------------------------------------------------------------------------- */++#define MAX_SPARE_WORKERS 6++/*+ * The maximum number of NUMA nodes we support.  This is a fixed limit so that+ * we can have static arrays of this size in the RTS for speed.+ */+#define MAX_NUMA_NODES 16
+ includes/rts/EventLogFormat.h view
@@ -0,0 +1,264 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2008-2009+ *+ * Event log format+ *+ * The log format is designed to be extensible: old tools should be+ * able to parse (but not necessarily understand all of) new versions+ * of the format, and new tools will be able to understand old log+ * files.+ *+ * Each event has a specific format.  If you add new events, give them+ * new numbers: we never re-use old event numbers.+ *+ * - The format is endian-independent: all values are represented in+ *    bigendian order.+ *+ * - The format is extensible:+ *+ *    - The header describes each event type and its length.  Tools+ *      that don't recognise a particular event type can skip those events.+ *+ *    - There is room for extra information in the event type+ *      specification, which can be ignored by older tools.+ *+ *    - Events can have extra information added, but existing fields+ *      cannot be changed.  Tools should ignore extra fields at the+ *      end of the event record.+ *+ *    - Old event type ids are never re-used; just take a new identifier.+ *+ *+ * The format+ * ----------+ *+ * log : EVENT_HEADER_BEGIN+ *       EventType*+ *       EVENT_HEADER_END+ *       EVENT_DATA_BEGIN+ *       Event*+ *       EVENT_DATA_END+ *+ * EventType :+ *       EVENT_ET_BEGIN+ *       Word16         -- unique identifier for this event+ *       Int16          -- >=0  size of the event in bytes (minus the header)+ *                      -- -1   variable size+ *       Word32         -- length of the next field in bytes+ *       Word8*         -- string describing the event+ *       Word32         -- length of the next field in bytes+ *       Word8*         -- extra info (for future extensions)+ *       EVENT_ET_END+ *+ * Event :+ *       Word16         -- event_type+ *       Word64         -- time (nanosecs)+ *       [Word16]       -- length of the rest (for variable-sized events only)+ *       ... extra event-specific info ...+ *+ *+ * To add a new event+ * ------------------+ *+ *  - In this file:+ *    - give it a new number, add a new #define EVENT_XXX below+ *  - In EventLog.c+ *    - add it to the EventDesc array+ *    - emit the event type in initEventLogging()+ *    - emit the new event in postEvent_()+ *    - generate the event itself by calling postEvent() somewhere+ *  - In the Haskell code to parse the event log file:+ *    - add types and code to read the new event+ *+ * -------------------------------------------------------------------------- */++#pragma once++/*+ * Markers for begin/end of the Header.+ */+#define EVENT_HEADER_BEGIN    0x68647262 /* 'h' 'd' 'r' 'b' */+#define EVENT_HEADER_END      0x68647265 /* 'h' 'd' 'r' 'e' */++#define EVENT_DATA_BEGIN      0x64617462 /* 'd' 'a' 't' 'b' */+#define EVENT_DATA_END        0xffff++/*+ * Markers for begin/end of the list of Event Types in the Header.+ * Header, Event Type, Begin = hetb+ * Header, Event Type, End = hete+ */+#define EVENT_HET_BEGIN       0x68657462 /* 'h' 'e' 't' 'b' */+#define EVENT_HET_END         0x68657465 /* 'h' 'e' 't' 'e' */++#define EVENT_ET_BEGIN        0x65746200 /* 'e' 't' 'b' 0 */+#define EVENT_ET_END          0x65746500 /* 'e' 't' 'e' 0 */++/*+ * Types of event+ */+#define EVENT_CREATE_THREAD        0 /* (thread)               */+#define EVENT_RUN_THREAD           1 /* (thread)               */+#define EVENT_STOP_THREAD          2 /* (thread, status, blockinfo) */+#define EVENT_THREAD_RUNNABLE      3 /* (thread)               */+#define EVENT_MIGRATE_THREAD       4 /* (thread, new_cap)      */+/* 5, 6, 7 deprecated */+#define EVENT_THREAD_WAKEUP        8 /* (thread, other_cap)    */+#define EVENT_GC_START             9 /* ()                     */+#define EVENT_GC_END              10 /* ()                     */+#define EVENT_REQUEST_SEQ_GC      11 /* ()                     */+#define EVENT_REQUEST_PAR_GC      12 /* ()                     */+/* 13, 14 deprecated */+#define EVENT_CREATE_SPARK_THREAD 15 /* (spark_thread)         */+#define EVENT_LOG_MSG             16 /* (message ...)          */+/* 17 deprecated */+#define EVENT_BLOCK_MARKER        18 /* (size, end_time, capability) */+#define EVENT_USER_MSG            19 /* (message ...)          */+#define EVENT_GC_IDLE             20 /* () */+#define EVENT_GC_WORK             21 /* () */+#define EVENT_GC_DONE             22 /* () */+/* 23, 24 used by eden */+#define EVENT_CAPSET_CREATE       25 /* (capset, capset_type)  */+#define EVENT_CAPSET_DELETE       26 /* (capset)               */+#define EVENT_CAPSET_ASSIGN_CAP   27 /* (capset, cap)          */+#define EVENT_CAPSET_REMOVE_CAP   28 /* (capset, cap)          */+/* the RTS identifier is in the form of "GHC-version rts_way"  */+#define EVENT_RTS_IDENTIFIER      29 /* (capset, name_version_string) */+/* the vectors in these events are null separated strings             */+#define EVENT_PROGRAM_ARGS        30 /* (capset, commandline_vector)  */+#define EVENT_PROGRAM_ENV         31 /* (capset, environment_vector)  */+#define EVENT_OSPROCESS_PID       32 /* (capset, pid)          */+#define EVENT_OSPROCESS_PPID      33 /* (capset, parent_pid)   */+#define EVENT_SPARK_COUNTERS      34 /* (crt,dud,ovf,cnv,gcd,fiz,rem) */+#define EVENT_SPARK_CREATE        35 /* ()                     */+#define EVENT_SPARK_DUD           36 /* ()                     */+#define EVENT_SPARK_OVERFLOW      37 /* ()                     */+#define EVENT_SPARK_RUN           38 /* ()                     */+#define EVENT_SPARK_STEAL         39 /* (victim_cap)           */+#define EVENT_SPARK_FIZZLE        40 /* ()                     */+#define EVENT_SPARK_GC            41 /* ()                     */+#define EVENT_INTERN_STRING       42 /* (string, id) {not used by ghc} */+#define EVENT_WALL_CLOCK_TIME     43 /* (capset, unix_epoch_seconds, nanoseconds) */+#define EVENT_THREAD_LABEL        44 /* (thread, name_string)  */+#define EVENT_CAP_CREATE          45 /* (cap)                  */+#define EVENT_CAP_DELETE          46 /* (cap)                  */+#define EVENT_CAP_DISABLE         47 /* (cap)                  */+#define EVENT_CAP_ENABLE          48 /* (cap)                  */+#define EVENT_HEAP_ALLOCATED      49 /* (heap_capset, alloc_bytes) */+#define EVENT_HEAP_SIZE           50 /* (heap_capset, size_bytes) */+#define EVENT_HEAP_LIVE           51 /* (heap_capset, live_bytes) */+#define EVENT_HEAP_INFO_GHC       52 /* (heap_capset, n_generations,+                                         max_heap_size, alloc_area_size,+                                         mblock_size, block_size) */+#define EVENT_GC_STATS_GHC        53 /* (heap_capset, generation,+                                         copied_bytes, slop_bytes, frag_bytes,+                                         par_n_threads,+                                         par_max_copied,+                                         par_tot_copied, par_balanced_copied) */+#define EVENT_GC_GLOBAL_SYNC      54 /* ()                     */+#define EVENT_TASK_CREATE         55 /* (taskID, cap, tid)       */+#define EVENT_TASK_MIGRATE        56 /* (taskID, cap, new_cap)   */+#define EVENT_TASK_DELETE         57 /* (taskID)                 */+#define EVENT_USER_MARKER         58 /* (marker_name) */+#define EVENT_HACK_BUG_T9003      59 /* Hack: see trac #9003 */++/* Range 60 - 80 is used by eden for parallel tracing+ * see http://www.mathematik.uni-marburg.de/~eden/+ */++/* Range 100 - 139 is reserved for Mercury. */++/* Range 140 - 159 is reserved for Perf events. */++/* Range 160 - 180 is reserved for cost-centre heap profiling events. */++#define EVENT_HEAP_PROF_BEGIN              160+#define EVENT_HEAP_PROF_COST_CENTRE        161+#define EVENT_HEAP_PROF_SAMPLE_BEGIN       162+#define EVENT_HEAP_PROF_SAMPLE_COST_CENTRE 163+#define EVENT_HEAP_PROF_SAMPLE_STRING      164++#define EVENT_USER_BINARY_MSG              181++/*+ * The highest event code +1 that ghc itself emits. Note that some event+ * ranges higher than this are reserved but not currently emitted by ghc.+ * This must match the size of the EventDesc[] array in EventLog.c+ */+#define NUM_GHC_EVENT_TAGS        182++#if 0  /* DEPRECATED EVENTS: */+/* we don't actually need to record the thread, it's implicit */+#define EVENT_RUN_SPARK            5 /* (thread)               */+#define EVENT_STEAL_SPARK          6 /* (thread, victim_cap)   */+/* shutdown replaced by EVENT_CAP_DELETE */+#define EVENT_SHUTDOWN             7 /* ()                     */+/* ghc changed how it handles sparks so these are no longer applicable */+#define EVENT_CREATE_SPARK        13 /* (cap, thread) */+#define EVENT_SPARK_TO_THREAD     14 /* (cap, thread, spark_thread) */+#define EVENT_STARTUP             17 /* (num_capabilities)     */+/* these are used by eden but are replaced by new alternatives for ghc */+#define EVENT_VERSION             23 /* (version_string) */+#define EVENT_PROGRAM_INVOCATION  24 /* (commandline_string) */+#endif++/*+ * Status values for EVENT_STOP_THREAD+ *+ * 1-5 are the StgRun return values (from includes/Constants.h):+ *+ * #define HeapOverflow   1+ * #define StackOverflow  2+ * #define ThreadYielding 3+ * #define ThreadBlocked  4+ * #define ThreadFinished 5+ * #define ForeignCall                  6+ * #define BlockedOnMVar                7+ * #define BlockedOnBlackHole           8+ * #define BlockedOnRead                9+ * #define BlockedOnWrite               10+ * #define BlockedOnDelay               11+ * #define BlockedOnSTM                 12+ * #define BlockedOnDoProc              13+ * #define BlockedOnCCall               -- not used (see ForeignCall)+ * #define BlockedOnCCall_NoUnblockExc  -- not used (see ForeignCall)+ * #define BlockedOnMsgThrowTo          16+ */+#define THREAD_SUSPENDED_FOREIGN_CALL 6++/*+ * Capset type values for EVENT_CAPSET_CREATE+ */+#define CAPSET_TYPE_CUSTOM      1  /* reserved for end-user applications */+#define CAPSET_TYPE_OSPROCESS   2  /* caps belong to the same OS process */+#define CAPSET_TYPE_CLOCKDOMAIN 3  /* caps share a local clock/time      */++/*+ * Heap profile breakdown types. See EVENT_HEAP_PROF_BEGIN.+ */+typedef enum {+    HEAP_PROF_BREAKDOWN_COST_CENTRE = 0x1,+    HEAP_PROF_BREAKDOWN_MODULE,+    HEAP_PROF_BREAKDOWN_CLOSURE_DESCR,+    HEAP_PROF_BREAKDOWN_TYPE_DESCR,+    HEAP_PROF_BREAKDOWN_RETAINER,+    HEAP_PROF_BREAKDOWN_BIOGRAPHY,+    HEAP_PROF_BREAKDOWN_CLOSURE_TYPE+} HeapProfBreakdown;++#if !defined(EVENTLOG_CONSTANTS_ONLY)++typedef StgWord16 EventTypeNum;+typedef StgWord64 EventTimestamp; /* in nanoseconds */+typedef StgWord32 EventThreadID;+typedef StgWord16 EventCapNo;+typedef StgWord16 EventPayloadSize; /* variable-size events */+typedef StgWord16 EventThreadStatus; /* status for EVENT_STOP_THREAD */+typedef StgWord32 EventCapsetID;+typedef StgWord16 EventCapsetType;   /* types for EVENT_CAPSET_CREATE */+typedef StgWord64 EventTaskId;         /* for EVENT_TASK_* */+typedef StgWord64 EventKernelThreadId; /* for EVENT_TASK_CREATE */++#define EVENT_PAYLOAD_SIZE_MAX STG_WORD16_MAX+#endif
+ includes/rts/EventLogWriter.h view
@@ -0,0 +1,40 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2008-2017+ *+ * Support for fast binary event logging.+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#include <stddef.h>+#include <stdbool.h>++/*+ *  Abstraction for writing eventlog data.+ */+typedef struct {+    // Initialize an EventLogWriter (may be NULL)+    void (* initEventLogWriter) (void);++    // Write a series of events+    bool (* writeEventLog) (void *eventlog, size_t eventlog_size);++    // Flush possibly existing buffers (may be NULL)+    void (* flushEventLog) (void);++    // Close an initialized EventLogOutput (may be NULL)+    void (* stopEventLogWriter) (void);+} EventLogWriter;++/*+ * An EventLogWriter which writes eventlogs to+ * a file `program.eventlog`.+ */+extern const EventLogWriter FileEventLogWriter;
+ includes/rts/FileLock.h view
@@ -0,0 +1,19 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2007-2009+ *+ * File locking support as required by Haskell+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#include "Stg.h"++int  lockFile(int fd, StgWord64 dev, StgWord64 ino, int for_writing);+int  unlockFile(int fd);
+ includes/rts/Flags.h view
@@ -0,0 +1,301 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * Datatypes that holds the command-line flag settings.+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#include <stdio.h>+#include <stdint.h>+#include <stdbool.h>+#include "stg/Types.h"+#include "Time.h"++/* For defaults, see the @initRtsFlagsDefaults@ routine. */++/* Note [Synchronization of flags and base APIs]+ *+ * We provide accessors to RTS flags in base. (GHC.RTS module)+ * The API should be updated whenever RTS flags are modified.+ */++/* See Note [Synchronization of flags and base APIs] */+typedef struct _GC_FLAGS {+    FILE   *statsFile;+    uint32_t  giveStats;+#define NO_GC_STATS	 0+#define COLLECT_GC_STATS 1+#define ONELINE_GC_STATS 2+#define SUMMARY_GC_STATS 3+#define VERBOSE_GC_STATS 4++    uint32_t     maxStkSize;         /* in *words* */+    uint32_t     initialStkSize;     /* in *words* */+    uint32_t     stkChunkSize;       /* in *words* */+    uint32_t     stkChunkBufferSize; /* in *words* */++    uint32_t     maxHeapSize;        /* in *blocks* */+    uint32_t     minAllocAreaSize;   /* in *blocks* */+    uint32_t     largeAllocLim;      /* in *blocks* */+    uint32_t     nurseryChunkSize;   /* in *blocks* */+    uint32_t     minOldGenSize;      /* in *blocks* */+    uint32_t     heapSizeSuggestion; /* in *blocks* */+    bool heapSizeSuggestionAuto;+    double  oldGenFactor;+    double  pcFreeHeap;++    uint32_t     generations;+    bool squeezeUpdFrames;++    bool compact;		/* True <=> "compact all the time" */+    double  compactThreshold;++    bool sweep;		/* use "mostly mark-sweep" instead of copying+                                 * for the oldest generation */+    bool ringBell;++    Time    idleGCDelayTime;    /* units: TIME_RESOLUTION */+    bool doIdleGC;++    Time    longGCSync;         /* units: TIME_RESOLUTION */++    StgWord heapBase;           /* address to ask the OS for memory */++    StgWord allocLimitGrace;    /* units: *blocks*+                                 * After an AllocationLimitExceeded+                                 * exception has been raised, how much+                                 * extra space is given to the thread+                                 * to handle the exception before we+                                 * raise it again.+                                 */+    StgWord heapLimitGrace;     /* units: *blocks*+                                 * After a HeapOverflow exception has+                                 * been raised, how much extra space is+                                 * given to the thread to handle the+                                 * exception before we raise it again.+                                 */++    bool numa;                   /* Use NUMA */+    StgWord numaMask;+} GC_FLAGS;++/* See Note [Synchronization of flags and base APIs] */+typedef struct _DEBUG_FLAGS {+    /* flags to control debugging output & extra checking in various subsystems */+    bool scheduler;      /* 's' */+    bool interpreter;    /* 'i' */+    bool weak;           /* 'w' */+    bool gccafs;         /* 'G' */+    bool gc;             /* 'g' */+    bool block_alloc;    /* 'b' */+    bool sanity;         /* 'S'   warning: might be expensive! */+    bool stable;         /* 't' */+    bool prof;           /* 'p' */+    bool linker;         /* 'l'   the object linker */+    bool apply;          /* 'a' */+    bool stm;            /* 'm' */+    bool squeeze;        /* 'z'  stack squeezing & lazy blackholing */+    bool hpc;            /* 'c' coverage */+    bool sparks;         /* 'r' */+    bool numa;           /* '--debug-numa' */+    bool compact;        /* 'C' */+} DEBUG_FLAGS;++/* See Note [Synchronization of flags and base APIs] */+typedef struct _COST_CENTRE_FLAGS {+    uint32_t    doCostCentres;+# define COST_CENTRES_NONE      0+# define COST_CENTRES_SUMMARY	1+# define COST_CENTRES_VERBOSE	2 /* incl. serial time profile */+# define COST_CENTRES_ALL	3+# define COST_CENTRES_JSON      4++    int	    profilerTicks;   /* derived */+    int	    msecsPerTick;    /* derived */+    char const *outputFileNameStem;+} COST_CENTRE_FLAGS;++/* See Note [Synchronization of flags and base APIs] */+typedef struct _PROFILING_FLAGS {+    uint32_t doHeapProfile;+# define NO_HEAP_PROFILING	0	/* N.B. Used as indexes into arrays */+# define HEAP_BY_CCS		1+# define HEAP_BY_MOD		2+# define HEAP_BY_DESCR		4+# define HEAP_BY_TYPE		5+# define HEAP_BY_RETAINER       6+# define HEAP_BY_LDV            7++# define HEAP_BY_CLOSURE_TYPE   8++    Time        heapProfileInterval; /* time between samples */+    uint32_t    heapProfileIntervalTicks; /* ticks between samples (derived) */+    bool        includeTSOs;+++    bool		showCCSOnException;++    uint32_t    maxRetainerSetSize;++    uint32_t    ccsLength;++    const char*         modSelector;+    const char*         descrSelector;+    const char*         typeSelector;+    const char*         ccSelector;+    const char*         ccsSelector;+    const char*         retainerSelector;+    const char*         bioSelector;++} PROFILING_FLAGS;++#define TRACE_NONE      0+#define TRACE_EVENTLOG  1+#define TRACE_STDERR    2++/* See Note [Synchronization of flags and base APIs] */+typedef struct _TRACE_FLAGS {+    int tracing;+    bool timestamp;      /* show timestamp in stderr output */+    bool scheduler;      /* trace scheduler events */+    bool gc;             /* trace GC events */+    bool sparks_sampled; /* trace spark events by a sampled method */+    bool sparks_full;    /* trace spark events 100% accurately */+    bool user;           /* trace user events (emitted from Haskell code) */+    char *trace_output;  /* output filename for eventlog */+} TRACE_FLAGS;++/* See Note [Synchronization of flags and base APIs] */+typedef struct _CONCURRENT_FLAGS {+    Time ctxtSwitchTime;         /* units: TIME_RESOLUTION */+    int ctxtSwitchTicks;         /* derived */+} CONCURRENT_FLAGS;++/*+ * The tickInterval is the time interval between "ticks", ie.+ * timer signals (see Timer.{c,h}).  It is the frequency at+ * which we sample CCCS for profiling.+ *+ * It is changed by the +RTS -V<secs> flag.+ */+#define DEFAULT_TICK_INTERVAL USToTime(10000)++/*+ * When linkerAlwaysPic is true, the runtime linker assume that all object+ * files were compiled with -fPIC -fexternal-dynamic-refs and load them+ * anywhere in the address space.+ */+#if defined(x86_64_HOST_ARCH) && defined(darwin_HOST_OS)+#define DEFAULT_LINKER_ALWAYS_PIC true+#else+#define DEFAULT_LINKER_ALWAYS_PIC false+#endif++/* See Note [Synchronization of flags and base APIs] */+typedef struct _MISC_FLAGS {+    Time    tickInterval;        /* units: TIME_RESOLUTION */+    bool install_signal_handlers;+    bool install_seh_handlers;+    bool generate_dump_file;+    bool generate_stack_trace;+    bool machineReadable;+    bool internalCounters;       /* See Note [Internal Counter Stats] */+    bool linkerAlwaysPic;        /* Assume the object code is always PIC */+    StgWord linkerMemBase;       /* address to ask the OS for memory+                                  * for the linker, NULL ==> off */+} MISC_FLAGS;++/* See Note [Synchronization of flags and base APIs] */+typedef struct _PAR_FLAGS {+  uint32_t       nCapabilities;  /* number of threads to run simultaneously */+  bool           migrate;        /* migrate threads between capabilities */+  uint32_t       maxLocalSparks;+  bool           parGcEnabled;   /* enable parallel GC */+  uint32_t       parGcGen;       /* do parallel GC in this generation+                                  * and higher only */+  bool           parGcLoadBalancingEnabled;+                                 /* enable load-balancing in the+                                  * parallel GC */+  uint32_t       parGcLoadBalancingGen;+                                 /* do load-balancing in this+                                  * generation and higher only */++  uint32_t       parGcNoSyncWithIdle;+                                 /* if a Capability has been idle for+                                  * this many GCs, do not try to wake+                                  * it up when doing a+                                  * non-load-balancing parallel GC.+                                  * (zero disables) */++  uint32_t       parGcThreads;+                                 /* Use this many threads for parallel+                                  * GC (default: use all nNodes). */++  bool           setAffinity;    /* force thread affinity with CPUs */+} PAR_FLAGS;++/* See Note [Synchronization of flags and base APIs] */+typedef struct _TICKY_FLAGS {+    bool showTickyStats;+    FILE   *tickyFile;+} TICKY_FLAGS;++/* Put them together: */++/* See Note [Synchronization of flags and base APIs] */+typedef struct _RTS_FLAGS {+    /* The first portion of RTS_FLAGS is invariant. */+    GC_FLAGS	      GcFlags;+    CONCURRENT_FLAGS  ConcFlags;+    MISC_FLAGS        MiscFlags;+    DEBUG_FLAGS	      DebugFlags;+    COST_CENTRE_FLAGS CcFlags;+    PROFILING_FLAGS   ProfFlags;+    TRACE_FLAGS       TraceFlags;+    TICKY_FLAGS	      TickyFlags;+    PAR_FLAGS	      ParFlags;+} RTS_FLAGS;++#if defined(COMPILING_RTS_MAIN)+extern DLLIMPORT RTS_FLAGS RtsFlags;+#elif IN_STG_CODE+/* Hack because the C code generator can't generate '&label'. */+extern RTS_FLAGS RtsFlags[];+#else+extern RTS_FLAGS RtsFlags;+#endif++/*+ * The printf formats are here, so we are less likely to make+ * overly-long filenames (with disastrous results).  No more than 128+ * chars, please!+ */++#define STATS_FILENAME_MAXLEN	128++#define GR_FILENAME_FMT		"%0.124s.gr"+#define HP_FILENAME_FMT		"%0.124s.hp"+#define LIFE_FILENAME_FMT	"%0.122s.life"+#define PROF_FILENAME_FMT	"%0.122s.prof"+#define PROF_FILENAME_FMT_GUM	"%0.118s.%03d.prof"+#define QP_FILENAME_FMT		"%0.124s.qp"+#define STAT_FILENAME_FMT	"%0.122s.stat"+#define TICKY_FILENAME_FMT	"%0.121s.ticky"+#define TIME_FILENAME_FMT	"%0.122s.time"+#define TIME_FILENAME_FMT_GUM	"%0.118s.%03d.time"++/* an "int" so as to match normal "argc" */+/* Now defined in Stg.h (lib/std/cbits need these too.)+extern int     prog_argc;+extern char  **prog_argv;+*/+extern int      rts_argc;  /* ditto */+extern char   **rts_argv;
+ includes/rts/GetTime.h view
@@ -0,0 +1,16 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1995-2009+ *+ * Interface to the RTS time+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++StgWord64 getMonotonicNSec (void);
+ includes/rts/Globals.h view
@@ -0,0 +1,36 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2006-2009+ *+ * The RTS stores some "global" values on behalf of libraries, so that+ * some libraries can ensure that certain top-level things are shared+ * even when multiple versions of the library are loaded.  e.g. see+ * Data.Typeable and GHC.Conc.+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#define mkStoreAccessorPrototype(name)                                  \+    StgStablePtr                                                        \+    getOrSet##name(StgStablePtr ptr);++mkStoreAccessorPrototype(GHCConcSignalSignalHandlerStore)+mkStoreAccessorPrototype(GHCConcWindowsPendingDelaysStore)+mkStoreAccessorPrototype(GHCConcWindowsIOManagerThreadStore)+mkStoreAccessorPrototype(GHCConcWindowsProddingStore)+mkStoreAccessorPrototype(SystemEventThreadEventManagerStore)+mkStoreAccessorPrototype(SystemEventThreadIOManagerThreadStore)+mkStoreAccessorPrototype(SystemTimerThreadEventManagerStore)+mkStoreAccessorPrototype(SystemTimerThreadIOManagerThreadStore)+mkStoreAccessorPrototype(LibHSghcFastStringTable)+mkStoreAccessorPrototype(LibHSghcPersistentLinkerState)+mkStoreAccessorPrototype(LibHSghcInitLinkerDone)+mkStoreAccessorPrototype(LibHSghcGlobalDynFlags)+mkStoreAccessorPrototype(LibHSghcStaticOptions)+mkStoreAccessorPrototype(LibHSghcStaticOptionsReady)
+ includes/rts/Hpc.h view
@@ -0,0 +1,34 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2008-2009+ *+ * Haskell Program Coverage+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * -------------------------------------------------------------------------- */++#pragma once++// Simple linked list of modules+typedef struct _HpcModuleInfo {+  char *modName;                // name of module+  StgWord32 tickCount;          // number of ticks+  StgWord32 hashNo;             // Hash number for this module's mix info+  StgWord64 *tixArr;            // tix Array; local for this module+  bool from_file;               // data was read from the .tix file+  struct _HpcModuleInfo *next;+} HpcModuleInfo;++void hs_hpc_module (char *modName,+                    StgWord32 modCount,+                    StgWord32 modHashNo,+                    StgWord64 *tixArr);++HpcModuleInfo * hs_hpc_rootModule (void);++void startupHpc(void);+void exitHpc(void);
+ includes/rts/IOManager.h view
@@ -0,0 +1,43 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * IO Manager functionality in the RTS+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * -------------------------------------------------------------------------- */++#pragma once++#if defined(mingw32_HOST_OS)++int  rts_InstallConsoleEvent ( int action, StgStablePtr *handler );+void rts_ConsoleHandlerDone  ( int ev );+extern StgInt console_handler;++void *   getIOManagerEvent  (void);+HsWord32 readIOManagerEvent (void);+void     sendIOManagerEvent (HsWord32 event);++#else++void     setIOManagerControlFd   (uint32_t cap_no, int fd);+void     setTimerManagerControlFd(int fd);+void     setIOManagerWakeupFd   (int fd);++#endif++//+// Communicating with the IO manager thread (see GHC.Conc).+// Posix implementation in posix/Signals.c+// Win32 implementation in win32/ThrIOManager.c+//+void ioManagerWakeup (void);+#if defined(THREADED_RTS)+void ioManagerDie (void);+void ioManagerStart (void);+#endif
+ includes/rts/Libdw.h view
@@ -0,0 +1,97 @@+/* ---------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2014-2015+ *+ * Producing DWARF-based stacktraces with libdw.+ *+ * --------------------------------------------------------------------------*/++#pragma once++// for FILE+#include <stdio.h>++// Chunk capacity+// This is rather arbitrary+#define BACKTRACE_CHUNK_SZ 256++/*+ * Note [Chunked stack representation]+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+ *+ * Consider the stack,+ *     main                   calls                        (bottom of stack)+ *       func1                which in turn calls+ *         func2              which calls+ *          func3             which calls+ *            func4           which calls+ *              func5         which calls+ *                func6       which calls+ *                  func7     which requests a backtrace   (top of stack)+ *+ * This would produce the Backtrace (using a smaller chunk size of three for+ * illustrative purposes),+ *+ * Backtrace     /----> Chunk         /----> Chunk         /----> Chunk+ * last --------/       next --------/       next --------/       next+ * n_frames=8           n_frames=2           n_frames=3           n_frames=3+ *                      ~~~~~~~~~~           ~~~~~~~~~~           ~~~~~~~~~~+ *                      func1                func4                func7+ *                      main                 func3                func6+ *                                           func2                func5+ *+ */++/* A chunk of code addresses from an execution stack+ *+ * The first address in this list corresponds to the stack frame+ * nearest to the "top" of the stack.+ */+typedef struct BacktraceChunk_ {+    StgWord n_frames;                      // number of frames in this chunk+    struct BacktraceChunk_ *next;          // the chunk following this one+    StgPtr frames[BACKTRACE_CHUNK_SZ];     // the code addresses from the+                                           // frames+} __attribute__((packed)) BacktraceChunk;++/* A chunked list of code addresses from an execution stack+ *+ * This structure is optimized for append operations since we append O(stack+ * depth) times yet typically only traverse the stack trace once. Consequently,+ * the "top" stack frame (that is, the one where we started unwinding) can be+ * found in the last chunk. Yes, this is a bit inconsistent with the ordering+ * within a chunk. See Note [Chunked stack representation] for a depiction.+ */+typedef struct Backtrace_ {+    StgWord n_frames;        // Total number of frames in the backtrace+    BacktraceChunk *last;    // The first chunk of frames (corresponding to the+                             // bottom of the stack)+} Backtrace;++/* Various information describing the location of an address */+typedef struct Location_ {+    const char *object_file;+    const char *function;++    // lineno and colno are only valid if source_file /= NULL+    const char *source_file;+    StgWord32 lineno;+    StgWord32 colno;+} __attribute__((packed)) Location;++struct LibdwSession_;+typedef struct LibdwSession_ LibdwSession;++/* Free a backtrace */+void backtraceFree(Backtrace *bt);++/* Request a backtrace of the current stack state.+ * May return NULL if a backtrace can't be acquired. */+Backtrace *libdwGetBacktrace(LibdwSession *session);++/* Lookup Location information for the given address.+ * Returns 0 if successful, 1 if address could not be found. */+int libdwLookupLocation(LibdwSession *session, Location *loc, StgPtr pc);++/* Pretty-print a backtrace to the given FILE */+void libdwPrintBacktrace(LibdwSession *session, FILE *file, Backtrace *bt);
+ includes/rts/LibdwPool.h view
@@ -0,0 +1,19 @@+/* ---------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2015-2016+ *+ * A pool of libdw sessions+ *+ * --------------------------------------------------------------------------*/++#pragma once++/* Claim a session from the pool */+LibdwSession *libdwPoolTake(void);++/* Return a session to the pool */+void libdwPoolRelease(LibdwSession *sess);++/* Free any sessions in the pool forcing a reload of any loaded debug+ * information */+void libdwPoolClear(void);
+ includes/rts/Linker.h view
@@ -0,0 +1,101 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2009+ *+ * RTS Object Linker+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#if defined(mingw32_HOST_OS)+typedef wchar_t pathchar;+#define PATH_FMT "ls"+#else+typedef char    pathchar;+#define PATH_FMT "s"+#endif++/* Initialize the object linker. Equivalent to initLinker_(1). */+void initLinker (void);++/* Initialize the object linker.+ * The retain_cafs argument is:+ *+ *   non-zero => Retain CAFs unconditionally in linked Haskell code.+ *               Note that this prevents any code from being unloaded.+ *               It should not be necessary unless you are GHCi or+ *               hs-plugins, which needs to be able call any function+ *               in the compiled code.+ *+ *   zero     => Do not retain CAFs.  Everything reachable from foreign+ *               exports will be retained, due to the StablePtrs+ *               created by the module initialisation code.  unloadObj+ *               frees these StablePtrs, which will allow the CAFs to+ *               be GC'd and the code to be removed.+ */+void initLinker_ (int retain_cafs);++/* insert a symbol in the hash table */+HsInt insertSymbol(pathchar* obj_name, char* key, void* data);++/* lookup a symbol in the hash table */+void *lookupSymbol( char *lbl );++/* See Linker.c Note [runtime-linker-phases] */+typedef enum {+    OBJECT_LOADED,+    OBJECT_NEEDED,+    OBJECT_RESOLVED,+    OBJECT_UNLOADED,+    OBJECT_DONT_RESOLVE,+    OBJECT_NOT_LOADED     /* The object was either never loaded or has been+                             fully unloaded */+} OStatus;++/* check object load status */+OStatus getObjectLoadStatus( pathchar *path );++/* delete an object from the pool */+HsInt unloadObj( pathchar *path );++/* purge an object's symbols from the symbol table, but don't unload it */+HsInt purgeObj( pathchar *path );++/* add an obj (populate the global symbol table, but don't resolve yet) */+HsInt loadObj( pathchar *path );++/* add an arch (populate the global symbol table, but don't resolve yet) */+HsInt loadArchive( pathchar *path );++/* resolve all the currently unlinked objects in memory */+HsInt resolveObjs( void );++/* load a dynamic library */+const char *addDLL( pathchar* dll_name );++/* add a path to the library search path */+HsPtr addLibrarySearchPath(pathchar* dll_path);++/* removes a directory from the search path,+   path must have been added using addLibrarySearchPath */+HsBool removeLibrarySearchPath(HsPtr dll_path_index);++/* give a warning about missing Windows patches that would make+   the linker work better */+void warnMissingKBLibraryPaths( void );++/* -----------------------------------------------------------------------------+* Searches the system directories to determine if there is a system DLL that+* satisfies the given name. This prevent GHCi from linking against a static+* library if a DLL is available.+*/+pathchar* findSystemLibrary(pathchar* dll_name);++/* called by the initialization code for a module, not a user API */+StgStablePtr foreignExportStablePtr (StgPtr p);
+ includes/rts/Main.h view
@@ -0,0 +1,18 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2009+ *+ * Entry point for standalone Haskell programs.+ *+ * ---------------------------------------------------------------------------*/++#pragma once++/* -----------------------------------------------------------------------------+ * The entry point for Haskell programs that use a Haskell main function+ * -------------------------------------------------------------------------- */++int hs_main (int argc, char *argv[],     // program args+             StgClosure *main_closure,   // closure for Main.main+             RtsConfig rts_config)       // RTS configuration+   GNUC3_ATTRIBUTE(__noreturn__);
+ includes/rts/Messages.h view
@@ -0,0 +1,104 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * Message API for use inside the RTS.  All messages generated by the+ * RTS should go through one of the functions declared here, and we+ * also provide hooks so that messages from the RTS can be redirected+ * as appropriate.+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#include <stdarg.h>++#if defined(mingw32_HOST_OS)+/* On Win64, if we say "printf" then gcc thinks we are going to use+   MS format specifiers like %I64d rather than %llu */+#define PRINTF gnu_printf+#else+/* However, on OS X, "gnu_printf" isn't recognised */+#define PRINTF printf+#endif++/* -----------------------------------------------------------------------------+ * Message generation+ * -------------------------------------------------------------------------- */++/*+ * A fatal internal error: this is for errors that probably indicate+ * bugs in the RTS or compiler.  We normally output bug reporting+ * instructions along with the error message.+ *+ * barf() invokes (*fatalInternalErrorFn)().  This function is not+ * expected to return.+ */+void barf(const char *s, ...)+   GNUC3_ATTRIBUTE(__noreturn__)+   GNUC3_ATTRIBUTE(format(PRINTF, 1, 2));++void vbarf(const char *s, va_list ap)+   GNUC3_ATTRIBUTE(__noreturn__);++// declared in Rts.h:+// extern void _assertFail(const char *filename, unsigned int linenum)+//    GNUC3_ATTRIBUTE(__noreturn__);++/*+ * An error condition which is caused by and/or can be corrected by+ * the user.+ *+ * errorBelch() invokes (*errorMsgFn)().+ */+void errorBelch(const char *s, ...)+   GNUC3_ATTRIBUTE(format (PRINTF, 1, 2));++void verrorBelch(const char *s, va_list ap);++/*+ * An error condition which is caused by and/or can be corrected by+ * the user, and which has an associated error condition reported+ * by the system (in errno on Unix, and GetLastError() on Windows).+ * The system error message is appended to the message generated+ * from the supplied format string.+ *+ * sysErrorBelch() invokes (*sysErrorMsgFn)().+ */+void sysErrorBelch(const char *s, ...)+   GNUC3_ATTRIBUTE(format (PRINTF, 1, 2));++void vsysErrorBelch(const char *s, va_list ap);++/*+ * A debugging message.  Debugging messages are generated either as a+ * virtue of having DEBUG turned on, or by being explicitly selected+ * via RTS options (eg. +RTS -Ds).+ *+ * debugBelch() invokes (*debugMsgFn)().+ */+void debugBelch(const char *s, ...)+   GNUC3_ATTRIBUTE(format (PRINTF, 1, 2));++void vdebugBelch(const char *s, va_list ap);+++/* Hooks for redirecting message generation: */++typedef void RtsMsgFunction(const char *, va_list);++extern RtsMsgFunction *fatalInternalErrorFn;+extern RtsMsgFunction *debugMsgFn;+extern RtsMsgFunction *errorMsgFn;++/* Default stdio implementation of the message hooks: */++extern RtsMsgFunction rtsFatalInternalErrorFn;+extern RtsMsgFunction rtsDebugMsgFn;+extern RtsMsgFunction rtsErrorMsgFn;+extern RtsMsgFunction rtsSysErrorMsgFn;
+ includes/rts/OSThreads.h view
@@ -0,0 +1,258 @@+/* ---------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2001-2009+ *+ * Accessing OS threads functionality in a (mostly) OS-independent+ * manner.+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * --------------------------------------------------------------------------*/++#pragma once++#if defined(HAVE_PTHREAD_H) && !defined(mingw32_HOST_OS)++#if defined(CMINUSMINUS)++#define OS_ACQUIRE_LOCK(mutex) foreign "C" pthread_mutex_lock(mutex)+#define OS_RELEASE_LOCK(mutex) foreign "C" pthread_mutex_unlock(mutex)+#define OS_ASSERT_LOCK_HELD(mutex) /* nothing */++#else++#include <pthread.h>+#include <errno.h>++typedef pthread_cond_t  Condition;+typedef pthread_mutex_t Mutex;+typedef pthread_t       OSThreadId;+typedef pthread_key_t   ThreadLocalKey;++#define OSThreadProcAttr /* nothing */++#define INIT_COND_VAR       PTHREAD_COND_INITIALIZER++#if defined(LOCK_DEBUG)+#define LOCK_DEBUG_BELCH(what, mutex) \+  debugBelch("%s(0x%p) %s %d\n", what, mutex, __FILE__, __LINE__)+#else+#define LOCK_DEBUG_BELCH(what, mutex) /* nothing */+#endif++/* Always check the result of lock and unlock. */+#define OS_ACQUIRE_LOCK(mutex) \+  LOCK_DEBUG_BELCH("ACQUIRE_LOCK", mutex); \+  if (pthread_mutex_lock(mutex) == EDEADLK) { \+    barf("multiple ACQUIRE_LOCK: %s %d", __FILE__,__LINE__); \+  }++// Returns zero if the lock was acquired.+EXTERN_INLINE int TRY_ACQUIRE_LOCK(pthread_mutex_t *mutex);+EXTERN_INLINE int TRY_ACQUIRE_LOCK(pthread_mutex_t *mutex)+{+    LOCK_DEBUG_BELCH("TRY_ACQUIRE_LOCK", mutex);+    return pthread_mutex_trylock(mutex);+}++#define OS_RELEASE_LOCK(mutex) \+  LOCK_DEBUG_BELCH("RELEASE_LOCK", mutex); \+  if (pthread_mutex_unlock(mutex) != 0) { \+    barf("RELEASE_LOCK: I do not own this lock: %s %d", __FILE__,__LINE__); \+  }++// Note: this assertion calls pthread_mutex_lock() on a mutex that+// is already held by the calling thread.  The mutex should therefore+// have been created with PTHREAD_MUTEX_ERRORCHECK, otherwise this+// assertion will hang.  We always initialise mutexes with+// PTHREAD_MUTEX_ERRORCHECK when DEBUG is on (see rts/posix/OSThreads.h).+#define OS_ASSERT_LOCK_HELD(mutex) ASSERT(pthread_mutex_lock(mutex) == EDEADLK)++#endif // CMINUSMINUS++# elif defined(HAVE_WINDOWS_H)++#if defined(CMINUSMINUS)++/* We jump through a hoop here to get a CCall EnterCriticalSection+   and LeaveCriticalSection, as that's what C-- wants. */++#define OS_ACQUIRE_LOCK(mutex) foreign "stdcall" EnterCriticalSection(mutex)+#define OS_RELEASE_LOCK(mutex) foreign "stdcall" LeaveCriticalSection(mutex)+#define OS_ASSERT_LOCK_HELD(mutex) /* nothing */++#else++#include <windows.h>++typedef HANDLE Condition;+typedef DWORD OSThreadId;+// don't be tempted to use HANDLE as the OSThreadId: there can be+// many HANDLES to a given thread, so comparison would not work.+typedef DWORD ThreadLocalKey;++#define OSThreadProcAttr __stdcall++#define INIT_COND_VAR  0++// We have a choice for implementing Mutexes on Windows.  Standard+// Mutexes are kernel objects that require kernel calls to+// acquire/release, whereas CriticalSections are spin-locks that block+// in the kernel after spinning for a configurable number of times.+// CriticalSections are *much* faster, so we use those.  The Mutex+// implementation is left here for posterity.+#define USE_CRITICAL_SECTIONS 1++#if USE_CRITICAL_SECTIONS++typedef CRITICAL_SECTION Mutex;++#if defined(LOCK_DEBUG)++#define OS_ACQUIRE_LOCK(mutex) \+  debugBelch("ACQUIRE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \+  EnterCriticalSection(mutex)+#define OS_RELEASE_LOCK(mutex) \+  debugBelch("RELEASE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \+  LeaveCriticalSection(mutex)+#define OS_ASSERT_LOCK_HELD(mutex) /* nothing */++#else++#define OS_ACQUIRE_LOCK(mutex)      EnterCriticalSection(mutex)+#define TRY_ACQUIRE_LOCK(mutex)  (TryEnterCriticalSection(mutex) == 0)+#define OS_RELEASE_LOCK(mutex)      LeaveCriticalSection(mutex)++// I don't know how to do this.  TryEnterCriticalSection() doesn't do+// the right thing.+#define OS_ASSERT_LOCK_HELD(mutex) /* nothing */++#endif++#else++typedef HANDLE Mutex;++// casting to (Mutex *) here required due to use in .cmm files where+// the argument has (void *) type.+#define OS_ACQUIRE_LOCK(mutex)                                     \+    if (WaitForSingleObject(*((Mutex *)mutex),INFINITE) == WAIT_FAILED) { \+        barf("WaitForSingleObject: %d", GetLastError());        \+    }++#define OS_RELEASE_LOCK(mutex)                             \+    if (ReleaseMutex(*((Mutex *)mutex)) == 0) {         \+        barf("ReleaseMutex: %d", GetLastError());       \+    }++#define OS_ASSERT_LOCK_HELD(mutex) /* nothing */+#endif++#endif // CMINUSMINUS++# elif defined(THREADED_RTS)+#  error "Threads not supported"+# endif+++#if !defined(CMINUSMINUS)+//+// General thread operations+//+extern OSThreadId osThreadId      ( void );+extern void shutdownThread        ( void )   GNUC3_ATTRIBUTE(__noreturn__);+extern void yieldThread           ( void );++typedef void* OSThreadProcAttr OSThreadProc(void *);++extern int  createOSThread        ( OSThreadId* tid, char *name,+                                    OSThreadProc *startProc, void *param);+extern bool osThreadIsAlive       ( OSThreadId id );+extern void interruptOSThread     (OSThreadId id);++//+// Condition Variables+//+extern void initCondition         ( Condition* pCond );+extern void closeCondition        ( Condition* pCond );+extern bool broadcastCondition    ( Condition* pCond );+extern bool signalCondition       ( Condition* pCond );+extern bool waitCondition         ( Condition* pCond, Mutex* pMut );++//+// Mutexes+//+extern void initMutex             ( Mutex* pMut );+extern void closeMutex            ( Mutex* pMut );++//+// Thread-local storage+//+void  newThreadLocalKey (ThreadLocalKey *key);+void *getThreadLocalVar (ThreadLocalKey *key);+void  setThreadLocalVar (ThreadLocalKey *key, void *value);+void  freeThreadLocalKey (ThreadLocalKey *key);++// Processors and affinity+void setThreadAffinity (uint32_t n, uint32_t m);+void setThreadNode (uint32_t node);+void releaseThreadNode (void);+#endif // !CMINUSMINUS++#if defined(THREADED_RTS)++#define ACQUIRE_LOCK(l) OS_ACQUIRE_LOCK(l)+#define RELEASE_LOCK(l) OS_RELEASE_LOCK(l)+#define ASSERT_LOCK_HELD(l) OS_ASSERT_LOCK_HELD(l)++#else++#define ACQUIRE_LOCK(l)+#define RELEASE_LOCK(l)+#define ASSERT_LOCK_HELD(l)++#endif /* defined(THREADED_RTS) */++#if !defined(CMINUSMINUS)+//+// Support for forkOS (defined regardless of THREADED_RTS, but does+// nothing when !THREADED_RTS).+//+int forkOS_createThread ( HsStablePtr entry );++//+// Free any global resources created in OSThreads.+//+void freeThreadingResources(void);++//+// Returns the number of processor cores in the machine+//+uint32_t getNumberOfProcessors (void);++//+// Support for getting at the kernel thread Id for tracing/profiling.+//+// This stuff is optional and only used for tracing/profiling purposes, to+// match up thread ids recorded by other tools. For example, on Linux and OSX+// the pthread_t type is not the same as the kernel thread id, and system+// profiling tools like Linux perf, and OSX's DTrace use the kernel thread Id.+// So if we want to match up RTS tasks with kernel threads recorded by these+// tools then we need to know the kernel thread Id, and this must be a separate+// type from the OSThreadId.+//+// If the feature cannot be supported on an OS, it is OK to always return 0.+// In particular it would almost certaily be meaningless on systems not using+// a 1:1 threading model.++// We use a common serialisable representation on all OSs+// This is ok for Windows, OSX and Linux.+typedef StgWord64 KernelThreadId;++// Get the current kernel thread id+KernelThreadId kernelThreadId (void);++#endif /* CMINUSMINUS */
+ includes/rts/Parallel.h view
@@ -0,0 +1,16 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * Parallelism-related functionality+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * -------------------------------------------------------------------------- */++#pragma once++StgInt newSpark (StgRegTable *reg, StgClosure *p);
+ includes/rts/PrimFloat.h view
@@ -0,0 +1,17 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * Primitive floating-point operations+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++StgDouble __int_encodeDouble (I_ j, I_ e);+StgFloat  __int_encodeFloat (I_ j, I_ e);+StgDouble __word_encodeDouble (W_ j, I_ e);+StgFloat  __word_encodeFloat (W_ j, I_ e);
+ includes/rts/Profiling.h view
@@ -0,0 +1,17 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2017-2018+ *+ * Cost-centre profiling API+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * -------------------------------------------------------------------------- */++#pragma once++void registerCcList(CostCentre **cc_list);+void registerCcsList(CostCentreStack **cc_list);
+ includes/rts/Signals.h view
@@ -0,0 +1,23 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * RTS signal handling + *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++/* NB. #included in Haskell code, no prototypes in here. */++/* arguments to stg_sig_install() */+#define STG_SIG_DFL   (-1)+#define STG_SIG_IGN   (-2)+#define STG_SIG_ERR   (-3)+#define STG_SIG_HAN   (-4)+#define STG_SIG_RST   (-5)
+ includes/rts/SpinLock.h view
@@ -0,0 +1,116 @@+/* ----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2006-2009+ *+ * Spin locks+ *+ * These are simple spin-only locks as opposed to Mutexes which+ * probably spin for a while before blocking in the kernel.  We use+ * these when we are sure that all our threads are actively running on+ * a CPU, eg. in the GC.+ *+ * TODO: measure whether we really need these, or whether Mutexes+ * would do (and be a bit safer if a CPU becomes loaded).+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * -------------------------------------------------------------------------- */++#pragma once++#if defined(THREADED_RTS)++#if defined(PROF_SPIN)+typedef struct SpinLock_+{+    StgWord   lock;+    StgWord64 spin;  // incremented every time we spin in ACQUIRE_SPIN_LOCK+    StgWord64 yield; // incremented every time we yield in ACQUIRE_SPIN_LOCK+} SpinLock;+#else+typedef StgWord SpinLock;+#endif++#if defined(PROF_SPIN)++// PROF_SPIN enables counting the number of times we spin on a lock++// acquire spin lock+INLINE_HEADER void ACQUIRE_SPIN_LOCK(SpinLock * p)+{+    StgWord32 r = 0;+    uint32_t i;+    do {+        for (i = 0; i < SPIN_COUNT; i++) {+            r = cas((StgVolatilePtr)&(p->lock), 1, 0);+            if (r != 0) return;+            p->spin++;+            busy_wait_nop();+        }+        p->yield++;+        yieldThread();+    } while (1);+}++// release spin lock+INLINE_HEADER void RELEASE_SPIN_LOCK(SpinLock * p)+{+    write_barrier();+    p->lock = 1;+}++// initialise spin lock+INLINE_HEADER void initSpinLock(SpinLock * p)+{+    write_barrier();+    p->lock = 1;+    p->spin = 0;+    p->yield = 0;+}++#else++// acquire spin lock+INLINE_HEADER void ACQUIRE_SPIN_LOCK(SpinLock * p)+{+    StgWord32 r = 0;+    uint32_t i;+    do {+        for (i = 0; i < SPIN_COUNT; i++) {+            r = cas((StgVolatilePtr)p, 1, 0);+            if (r != 0) return;+            busy_wait_nop();+        }+        yieldThread();+    } while (1);+}++// release spin lock+INLINE_HEADER void RELEASE_SPIN_LOCK(SpinLock * p)+{+    write_barrier();+    (*p) = 1;+}++// init spin lock+INLINE_HEADER void initSpinLock(SpinLock * p)+{+    write_barrier();+    (*p) = 1;+}++#endif /* PROF_SPIN */++#else /* !THREADED_RTS */++// Using macros here means we don't have to ensure the argument is in scope+#define ACQUIRE_SPIN_LOCK(p) /* nothing */+#define RELEASE_SPIN_LOCK(p) /* nothing */++INLINE_HEADER void initSpinLock(void * p STG_UNUSED)+{ /* nothing */ }++#endif /* THREADED_RTS */
+ includes/rts/StableName.h view
@@ -0,0 +1,32 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * Stable Names+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++/* -----------------------------------------------------------------------------+   PRIVATE from here.+   -------------------------------------------------------------------------- */++typedef struct {+    StgPtr  addr;        // Haskell object when entry is in use, next free+                         // entry (NULL when this is the last free entry)+                         // otherwise. May be NULL temporarily during GC (when+                         // pointee dies).++    StgPtr  old;         // Old Haskell object, used during GC++    StgClosure *sn_obj;  // The StableName object, or NULL when the entry is+                         // free+} snEntry;++extern DLL_IMPORT_RTS snEntry *stable_name_table;
+ includes/rts/StablePtr.h view
@@ -0,0 +1,35 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * Stable Pointers+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++EXTERN_INLINE StgPtr deRefStablePtr (StgStablePtr stable_ptr);+StgStablePtr getStablePtr  (StgPtr p);++/* -----------------------------------------------------------------------------+   PRIVATE from here.+   -------------------------------------------------------------------------- */++typedef struct {+    StgPtr addr;         // Haskell object when entry is in use, next free+                         // entry (NULL when this is the last free entry)+                         // otherwise.+} spEntry;++extern DLL_IMPORT_RTS spEntry *stable_ptr_table;++EXTERN_INLINE+StgPtr deRefStablePtr(StgStablePtr sp)+{+    return stable_ptr_table[(StgWord)sp].addr;+}
+ includes/rts/StaticPtrTable.h view
@@ -0,0 +1,44 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2008-2009+ *+ * Initialization of the Static Pointer Table+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * -------------------------------------------------------------------------- */++#pragma once++/** Inserts an entry in the Static Pointer Table.+ *+ * The key is a fingerprint computed from the static pointer and the spe_closure+ * is a pointer to the closure defining the table entry.+ *+ * A stable pointer to the closure is made to prevent it from being garbage+ * collected while the entry exists on the table.+ *+ * This function is called from the code generated by+ * compiler/deSugar/StaticPtrTable.sptInitCode+ *+ * */+void hs_spt_insert (StgWord64 key[2],void* spe_closure);++/** Inserts an entry for a StgTablePtr in the Static Pointer Table.+ *+ * This function is called from the GHCi interpreter to insert+ * SPT entries for bytecode objects.+ *+ * */+void hs_spt_insert_stableptr(StgWord64 key[2], StgStablePtr *entry);++/** Removes an entry from the Static Pointer Table.+ *+ * This function is called from the code generated by+ * compiler/deSugar/StaticPtrTable.sptInitCode+ *+ * */+void hs_spt_remove (StgWord64 key[2]);
+ includes/rts/TTY.h view
@@ -0,0 +1,17 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2009+ *+ * POSIX TTY-related functionality+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * -------------------------------------------------------------------------- */++#pragma once++void* __hscore_get_saved_termios(int fd);+void  __hscore_set_saved_termios(int fd, void* ts);
+ includes/rts/Threads.h view
@@ -0,0 +1,74 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team 1998-2009+ *+ * External API for the scheduler.  For most uses, the functions in+ * RtsAPI.h should be enough.+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#if defined(HAVE_SYS_TYPES_H)+#include <sys/types.h>+#endif++//+// Creating threads+//+StgTSO *createThread (Capability *cap, W_ stack_size);++void scheduleWaitThread (/* in    */ StgTSO *tso,+                         /* out   */ HaskellObj* ret,+                         /* inout */ Capability **cap);++StgTSO *createGenThread       (Capability *cap, W_ stack_size,+                               StgClosure *closure);+StgTSO *createIOThread        (Capability *cap, W_ stack_size,+                               StgClosure *closure);+StgTSO *createStrictIOThread  (Capability *cap, W_ stack_size,+                               StgClosure *closure);++// Suspending/resuming threads around foreign calls+void *        suspendThread (StgRegTable *, bool interruptible);+StgRegTable * resumeThread  (void *);++//+// Thread operations from Threads.c+//+int     cmp_thread                       (StgPtr tso1, StgPtr tso2);+int     rts_getThreadId                  (StgPtr tso);+void    rts_enableThreadAllocationLimit  (StgPtr tso);+void    rts_disableThreadAllocationLimit (StgPtr tso);++#if !defined(mingw32_HOST_OS)+pid_t  forkProcess     (HsStablePtr *entry);+#else+pid_t  forkProcess     (HsStablePtr *entry)+    GNU_ATTRIBUTE(__noreturn__);+#endif++HsBool rtsSupportsBoundThreads (void);++// The number of Capabilities.+// ToDo: I would like this to be private to the RTS and instead expose a+// function getNumCapabilities(), but it is used in compiler/cbits/genSym.c+extern unsigned int n_capabilities;++// The number of Capabilities that are not disabled+extern uint32_t enabled_capabilities;++#if !IN_STG_CODE+extern Capability MainCapability;+#endif++//+// Change the number of capabilities (only supports increasing the+// current value at the moment).+//+extern void setNumCapabilities (uint32_t new_);
+ includes/rts/Ticky.h view
@@ -0,0 +1,32 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * TICKY_TICKY types+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++/* -----------------------------------------------------------------------------+   The StgEntCounter type - needed regardless of TICKY_TICKY+   -------------------------------------------------------------------------- */++typedef struct _StgEntCounter {+  /* Using StgWord for everything, because both the C and asm code+     generators make trouble if you try to pack things tighter */+    StgWord     registeredp;    /* 0 == no, 1 == yes */+    StgInt      arity;          /* arity (static info) */+    StgInt      allocd;         /* # allocation of this closure */+                                /* (rest of args are in registers) */+    char        *str;           /* name of the thing */+    char        *arg_kinds;     /* info about the args types */+    StgInt      entry_count;    /* Trips to fast entry code */+    StgInt      allocs;         /* number of allocations by this fun */+    struct _StgEntCounter *link;/* link to chain them all together */+} StgEntCounter;
+ includes/rts/Time.h view
@@ -0,0 +1,44 @@+/* ----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2004+ *+ * Time values in the RTS+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * --------------------------------------------------------------------------*/++#pragma once++// For most time values in the RTS we use a fixed resolution of nanoseconds,+// normalising the time we get from platform-dependent APIs to this+// resolution.+#define TIME_RESOLUTION 1000000000+typedef int64_t Time;++#define TIME_MAX HS_INT64_MAX++#if TIME_RESOLUTION == 1000000000+// I'm being lazy, but it's awkward to define fully general versions of these+#define TimeToMS(t)      ((t) / 1000000)+#define TimeToUS(t)      ((t) / 1000)+#define TimeToNS(t)      (t)+#define MSToTime(t)      ((Time)(t) * 1000000)+#define USToTime(t)      ((Time)(t) * 1000)+#define NSToTime(t)      ((Time)(t))+#else+#error Fix TimeToNS(), TimeToUS() etc.+#endif++#define SecondsToTime(t) ((Time)(t) * TIME_RESOLUTION)+#define TimeToSeconds(t) ((t) / TIME_RESOLUTION)++// Use instead of SecondsToTime() when we have a floating-point+// seconds value, to avoid truncating it.+INLINE_HEADER Time fsecondsToTime (double t)+{+    return (Time)(t * TIME_RESOLUTION);+}++Time getProcessElapsedTime (void);
+ includes/rts/Timer.h view
@@ -0,0 +1,18 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1995-2009+ *+ * Interface to the RTS timer signal (uses OS-dependent Ticker.h underneath)+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++void startTimer (void);+void stopTimer  (void);+int rtsTimerSignal (void);
+ includes/rts/Types.h view
@@ -0,0 +1,31 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * RTS-specific types.+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#include <stddef.h>+#include <stdbool.h>++// Deprecated, use uint32_t instead.+typedef unsigned int nat __attribute__((deprecated));  /* uint32_t */++/* ullong (64|128-bit) type: only include if needed (not ANSI) */+#if defined(__GNUC__)+#define LL(x) (x##LL)+#else+#define LL(x) (x##L)+#endif++typedef struct StgClosure_   StgClosure;+typedef struct StgInfoTable_ StgInfoTable;+typedef struct StgTSO_       StgTSO;
+ includes/rts/Utils.h view
@@ -0,0 +1,16 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * RTS external APIs.  This file declares everything that the GHC RTS+ * exposes externally.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++/* Alternate to raise(3) for threaded rts, for BSD-based OSes */+int genericRaise(int sig);
+ includes/rts/prof/CCS.h view
@@ -0,0 +1,226 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2009-2012+ *+ * Macros for profiling operations in STG code+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++/* -----------------------------------------------------------------------------+ * Data Structures+ * ---------------------------------------------------------------------------*/+/*+ * Note [struct alignment]+ * NB. be careful to avoid unwanted padding between fields, by+ * putting the 8-byte fields on an 8-byte boundary.  Padding can+ * vary between C compilers, and we don't take into account any+ * possible padding when generating CCS and CC decls in the code+ * generator (compiler/codeGen/StgCmmProf.hs).+ */++typedef struct CostCentre_ {+    StgInt ccID;              // Unique Id, allocated by the RTS++    char * label;+    char * module;+    char * srcloc;++    // used for accumulating costs at the end of the run...+    StgWord64 mem_alloc;      // align 8 (Note [struct alignment])+    StgWord   time_ticks;++    StgBool is_caf;           // true <=> CAF cost centre++    struct CostCentre_ *link;+} CostCentre;++typedef struct CostCentreStack_ {+    StgInt ccsID;               // unique ID, allocated by the RTS++    CostCentre *cc;             // Cost centre at the top of the stack++    struct CostCentreStack_ *prevStack;   // parent+    struct IndexTable_      *indexTable;  // children+    struct CostCentreStack_ *root;        // root of stack+    StgWord    depth;           // number of items in the stack++    StgWord64  scc_count;       // Count of times this CCS is entered+                                // align 8 (Note [struct alignment])++    StgWord    selected;        // is this CCS shown in the heap+                                // profile? (zero if excluded via -hc+                                // -hm etc.)++    StgWord    time_ticks;      // number of time ticks accumulated by+                                // this CCS++    StgWord64  mem_alloc;       // mem allocated by this CCS+                                // align 8 (Note [struct alignment])++    StgWord64  inherited_alloc; // sum of mem_alloc over all children+                                // (calculated at the end)+                                // align 8 (Note [struct alignment])++    StgWord    inherited_ticks; // sum of time_ticks over all children+                                // (calculated at the end)+} CostCentreStack;+++/* -----------------------------------------------------------------------------+ * Start and stop the profiling timer.  These can be called from+ * Haskell to restrict the profile to portion(s) of the execution.+ * See the module GHC.Profiling.+ * ---------------------------------------------------------------------------*/++void stopProfTimer      ( void );+void startProfTimer     ( void );++/* -----------------------------------------------------------------------------+ * The rest is PROFILING only...+ * ---------------------------------------------------------------------------*/++#if defined(PROFILING)++/* -----------------------------------------------------------------------------+ * Constants+ * ---------------------------------------------------------------------------*/++#define EMPTY_STACK NULL+#define EMPTY_TABLE NULL++/* Constants used to set is_caf flag on CostCentres */+#define CC_IS_CAF      true+#define CC_NOT_CAF     false+/* -----------------------------------------------------------------------------+ * Data Structures+ * ---------------------------------------------------------------------------*/++// IndexTable is the list of children of a CCS. (Alternatively it is a+// cache of the results of pushing onto a CCS, so that the second and+// subsequent times we push a certain CC on a CCS we get the same+// result).++typedef struct IndexTable_ {+    // Just a linked list of (cc, ccs) pairs, where the `ccs` is the result of+    // pushing `cc` to the owner of the index table (another CostCentreStack).+    CostCentre *cc;+    CostCentreStack *ccs;+    struct IndexTable_ *next;+    // back_edge is true when `cc` is already in the stack, so pushing it+    // truncates or drops (see RECURSION_DROPS and RECURSION_TRUNCATES in+    // Profiling.c).+    bool back_edge;+} IndexTable;+++/* -----------------------------------------------------------------------------+   Pre-defined cost centres and cost centre stacks+   -------------------------------------------------------------------------- */++#if IN_STG_CODE++extern StgWord CC_MAIN[];+extern StgWord CCS_MAIN[];      // Top CCS++extern StgWord CC_SYSTEM[];+extern StgWord CCS_SYSTEM[];    // RTS costs++extern StgWord CC_GC[];+extern StgWord CCS_GC[];         // Garbage collector costs++extern StgWord CC_OVERHEAD[];+extern StgWord CCS_OVERHEAD[];   // Profiling overhead++extern StgWord CC_DONT_CARE[];+extern StgWord CCS_DONT_CARE[];  // CCS attached to static constructors++#else++extern CostCentre      CC_MAIN[];+extern CostCentreStack CCS_MAIN[];      // Top CCS++extern CostCentre      CC_SYSTEM[];+extern CostCentreStack CCS_SYSTEM[];    // RTS costs++extern CostCentre      CC_GC[];+extern CostCentreStack CCS_GC[];         // Garbage collector costs++extern CostCentre      CC_OVERHEAD[];+extern CostCentreStack CCS_OVERHEAD[];   // Profiling overhead++extern CostCentre      CC_DONT_CARE[];+extern CostCentreStack CCS_DONT_CARE[];  // shouldn't ever get set++extern CostCentre      CC_PINNED[];+extern CostCentreStack CCS_PINNED[];     // pinned memory++extern CostCentre      CC_IDLE[];+extern CostCentreStack CCS_IDLE[];       // capability is idle++#endif /* IN_STG_CODE */++extern unsigned int RTS_VAR(era);++/* -----------------------------------------------------------------------------+ * Functions+ * ---------------------------------------------------------------------------*/++CostCentreStack * pushCostCentre (CostCentreStack *, CostCentre *);+void              enterFunCCS    (StgRegTable *reg, CostCentreStack *);+CostCentre *mkCostCentre (char *label, char *module, char *srcloc);++extern CostCentre * RTS_VAR(CC_LIST);               // registered CC list++/* -----------------------------------------------------------------------------+ * Declaring Cost Centres & Cost Centre Stacks.+ * -------------------------------------------------------------------------- */++# define CC_DECLARE(cc_ident,name,mod,loc,caf,is_local)  \+     is_local CostCentre cc_ident[1]                     \+       = {{ .ccID       = 0,                             \+            .label      = name,                          \+            .module     = mod,                           \+            .srcloc     = loc,                           \+            .time_ticks = 0,                             \+            .mem_alloc  = 0,                             \+            .link       = 0,                             \+            .is_caf     = caf                            \+         }};++# define CCS_DECLARE(ccs_ident,cc_ident,is_local)        \+     is_local CostCentreStack ccs_ident[1]               \+       = {{ .ccsID               = 0,                    \+            .cc                  = cc_ident,             \+            .prevStack           = NULL,                 \+            .indexTable          = NULL,                 \+            .root                = NULL,                 \+            .depth               = 0,                    \+            .selected            = 0,                    \+            .scc_count           = 0,                    \+            .time_ticks          = 0,                    \+            .mem_alloc           = 0,                    \+            .inherited_ticks     = 0,                    \+            .inherited_alloc     = 0                     \+       }};++/* -----------------------------------------------------------------------------+ * Time / Allocation Macros+ * ---------------------------------------------------------------------------*/++/* eliminate profiling overhead from allocation costs */+#define CCS_ALLOC(ccs, size) (ccs)->mem_alloc += ((size)-sizeofW(StgProfHeader))+#define ENTER_CCS_THUNK(cap,p) cap->r.rCCCS = p->header.prof.ccs++#else /* !PROFILING */++#define CCS_ALLOC(ccs, amount) doNothing()+#define ENTER_CCS_THUNK(cap,p) doNothing()++#endif /* PROFILING */
+ includes/rts/prof/LDV.h view
@@ -0,0 +1,44 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The University of Glasgow, 2009+ *+ * Lag/Drag/Void profiling.+ *+ * Do not #include this file directly: #include "Rts.h" instead.+ *+ * To understand the structure of the RTS headers, see the wiki:+ *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#if defined(PROFILING)++/* retrieves the LDV word from closure c */+#define LDVW(c)                 (((StgClosure *)(c))->header.prof.hp.ldvw)++/*+ * Stores the creation time for closure c.+ * This macro is called at the very moment of closure creation.+ *+ * NOTE: this initializes LDVW(c) to zero, which ensures that there+ * is no conflict between retainer profiling and LDV profiling,+ * because retainer profiling also expects LDVW(c) to be initialised+ * to zero.+ */++#if defined(CMINUSMINUS)++#else++#define LDV_RECORD_CREATE(c)   \+  LDVW((c)) = ((StgWord)RTS_DEREF(era) << LDV_SHIFT) | LDV_STATE_CREATE++#endif++#else  /* !PROFILING */++#define LDV_RECORD_CREATE(c)   /* nothing */++#endif /* PROFILING */
+ includes/rts/storage/Block.h view
@@ -0,0 +1,341 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-1999+ *+ * Block structure for the storage manager+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#include "ghcconfig.h"++/* The actual block and megablock-size constants are defined in+ * includes/Constants.h, all constants here are derived from these.+ */++/* Block related constants (BLOCK_SHIFT is defined in Constants.h) */++#if SIZEOF_LONG == SIZEOF_VOID_P+#define UNIT 1UL+#elif SIZEOF_LONG_LONG == SIZEOF_VOID_P+#define UNIT 1ULL+#else+#error "Size of pointer is suspicious."+#endif++#if defined(CMINUSMINUS)+#define BLOCK_SIZE   (1<<BLOCK_SHIFT)+#else+#define BLOCK_SIZE   (UNIT<<BLOCK_SHIFT)+// Note [integer overflow]+#endif++#define BLOCK_SIZE_W (BLOCK_SIZE/sizeof(W_))+#define BLOCK_MASK   (BLOCK_SIZE-1)++#define BLOCK_ROUND_UP(p)   (((W_)(p)+BLOCK_SIZE-1) & ~BLOCK_MASK)+#define BLOCK_ROUND_DOWN(p) ((void *) ((W_)(p) & ~BLOCK_MASK))++/* Megablock related constants (MBLOCK_SHIFT is defined in Constants.h) */++#if defined(CMINUSMINUS)+#define MBLOCK_SIZE    (1<<MBLOCK_SHIFT)+#else+#define MBLOCK_SIZE    (UNIT<<MBLOCK_SHIFT)+// Note [integer overflow]+#endif++#define MBLOCK_SIZE_W  (MBLOCK_SIZE/sizeof(W_))+#define MBLOCK_MASK    (MBLOCK_SIZE-1)++#define MBLOCK_ROUND_UP(p)   ((void *)(((W_)(p)+MBLOCK_SIZE-1) & ~MBLOCK_MASK))+#define MBLOCK_ROUND_DOWN(p) ((void *)((W_)(p) & ~MBLOCK_MASK ))++/* The largest size an object can be before we give it a block of its+ * own and treat it as an immovable object during GC, expressed as a+ * fraction of BLOCK_SIZE.+ */+#define LARGE_OBJECT_THRESHOLD ((uint32_t)(BLOCK_SIZE * 8 / 10))++/*+ * Note [integer overflow]+ *+ * The UL suffix in BLOCK_SIZE and MBLOCK_SIZE promotes the expression+ * to an unsigned long, which means that expressions involving these+ * will be promoted to unsigned long, which makes integer overflow+ * less likely.  Historically, integer overflow in expressions like+ *    (n * BLOCK_SIZE)+ * where n is int or unsigned int, have caused obscure segfaults in+ * programs that use large amounts of memory (e.g. #7762, #5086).+ */++/* -----------------------------------------------------------------------------+ * Block descriptor.  This structure *must* be the right length, so we+ * can do pointer arithmetic on pointers to it.+ */++/* The block descriptor is 64 bytes on a 64-bit machine, and 32-bytes+ * on a 32-bit machine.+ */++// Note: fields marked with [READ ONLY] must not be modified by the+// client of the block allocator API.  All other fields can be+// freely modified.++#if !defined(CMINUSMINUS)+typedef struct bdescr_ {++    StgPtr start;              // [READ ONLY] start addr of memory++    StgPtr free;               // First free byte of memory.+                               // allocGroup() sets this to the value of start.+                               // NB. during use this value should lie+                               // between start and start + blocks *+                               // BLOCK_SIZE.  Values outside this+                               // range are reserved for use by the+                               // block allocator.  In particular, the+                               // value (StgPtr)(-1) is used to+                               // indicate that a block is unallocated.++    struct bdescr_ *link;      // used for chaining blocks together++    union {+        struct bdescr_ *back;  // used (occasionally) for doubly-linked lists+        StgWord *bitmap;       // bitmap for marking GC+        StgPtr  scan;          // scan pointer for copying GC+    } u;++    struct generation_ *gen;   // generation++    StgWord16 gen_no;          // gen->no, cached+    StgWord16 dest_no;         // number of destination generation+    StgWord16 node;            // which memory node does this block live on?++    StgWord16 flags;           // block flags, see below++    StgWord32 blocks;          // [READ ONLY] no. of blocks in a group+                               // (if group head, 0 otherwise)++#if SIZEOF_VOID_P == 8+    StgWord32 _padding[3];+#else+    StgWord32 _padding[0];+#endif+} bdescr;+#endif++#if SIZEOF_VOID_P == 8+#define BDESCR_SIZE  0x40+#define BDESCR_MASK  0x3f+#define BDESCR_SHIFT 6+#else+#define BDESCR_SIZE  0x20+#define BDESCR_MASK  0x1f+#define BDESCR_SHIFT 5+#endif++/* Block contains objects evacuated during this GC */+#define BF_EVACUATED 1+/* Block is a large object */+#define BF_LARGE     2+/* Block is pinned */+#define BF_PINNED    4+/* Block is to be marked, not copied */+#define BF_MARKED    8+/* Block is executable */+#define BF_EXEC      32+/* Block contains only a small amount of live data */+#define BF_FRAGMENTED 64+/* we know about this block (for finding leaks) */+#define BF_KNOWN     128+/* Block was swept in the last generation */+#define BF_SWEPT     256+/* Block is part of a Compact */+#define BF_COMPACT   512+/* Maximum flag value (do not define anything higher than this!) */+#define BF_FLAG_MAX  (1 << 15)++/* Finding the block descriptor for a given block -------------------------- */++#if defined(CMINUSMINUS)++#define Bdescr(p) \+    ((((p) &  MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT)) \+     | ((p) & ~MBLOCK_MASK))++#else++EXTERN_INLINE bdescr *Bdescr(StgPtr p);+EXTERN_INLINE bdescr *Bdescr(StgPtr p)+{+  return (bdescr *)+    ((((W_)p &  MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT))+     | ((W_)p & ~MBLOCK_MASK)+     );+}++#endif++/* Useful Macros ------------------------------------------------------------ */++/* Offset of first real data block in a megablock */++#define FIRST_BLOCK_OFF \+   ((W_)BLOCK_ROUND_UP(BDESCR_SIZE * (MBLOCK_SIZE / BLOCK_SIZE)))++/* First data block in a given megablock */++#define FIRST_BLOCK(m) ((void *)(FIRST_BLOCK_OFF + (W_)(m)))++/* Last data block in a given megablock */++#define LAST_BLOCK(m)  ((void *)(MBLOCK_SIZE-BLOCK_SIZE + (W_)(m)))++/* First real block descriptor in a megablock */++#define FIRST_BDESCR(m) \+   ((bdescr *)((FIRST_BLOCK_OFF>>(BLOCK_SHIFT-BDESCR_SHIFT)) + (W_)(m)))++/* Last real block descriptor in a megablock */++#define LAST_BDESCR(m) \+  ((bdescr *)(((MBLOCK_SIZE-BLOCK_SIZE)>>(BLOCK_SHIFT-BDESCR_SHIFT)) + (W_)(m)))++/* Number of usable blocks in a megablock */++#if !defined(CMINUSMINUS) // already defined in DerivedConstants.h+#define BLOCKS_PER_MBLOCK ((MBLOCK_SIZE - FIRST_BLOCK_OFF) / BLOCK_SIZE)+#endif++/* How many blocks in this megablock group */++#define MBLOCK_GROUP_BLOCKS(n) \+   (BLOCKS_PER_MBLOCK + (n-1) * (MBLOCK_SIZE / BLOCK_SIZE))++/* Compute the required size of a megablock group */++#define BLOCKS_TO_MBLOCKS(n) \+   (1 + (W_)MBLOCK_ROUND_UP((n-BLOCKS_PER_MBLOCK) * BLOCK_SIZE) / MBLOCK_SIZE)+++#if !defined(CMINUSMINUS)+/* to the end... */++/* Double-linked block lists: --------------------------------------------- */++INLINE_HEADER void+dbl_link_onto(bdescr *bd, bdescr **list)+{+  bd->link = *list;+  bd->u.back = NULL;+  if (*list) {+    (*list)->u.back = bd; /* double-link the list */+  }+  *list = bd;+}++INLINE_HEADER void+dbl_link_remove(bdescr *bd, bdescr **list)+{+    if (bd->u.back) {+        bd->u.back->link = bd->link;+    } else {+        *list = bd->link;+    }+    if (bd->link) {+        bd->link->u.back = bd->u.back;+    }+}++INLINE_HEADER void+dbl_link_insert_after(bdescr *bd, bdescr *after)+{+    bd->link = after->link;+    bd->u.back = after;+    if (after->link) {+        after->link->u.back = bd;+    }+    after->link = bd;+}++INLINE_HEADER void+dbl_link_replace(bdescr *new_, bdescr *old, bdescr **list)+{+    new_->link = old->link;+    new_->u.back = old->u.back;+    if (old->link) {+        old->link->u.back = new_;+    }+    if (old->u.back) {+        old->u.back->link = new_;+    } else {+        *list = new_;+    }+}++/* Initialisation ---------------------------------------------------------- */++extern void initBlockAllocator(void);++/* Allocation -------------------------------------------------------------- */++bdescr *allocGroup(W_ n);++EXTERN_INLINE bdescr* allocBlock(void);+EXTERN_INLINE bdescr* allocBlock(void)+{+    return allocGroup(1);+}++bdescr *allocGroupOnNode(uint32_t node, W_ n);++EXTERN_INLINE bdescr* allocBlockOnNode(uint32_t node);+EXTERN_INLINE bdescr* allocBlockOnNode(uint32_t node)+{+    return allocGroupOnNode(node,1);+}++// versions that take the storage manager lock for you:+bdescr *allocGroup_lock(W_ n);+bdescr *allocBlock_lock(void);++bdescr *allocGroupOnNode_lock(uint32_t node, W_ n);+bdescr *allocBlockOnNode_lock(uint32_t node);++/* De-Allocation ----------------------------------------------------------- */++void freeGroup(bdescr *p);+void freeChain(bdescr *p);++// versions that take the storage manager lock for you:+void freeGroup_lock(bdescr *p);+void freeChain_lock(bdescr *p);++bdescr * splitBlockGroup (bdescr *bd, uint32_t blocks);++/* Round a value to megablocks --------------------------------------------- */++// We want to allocate an object around a given size, round it up or+// down to the nearest size that will fit in an mblock group.+INLINE_HEADER StgWord+round_to_mblocks(StgWord words)+{+    if (words > BLOCKS_PER_MBLOCK * BLOCK_SIZE_W) {+        // first, ignore the gap at the beginning of the first mblock by+        // adding it to the total words.  Then we can pretend we're+        // dealing in a uniform unit of megablocks.+        words += FIRST_BLOCK_OFF/sizeof(W_);++        if ((words % MBLOCK_SIZE_W) < (MBLOCK_SIZE_W / 2)) {+            words = (words / MBLOCK_SIZE_W) * MBLOCK_SIZE_W;+        } else {+            words = ((words / MBLOCK_SIZE_W) + 1) * MBLOCK_SIZE_W;+        }++        words -= FIRST_BLOCK_OFF/sizeof(W_);+    }+    return words;+}++#endif /* !CMINUSMINUS */
+ includes/rts/storage/ClosureMacros.h view
@@ -0,0 +1,587 @@+/* ----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2012+ *+ * Macros for building and manipulating closures+ *+ * -------------------------------------------------------------------------- */++#pragma once++/* -----------------------------------------------------------------------------+   Info tables are slammed up against the entry code, and the label+   for the info table is at the *end* of the table itself.  This+   inline function adjusts an info pointer to point to the beginning+   of the table, so we can use standard C structure indexing on it.++   Note: this works for SRT info tables as long as you don't want to+   access the SRT, since they are laid out the same with the SRT+   pointer as the first word in the table.++   NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:++   A couple of definitions:++       "info pointer"    The first word of the closure.  Might point+                         to either the end or the beginning of the+                         info table, depending on whether we're using+                         the mini interpreter or not.  GET_INFO(c)+                         retrieves the info pointer of a closure.++       "info table"      The info table structure associated with a+                         closure.  This is always a pointer to the+                         beginning of the structure, so we can+                         use standard C structure indexing to pull out+                         the fields.  get_itbl(c) returns a pointer to+                         the info table for closure c.++   An address of the form xxxx_info points to the end of the info+   table or the beginning of the info table depending on whether we're+   mangling or not respectively.  So,++         c->header.info = xxx_info++   makes absolute sense, whether mangling or not.++   -------------------------------------------------------------------------- */++INLINE_HEADER void SET_INFO(StgClosure *c, const StgInfoTable *info) {+    c->header.info = info;+}+INLINE_HEADER const StgInfoTable *GET_INFO(StgClosure *c) {+    return c->header.info;+}++#define GET_ENTRY(c)  (ENTRY_CODE(GET_INFO(c)))++#if defined(TABLES_NEXT_TO_CODE)+EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info);+EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info - 1;}+EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info);+EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info - 1;}+INLINE_HEADER StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info - 1;}+INLINE_HEADER StgThunkInfoTable *THUNK_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgThunkInfoTable *)info - 1;}+INLINE_HEADER StgConInfoTable *CON_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgConInfoTable *)info - 1;}+INLINE_HEADER StgFunInfoTable *itbl_to_fun_itbl(const StgInfoTable *i) {return (StgFunInfoTable *)(i + 1) - 1;}+INLINE_HEADER StgRetInfoTable *itbl_to_ret_itbl(const StgInfoTable *i) {return (StgRetInfoTable *)(i + 1) - 1;}+INLINE_HEADER StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {return (StgThunkInfoTable *)(i + 1) - 1;}+INLINE_HEADER StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)(i + 1) - 1;}+#else+EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info);+EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info;}+EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info);+EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info;}+INLINE_HEADER StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info;}+INLINE_HEADER StgThunkInfoTable *THUNK_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgThunkInfoTable *)info;}+INLINE_HEADER StgConInfoTable *CON_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgConInfoTable *)info;}+INLINE_HEADER StgFunInfoTable *itbl_to_fun_itbl(const StgInfoTable *i) {return (StgFunInfoTable *)i;}+INLINE_HEADER StgRetInfoTable *itbl_to_ret_itbl(const StgInfoTable *i) {return (StgRetInfoTable *)i;}+INLINE_HEADER StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {return (StgThunkInfoTable *)i;}+INLINE_HEADER StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)i;}+#endif++EXTERN_INLINE const StgInfoTable *get_itbl(const StgClosure *c);+EXTERN_INLINE const StgInfoTable *get_itbl(const StgClosure *c)+{+   return INFO_PTR_TO_STRUCT(c->header.info);+}++EXTERN_INLINE const StgRetInfoTable *get_ret_itbl(const StgClosure *c);+EXTERN_INLINE const StgRetInfoTable *get_ret_itbl(const StgClosure *c)+{+   return RET_INFO_PTR_TO_STRUCT(c->header.info);+}++INLINE_HEADER const StgFunInfoTable *get_fun_itbl(const StgClosure *c)+{+   return FUN_INFO_PTR_TO_STRUCT(c->header.info);+}++INLINE_HEADER const StgThunkInfoTable *get_thunk_itbl(const StgClosure *c)+{+   return THUNK_INFO_PTR_TO_STRUCT(c->header.info);+}++INLINE_HEADER const StgConInfoTable *get_con_itbl(const StgClosure *c)+{+   return CON_INFO_PTR_TO_STRUCT((c)->header.info);+}++INLINE_HEADER StgHalfWord GET_TAG(const StgClosure *con)+{+    return get_itbl(con)->srt;+}++/* -----------------------------------------------------------------------------+   Macros for building closures+   -------------------------------------------------------------------------- */++#if defined(PROFILING)+#if defined(DEBUG_RETAINER)+/*+  For the sake of debugging, we take the safest way for the moment. Actually, this+  is useful to check the sanity of heap before beginning retainer profiling.+  flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.+  Note: change those functions building Haskell objects from C datatypes, i.e.,+  all rts_mk???() functions in RtsAPI.c, as well.+ */+#define SET_PROF_HDR(c,ccs_)            \+        ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))+#else+/*+  For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to+  NULL | flip (flip is defined in RetainerProfile.c) because even when flip+  is 1, rs is invalid and will be initialized to NULL | flip later when+  the closure *c is visited.+ */+/*+#define SET_PROF_HDR(c,ccs_)            \+        ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)+ */+/*+  The following macro works for both retainer profiling and LDV profiling:+  for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.+  See the invariants on ldvTime.+ */+#define SET_PROF_HDR(c,ccs_)            \+        ((c)->header.prof.ccs = ccs_,   \+        LDV_RECORD_CREATE((c)))+#endif /* DEBUG_RETAINER */+#else+#define SET_PROF_HDR(c,ccs)+#endif++#define SET_HDR(c,_info,ccs)                            \+   {                                                    \+        (c)->header.info = _info;                       \+        SET_PROF_HDR((StgClosure *)(c),ccs);            \+   }++#define SET_ARR_HDR(c,info,costCentreStack,n_bytes)     \+   SET_HDR(c,info,costCentreStack);                     \+   (c)->bytes = n_bytes;++// Use when changing a closure from one kind to another+#define OVERWRITE_INFO(c, new_info)                             \+    OVERWRITING_CLOSURE((StgClosure *)(c));                     \+    SET_INFO((StgClosure *)(c), (new_info));                    \+    LDV_RECORD_CREATE(c);++/* -----------------------------------------------------------------------------+   How to get hold of the static link field for a static closure.+   -------------------------------------------------------------------------- */++/* These are hard-coded. */+#define THUNK_STATIC_LINK(p) (&(p)->payload[1])+#define IND_STATIC_LINK(p)   (&(p)->payload[1])++INLINE_HEADER StgClosure **+STATIC_LINK(const StgInfoTable *info, StgClosure *p)+{+    switch (info->type) {+    case THUNK_STATIC:+        return THUNK_STATIC_LINK(p);+    case IND_STATIC:+        return IND_STATIC_LINK(p);+    default:+        return &(p)->payload[info->layout.payload.ptrs ++                             info->layout.payload.nptrs];+    }+}++/* -----------------------------------------------------------------------------+   INTLIKE and CHARLIKE closures.+   -------------------------------------------------------------------------- */++INLINE_HEADER P_ CHARLIKE_CLOSURE(int n) {+    return (P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE];+}+INLINE_HEADER P_ INTLIKE_CLOSURE(int n) {+    return (P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE];+}++/* ----------------------------------------------------------------------------+   Macros for untagging and retagging closure pointers+   For more information look at the comments in Cmm.h+   ------------------------------------------------------------------------- */++static inline StgWord+GET_CLOSURE_TAG(const StgClosure * p)+{+    return (StgWord)p & TAG_MASK;+}++static inline StgClosure *+UNTAG_CLOSURE(StgClosure * p)+{+    return (StgClosure*)((StgWord)p & ~TAG_MASK);+}++static inline const StgClosure *+UNTAG_CONST_CLOSURE(const StgClosure * p)+{+    return (const StgClosure*)((StgWord)p & ~TAG_MASK);+}++static inline StgClosure *+TAG_CLOSURE(StgWord tag,StgClosure * p)+{+    return (StgClosure*)((StgWord)p | tag);+}++/* -----------------------------------------------------------------------------+   Forwarding pointers+   -------------------------------------------------------------------------- */++#define IS_FORWARDING_PTR(p) ((((StgWord)p) & 1) != 0)+#define MK_FORWARDING_PTR(p) (((StgWord)p) | 1)+#define UN_FORWARDING_PTR(p) (((StgWord)p) - 1)++/* -----------------------------------------------------------------------------+   DEBUGGING predicates for pointers++   LOOKS_LIKE_INFO_PTR(p)    returns False if p is definitely not an info ptr+   LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr++   These macros are complete but not sound.  That is, they might+   return false positives.  Do not rely on them to distinguish info+   pointers from closure pointers, for example.++   We don't use address-space predicates these days, for portability+   reasons, and the fact that code/data can be scattered about the+   address space in a dynamically-linked environment.  Our best option+   is to look at the alleged info table and see whether it seems to+   make sense...+   -------------------------------------------------------------------------- */++INLINE_HEADER bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p)+{+    StgInfoTable *info = INFO_PTR_TO_STRUCT((StgInfoTable *)p);+    return info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES;+}++INLINE_HEADER bool LOOKS_LIKE_INFO_PTR (StgWord p)+{+    return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p));+}++INLINE_HEADER bool LOOKS_LIKE_CLOSURE_PTR (const void *p)+{+    return LOOKS_LIKE_INFO_PTR((StgWord)+            (UNTAG_CONST_CLOSURE((const StgClosure *)(p)))->header.info);+}++/* -----------------------------------------------------------------------------+   Macros for calculating the size of a closure+   -------------------------------------------------------------------------- */++EXTERN_INLINE StgOffset PAP_sizeW   ( uint32_t n_args );+EXTERN_INLINE StgOffset PAP_sizeW   ( uint32_t n_args )+{ return sizeofW(StgPAP) + n_args; }++EXTERN_INLINE StgOffset AP_sizeW   ( uint32_t n_args );+EXTERN_INLINE StgOffset AP_sizeW   ( uint32_t n_args )+{ return sizeofW(StgAP) + n_args; }++EXTERN_INLINE StgOffset AP_STACK_sizeW ( uint32_t size );+EXTERN_INLINE StgOffset AP_STACK_sizeW ( uint32_t size )+{ return sizeofW(StgAP_STACK) + size; }++EXTERN_INLINE StgOffset CONSTR_sizeW( uint32_t p, uint32_t np );+EXTERN_INLINE StgOffset CONSTR_sizeW( uint32_t p, uint32_t np )+{ return sizeofW(StgHeader) + p + np; }++EXTERN_INLINE StgOffset THUNK_SELECTOR_sizeW ( void );+EXTERN_INLINE StgOffset THUNK_SELECTOR_sizeW ( void )+{ return sizeofW(StgSelector); }++EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void );+EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void )+{ return sizeofW(StgInd); } // a BLACKHOLE is a kind of indirection++/* --------------------------------------------------------------------------+   Sizes of closures+   ------------------------------------------------------------------------*/++EXTERN_INLINE StgOffset sizeW_fromITBL( const StgInfoTable* itbl );+EXTERN_INLINE StgOffset sizeW_fromITBL( const StgInfoTable* itbl )+{ return sizeofW(StgClosure)+       + sizeofW(StgPtr)  * itbl->layout.payload.ptrs+       + sizeofW(StgWord) * itbl->layout.payload.nptrs; }++EXTERN_INLINE StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl );+EXTERN_INLINE StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl )+{ return sizeofW(StgThunk)+       + sizeofW(StgPtr)  * itbl->layout.payload.ptrs+       + sizeofW(StgWord) * itbl->layout.payload.nptrs; }++EXTERN_INLINE StgOffset ap_stack_sizeW( StgAP_STACK* x );+EXTERN_INLINE StgOffset ap_stack_sizeW( StgAP_STACK* x )+{ return AP_STACK_sizeW(x->size); }++EXTERN_INLINE StgOffset ap_sizeW( StgAP* x );+EXTERN_INLINE StgOffset ap_sizeW( StgAP* x )+{ return AP_sizeW(x->n_args); }++EXTERN_INLINE StgOffset pap_sizeW( StgPAP* x );+EXTERN_INLINE StgOffset pap_sizeW( StgPAP* x )+{ return PAP_sizeW(x->n_args); }++EXTERN_INLINE StgWord arr_words_words( StgArrBytes* x);+EXTERN_INLINE StgWord arr_words_words( StgArrBytes* x)+{ return ROUNDUP_BYTES_TO_WDS(x->bytes); }++EXTERN_INLINE StgOffset arr_words_sizeW( StgArrBytes* x );+EXTERN_INLINE StgOffset arr_words_sizeW( StgArrBytes* x )+{ return sizeofW(StgArrBytes) + arr_words_words(x); }++EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x );+EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )+{ return sizeofW(StgMutArrPtrs) + x->size; }++EXTERN_INLINE StgOffset small_mut_arr_ptrs_sizeW( StgSmallMutArrPtrs* x );+EXTERN_INLINE StgOffset small_mut_arr_ptrs_sizeW( StgSmallMutArrPtrs* x )+{ return sizeofW(StgSmallMutArrPtrs) + x->ptrs; }++EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack );+EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack )+{ return sizeofW(StgStack) + stack->stack_size; }++EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco );+EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco )+{ return bco->size; }++EXTERN_INLINE StgWord compact_nfdata_full_sizeW ( StgCompactNFData *str );+EXTERN_INLINE StgWord compact_nfdata_full_sizeW ( StgCompactNFData *str )+{ return str->totalW; }++/*+ * TODO: Consider to switch return type from 'uint32_t' to 'StgWord' #8742+ *+ * (Also for 'closure_sizeW' below)+ */+EXTERN_INLINE uint32_t+closure_sizeW_ (const StgClosure *p, const StgInfoTable *info);+EXTERN_INLINE uint32_t+closure_sizeW_ (const StgClosure *p, const StgInfoTable *info)+{+    switch (info->type) {+    case THUNK_0_1:+    case THUNK_1_0:+        return sizeofW(StgThunk) + 1;+    case FUN_0_1:+    case CONSTR_0_1:+    case FUN_1_0:+    case CONSTR_1_0:+        return sizeofW(StgHeader) + 1;+    case THUNK_0_2:+    case THUNK_1_1:+    case THUNK_2_0:+        return sizeofW(StgThunk) + 2;+    case FUN_0_2:+    case CONSTR_0_2:+    case FUN_1_1:+    case CONSTR_1_1:+    case FUN_2_0:+    case CONSTR_2_0:+        return sizeofW(StgHeader) + 2;+    case THUNK:+        return thunk_sizeW_fromITBL(info);+    case THUNK_SELECTOR:+        return THUNK_SELECTOR_sizeW();+    case AP_STACK:+        return ap_stack_sizeW((StgAP_STACK *)p);+    case AP:+        return ap_sizeW((StgAP *)p);+    case PAP:+        return pap_sizeW((StgPAP *)p);+    case IND:+        return sizeofW(StgInd);+    case ARR_WORDS:+        return arr_words_sizeW((StgArrBytes *)p);+    case MUT_ARR_PTRS_CLEAN:+    case MUT_ARR_PTRS_DIRTY:+    case MUT_ARR_PTRS_FROZEN_CLEAN:+    case MUT_ARR_PTRS_FROZEN_DIRTY:+        return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);+    case SMALL_MUT_ARR_PTRS_CLEAN:+    case SMALL_MUT_ARR_PTRS_DIRTY:+    case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:+    case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:+        return small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);+    case TSO:+        return sizeofW(StgTSO);+    case STACK:+        return stack_sizeW((StgStack*)p);+    case BCO:+        return bco_sizeW((StgBCO *)p);+    case TREC_CHUNK:+        return sizeofW(StgTRecChunk);+    default:+        return sizeW_fromITBL(info);+    }+}++// The definitive way to find the size, in words, of a heap-allocated closure+EXTERN_INLINE uint32_t closure_sizeW (const StgClosure *p);+EXTERN_INLINE uint32_t closure_sizeW (const StgClosure *p)+{+    return closure_sizeW_(p, get_itbl(p));+}++/* -----------------------------------------------------------------------------+   Sizes of stack frames+   -------------------------------------------------------------------------- */++EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame );+EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame )+{+    const StgRetInfoTable *info;++    info = get_ret_itbl(frame);+    switch (info->i.type) {++    case RET_FUN:+        return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size;++    case RET_BIG:+        return 1 + GET_LARGE_BITMAP(&info->i)->size;++    case RET_BCO:+        return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]);++    default:+        return 1 + BITMAP_SIZE(info->i.layout.bitmap);+    }+}++/* -----------------------------------------------------------------------------+   StgMutArrPtrs macros++   An StgMutArrPtrs has a card table to indicate which elements are+   dirty for the generational GC.  The card table is an array of+   bytes, where each byte covers (1 << MUT_ARR_PTRS_CARD_BITS)+   elements.  The card table is directly after the array data itself.+   -------------------------------------------------------------------------- */++// The number of card bytes needed+INLINE_HEADER W_ mutArrPtrsCards (W_ elems)+{+    return (W_)((elems + (1 << MUT_ARR_PTRS_CARD_BITS) - 1)+                           >> MUT_ARR_PTRS_CARD_BITS);+}++// The number of words in the card table+INLINE_HEADER W_ mutArrPtrsCardTableSize (W_ elems)+{+    return ROUNDUP_BYTES_TO_WDS(mutArrPtrsCards(elems));+}++// The address of the card for a particular card number+INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n)+{+    return ((StgWord8 *)&(a->payload[a->ptrs]) + n);+}++/* -----------------------------------------------------------------------------+   Replacing a closure with a different one.  We must call+   OVERWRITING_CLOSURE(p) on the old closure that is about to be+   overwritten.++   Note [zeroing slop]++   In some scenarios we write zero words into "slop"; memory that is+   left unoccupied after we overwrite a closure in the heap with a+   smaller closure.++   Zeroing slop is required for:++    - full-heap sanity checks (DEBUG, and +RTS -DS)+    - LDV profiling (PROFILING, and +RTS -hb)++   Zeroing slop must be disabled for:++    - THREADED_RTS with +RTS -N2 and greater, because we cannot+      overwrite slop when another thread might be reading it.++   Hence, slop is zeroed when either:++    - PROFILING && era <= 0 (LDV is on)+    - !THREADED_RTS && DEBUG++   And additionally:++    - LDV profiling and +RTS -N2 are incompatible+    - full-heap sanity checks are disabled for THREADED_RTS++   -------------------------------------------------------------------------- */++#if defined(PROFILING)+#define ZERO_SLOP_FOR_LDV_PROF 1+#else+#define ZERO_SLOP_FOR_LDV_PROF 0+#endif++#if defined(DEBUG) && !defined(THREADED_RTS)+#define ZERO_SLOP_FOR_SANITY_CHECK 1+#else+#define ZERO_SLOP_FOR_SANITY_CHECK 0+#endif++#if ZERO_SLOP_FOR_LDV_PROF || ZERO_SLOP_FOR_SANITY_CHECK+#define OVERWRITING_CLOSURE(c) overwritingClosure(c)+#define OVERWRITING_CLOSURE_OFS(c,n) overwritingClosureOfs(c,n)+#else+#define OVERWRITING_CLOSURE(c) /* nothing */+#define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */+#endif++#if defined(PROFILING)+void LDV_recordDead (const StgClosure *c, uint32_t size);+#endif++EXTERN_INLINE void overwritingClosure_ (StgClosure *p,+                                        uint32_t offset /* in words */,+                                        uint32_t size /* closure size, in words */);+EXTERN_INLINE void overwritingClosure_ (StgClosure *p, uint32_t offset, uint32_t size)+{+#if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK+    // see Note [zeroing slop], also #8402+    if (era <= 0) return;+#endif++    // For LDV profiling, we need to record the closure as dead+#if defined(PROFILING)+    LDV_recordDead(p, size);+#endif++    for (uint32_t i = offset; i < size; i++) {+        ((StgWord *)p)[i] = 0;+    }+}++EXTERN_INLINE void overwritingClosure (StgClosure *p);+EXTERN_INLINE void overwritingClosure (StgClosure *p)+{+    overwritingClosure_(p, sizeofW(StgThunkHeader), closure_sizeW(p));+}++// Version of 'overwritingClosure' which overwrites only a suffix of a+// closure.  The offset is expressed in words relative to 'p' and shall+// be less than or equal to closure_sizeW(p), and usually at least as+// large as the respective thunk header.+//+// Note: As this calls LDV_recordDead() you have to call LDV_RECORD()+//       on the final state of the closure at the call-site+EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset);+EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset)+{+    overwritingClosure_(p, offset, closure_sizeW(p));+}++// Version of 'overwritingClosure' which takes closure size as argument.+EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size /* in words */);+EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size)+{+    overwritingClosure_(p, sizeofW(StgThunkHeader), size);+}
+ includes/rts/storage/ClosureTypes.h view
@@ -0,0 +1,86 @@+/* ----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2005+ *+ * Closure Type Constants: out here because the native code generator+ * needs to get at them.+ *+ * -------------------------------------------------------------------------- */++#pragma once++/*+ * WARNING WARNING WARNING+ *+ * If you add or delete any closure types, don't forget to update the following,+ *   - the closure flags table in rts/ClosureFlags.c+ *   - isRetainer in rts/RetainerProfile.c+ *   - the closure_type_names list in rts/Printer.c+ */++/* Object tag 0 raises an internal error */+#define INVALID_OBJECT                0+#define CONSTR                        1+#define CONSTR_1_0                    2+#define CONSTR_0_1                    3+#define CONSTR_2_0                    4+#define CONSTR_1_1                    5+#define CONSTR_0_2                    6+#define CONSTR_NOCAF                  7+#define FUN                           8+#define FUN_1_0                       9+#define FUN_0_1                       10+#define FUN_2_0                       11+#define FUN_1_1                       12+#define FUN_0_2                       13+#define FUN_STATIC                    14+#define THUNK                         15+#define THUNK_1_0                     16+#define THUNK_0_1                     17+#define THUNK_2_0                     18+#define THUNK_1_1                     19+#define THUNK_0_2                     20+#define THUNK_STATIC                  21+#define THUNK_SELECTOR                22+#define BCO                           23+#define AP                            24+#define PAP                           25+#define AP_STACK                      26+#define IND                           27+#define IND_STATIC                    28+#define RET_BCO                       29+#define RET_SMALL                     30+#define RET_BIG                       31+#define RET_FUN                       32+#define UPDATE_FRAME                  33+#define CATCH_FRAME                   34+#define UNDERFLOW_FRAME               35+#define STOP_FRAME                    36+#define BLOCKING_QUEUE                37+#define BLACKHOLE                     38+#define MVAR_CLEAN                    39+#define MVAR_DIRTY                    40+#define TVAR                          41+#define ARR_WORDS                     42+#define MUT_ARR_PTRS_CLEAN            43+#define MUT_ARR_PTRS_DIRTY            44+#define MUT_ARR_PTRS_FROZEN_DIRTY     45+#define MUT_ARR_PTRS_FROZEN_CLEAN     46+#define MUT_VAR_CLEAN                 47+#define MUT_VAR_DIRTY                 48+#define WEAK                          49+#define PRIM                          50+#define MUT_PRIM                      51+#define TSO                           52+#define STACK                         53+#define TREC_CHUNK                    54+#define ATOMICALLY_FRAME              55+#define CATCH_RETRY_FRAME             56+#define CATCH_STM_FRAME               57+#define WHITEHOLE                     58+#define SMALL_MUT_ARR_PTRS_CLEAN      59+#define SMALL_MUT_ARR_PTRS_DIRTY      60+#define SMALL_MUT_ARR_PTRS_FROZEN_DIRTY 61+#define SMALL_MUT_ARR_PTRS_FROZEN_CLEAN 62+#define COMPACT_NFDATA                63+#define N_CLOSURE_TYPES               64
+ includes/rts/storage/Closures.h view
@@ -0,0 +1,470 @@+/* ----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2004+ *+ * Closures+ *+ * -------------------------------------------------------------------------- */++#pragma once++/*+ * The Layout of a closure header depends on which kind of system we're+ * compiling for: profiling, parallel, ticky, etc.+ */++/* -----------------------------------------------------------------------------+   The profiling header+   -------------------------------------------------------------------------- */++typedef struct {+  CostCentreStack *ccs;+  union {+    struct _RetainerSet *rs;  /* Retainer Set */+    StgWord ldvw;             /* Lag/Drag/Void Word */+  } hp;+} StgProfHeader;++/* -----------------------------------------------------------------------------+   The SMP header++   A thunk has a padding word to take the updated value.  This is so+   that the update doesn't overwrite the payload, so we can avoid+   needing to lock the thunk during entry and update.++   Note: this doesn't apply to THUNK_STATICs, which have no payload.++   Note: we leave this padding word in all ways, rather than just SMP,+   so that we don't have to recompile all our libraries for SMP.+   -------------------------------------------------------------------------- */++typedef struct {+    StgWord pad;+} StgSMPThunkHeader;++/* -----------------------------------------------------------------------------+   The full fixed-size closure header++   The size of the fixed header is the sum of the optional parts plus a single+   word for the entry code pointer.+   -------------------------------------------------------------------------- */++typedef struct {+    const StgInfoTable* info;+#if defined(PROFILING)+    StgProfHeader         prof;+#endif+} StgHeader;++typedef struct {+    const StgInfoTable* info;+#if defined(PROFILING)+    StgProfHeader         prof;+#endif+    StgSMPThunkHeader     smp;+} StgThunkHeader;++#define THUNK_EXTRA_HEADER_W (sizeofW(StgThunkHeader)-sizeofW(StgHeader))++/* -----------------------------------------------------------------------------+   Closure Types++   For any given closure type (defined in InfoTables.h), there is a+   corresponding structure defined below.  The name of the structure+   is obtained by concatenating the closure type with '_closure'+   -------------------------------------------------------------------------- */++/* All closures follow the generic format */++typedef struct StgClosure_ {+    StgHeader   header;+    struct StgClosure_ *payload[];+} *StgClosurePtr; // StgClosure defined in rts/Types.h++typedef struct {+    StgThunkHeader  header;+    struct StgClosure_ *payload[];+} StgThunk;++typedef struct {+    StgThunkHeader   header;+    StgClosure *selectee;+} StgSelector;++typedef struct {+    StgHeader   header;+    StgHalfWord arity;          /* zero if it is an AP */+    StgHalfWord n_args;+    StgClosure *fun;            /* really points to a fun */+    StgClosure *payload[];+} StgPAP;++typedef struct {+    StgThunkHeader   header;+    StgHalfWord arity;          /* zero if it is an AP */+    StgHalfWord n_args;+    StgClosure *fun;            /* really points to a fun */+    StgClosure *payload[];+} StgAP;++typedef struct {+    StgThunkHeader   header;+    StgWord     size;                    /* number of words in payload */+    StgClosure *fun;+    StgClosure *payload[]; /* contains a chunk of *stack* */+} StgAP_STACK;++typedef struct {+    StgHeader   header;+    StgClosure *indirectee;+} StgInd;++typedef struct {+    StgHeader     header;+    StgClosure   *indirectee;+    StgClosure   *static_link; // See Note [CAF lists]+    const StgInfoTable *saved_info;+        // `saved_info` also used for the link field for `debug_caf_list`,+        // see `newCAF` and Note [CAF lists] in rts/sm/Storage.h.+} StgIndStatic;++typedef struct StgBlockingQueue_ {+    StgHeader   header;+    struct StgBlockingQueue_ *link;+        // here so it looks like an IND, to be able to skip the queue without+        // deleting it (done in wakeBlockingQueue())+    StgClosure *bh;  // the BLACKHOLE+    StgTSO     *owner;+    struct MessageBlackHole_ *queue;+        // holds TSOs blocked on `bh`+} StgBlockingQueue;++typedef struct {+    StgHeader  header;+    StgWord    bytes;+    StgWord    payload[];+} StgArrBytes;++typedef struct {+    StgHeader   header;+    StgWord     ptrs;+    StgWord     size; // ptrs plus card table+    StgClosure *payload[];+    // see also: StgMutArrPtrs macros in ClosureMacros.h+} StgMutArrPtrs;++typedef struct {+    StgHeader   header;+    StgWord     ptrs;+    StgClosure *payload[];+} StgSmallMutArrPtrs;++typedef struct {+    StgHeader   header;+    StgClosure *var;+} StgMutVar;++typedef struct _StgUpdateFrame {+    StgHeader  header;+    StgClosure *updatee;+} StgUpdateFrame;++typedef struct {+    StgHeader  header;+    StgWord    exceptions_blocked;+    StgClosure *handler;+} StgCatchFrame;++typedef struct {+    const StgInfoTable* info;+    struct StgStack_ *next_chunk;+} StgUnderflowFrame;++typedef struct {+    StgHeader  header;+} StgStopFrame;++typedef struct {+  StgHeader header;+  StgWord data;+} StgIntCharlikeClosure;++/* statically allocated */+typedef struct {+  StgHeader  header;+} StgRetry;++typedef struct _StgStableName {+  StgHeader      header;+  StgWord        sn;+} StgStableName;++typedef struct _StgWeak {       /* Weak v */+  StgHeader header;+  StgClosure *cfinalizers;+  StgClosure *key;+  StgClosure *value;            /* v */+  StgClosure *finalizer;+  struct _StgWeak *link;+} StgWeak;++typedef struct _StgCFinalizerList {+  StgHeader header;+  StgClosure *link;+  void (*fptr)(void);+  void *ptr;+  void *eptr;+  StgWord flag; /* has environment (0 or 1) */+} StgCFinalizerList;++/* Byte code objects.  These are fixed size objects with pointers to+ * four arrays, designed so that a BCO can be easily "re-linked" to+ * other BCOs, to facilitate GHC's intelligent recompilation.  The+ * array of instructions is static and not re-generated when the BCO+ * is re-linked, but the other 3 arrays will be regenerated.+ *+ * A BCO represents either a function or a stack frame.  In each case,+ * it needs a bitmap to describe to the garbage collector the+ * pointerhood of its arguments/free variables respectively, and in+ * the case of a function it also needs an arity.  These are stored+ * directly in the BCO, rather than in the instrs array, for two+ * reasons:+ * (a) speed: we need to get at the bitmap info quickly when+ *     the GC is examining APs and PAPs that point to this BCO+ * (b) a subtle interaction with the compacting GC.  In compacting+ *     GC, the info that describes the size/layout of a closure+ *     cannot be in an object more than one level of indirection+ *     away from the current object, because of the order in+ *     which pointers are updated to point to their new locations.+ */++typedef struct {+    StgHeader      header;+    StgArrBytes   *instrs;      /* a pointer to an ArrWords */+    StgArrBytes   *literals;    /* a pointer to an ArrWords */+    StgMutArrPtrs *ptrs;        /* a pointer to a  MutArrPtrs */+    StgHalfWord   arity;        /* arity of this BCO */+    StgHalfWord   size;         /* size of this BCO (in words) */+    StgWord       bitmap[];  /* an StgLargeBitmap */+} StgBCO;++#define BCO_BITMAP(bco)      ((StgLargeBitmap *)((StgBCO *)(bco))->bitmap)+#define BCO_BITMAP_SIZE(bco) (BCO_BITMAP(bco)->size)+#define BCO_BITMAP_BITS(bco) (BCO_BITMAP(bco)->bitmap)+#define BCO_BITMAP_SIZEW(bco) ((BCO_BITMAP_SIZE(bco) + BITS_IN(StgWord) - 1) \+                                / BITS_IN(StgWord))++/* A function return stack frame: used when saving the state for a+ * garbage collection at a function entry point.  The function+ * arguments are on the stack, and we also save the function (its+ * info table describes the pointerhood of the arguments).+ *+ * The stack frame size is also cached in the frame for convenience.+ *+ * The only RET_FUN is stg_gc_fun, which is created by __stg_gc_fun,+ * both in HeapStackCheck.cmm.+ */+typedef struct {+    const StgInfoTable* info;+    StgWord        size;+    StgClosure *   fun;+    StgClosure *   payload[];+} StgRetFun;++/* Concurrent communication objects */++typedef struct StgMVarTSOQueue_ {+    StgHeader                header;+    struct StgMVarTSOQueue_ *link;+    struct StgTSO_          *tso;+} StgMVarTSOQueue;++typedef struct {+    StgHeader                header;+    struct StgMVarTSOQueue_ *head;+    struct StgMVarTSOQueue_ *tail;+    StgClosure*              value;+} StgMVar;+++/* STM data structures+ *+ *  StgTVar defines the only type that can be updated through the STM+ *  interface.+ *+ *  Note that various optimisations may be possible in order to use less+ *  space for these data structures at the cost of more complexity in the+ *  implementation:+ *+ *   - In StgTVar, current_value and first_watch_queue_entry could be held in+ *     the same field: if any thread is waiting then its expected_value for+ *     the tvar is the current value.+ *+ *   - In StgTRecHeader, it might be worthwhile having separate chunks+ *     of read-only and read-write locations.  This would save a+ *     new_value field in the read-only locations.+ *+ *   - In StgAtomicallyFrame, we could combine the waiting bit into+ *     the header (maybe a different info tbl for a waiting transaction).+ *     This means we can specialise the code for the atomically frame+ *     (it immediately switches on frame->waiting anyway).+ */++typedef struct StgTRecHeader_ StgTRecHeader;++typedef struct StgTVarWatchQueue_ {+  StgHeader                  header;+  StgClosure                *closure; // StgTSO+  struct StgTVarWatchQueue_ *next_queue_entry;+  struct StgTVarWatchQueue_ *prev_queue_entry;+} StgTVarWatchQueue;++typedef struct {+  StgHeader                  header;+  StgClosure                *volatile current_value;+  StgTVarWatchQueue         *volatile first_watch_queue_entry;+  StgInt                     volatile num_updates;+} StgTVar;++/* new_value == expected_value for read-only accesses */+/* new_value is a StgTVarWatchQueue entry when trec in state TREC_WAITING */+typedef struct {+  StgTVar                   *tvar;+  StgClosure                *expected_value;+  StgClosure                *new_value;+#if defined(THREADED_RTS)+  StgInt                     num_updates;+#endif+} TRecEntry;++#define TREC_CHUNK_NUM_ENTRIES 16++typedef struct StgTRecChunk_ {+  StgHeader                  header;+  struct StgTRecChunk_      *prev_chunk;+  StgWord                    next_entry_idx;+  TRecEntry                  entries[TREC_CHUNK_NUM_ENTRIES];+} StgTRecChunk;++typedef enum {+  TREC_ACTIVE,        /* Transaction in progress, outcome undecided */+  TREC_CONDEMNED,     /* Transaction in progress, inconsistent / out of date reads */+  TREC_COMMITTED,     /* Transaction has committed, now updating tvars */+  TREC_ABORTED,       /* Transaction has aborted, now reverting tvars */+  TREC_WAITING,       /* Transaction currently waiting */+} TRecState;++struct StgTRecHeader_ {+  StgHeader                  header;+  struct StgTRecHeader_     *enclosing_trec;+  StgTRecChunk              *current_chunk;+  TRecState                  state;+};++typedef struct {+  StgHeader   header;+  StgClosure *code;+  StgClosure *result;+} StgAtomicallyFrame;++typedef struct {+  StgHeader   header;+  StgClosure *code;+  StgClosure *handler;+} StgCatchSTMFrame;++typedef struct {+  StgHeader      header;+  StgWord        running_alt_code;+  StgClosure    *first_code;+  StgClosure    *alt_code;+} StgCatchRetryFrame;++/* ----------------------------------------------------------------------------+   Messages+   ------------------------------------------------------------------------- */++typedef struct Message_ {+    StgHeader        header;+    struct Message_ *link;+} Message;++typedef struct MessageWakeup_ {+    StgHeader header;+    Message  *link;+    StgTSO   *tso;+} MessageWakeup;++typedef struct MessageThrowTo_ {+    StgHeader   header;+    struct MessageThrowTo_ *link;+    StgTSO     *source;+    StgTSO     *target;+    StgClosure *exception;+} MessageThrowTo;++typedef struct MessageBlackHole_ {+    StgHeader   header;+    struct MessageBlackHole_ *link;+        // here so it looks like an IND, to be able to skip the message without+        // deleting it (done in throwToMsg())+    StgTSO     *tso;+    StgClosure *bh;+} MessageBlackHole;++/* ----------------------------------------------------------------------------+   Compact Regions+   ------------------------------------------------------------------------- */++//+// A compact region is a list of blocks.  Each block starts with an+// StgCompactNFDataBlock structure, and the list is chained through the next+// field of these structs.  (the link field of the bdescr is used to chain+// together multiple compact region on the compact_objects field of a+// generation).+//+// See Note [Compact Normal Forms] for details+//+typedef struct StgCompactNFDataBlock_ {+    struct StgCompactNFDataBlock_ *self;+       // the address of this block this is copied over to the+       // receiving end when serializing a compact, so the receiving+       // end can allocate the block at best as it can, and then+       // verify if pointer adjustment is needed or not by comparing+       // self with the actual address; the same data is sent over as+       // SerializedCompact metadata, but having it here simplifies+       // the fixup implementation.+    struct StgCompactNFData_ *owner;+       // the closure who owns this block (used in objectGetCompact)+    struct StgCompactNFDataBlock_ *next;+       // chain of blocks used for serialization and freeing+} StgCompactNFDataBlock;++//+// This is the Compact# primitive object.+//+typedef struct StgCompactNFData_ {+    StgHeader header;+      // for sanity and other checks in practice, nothing should ever+      // need the compact info pointer (we don't even need fwding+      // pointers because it's a large object)+    StgWord totalW;+      // Total number of words in all blocks in the compact+    StgWord autoBlockW;+      // size of automatically appended blocks+    StgPtr hp, hpLim;+      // the beginning and end of the free area in the nursery block.  This is+      // just a convenience so that we can avoid multiple indirections through+      // the nursery pointer below during compaction.+    StgCompactNFDataBlock *nursery;+      // where to (try to) allocate from when appending+    StgCompactNFDataBlock *last;+      // the last block of the chain (to know where to append new+      // blocks for resize)+    struct hashtable *hash;+      // the hash table for the current compaction, or NULL if+      // there's no (sharing-preserved) compaction in progress.+    StgClosure *result;+      // Used temporarily to store the result of compaction.  Doesn't need to be+      // a GC root.+} StgCompactNFData;
+ includes/rts/storage/FunTypes.h view
@@ -0,0 +1,54 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 2002+ *+ * Things for functions.+ *+ * ---------------------------------------------------------------------------*/++#pragma once++/* generic - function comes with a small bitmap */+#define ARG_GEN      0   ++/* generic - function comes with a large bitmap */+#define ARG_GEN_BIG  1++/* BCO - function is really a BCO */+#define ARG_BCO      2++/*+ * Specialised function types: bitmaps and calling sequences+ * for these functions are pre-generated: see ghc/utils/genapply and+ * generated code in ghc/rts/AutoApply.cmm.+ *+ *  NOTE: other places to change if you change this table:+ *       - utils/genapply/Main.hs: stackApplyTypes+ *       - compiler/codeGen/StgCmmLayout.hs: stdPattern+ */+#define ARG_NONE     3 +#define ARG_N        4  +#define ARG_P        5 +#define ARG_F        6 +#define ARG_D        7 +#define ARG_L        8 +#define ARG_V16      9 +#define ARG_V32      10+#define ARG_V64      11+#define ARG_NN       12 +#define ARG_NP       13+#define ARG_PN       14+#define ARG_PP       15+#define ARG_NNN      16+#define ARG_NNP      17+#define ARG_NPN      18+#define ARG_NPP      19+#define ARG_PNN      20+#define ARG_PNP      21+#define ARG_PPN      22+#define ARG_PPP      23+#define ARG_PPPP     24+#define ARG_PPPPP    25+#define ARG_PPPPPP   26+#define ARG_PPPPPPP  27+#define ARG_PPPPPPPP 28
+ includes/rts/storage/GC.h view
@@ -0,0 +1,248 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2004+ *+ * External Storage Manger Interface+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#include <stddef.h>+#include "rts/OSThreads.h"++/* -----------------------------------------------------------------------------+ * Generational GC+ *+ * We support an arbitrary number of generations.  Notes (in no particular+ * order):+ *+ *       - Objects "age" in the nursery for one GC cycle before being promoted+ *         to the next generation.  There is no aging in other generations.+ *+ *       - generation 0 is the allocation area.  It is given+ *         a fixed set of blocks during initialisation, and these blocks+ *         normally stay in G0S0.  In parallel execution, each+ *         Capability has its own nursery.+ *+ *       - during garbage collection, each generation which is an+ *         evacuation destination (i.e. all generations except G0) is+ *         allocated a to-space.  evacuated objects are allocated into+ *         the generation's to-space until GC is finished, when the+ *         original generations's contents may be freed and replaced+ *         by the to-space.+ *+ *       - the mutable-list is per-generation.  G0 doesn't have one+ *         (since every garbage collection collects at least G0).+ *+ *       - block descriptors contain a pointer to the generation that+ *         the block belongs to, for convenience.+ *+ *       - static objects are stored in per-generation lists.  See GC.c for+ *         details of how we collect CAFs in the generational scheme.+ *+ *       - large objects are per-generation, and are promoted in the+ *         same way as small objects.+ *+ * ------------------------------------------------------------------------- */++// A count of blocks needs to store anything up to the size of memory+// divided by the block size.  The safest thing is therefore to use a+// type that can store the full range of memory addresses,+// ie. StgWord.  Note that we have had some tricky int overflows in a+// couple of cases caused by using ints rather than longs (e.g. #5086)++typedef StgWord memcount;++typedef struct nursery_ {+    bdescr *       blocks;+    memcount       n_blocks;+} nursery;++// Nursery invariants:+//+//  - cap->r.rNursery points to the nursery for this capability+//+//  - cap->r.rCurrentNursery points to the block in the nursery that we are+//    currently allocating into.  While in Haskell the current heap pointer is+//    in Hp, outside Haskell it is stored in cap->r.rCurrentNursery->free.+//+//  - the blocks *after* cap->rCurrentNursery in the chain are empty+//    (although their bd->free pointers have not been updated to+//    reflect that)+//+//  - the blocks *before* cap->rCurrentNursery have been used.  Except+//    for rCurrentAlloc.+//+//  - cap->r.rCurrentAlloc is either NULL, or it points to a block in+//    the nursery *before* cap->r.rCurrentNursery.+//+// See also Note [allocation accounting] to understand how total+// memory allocation is tracked.++typedef struct generation_ {+    uint32_t       no;                  // generation number++    bdescr *       blocks;              // blocks in this gen+    memcount       n_blocks;            // number of blocks+    memcount       n_words;             // number of used words++    bdescr *       large_objects;       // large objects (doubly linked)+    memcount       n_large_blocks;      // no. of blocks used by large objs+    memcount       n_large_words;       // no. of words used by large objs+    memcount       n_new_large_words;   // words of new large objects+                                        // (for doYouWantToGC())++    bdescr *       compact_objects;     // compact objects chain+                                        // the second block in each compact is+                                        // linked from the closure object, while+                                        // the second compact object in the+                                        // chain is linked from bd->link (like+                                        // large objects)+    memcount       n_compact_blocks;    // no. of blocks used by all compacts+    bdescr *       compact_blocks_in_import; // compact objects being imported+                                             // (not known to the GC because+                                             // potentially invalid, but we+                                             // need to keep track of them+                                             // to avoid assertions in Sanity)+                                             // this is a list shaped like compact_objects+    memcount       n_compact_blocks_in_import; // no. of blocks used by compacts+                                               // being imported++    // Max blocks to allocate in this generation before collecting it. Collect+    // this generation when+    //+    //     n_blocks + n_large_blocks + n_compact_blocks > max_blocks+    //+    memcount       max_blocks;++    StgTSO *       threads;             // threads in this gen+                                        // linked via global_link+    StgWeak *      weak_ptr_list;       // weak pointers in this gen++    struct generation_ *to;             // destination gen for live objects++    // stats information+    uint32_t collections;+    uint32_t par_collections;+    uint32_t failed_promotions;         // Currently unused++    // ------------------------------------+    // Fields below are used during GC only++#if defined(THREADED_RTS)+    char pad[128];                      // make sure the following is+                                        // on a separate cache line.+    SpinLock     sync;                  // lock for large_objects+                                        //    and scavenged_large_objects+#endif++    int          mark;                  // mark (not copy)? (old gen only)+    int          compact;               // compact (not sweep)? (old gen only)++    // During GC, if we are collecting this gen, blocks and n_blocks+    // are copied into the following two fields.  After GC, these blocks+    // are freed.+    bdescr *     old_blocks;            // bdescr of first from-space block+    memcount     n_old_blocks;         // number of blocks in from-space+    memcount     live_estimate;         // for sweeping: estimate of live data++    bdescr *     scavenged_large_objects;  // live large objs after GC (d-link)+    memcount     n_scavenged_large_blocks; // size (not count) of above++    bdescr *     live_compact_objects;  // live compact objs after GC (d-link)+    memcount     n_live_compact_blocks; // size (not count) of above++    bdescr *     bitmap;                // bitmap for compacting collection++    StgTSO *     old_threads;+    StgWeak *    old_weak_ptr_list;+} generation;++extern generation * generations;+extern generation * g0;+extern generation * oldest_gen;++/* -----------------------------------------------------------------------------+   Generic allocation++   StgPtr allocate(Capability *cap, W_ n)+                                Allocates memory from the nursery in+                                the current Capability.++   StgPtr allocatePinned(Capability *cap, W_ n)+                                Allocates a chunk of contiguous store+                                n words long, which is at a fixed+                                address (won't be moved by GC).+                                Returns a pointer to the first word.+                                Always succeeds.++                                NOTE: the GC can't in general handle+                                pinned objects, so allocatePinned()+                                can only be used for ByteArrays at the+                                moment.++                                Don't forget to TICK_ALLOC_XXX(...)+                                after calling allocate or+                                allocatePinned, for the+                                benefit of the ticky-ticky profiler.++   -------------------------------------------------------------------------- */++StgPtr  allocate          ( Capability *cap, W_ n );+StgPtr  allocateMightFail ( Capability *cap, W_ n );+StgPtr  allocatePinned    ( Capability *cap, W_ n );++/* memory allocator for executable memory */+typedef void* AdjustorWritable;+typedef void* AdjustorExecutable;++AdjustorWritable allocateExec(W_ len, AdjustorExecutable *exec_addr);+void flushExec(W_ len, AdjustorExecutable exec_addr);+#if defined(ios_HOST_OS)+AdjustorWritable execToWritable(AdjustorExecutable exec);+#endif+void             freeExec (AdjustorExecutable p);++// Used by GC checks in external .cmm code:+extern W_ large_alloc_lim;++/* -----------------------------------------------------------------------------+   Performing Garbage Collection+   -------------------------------------------------------------------------- */++void performGC(void);+void performMajorGC(void);++/* -----------------------------------------------------------------------------+   The CAF table - used to let us revert CAFs in GHCi+   -------------------------------------------------------------------------- */++StgInd *newCAF         (StgRegTable *reg, StgIndStatic *caf);+StgInd *newRetainedCAF (StgRegTable *reg, StgIndStatic *caf);+StgInd *newGCdCAF      (StgRegTable *reg, StgIndStatic *caf);+void revertCAFs (void);++// Request that all CAFs are retained indefinitely.+// (preferably use RtsConfig.keep_cafs instead)+void setKeepCAFs (void);++/* -----------------------------------------------------------------------------+   This is the write barrier for MUT_VARs, a.k.a. IORefs.  A+   MUT_VAR_CLEAN object is not on the mutable list; a MUT_VAR_DIRTY+   is.  When written to, a MUT_VAR_CLEAN turns into a MUT_VAR_DIRTY+   and is put on the mutable list.+   -------------------------------------------------------------------------- */++void dirty_MUT_VAR(StgRegTable *reg, StgClosure *p);++/* set to disable CAF garbage collection in GHCi. */+/* (needed when dynamic libraries are used). */+extern bool keepCAFs;++INLINE_HEADER void initBdescr(bdescr *bd, generation *gen, generation *dest)+{+    bd->gen     = gen;+    bd->gen_no  = gen->no;+    bd->dest_no = dest->no;+}
+ includes/rts/storage/Heap.h view
@@ -0,0 +1,18 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The University of Glasgow 2006-2017+ *+ * Introspection into GHC's heap representation+ *+ * ---------------------------------------------------------------------------*/++#pragma once++#include "rts/storage/Closures.h"++StgMutArrPtrs *heap_view_closurePtrs(Capability *cap, StgClosure *closure);++void heap_view_closure_ptrs_in_pap_payload(StgClosure *ptrs[], StgWord *nptrs+                        , StgClosure *fun, StgClosure **payload, StgWord size);++StgWord heap_view_closureSize(StgClosure *closure);
+ includes/rts/storage/InfoTables.h view
@@ -0,0 +1,405 @@+/* ----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2002+ *+ * Info Tables+ *+ * -------------------------------------------------------------------------- */++#pragma once++/* ----------------------------------------------------------------------------+   Relative pointers++   Several pointer fields in info tables are expressed as offsets+   relative to the info pointer, so that we can generate+   position-independent code.++   Note [x86-64-relative]+   There is a complication on the x86_64 platform, where pointers are+   64 bits, but the tools don't support 64-bit relative relocations.+   However, the default memory model (small) ensures that all symbols+   have values in the lower 2Gb of the address space, so offsets all+   fit in 32 bits.  Hence we can use 32-bit offset fields.++   Somewhere between binutils-2.16.1 and binutils-2.16.91.0.6,+   support for 64-bit PC-relative relocations was added, so maybe this+   hackery can go away sometime.+   ------------------------------------------------------------------------- */++#if defined(x86_64_TARGET_ARCH)+#define OFFSET_FIELD(n) StgHalfInt n; StgHalfWord __pad_##n+#else+#define OFFSET_FIELD(n) StgInt n+#endif++/* -----------------------------------------------------------------------------+   Profiling info+   -------------------------------------------------------------------------- */++typedef struct {+#if !defined(TABLES_NEXT_TO_CODE)+    char *closure_type;+    char *closure_desc;+#else+    OFFSET_FIELD(closure_type_off);+    OFFSET_FIELD(closure_desc_off);+#endif+} StgProfInfo;++/* -----------------------------------------------------------------------------+   Closure flags+   -------------------------------------------------------------------------- */++/* The type flags provide quick access to certain properties of a closure. */++#define _HNF (1<<0)  /* head normal form?    */+#define _BTM (1<<1)  /* uses info->layout.bitmap */+#define _NS  (1<<2)  /* non-sparkable        */+#define _THU (1<<3)  /* thunk?               */+#define _MUT (1<<4)  /* mutable?             */+#define _UPT (1<<5)  /* unpointed?           */+#define _SRT (1<<6)  /* has an SRT?          */+#define _IND (1<<7)  /* is an indirection?   */++#define isMUTABLE(flags)   ((flags) &_MUT)+#define isBITMAP(flags)    ((flags) &_BTM)+#define isTHUNK(flags)     ((flags) &_THU)+#define isUNPOINTED(flags) ((flags) &_UPT)+#define hasSRT(flags)      ((flags) &_SRT)++extern StgWord16 closure_flags[];++#define closureFlags(c)         (closure_flags[get_itbl \+                                    (UNTAG_CONST_CLOSURE(c))->type])++#define closure_HNF(c)          (  closureFlags(c) & _HNF)+#define closure_BITMAP(c)       (  closureFlags(c) & _BTM)+#define closure_NON_SPARK(c)    ( (closureFlags(c) & _NS))+#define closure_SHOULD_SPARK(c) (!(closureFlags(c) & _NS))+#define closure_THUNK(c)        (  closureFlags(c) & _THU)+#define closure_MUTABLE(c)      (  closureFlags(c) & _MUT)+#define closure_UNPOINTED(c)    (  closureFlags(c) & _UPT)+#define closure_SRT(c)          (  closureFlags(c) & _SRT)+#define closure_IND(c)          (  closureFlags(c) & _IND)++/* same as above but for info-ptr rather than closure */+#define ipFlags(ip)             (closure_flags[ip->type])++#define ip_HNF(ip)               (  ipFlags(ip) & _HNF)+#define ip_BITMAP(ip)            (  ipFlags(ip) & _BTM)+#define ip_SHOULD_SPARK(ip)      (!(ipFlags(ip) & _NS))+#define ip_THUNK(ip)             (  ipFlags(ip) & _THU)+#define ip_MUTABLE(ip)           (  ipFlags(ip) & _MUT)+#define ip_UNPOINTED(ip)         (  ipFlags(ip) & _UPT)+#define ip_SRT(ip)               (  ipFlags(ip) & _SRT)+#define ip_IND(ip)               (  ipFlags(ip) & _IND)++/* -----------------------------------------------------------------------------+   Bitmaps++   These are used to describe the pointerhood of a sequence of words+   (usually on the stack) to the garbage collector.  The two primary+   uses are for stack frames, and functions (where we need to describe+   the layout of a PAP to the GC).++   In these bitmaps: 0 == ptr, 1 == non-ptr.+   -------------------------------------------------------------------------- */++/*+ * Small bitmaps:  for a small bitmap, we store the size and bitmap in+ * the same word, using the following macros.  If the bitmap doesn't+ * fit in a single word, we use a pointer to an StgLargeBitmap below.+ */+#define MK_SMALL_BITMAP(size,bits) (((bits)<<BITMAP_BITS_SHIFT) | (size))++#define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK)+#define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT)++/*+ * A large bitmap.+ */+typedef struct {+  StgWord size;+  StgWord bitmap[];+} StgLargeBitmap;++/* ----------------------------------------------------------------------------+   Info Tables+   ------------------------------------------------------------------------- */++/*+ * Stuff describing the closure layout.  Well, actually, it might+ * contain the selector index for a THUNK_SELECTOR.  This union is one+ * word long.+ */+typedef union {+    struct {                    /* Heap closure payload layout: */+        StgHalfWord ptrs;       /* number of pointers */+        StgHalfWord nptrs;      /* number of non-pointers */+    } payload;++    StgWord bitmap;               /* word-sized bit pattern describing */+                                  /*  a stack frame: see below */++#if !defined(TABLES_NEXT_TO_CODE)+    StgLargeBitmap* large_bitmap; /* pointer to large bitmap structure */+#else+    OFFSET_FIELD(large_bitmap_offset);  /* offset from info table to large bitmap structure */+#endif++    StgWord selector_offset;      /* used in THUNK_SELECTORs */++} StgClosureInfo;+++#if defined(x86_64_TARGET_ARCH) && defined(TABLES_NEXT_TO_CODE)+// On x86_64 we can fit a pointer offset in half a word, so put the SRT offset+// in the info->srt field directly.+//+// See the section "Referring to an SRT from the info table" in+// Note [SRTs] in CmmBuildInfoTables.hs+#define USE_INLINE_SRT_FIELD+#endif++#if defined(USE_INLINE_SRT_FIELD)+// offset to the SRT / closure, or zero if there's no SRT+typedef StgHalfInt StgSRTField;+#else+// non-zero if there is an SRT, the offset is in the optional srt field.+typedef StgHalfWord StgSRTField;+#endif+++/*+ * The "standard" part of an info table.  Every info table has this bit.+ */+typedef struct StgInfoTable_ {++#if !defined(TABLES_NEXT_TO_CODE)+    StgFunPtr       entry;      /* pointer to the entry code */+#endif++#if defined(PROFILING)+    StgProfInfo     prof;+#endif++    StgClosureInfo  layout;     /* closure layout info (one word) */++    StgHalfWord     type;       /* closure type */+    StgSRTField     srt;+       /* In a CONSTR:+            - the constructor tag+          In a FUN/THUNK+            - if USE_INLINE_SRT_FIELD+              - offset to the SRT (or zero if no SRT)+            - otherwise+              - non-zero if there is an SRT, offset is in srt_offset+       */++#if defined(TABLES_NEXT_TO_CODE)+    StgCode         code[];+#endif+} *StgInfoTablePtr; // StgInfoTable defined in rts/Types.h+++/* -----------------------------------------------------------------------------+   Function info tables++   This is the general form of function info tables.  The compiler+   will omit some of the fields in common cases:++   -  If fun_type is not ARG_GEN or ARG_GEN_BIG, then the slow_apply+      and bitmap fields may be left out (they are at the end, so omitting+      them doesn't affect the layout).++   -  If has_srt (in the std info table part) is zero, then the srt+      field needn't be set.  This only applies if the slow_apply and+      bitmap fields have also been omitted.+   -------------------------------------------------------------------------- */++/*+   Note [Encoding static reference tables]+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++   As static reference tables appear frequently in code, we use a special+   compact encoding for the common case of a module defining only a few CAFs: We+   produce one table containing a list of CAFs in the module and then include a+   bitmap in each info table describing which entries of this table the closure+   references.+ */++typedef struct StgFunInfoExtraRev_ {+    OFFSET_FIELD(slow_apply_offset); /* apply to args on the stack */+    union {+        StgWord bitmap;+        OFFSET_FIELD(bitmap_offset);    /* arg ptr/nonptr bitmap */+    } b;+#if !defined(USE_INLINE_SRT_FIELD)+    OFFSET_FIELD(srt_offset);   /* pointer to the SRT closure */+#endif+    StgHalfWord    fun_type;    /* function type */+    StgHalfWord    arity;       /* function arity */+} StgFunInfoExtraRev;++typedef struct StgFunInfoExtraFwd_ {+    StgHalfWord    fun_type;    /* function type */+    StgHalfWord    arity;       /* function arity */+    StgClosure    *srt;         /* pointer to the SRT closure */+    union { /* union for compat. with TABLES_NEXT_TO_CODE version */+        StgWord        bitmap;  /* arg ptr/nonptr bitmap */+    } b;+    StgFun         *slow_apply; /* apply to args on the stack */+} StgFunInfoExtraFwd;++typedef struct {+#if defined(TABLES_NEXT_TO_CODE)+    StgFunInfoExtraRev f;+    StgInfoTable i;+#else+    StgInfoTable i;+    StgFunInfoExtraFwd f;+#endif+} StgFunInfoTable;++// canned bitmap for each arg type, indexed by constants in FunTypes.h+extern const StgWord stg_arg_bitmaps[];++/* -----------------------------------------------------------------------------+   Return info tables+   -------------------------------------------------------------------------- */++/*+ * When info tables are laid out backwards, we can omit the SRT+ * pointer iff has_srt is zero.+ */++typedef struct {+#if defined(TABLES_NEXT_TO_CODE)+#if !defined(USE_INLINE_SRT_FIELD)+    OFFSET_FIELD(srt_offset);   /* offset to the SRT closure */+#endif+    StgInfoTable i;+#else+    StgInfoTable i;+    StgClosure  *srt;           /* pointer to the SRT closure */+#endif+} StgRetInfoTable;++/* -----------------------------------------------------------------------------+   Thunk info tables+   -------------------------------------------------------------------------- */++/*+ * When info tables are laid out backwards, we can omit the SRT+ * pointer iff has_srt is zero.+ */++typedef struct StgThunkInfoTable_ {+#if defined(TABLES_NEXT_TO_CODE)+#if !defined(USE_INLINE_SRT_FIELD)+    OFFSET_FIELD(srt_offset);   /* offset to the SRT closure */+#endif+    StgInfoTable i;+#else+    StgInfoTable i;+    StgClosure  *srt;           /* pointer to the SRT closure */+#endif+} StgThunkInfoTable;++/* -----------------------------------------------------------------------------+   Constructor info tables+   -------------------------------------------------------------------------- */++typedef struct StgConInfoTable_ {+#if !defined(TABLES_NEXT_TO_CODE)+    StgInfoTable i;+#endif++#if defined(TABLES_NEXT_TO_CODE)+    OFFSET_FIELD(con_desc); // the name of the data constructor+                            // as: Package:Module.Name+#else+    char *con_desc;+#endif++#if defined(TABLES_NEXT_TO_CODE)+    StgInfoTable i;+#endif+} StgConInfoTable;+++/* -----------------------------------------------------------------------------+   Accessor macros for fields that might be offsets (C version)+   -------------------------------------------------------------------------- */++/*+ * GET_SRT(info)+ * info must be a Stg[Ret|Thunk]InfoTable* (an info table that has a SRT)+ */+#if defined(TABLES_NEXT_TO_CODE)+#if defined(x86_64_TARGET_ARCH)+#define GET_SRT(info) \+  ((StgClosure*) (((StgWord) ((info)+1)) + (info)->i.srt))+#else+#define GET_SRT(info) \+  ((StgClosure*) (((StgWord) ((info)+1)) + (info)->srt_offset))+#endif+#else // !TABLES_NEXT_TO_CODE+#define GET_SRT(info) ((info)->srt)+#endif++/*+ * GET_CON_DESC(info)+ * info must be a StgConInfoTable*.+ */+#if defined(TABLES_NEXT_TO_CODE)+#define GET_CON_DESC(info) \+            ((const char *)((StgWord)((info)+1) + (info->con_desc)))+#else+#define GET_CON_DESC(info) ((const char *)(info)->con_desc)+#endif++/*+ * GET_FUN_SRT(info)+ * info must be a StgFunInfoTable*+ */+#if defined(TABLES_NEXT_TO_CODE)+#if defined(x86_64_TARGET_ARCH)+#define GET_FUN_SRT(info) \+  ((StgClosure*) (((StgWord) ((info)+1)) + (info)->i.srt))+#else+#define GET_FUN_SRT(info) \+  ((StgClosure*) (((StgWord) ((info)+1)) + (info)->f.srt_offset))+#endif+#else+#define GET_FUN_SRT(info) ((info)->f.srt)+#endif++#if defined(TABLES_NEXT_TO_CODE)+#define GET_LARGE_BITMAP(info) ((StgLargeBitmap*) (((StgWord) ((info)+1)) \+                                        + (info)->layout.large_bitmap_offset))+#else+#define GET_LARGE_BITMAP(info) ((info)->layout.large_bitmap)+#endif++#if defined(TABLES_NEXT_TO_CODE)+#define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) (((StgWord) ((info)+1)) \+                                        + (info)->f.b.bitmap_offset))+#else+#define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) ((info)->f.b.bitmap))+#endif++/*+ * GET_PROF_TYPE, GET_PROF_DESC+ */+#if defined(TABLES_NEXT_TO_CODE)+#define GET_PROF_TYPE(info) ((char *)((StgWord)((info)+1) + (info->prof.closure_type_off)))+#else+#define GET_PROF_TYPE(info) ((info)->prof.closure_type)+#endif+#if defined(TABLES_NEXT_TO_CODE)+#define GET_PROF_DESC(info) ((char *)((StgWord)((info)+1) + (info->prof.closure_desc_off)))+#else+#define GET_PROF_DESC(info) ((info)->prof.closure_desc)+#endif
+ includes/rts/storage/MBlock.h view
@@ -0,0 +1,32 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2008+ *+ * MegaBlock Allocator interface.+ *+ * See wiki commentary at+ *  https://gitlab.haskell.org/ghc/ghc/wikis/commentary/heap-alloced+ *+ * ---------------------------------------------------------------------------*/++#pragma once++extern W_ peak_mblocks_allocated;+extern W_ mblocks_allocated;++extern void initMBlocks(void);+extern void * getMBlock(void);+extern void * getMBlocks(uint32_t n);+extern void * getMBlockOnNode(uint32_t node);+extern void * getMBlocksOnNode(uint32_t node, uint32_t n);+extern void freeMBlocks(void *addr, uint32_t n);+extern void releaseFreeMemory(void);+extern void freeAllMBlocks(void);++extern void *getFirstMBlock(void **state);+extern void *getNextMBlock(void **state, void *mblock);++#if defined(THREADED_RTS)+// needed for HEAP_ALLOCED below+extern SpinLock gc_alloc_block_sync;+#endif
+ includes/rts/storage/TSO.h view
@@ -0,0 +1,261 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The GHC Team, 1998-2009+ *+ * The definitions for Thread State Objects.+ *+ * ---------------------------------------------------------------------------*/++#pragma once++/*+ * PROFILING info in a TSO+ */+typedef struct {+  CostCentreStack *cccs;       /* thread's current CCS */+} StgTSOProfInfo;++/*+ * There is no TICKY info in a TSO at this time.+ */++/*+ * Thread IDs are 32 bits.+ */+typedef StgWord32 StgThreadID;++#define tsoLocked(tso) ((tso)->flags & TSO_LOCKED)++/*+ * Type returned after running a thread.  Values of this type+ * include HeapOverflow, StackOverflow etc.  See Constants.h for the+ * full list.+ */+typedef unsigned int StgThreadReturnCode;++#if defined(mingw32_HOST_OS)+/* results from an async I/O request + its request ID. */+typedef struct {+  unsigned int reqID;+  int          len;+  int          errCode;+} StgAsyncIOResult;+#endif++/* Reason for thread being blocked. See comment above struct StgTso_. */+typedef union {+  StgClosure *closure;+  StgTSO *prev; // a back-link when the TSO is on the run queue (NotBlocked)+  struct MessageBlackHole_ *bh;+  struct MessageThrowTo_ *throwto;+  struct MessageWakeup_  *wakeup;+  StgInt fd;    /* StgInt instead of int, so that it's the same size as the ptrs */+#if defined(mingw32_HOST_OS)+  StgAsyncIOResult *async_result;+#endif+#if !defined(THREADED_RTS)+  StgWord target;+    // Only for the non-threaded RTS: the target time for a thread+    // blocked in threadDelay, in units of 1ms.  This is a+    // compromise: we don't want to take up much space in the TSO.  If+    // you want better resolution for threadDelay, use -threaded.+#endif+} StgTSOBlockInfo;+++/*+ * TSOs live on the heap, and therefore look just like heap objects.+ * Large TSOs will live in their own "block group" allocated by the+ * storage manager, and won't be copied during garbage collection.+ */++/*+ * Threads may be blocked for several reasons.  A blocked thread will+ * have the reason in the why_blocked field of the TSO, and some+ * further info (such as the closure the thread is blocked on, or the+ * file descriptor if the thread is waiting on I/O) in the block_info+ * field.+ */++typedef struct StgTSO_ {+    StgHeader               header;++    /* The link field, for linking threads together in lists (e.g. the+       run queue on a Capability.+    */+    struct StgTSO_*         _link;+    /*+      Currently used for linking TSOs on:+      * cap->run_queue_{hd,tl}+      * (non-THREADED_RTS); the blocked_queue+      * and pointing to the next chunk for a ThreadOldStack++       NOTE!!!  do not modify _link directly, it is subject to+       a write barrier for generational GC.  Instead use the+       setTSOLink() function.  Exceptions to this rule are:++       * setting the link field to END_TSO_QUEUE+       * setting the link field of the currently running TSO, as it+         will already be dirty.+    */++    struct StgTSO_*         global_link;    // Links threads on the+                                            // generation->threads lists++    /*+     * The thread's stack+     */+    struct StgStack_       *stackobj;++    /*+     * The tso->dirty flag indicates that this TSO's stack should be+     * scanned during garbage collection.  It also indicates that this+     * TSO is on the mutable list.+     *+     * NB. The dirty flag gets a word to itself, so that it can be set+     * safely by multiple threads simultaneously (the flags field is+     * not safe for this purpose; see #3429).  It is harmless for the+     * TSO to be on the mutable list multiple times.+     *+     * tso->dirty is set by dirty_TSO(), and unset by the garbage+     * collector (only).+     */++    StgWord16               what_next;      // Values defined in Constants.h+    StgWord16               why_blocked;    // Values defined in Constants.h+    StgWord32               flags;          // Values defined in Constants.h+    StgTSOBlockInfo         block_info;+    StgThreadID             id;+    StgWord32               saved_errno;+    StgWord32               dirty;          /* non-zero => dirty */+    struct InCall_*         bound;+    struct Capability_*     cap;++    struct StgTRecHeader_ * trec;       /* STM transaction record */++    /*+     * A list of threads blocked on this TSO waiting to throw exceptions.+    */+    struct MessageThrowTo_ * blocked_exceptions;++    /*+     * A list of StgBlockingQueue objects, representing threads+     * blocked on thunks that are under evaluation by this thread.+    */+    struct StgBlockingQueue_ *bq;++    /*+     * The allocation limit for this thread, which is updated as the+     * thread allocates.  If the value drops below zero, and+     * TSO_ALLOC_LIMIT is set in flags, we raise an exception in the+     * thread, and give the thread a little more space to handle the+     * exception before we raise the exception again.+     *+     * This is an integer, because we might update it in a place where+     * it isn't convenient to raise the exception, so we want it to+     * stay negative until we get around to checking it.+     *+     * Use only PK_Int64/ASSIGN_Int64 macros to get/set the value of alloc_limit+     * in C code otherwise you will cause alignment issues on SPARC+     */+    StgInt64  alloc_limit;     /* in bytes */++    /*+     * sum of the sizes of all stack chunks (in words), used to decide+     * whether to throw the StackOverflow exception when the stack+     * overflows, or whether to just chain on another stack chunk.+     *+     * Note that this overestimates the real stack size, because each+     * chunk will have a gap at the end, of +RTS -kb<size> words.+     * This means stack overflows are not entirely accurate, because+     * the more gaps there are, the sooner the stack will run into the+     * hard +RTS -K<size> limit.+     */+    StgWord32  tot_stack_size;++#if defined(TICKY_TICKY)+    /* TICKY-specific stuff would go here. */+#endif+#if defined(PROFILING)+    StgTSOProfInfo prof;+#endif+#if defined(mingw32_HOST_OS)+    StgWord32 saved_winerror;+#endif++} *StgTSOPtr; // StgTSO defined in rts/Types.h++typedef struct StgStack_ {+    StgHeader  header;+    StgWord32  stack_size;     // stack size in *words*+    StgWord32  dirty;          // non-zero => dirty+    StgPtr     sp;             // current stack pointer+    StgWord    stack[];+} StgStack;++// Calculate SpLim from a TSO (reads tso->stackobj, but no fields from+// the stackobj itself).+INLINE_HEADER StgPtr tso_SpLim (StgTSO* tso)+{+    return tso->stackobj->stack + RESERVED_STACK_WORDS;+}++/* -----------------------------------------------------------------------------+   functions+   -------------------------------------------------------------------------- */++void dirty_TSO  (Capability *cap, StgTSO *tso);+void setTSOLink (Capability *cap, StgTSO *tso, StgTSO *target);+void setTSOPrev (Capability *cap, StgTSO *tso, StgTSO *target);++void dirty_STACK (Capability *cap, StgStack *stack);++/* -----------------------------------------------------------------------------+   Invariants:++   An active thread has the following properties:++      tso->stack < tso->sp < tso->stack+tso->stack_size+      tso->stack_size <= tso->max_stack_size++      RESERVED_STACK_WORDS is large enough for any heap-check or+      stack-check failure.++      The size of the TSO struct plus the stack is either+        (a) smaller than a block, or+        (b) a multiple of BLOCK_SIZE++        tso->why_blocked       tso->block_info      location+        ----------------------------------------------------------------------+        NotBlocked             END_TSO_QUEUE        runnable_queue, or running++        BlockedOnBlackHole     MessageBlackHole *   TSO->bq++        BlockedOnMVar          the MVAR             the MVAR's queue++        BlockedOnSTM           END_TSO_QUEUE        STM wait queue(s)+        BlockedOnSTM           STM_AWOKEN           run queue++        BlockedOnMsgThrowTo    MessageThrowTo *     TSO->blocked_exception++        BlockedOnRead          NULL                 blocked_queue+        BlockedOnWrite         NULL                 blocked_queue+        BlockedOnDelay         NULL                 blocked_queue++      tso->link == END_TSO_QUEUE, if the thread is currently running.++   A zombie thread has the following properties:++      tso->what_next == ThreadComplete or ThreadKilled+      tso->link     ==  (could be on some queue somewhere)+      tso->sp       ==  tso->stack + tso->stack_size - 1 (i.e. top stack word)+      tso->sp[0]    ==  return value of thread, if what_next == ThreadComplete,+                        exception             , if what_next == ThreadKilled++      (tso->sp is left pointing at the top word on the stack so that+      the return value or exception will be retained by a GC).++ ---------------------------------------------------------------------------- */++/* this is the NIL ptr for a TSO queue (e.g. runnable queue) */+#define END_TSO_QUEUE  ((StgTSO *)(void*)&stg_END_TSO_QUEUE_closure)
+ libraries/ghc-boot-th/GHC/ForeignSrcLang/Type.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE DeriveGeneric #-}+module GHC.ForeignSrcLang.Type+  ( ForeignSrcLang(..)+  ) where++import Prelude -- See note [Why do we import Prelude here?]+import GHC.Generics (Generic)++-- | Foreign formats supported by GHC via TH+data ForeignSrcLang+  = LangC      -- ^ C+  | LangCxx    -- ^ C+++  | LangObjc   -- ^ Objective C+  | LangObjcxx -- ^ Objective C+++  | LangAsm    -- ^ Assembly language (.s)+  | RawObject  -- ^ Object (.o)+  deriving (Eq, Show, Generic)
+ libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs view
@@ -0,0 +1,142 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.LanguageExtensions.Type+-- Copyright   :  (c) The GHC Team+--+-- Maintainer  :  ghc-devs@haskell.org+-- Portability :  portable+--+-- A data type defining the language extensions supported by GHC.+--+{-# LANGUAGE DeriveGeneric #-}+module GHC.LanguageExtensions.Type ( Extension(..) ) where++import Prelude -- See note [Why do we import Prelude here?]+import GHC.Generics++-- | The language extensions known to GHC.+--+-- Note that there is an orphan 'Binary' instance for this type supplied by+-- the "GHC.LanguageExtensions" module provided by @ghc-boot@. We can't provide+-- here as this would require adding transitive dependencies to the+-- @template-haskell@ package, which must have a minimal dependency set.+data Extension+-- See Note [Updating flag description in the User's Guide] in DynFlags+   = Cpp+   | OverlappingInstances+   | UndecidableInstances+   | IncoherentInstances+   | UndecidableSuperClasses+   | MonomorphismRestriction+   | MonoPatBinds+   | MonoLocalBinds+   | RelaxedPolyRec           -- Deprecated+   | ExtendedDefaultRules     -- Use GHC's extended rules for defaulting+   | ForeignFunctionInterface+   | UnliftedFFITypes+   | InterruptibleFFI+   | CApiFFI+   | GHCForeignImportPrim+   | JavaScriptFFI+   | ParallelArrays           -- Syntactic support for parallel arrays+   | Arrows                   -- Arrow-notation syntax+   | TemplateHaskell+   | TemplateHaskellQuotes    -- subset of TH supported by stage1, no splice+   | QuasiQuotes+   | ImplicitParams+   | ImplicitPrelude+   | ScopedTypeVariables+   | AllowAmbiguousTypes+   | UnboxedTuples+   | UnboxedSums+   | BangPatterns+   | TypeFamilies+   | TypeFamilyDependencies+   | TypeInType+   | OverloadedStrings+   | OverloadedLists+   | NumDecimals+   | DisambiguateRecordFields+   | RecordWildCards+   | RecordPuns+   | ViewPatterns+   | GADTs+   | GADTSyntax+   | NPlusKPatterns+   | DoAndIfThenElse+   | BlockArguments+   | RebindableSyntax+   | ConstraintKinds+   | PolyKinds                -- Kind polymorphism+   | DataKinds                -- Datatype promotion+   | InstanceSigs+   | ApplicativeDo++   | StandaloneDeriving+   | DeriveDataTypeable+   | AutoDeriveTypeable       -- Automatic derivation of Typeable+   | DeriveFunctor+   | DeriveTraversable+   | DeriveFoldable+   | DeriveGeneric            -- Allow deriving Generic/1+   | DefaultSignatures        -- Allow extra signatures for defmeths+   | DeriveAnyClass           -- Allow deriving any class+   | DeriveLift               -- Allow deriving Lift+   | DerivingStrategies+   | DerivingVia              -- Derive through equal representation++   | TypeSynonymInstances+   | FlexibleContexts+   | FlexibleInstances+   | ConstrainedClassMethods+   | MultiParamTypeClasses+   | NullaryTypeClasses+   | FunctionalDependencies+   | UnicodeSyntax+   | ExistentialQuantification+   | MagicHash+   | EmptyDataDecls+   | KindSignatures+   | RoleAnnotations+   | ParallelListComp+   | TransformListComp+   | MonadComprehensions+   | GeneralizedNewtypeDeriving+   | RecursiveDo+   | PostfixOperators+   | TupleSections+   | PatternGuards+   | LiberalTypeSynonyms+   | RankNTypes+   | ImpredicativeTypes+   | TypeOperators+   | ExplicitNamespaces+   | PackageImports+   | ExplicitForAll+   | AlternativeLayoutRule+   | AlternativeLayoutRuleTransitional+   | DatatypeContexts+   | NondecreasingIndentation+   | RelaxedLayout+   | TraditionalRecordSyntax+   | LambdaCase+   | MultiWayIf+   | BinaryLiterals+   | NegativeLiterals+   | HexFloatLiterals+   | DuplicateRecordFields+   | OverloadedLabels+   | EmptyCase+   | PatternSynonyms+   | PartialTypeSignatures+   | NamedWildCards+   | StaticPointers+   | TypeApplications+   | Strict+   | StrictData+   | MonadFailDesugaring+   | EmptyDataDeriving+   | NumericUnderscores+   | QuantifiedConstraints+   | StarIsType+   deriving (Eq, Enum, Show, Generic)
+ libraries/ghc-boot-th/GHC/Lexeme.hs view
@@ -0,0 +1,50 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Lexeme+-- Copyright   :  (c) The GHC Team+--+-- Maintainer  :  ghc-devs@haskell.org+-- Portability :  portable+--+-- Functions to evaluate whether or not a string is a valid identifier.+--+module GHC.Lexeme (+          -- * Lexical characteristics of Haskell names+        startsVarSym, startsVarId, startsConSym, startsConId,+        startsVarSymASCII, isVarSymChar, okSymChar+  ) where++import Prelude -- See note [Why do we import Prelude here?]+import Data.Char++-- | Is this character acceptable in a symbol (after the first char)?+-- See alexGetByte in Lexer.x+okSymChar :: Char -> Bool+okSymChar c+  | c `elem` "(),;[]`{}_\"'"+  = False+  | otherwise+  = case generalCategory c of+      ConnectorPunctuation -> True+      DashPunctuation      -> True+      OtherPunctuation     -> True+      MathSymbol           -> True+      CurrencySymbol       -> True+      ModifierSymbol       -> True+      OtherSymbol          -> True+      _                    -> False++startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool+startsVarSym c = okSymChar c && c /= ':' -- Infix Ids+startsConSym c = c == ':'                -- Infix data constructors+startsVarId c  = c == '_' || case generalCategory c of  -- Ordinary Ids+  LowercaseLetter -> True+  OtherLetter     -> True   -- See #1103+  _               -> False+startsConId c  = isUpper c || c == '('  -- Ordinary type constructors and data constructors++startsVarSymASCII :: Char -> Bool+startsVarSymASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"++isVarSymChar :: Char -> Bool+isVarSymChar c = c == ':' || startsVarSym c
+ libraries/ghc-boot/GHC/ForeignSrcLang.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | See @GHC.LanguageExtensions@ for an explanation+-- on why this is needed+module GHC.ForeignSrcLang+  ( module GHC.ForeignSrcLang.Type+  ) where++import Data.Binary+import GHC.ForeignSrcLang.Type++instance Binary ForeignSrcLang
+ libraries/ghc-boot/GHC/LanguageExtensions.hs view
@@ -0,0 +1,17 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | This module re-exports the 'Extension' type along with an orphan 'Binary'+-- instance for it.+--+-- Note that the @ghc-boot@ package has a large set of dependencies; for this+-- reason the 'Extension' type itself is defined in the+-- "GHC.LanguageExtensions.Type" module provided by the @ghc-boot-th@ package,+-- which has no dependencies outside of @base@. For this reason+-- @template-haskell@ depends upon @ghc-boot-th@, not @ghc-boot@.+--+module GHC.LanguageExtensions ( module GHC.LanguageExtensions.Type ) where++import Data.Binary+import GHC.LanguageExtensions.Type++instance Binary Extension
+ libraries/ghc-boot/GHC/PackageDb.hs view
@@ -0,0 +1,577 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.PackageDb+-- Copyright   :  (c) The University of Glasgow 2009, Duncan Coutts 2014+--+-- Maintainer  :  ghc-devs@haskell.org+-- Portability :  portable+--+-- This module provides the view of GHC's database of registered packages that+-- is shared between GHC the compiler\/library, and the ghc-pkg program. It+-- defines the database format that is shared between GHC and ghc-pkg.+--+-- The database format, and this library are constructed so that GHC does not+-- have to depend on the Cabal library. The ghc-pkg program acts as the+-- gateway between the external package format (which is defined by Cabal) and+-- the internal package format which is specialised just for GHC.+--+-- GHC the compiler only needs some of the information which is kept about+-- registerd packages, such as module names, various paths etc. On the other+-- hand ghc-pkg has to keep all the information from Cabal packages and be able+-- to regurgitate it for users and other tools.+--+-- The first trick is that we duplicate some of the information in the package+-- database. We essentially keep two versions of the datbase in one file, one+-- version used only by ghc-pkg which keeps the full information (using the+-- serialised form of the 'InstalledPackageInfo' type defined by the Cabal+-- library); and a second version written by ghc-pkg and read by GHC which has+-- just the subset of information that GHC needs.+--+-- The second trick is that this module only defines in detail the format of+-- the second version -- the bit GHC uses -- and the part managed by ghc-pkg+-- is kept in the file but here we treat it as an opaque blob of data. That way+-- this library avoids depending on Cabal.+--+module GHC.PackageDb (+       InstalledPackageInfo(..),+       DbModule(..),+       DbUnitId(..),+       BinaryStringRep(..),+       DbUnitIdModuleRep(..),+       emptyInstalledPackageInfo,+       PackageDbLock,+       lockPackageDb,+       unlockPackageDb,+       DbMode(..),+       DbOpenMode(..),+       isDbOpenReadMode,+       readPackageDbForGhc,+       readPackageDbForGhcPkg,+       writePackageDb+  ) where++import Prelude -- See note [Why do we import Prelude here?]+import Data.Version (Version(..))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS.Char8+import qualified Data.ByteString.Lazy as BS.Lazy+import qualified Data.ByteString.Lazy.Internal as BS.Lazy (defaultChunkSize)+import qualified Data.Foldable as F+import qualified Data.Traversable as F+import Data.Binary as Bin+import Data.Binary.Put as Bin+import Data.Binary.Get as Bin+import Control.Exception as Exception+import Control.Monad (when)+import System.FilePath+import System.IO+import System.IO.Error+import GHC.IO.Exception (IOErrorType(InappropriateType))+import GHC.IO.Handle.Lock+import System.Directory+++-- | This is a subset of Cabal's 'InstalledPackageInfo', with just the bits+-- that GHC is interested in.  See Cabal's documentation for a more detailed+-- description of all of the fields.+--+data InstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod+   = InstalledPackageInfo {+       unitId             :: instunitid,+       componentId        :: compid,+       instantiatedWith   :: [(modulename, mod)],+       sourcePackageId    :: srcpkgid,+       packageName        :: srcpkgname,+       packageVersion     :: Version,+       sourceLibName      :: Maybe srcpkgname,+       abiHash            :: String,+       depends            :: [instunitid],+       -- | Like 'depends', but each dependency is annotated with the+       -- ABI hash we expect the dependency to respect.+       abiDepends         :: [(instunitid, String)],+       importDirs         :: [FilePath],+       hsLibraries        :: [String],+       extraLibraries     :: [String],+       extraGHCiLibraries :: [String],+       libraryDirs        :: [FilePath],+       libraryDynDirs     :: [FilePath],+       frameworks         :: [String],+       frameworkDirs      :: [FilePath],+       ldOptions          :: [String],+       ccOptions          :: [String],+       includes           :: [String],+       includeDirs        :: [FilePath],+       haddockInterfaces  :: [FilePath],+       haddockHTMLs       :: [FilePath],+       exposedModules     :: [(modulename, Maybe mod)],+       hiddenModules      :: [modulename],+       indefinite         :: Bool,+       exposed            :: Bool,+       trusted            :: Bool+     }+  deriving (Eq, Show)++-- | A convenience constraint synonym for common constraints over parameters+-- to 'InstalledPackageInfo'.+type RepInstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod =+    (BinaryStringRep srcpkgid, BinaryStringRep srcpkgname,+     BinaryStringRep modulename, BinaryStringRep compid,+     BinaryStringRep instunitid,+     DbUnitIdModuleRep instunitid compid unitid modulename mod)++-- | A type-class for the types which can be converted into 'DbModule'/'DbUnitId'.+-- There is only one type class because these types are mutually recursive.+-- NB: The functional dependency helps out type inference in cases+-- where types would be ambiguous.+class DbUnitIdModuleRep instunitid compid unitid modulename mod+    | mod -> unitid, unitid -> mod, mod -> modulename, unitid -> compid, unitid -> instunitid+    where+  fromDbModule :: DbModule instunitid compid unitid modulename mod -> mod+  toDbModule :: mod -> DbModule instunitid compid unitid modulename mod+  fromDbUnitId :: DbUnitId instunitid compid unitid modulename mod -> unitid+  toDbUnitId :: unitid -> DbUnitId instunitid compid unitid modulename mod++-- | @ghc-boot@'s copy of 'Module', i.e. what is serialized to the database.+-- Use 'DbUnitIdModuleRep' to convert it into an actual 'Module'.+-- It has phantom type parameters as this is the most convenient way+-- to avoid undecidable instances.+data DbModule instunitid compid unitid modulename mod+   = DbModule {+       dbModuleUnitId :: unitid,+       dbModuleName :: modulename+     }+   | DbModuleVar {+       dbModuleVarName :: modulename+     }+  deriving (Eq, Show)++-- | @ghc-boot@'s copy of 'UnitId', i.e. what is serialized to the database.+-- Use 'DbUnitIdModuleRep' to convert it into an actual 'UnitId'.+-- It has phantom type parameters as this is the most convenient way+-- to avoid undecidable instances.+data DbUnitId instunitid compid unitid modulename mod+   = DbUnitId compid [(modulename, mod)]+   | DbInstalledUnitId instunitid+  deriving (Eq, Show)++class BinaryStringRep a where+  fromStringRep :: BS.ByteString -> a+  toStringRep   :: a -> BS.ByteString++emptyInstalledPackageInfo :: RepInstalledPackageInfo a b c d e f g+                          => InstalledPackageInfo a b c d e f g+emptyInstalledPackageInfo =+  InstalledPackageInfo {+       unitId             = fromStringRep BS.empty,+       componentId        = fromStringRep BS.empty,+       instantiatedWith   = [],+       sourcePackageId    = fromStringRep BS.empty,+       packageName        = fromStringRep BS.empty,+       packageVersion     = Version [] [],+       sourceLibName      = Nothing,+       abiHash            = "",+       depends            = [],+       abiDepends         = [],+       importDirs         = [],+       hsLibraries        = [],+       extraLibraries     = [],+       extraGHCiLibraries = [],+       libraryDirs        = [],+       libraryDynDirs     = [],+       frameworks         = [],+       frameworkDirs      = [],+       ldOptions          = [],+       ccOptions          = [],+       includes           = [],+       includeDirs        = [],+       haddockInterfaces  = [],+       haddockHTMLs       = [],+       exposedModules     = [],+       hiddenModules      = [],+       indefinite         = False,+       exposed            = False,+       trusted            = False+  }++-- | Represents a lock of a package db.+newtype PackageDbLock = PackageDbLock Handle++-- | Acquire an exclusive lock related to package DB under given location.+lockPackageDb :: FilePath -> IO PackageDbLock++-- | Release the lock related to package DB.+unlockPackageDb :: PackageDbLock -> IO ()++-- | Acquire a lock of given type related to package DB under given location.+lockPackageDbWith :: LockMode -> FilePath -> IO PackageDbLock+lockPackageDbWith mode file = do+  -- We are trying to open the lock file and then lock it. Thus the lock file+  -- needs to either exist or we need to be able to create it. Ideally we+  -- would not assume that the lock file always exists in advance. When we are+  -- dealing with a package DB where we have write access then if the lock+  -- file does not exist then we can create it by opening the file in+  -- read/write mode. On the other hand if we are dealing with a package DB+  -- where we do not have write access (e.g. a global DB) then we can only+  -- open in read mode, and the lock file had better exist already or we're in+  -- trouble. So for global read-only DBs on platforms where we must lock the+  -- DB for reading then we will require that the installer/packaging has+  -- included the lock file.+  --+  -- Thus the logic here is to first try opening in read-write mode+  -- and if that fails we try read-only (to handle global read-only DBs).+  -- If either succeed then lock the file. IO exceptions (other than the first+  -- open attempt failing due to the file not existing) simply propagate.+  --+  -- Note that there is a complexity here which was discovered in #13945: some+  -- filesystems (e.g. NFS) will only allow exclusive locking if the fd was+  -- opened for write access. We would previously try opening the lockfile for+  -- read-only access first, however this failed when run on such filesystems.+  -- Consequently, we now try read-write access first, falling back to read-only+  -- if we are denied permission (e.g. in the case of a global database).+  catchJust+    (\e -> if isPermissionError e then Just () else Nothing)+    (lockFileOpenIn ReadWriteMode)+    (const $ lockFileOpenIn ReadMode)+  where+    lock = file <.> "lock"++    lockFileOpenIn io_mode = bracketOnError+      (openBinaryFile lock io_mode)+      hClose+      -- If file locking support is not available, ignore the error and proceed+      -- normally. Without it the only thing we lose on non-Windows platforms is+      -- the ability to safely issue concurrent updates to the same package db.+      $ \hnd -> do hLock hnd mode `catch` \FileLockingNotSupported -> return ()+                   return $ PackageDbLock hnd++lockPackageDb = lockPackageDbWith ExclusiveLock+unlockPackageDb (PackageDbLock hnd) = do+    hUnlock hnd+    hClose hnd++-- | Mode to open a package db in.+data DbMode = DbReadOnly | DbReadWrite++-- | 'DbOpenMode' holds a value of type @t@ but only in 'DbReadWrite' mode.  So+-- it is like 'Maybe' but with a type argument for the mode to enforce that the+-- mode is used consistently.+data DbOpenMode (mode :: DbMode) t where+  DbOpenReadOnly  ::      DbOpenMode 'DbReadOnly t+  DbOpenReadWrite :: t -> DbOpenMode 'DbReadWrite t++deriving instance Functor (DbOpenMode mode)+deriving instance F.Foldable (DbOpenMode mode)+deriving instance F.Traversable (DbOpenMode mode)++isDbOpenReadMode :: DbOpenMode mode t -> Bool+isDbOpenReadMode = \case+  DbOpenReadOnly    -> True+  DbOpenReadWrite{} -> False++-- | Read the part of the package DB that GHC is interested in.+--+readPackageDbForGhc :: RepInstalledPackageInfo a b c d e f g =>+                       FilePath -> IO [InstalledPackageInfo a b c d e f g]+readPackageDbForGhc file =+  decodeFromFile file DbOpenReadOnly getDbForGhc >>= \case+    (pkgs, DbOpenReadOnly) -> return pkgs+  where+    getDbForGhc = do+      _version    <- getHeader+      _ghcPartLen <- get :: Get Word32+      ghcPart     <- get+      -- the next part is for ghc-pkg, but we stop here.+      return ghcPart++-- | Read the part of the package DB that ghc-pkg is interested in+--+-- Note that the Binary instance for ghc-pkg's representation of packages+-- is not defined in this package. This is because ghc-pkg uses Cabal types+-- (and Binary instances for these) which this package does not depend on.+--+-- If we open the package db in read only mode, we get its contents. Otherwise+-- we additionally receive a PackageDbLock that represents a lock on the+-- database, so that we can safely update it later.+--+readPackageDbForGhcPkg :: Binary pkgs => FilePath -> DbOpenMode mode t ->+                          IO (pkgs, DbOpenMode mode PackageDbLock)+readPackageDbForGhcPkg file mode =+    decodeFromFile file mode getDbForGhcPkg+  where+    getDbForGhcPkg = do+      _version    <- getHeader+      -- skip over the ghc part+      ghcPartLen  <- get :: Get Word32+      _ghcPart    <- skip (fromIntegral ghcPartLen)+      -- the next part is for ghc-pkg+      ghcPkgPart  <- get+      return ghcPkgPart++-- | Write the whole of the package DB, both parts.+--+writePackageDb :: (Binary pkgs, RepInstalledPackageInfo a b c d e f g) =>+                  FilePath -> [InstalledPackageInfo a b c d e f g] ->+                  pkgs -> IO ()+writePackageDb file ghcPkgs ghcPkgPart =+  writeFileAtomic file (runPut putDbForGhcPkg)+  where+    putDbForGhcPkg = do+        putHeader+        put               ghcPartLen+        putLazyByteString ghcPart+        put               ghcPkgPart+      where+        ghcPartLen :: Word32+        ghcPartLen = fromIntegral (BS.Lazy.length ghcPart)+        ghcPart    = encode ghcPkgs++getHeader :: Get (Word32, Word32)+getHeader = do+    magic <- getByteString (BS.length headerMagic)+    when (magic /= headerMagic) $+      fail "not a ghc-pkg db file, wrong file magic number"++    majorVersion <- get :: Get Word32+    -- The major version is for incompatible changes++    minorVersion <- get :: Get Word32+    -- The minor version is for compatible extensions++    when (majorVersion /= 1) $+      fail "unsupported ghc-pkg db format version"+    -- If we ever support multiple major versions then we'll have to change+    -- this code++    -- The header can be extended without incrementing the major version,+    -- we ignore fields we don't know about (currently all).+    headerExtraLen <- get :: Get Word32+    skip (fromIntegral headerExtraLen)++    return (majorVersion, minorVersion)++putHeader :: Put+putHeader = do+    putByteString headerMagic+    put majorVersion+    put minorVersion+    put headerExtraLen+  where+    majorVersion   = 1 :: Word32+    minorVersion   = 0 :: Word32+    headerExtraLen = 0 :: Word32++headerMagic :: BS.ByteString+headerMagic = BS.Char8.pack "\0ghcpkg\0"+++-- TODO: we may be able to replace the following with utils from the binary+-- package in future.++-- | Feed a 'Get' decoder with data chunks from a file.+--+decodeFromFile :: FilePath -> DbOpenMode mode t -> Get pkgs ->+                  IO (pkgs, DbOpenMode mode PackageDbLock)+decodeFromFile file mode decoder = case mode of+  DbOpenReadOnly -> do+  -- When we open the package db in read only mode, there is no need to acquire+  -- shared lock on non-Windows platform because we update the database with an+  -- atomic rename, so readers will always see the database in a consistent+  -- state.+#if defined(mingw32_HOST_OS)+    bracket (lockPackageDbWith SharedLock file) unlockPackageDb $ \_ -> do+#endif+      (, DbOpenReadOnly) <$> decodeFileContents+  DbOpenReadWrite{} -> do+    -- When we open the package db in read/write mode, acquire an exclusive lock+    -- on the database and return it so we can keep it for the duration of the+    -- update.+    bracketOnError (lockPackageDb file) unlockPackageDb $ \lock -> do+      (, DbOpenReadWrite lock) <$> decodeFileContents+  where+    decodeFileContents = withBinaryFile file ReadMode $ \hnd ->+      feed hnd (runGetIncremental decoder)++    feed hnd (Partial k)  = do chunk <- BS.hGet hnd BS.Lazy.defaultChunkSize+                               if BS.null chunk+                                 then feed hnd (k Nothing)+                                 else feed hnd (k (Just chunk))+    feed _ (Done _ _ res) = return res+    feed _ (Fail _ _ msg) = ioError err+      where+        err = mkIOError InappropriateType loc Nothing (Just file)+              `ioeSetErrorString` msg+        loc = "GHC.PackageDb.readPackageDb"++-- Copied from Cabal's Distribution.Simple.Utils.+writeFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO ()+writeFileAtomic targetPath content = do+  let (targetDir, targetFile) = splitFileName targetPath+  Exception.bracketOnError+    (openBinaryTempFileWithDefaultPermissions targetDir $ targetFile <.> "tmp")+    (\(tmpPath, handle) -> hClose handle >> removeFile tmpPath)+    (\(tmpPath, handle) -> do+        BS.Lazy.hPut handle content+        hClose handle+        renameFile tmpPath targetPath)++instance (RepInstalledPackageInfo a b c d e f g) =>+         Binary (InstalledPackageInfo a b c d e f g) where+  put (InstalledPackageInfo+         unitId componentId instantiatedWith sourcePackageId+         packageName packageVersion+         sourceLibName+         abiHash depends abiDepends importDirs+         hsLibraries extraLibraries extraGHCiLibraries+         libraryDirs libraryDynDirs+         frameworks frameworkDirs+         ldOptions ccOptions+         includes includeDirs+         haddockInterfaces haddockHTMLs+         exposedModules hiddenModules+         indefinite exposed trusted) = do+    put (toStringRep sourcePackageId)+    put (toStringRep packageName)+    put packageVersion+    put (fmap toStringRep sourceLibName)+    put (toStringRep unitId)+    put (toStringRep componentId)+    put (map (\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod))+             instantiatedWith)+    put abiHash+    put (map toStringRep depends)+    put (map (\(k,v) -> (toStringRep k, v)) abiDepends)+    put importDirs+    put hsLibraries+    put extraLibraries+    put extraGHCiLibraries+    put libraryDirs+    put libraryDynDirs+    put frameworks+    put frameworkDirs+    put ldOptions+    put ccOptions+    put includes+    put includeDirs+    put haddockInterfaces+    put haddockHTMLs+    put (map (\(mod_name, mb_mod) -> (toStringRep mod_name, fmap toDbModule mb_mod))+             exposedModules)+    put (map toStringRep hiddenModules)+    put indefinite+    put exposed+    put trusted++  get = do+    sourcePackageId    <- get+    packageName        <- get+    packageVersion     <- get+    sourceLibName      <- get+    unitId             <- get+    componentId        <- get+    instantiatedWith   <- get+    abiHash            <- get+    depends            <- get+    abiDepends         <- get+    importDirs         <- get+    hsLibraries        <- get+    extraLibraries     <- get+    extraGHCiLibraries <- get+    libraryDirs        <- get+    libraryDynDirs     <- get+    frameworks         <- get+    frameworkDirs      <- get+    ldOptions          <- get+    ccOptions          <- get+    includes           <- get+    includeDirs        <- get+    haddockInterfaces  <- get+    haddockHTMLs       <- get+    exposedModules     <- get+    hiddenModules      <- get+    indefinite         <- get+    exposed            <- get+    trusted            <- get+    return (InstalledPackageInfo+              (fromStringRep unitId)+              (fromStringRep componentId)+              (map (\(mod_name, mod) -> (fromStringRep mod_name, fromDbModule mod))+                instantiatedWith)+              (fromStringRep sourcePackageId)+              (fromStringRep packageName) packageVersion+              (fmap fromStringRep sourceLibName)+              abiHash+              (map fromStringRep depends)+              (map (\(k,v) -> (fromStringRep k, v)) abiDepends)+              importDirs+              hsLibraries extraLibraries extraGHCiLibraries+              libraryDirs libraryDynDirs+              frameworks frameworkDirs+              ldOptions ccOptions+              includes includeDirs+              haddockInterfaces haddockHTMLs+              (map (\(mod_name, mb_mod) ->+                        (fromStringRep mod_name, fmap fromDbModule mb_mod))+                   exposedModules)+              (map fromStringRep hiddenModules)+              indefinite exposed trusted)++instance (BinaryStringRep modulename, BinaryStringRep compid,+          BinaryStringRep instunitid,+          DbUnitIdModuleRep instunitid compid unitid modulename mod) =>+         Binary (DbModule instunitid compid unitid modulename mod) where+  put (DbModule dbModuleUnitId dbModuleName) = do+    putWord8 0+    put (toDbUnitId dbModuleUnitId)+    put (toStringRep dbModuleName)+  put (DbModuleVar dbModuleVarName) = do+    putWord8 1+    put (toStringRep dbModuleVarName)+  get = do+    b <- getWord8+    case b of+      0 -> do dbModuleUnitId <- get+              dbModuleName <- get+              return (DbModule (fromDbUnitId dbModuleUnitId)+                               (fromStringRep dbModuleName))+      _ -> do dbModuleVarName <- get+              return (DbModuleVar (fromStringRep dbModuleVarName))++instance (BinaryStringRep modulename, BinaryStringRep compid,+          BinaryStringRep instunitid,+          DbUnitIdModuleRep instunitid compid unitid modulename mod) =>+         Binary (DbUnitId instunitid compid unitid modulename mod) where+  put (DbInstalledUnitId instunitid) = do+    putWord8 0+    put (toStringRep instunitid)+  put (DbUnitId dbUnitIdComponentId dbUnitIdInsts) = do+    putWord8 1+    put (toStringRep dbUnitIdComponentId)+    put (map (\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod)) dbUnitIdInsts)+  get = do+    b <- getWord8+    case b of+      0 -> do+        instunitid <- get+        return (DbInstalledUnitId (fromStringRep instunitid))+      _ -> do+        dbUnitIdComponentId <- get+        dbUnitIdInsts <- get+        return (DbUnitId+            (fromStringRep dbUnitIdComponentId)+            (map (\(mod_name, mod) -> ( fromStringRep mod_name+                                      , fromDbModule mod))+                 dbUnitIdInsts))
+ libraries/ghc-boot/GHC/Serialized.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++--+-- (c) The University of Glasgow 2002-2006+--+-- Serialized values++module GHC.Serialized (+    -- * Main Serialized data type+    Serialized(..),++    -- * Going into and out of 'Serialized'+    toSerialized, fromSerialized,++    -- * Handy serialization functions+    serializeWithData, deserializeWithData,+  ) where++import Prelude -- See note [Why do we import Prelude here?]+import Data.Bits+import Data.Word        ( Word8 )+import Data.Data+++-- | Represents a serialized value of a particular type. Attempts can be made to deserialize it at certain types+data Serialized = Serialized TypeRep [Word8]++-- | Put a Typeable value that we are able to actually turn into bytes into a 'Serialized' value ready for deserialization later+toSerialized :: forall a. Typeable a => (a -> [Word8]) -> a -> Serialized+toSerialized serialize what = Serialized (typeOf what) (serialize what)++-- | If the 'Serialized' value contains something of the given type, then use the specified deserializer to return @Just@ that.+-- Otherwise return @Nothing@.+fromSerialized :: forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a+fromSerialized deserialize (Serialized the_type bytes)+  | the_type == rep = Just (deserialize bytes)+  | otherwise       = Nothing+  where rep = typeRep (Proxy :: Proxy a)++-- | Use a 'Data' instance to implement a serialization scheme dual to that of 'deserializeWithData'+serializeWithData :: Data a => a -> [Word8]+serializeWithData what = serializeWithData' what []++serializeWithData' :: Data a => a -> [Word8] -> [Word8]+serializeWithData' what = fst $ gfoldl (\(before, a_to_b) a -> (before . serializeWithData' a, a_to_b a))+                                       (\x -> (serializeConstr (constrRep (toConstr what)), x))+                                       what++-- | Use a 'Data' instance to implement a deserialization scheme dual to that of 'serializeWithData'+deserializeWithData :: Data a => [Word8] -> a+deserializeWithData = snd . deserializeWithData'++deserializeWithData' :: forall a. Data a => [Word8] -> ([Word8], a)+deserializeWithData' bytes = deserializeConstr bytes $ \constr_rep bytes ->+                             gunfold (\(bytes, b_to_r) -> let (bytes', b) = deserializeWithData' bytes in (bytes', b_to_r b))+                                     (\x -> (bytes, x))+                                     (repConstr (dataTypeOf (undefined :: a)) constr_rep)+++serializeConstr :: ConstrRep -> [Word8] -> [Word8]+serializeConstr (AlgConstr ix)   = serializeWord8 1 . serializeInt ix+serializeConstr (IntConstr i)    = serializeWord8 2 . serializeInteger i+serializeConstr (FloatConstr r)  = serializeWord8 3 . serializeRational r+serializeConstr (CharConstr c)   = serializeWord8 4 . serializeChar c+++deserializeConstr :: [Word8] -> (ConstrRep -> [Word8] -> a) -> a+deserializeConstr bytes k = deserializeWord8 bytes $ \constr_ix bytes ->+                            case constr_ix of+                                1 -> deserializeInt      bytes $ \ix -> k (AlgConstr ix)+                                2 -> deserializeInteger  bytes $ \i  -> k (IntConstr i)+                                3 -> deserializeRational bytes $ \r  -> k (FloatConstr r)+                                4 -> deserializeChar     bytes $ \c  -> k (CharConstr c)+                                x -> error $ "deserializeConstr: unrecognised serialized constructor type " ++ show x ++ " in context " ++ show bytes+++serializeFixedWidthNum :: forall a. (Integral a, FiniteBits a) => a -> [Word8] -> [Word8]+serializeFixedWidthNum what = go (finiteBitSize what) what+  where+    go :: Int -> a -> [Word8] -> [Word8]+    go size current rest+      | size <= 0 = rest+      | otherwise = fromIntegral (current .&. 255) : go (size - 8) (current `shiftR` 8) rest++deserializeFixedWidthNum :: forall a b. (Integral a, FiniteBits a) => [Word8] -> (a -> [Word8] -> b) -> b+deserializeFixedWidthNum bytes k = go (finiteBitSize (undefined :: a)) bytes k+  where+    go :: Int -> [Word8] -> (a -> [Word8] -> b) -> b+    go size bytes k+      | size <= 0 = k 0 bytes+      | otherwise = case bytes of+                        (byte:bytes) -> go (size - 8) bytes (\x -> k ((x `shiftL` 8) .|. fromIntegral byte))+                        []           -> error "deserializeFixedWidthNum: unexpected end of stream"+++serializeEnum :: (Enum a) => a -> [Word8] -> [Word8]+serializeEnum = serializeInt . fromEnum++deserializeEnum :: Enum a => [Word8] -> (a -> [Word8] -> b) -> b+deserializeEnum bytes k = deserializeInt bytes (k . toEnum)+++serializeWord8 :: Word8 -> [Word8] -> [Word8]+serializeWord8 x = (x:)++deserializeWord8 :: [Word8] -> (Word8 -> [Word8] -> a) -> a+deserializeWord8 (byte:bytes) k = k byte bytes+deserializeWord8 []           _ = error "deserializeWord8: unexpected end of stream"+++serializeInt :: Int -> [Word8] -> [Word8]+serializeInt = serializeFixedWidthNum++deserializeInt :: [Word8] -> (Int -> [Word8] -> a) -> a+deserializeInt = deserializeFixedWidthNum+++serializeRational :: (Real a) => a -> [Word8] -> [Word8]+serializeRational = serializeString . show . toRational++deserializeRational :: (Fractional a) => [Word8] -> (a -> [Word8] -> b) -> b+deserializeRational bytes k = deserializeString bytes (k . fromRational . read)+++serializeInteger :: Integer -> [Word8] -> [Word8]+serializeInteger = serializeString . show++deserializeInteger :: [Word8] -> (Integer -> [Word8] -> a) -> a+deserializeInteger bytes k = deserializeString bytes (k . read)+++serializeChar :: Char -> [Word8] -> [Word8]+serializeChar = serializeString . show++deserializeChar :: [Word8] -> (Char -> [Word8] -> a) -> a+deserializeChar bytes k = deserializeString bytes (k . read)+++serializeString :: String -> [Word8] -> [Word8]+serializeString = serializeList serializeEnum++deserializeString :: [Word8] -> (String -> [Word8] -> a) -> a+deserializeString = deserializeList deserializeEnum+++serializeList :: (a -> [Word8] -> [Word8]) -> [a] -> [Word8] -> [Word8]+serializeList serialize_element xs = serializeInt (length xs) . foldr (.) id (map serialize_element xs)++deserializeList :: forall a b. (forall c. [Word8] -> (a -> [Word8] -> c) -> c)+                -> [Word8] -> ([a] -> [Word8] -> b) -> b+deserializeList deserialize_element bytes k = deserializeInt bytes $ \len bytes -> go len bytes k+  where+    go :: Int -> [Word8] -> ([a] -> [Word8] -> b) -> b+    go len bytes k+      | len <= 0  = k [] bytes+      | otherwise = deserialize_element bytes (\elt bytes -> go (len - 1) bytes (k . (elt:)))
+ libraries/ghc-heap/GHC/Exts/Heap.hs view
@@ -0,0 +1,272 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}++{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeFamilies #-}++{-|+Module      :  GHC.Exts.Heap+Copyright   :  (c) 2012 Joachim Breitner+License     :  BSD3+Maintainer  :  Joachim Breitner <mail@joachim-breitner.de>++With this module, you can investigate the heap representation of Haskell+values, i.e. to investigate sharing and lazy evaluation.+-}++module GHC.Exts.Heap (+    -- * Closure types+      Closure+    , GenClosure(..)+    , ClosureType(..)+    , PrimType(..)+    , HasHeapRep(getClosureData)++    -- * Info Table types+    , StgInfoTable(..)+    , EntryFunPtr+    , HalfWord+    , ItblCodes+    , itblSize+    , peekItbl+    , pokeItbl++     -- * Closure inspection+    , getBoxedClosureData+    , allClosures++    -- * Boxes+    , Box(..)+    , asBox+    , areBoxesEqual+    ) where++import Prelude+import GHC.Exts.Heap.Closures+import GHC.Exts.Heap.ClosureTypes+import GHC.Exts.Heap.Constants+#if defined(PROFILING)+import GHC.Exts.Heap.InfoTableProf+#else+import GHC.Exts.Heap.InfoTable+#endif+import GHC.Exts.Heap.Utils++import Control.Monad+import Data.Bits+import GHC.Arr+import GHC.Exts+import GHC.Int+import GHC.Word++#include "ghcconfig.h"++class HasHeapRep (a :: TYPE rep) where+    getClosureData :: a -> IO Closure++instance HasHeapRep (a :: TYPE 'LiftedRep) where+    getClosureData = getClosure++instance HasHeapRep (a :: TYPE 'UnliftedRep) where+    getClosureData x = getClosure (unsafeCoerce# x)++instance Int# ~ a => HasHeapRep (a :: TYPE 'IntRep) where+    getClosureData x = return $+        IntClosure { ptipe = PInt, intVal = I# x }++instance Word# ~ a => HasHeapRep (a :: TYPE 'WordRep) where+    getClosureData x = return $+        WordClosure { ptipe = PWord, wordVal = W# x }++instance Int64# ~ a => HasHeapRep (a :: TYPE 'Int64Rep) where+    getClosureData x = return $+        Int64Closure { ptipe = PInt64, int64Val = I64# (unsafeCoerce# x) }++instance Word64# ~ a => HasHeapRep (a :: TYPE 'Word64Rep) where+    getClosureData x = return $+        Word64Closure { ptipe = PWord64, word64Val = W64# (unsafeCoerce# x) }++instance Addr# ~ a => HasHeapRep (a :: TYPE 'AddrRep) where+    getClosureData x = return $+        AddrClosure { ptipe = PAddr, addrVal = I# (unsafeCoerce# x) }++instance Float# ~ a => HasHeapRep (a :: TYPE 'FloatRep) where+    getClosureData x = return $+        FloatClosure { ptipe = PFloat, floatVal = F# x }++instance Double# ~ a => HasHeapRep (a :: TYPE 'DoubleRep) where+    getClosureData x = return $+        DoubleClosure { ptipe = PDouble, doubleVal = D# x }++-- | This returns the raw representation of the given argument. The second+-- component of the triple is the raw words of the closure on the heap, and the+-- third component is those words that are actually pointers. Once back in the+-- Haskell world, the raw words that hold pointers may be outdated after a+-- garbage collector run, but the corresponding values in 'Box's will still+-- point to the correct value.+getClosureRaw :: a -> IO (Ptr StgInfoTable, [Word], [Box])+getClosureRaw x = do+    case unpackClosure# x of+-- This is a hack to cover the bootstrap compiler using the old version of+-- 'unpackClosure'. The new 'unpackClosure' return values are not merely+-- a reordering, so using the old version would not work.+#if MIN_VERSION_ghc_prim(0,5,3)+        (# iptr, dat, pointers #) -> do+#else+        (# iptr, pointers, dat #) -> do+#endif+            let nelems = (I# (sizeofByteArray# dat)) `div` wORD_SIZE+                end = fromIntegral nelems - 1+                rawWds = [W# (indexWordArray# dat i) | I# i <- [0.. end] ]+                pelems = I# (sizeofArray# pointers)+                ptrList = amap' Box $ Array 0 (pelems - 1) pelems pointers+            pure (Ptr iptr, rawWds, ptrList)++-- From compiler/ghci/RtClosureInspect.hs+amap' :: (t -> b) -> Array Int t -> [b]+amap' f (Array i0 i _ arr#) = map g [0 .. i - i0]+    where g (I# i#) = case indexArray# arr# i# of+                          (# e #) -> f e++-- | This function returns a parsed heap representation of the argument _at+-- this moment_, even if it is unevaluated or an indirection or other exotic+-- stuff.  Beware when passing something to this function, the same caveats as+-- for 'asBox' apply.+getClosure :: a -> IO Closure+getClosure x = do+    (iptr, wds, pts) <- getClosureRaw x+    itbl <- peekItbl iptr+    -- The remaining words after the header+    let rawWds = drop (closureTypeHeaderSize (tipe itbl)) wds+    -- For data args in a pointers then non-pointers closure+    -- This is incorrect in non pointers-first setups+    -- not sure if that happens+        npts = drop (closureTypeHeaderSize (tipe itbl) + length pts) wds+    case tipe itbl of+        t | t >= CONSTR && t <= CONSTR_NOCAF -> do+            (p, m, n) <- dataConNames iptr+            if m == "ByteCodeInstr" && n == "BreakInfo"+              then pure $ UnsupportedClosure itbl+              else pure $ ConstrClosure itbl pts npts p m n++        t | t >= THUNK && t <= THUNK_STATIC -> do+            pure $ ThunkClosure itbl pts npts++        THUNK_SELECTOR -> do+            unless (length pts >= 1) $+                fail "Expected at least 1 ptr argument to THUNK_SELECTOR"+            pure $ SelectorClosure itbl (head pts)++        t | t >= FUN && t <= FUN_STATIC -> do+            pure $ FunClosure itbl pts npts++        AP -> do+            unless (length pts >= 1) $+                fail "Expected at least 1 ptr argument to AP"+            -- We expect at least the arity, n_args, and fun fields+            unless (length rawWds >= 2) $+                fail $ "Expected at least 2 raw words to AP"+            let splitWord = rawWds !! 0+            pure $ APClosure itbl+#if defined(WORDS_BIGENDIAN)+                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))+                (fromIntegral splitWord)+#else+                (fromIntegral splitWord)+                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))+#endif+                (head pts) (tail pts)++        PAP -> do+            unless (length pts >= 1) $+                fail "Expected at least 1 ptr argument to PAP"+            -- We expect at least the arity, n_args, and fun fields+            unless (length rawWds >= 2) $+                fail "Expected at least 2 raw words to PAP"+            let splitWord = rawWds !! 0+            pure $ PAPClosure itbl+#if defined(WORDS_BIGENDIAN)+                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))+                (fromIntegral splitWord)+#else+                (fromIntegral splitWord)+                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))+#endif+                (head pts) (tail pts)++        AP_STACK -> do+            unless (length pts >= 1) $+                fail "Expected at least 1 ptr argument to AP_STACK"+            pure $ APStackClosure itbl (head pts) (tail pts)++        IND -> do+            unless (length pts >= 1) $+                fail "Expected at least 1 ptr argument to IND"+            pure $ IndClosure itbl (head pts)++        IND_STATIC -> do+            unless (length pts >= 1) $+                fail "Expected at least 1 ptr argument to IND_STATIC"+            pure $ IndClosure itbl (head pts)++        BLACKHOLE -> do+            unless (length pts >= 1) $+                fail "Expected at least 1 ptr argument to BLACKHOLE"+            pure $ BlackholeClosure itbl (head pts)++        BCO -> do+            unless (length pts >= 3) $+                fail $ "Expected at least 3 ptr argument to BCO, found "+                        ++ show (length pts)+            unless (length rawWds >= 4) $+                fail $ "Expected at least 4 words to BCO, found "+                        ++ show (length rawWds)+            let splitWord = rawWds !! 3+            pure $ BCOClosure itbl (pts !! 0) (pts !! 1) (pts !! 2)+#if defined(WORDS_BIGENDIAN)+                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))+                (fromIntegral splitWord)+#else+                (fromIntegral splitWord)+                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))+#endif+                (drop 4 rawWds)++        ARR_WORDS -> do+            unless (length rawWds >= 1) $+                fail $ "Expected at least 1 words to ARR_WORDS, found "+                        ++ show (length rawWds)+            pure $ ArrWordsClosure itbl (head rawWds) (tail rawWds)++        t | t >= MUT_ARR_PTRS_CLEAN && t <= MUT_ARR_PTRS_FROZEN_CLEAN -> do+            unless (length rawWds >= 2) $+                fail $ "Expected at least 2 words to MUT_ARR_PTRS_* "+                        ++ "found " ++ show (length rawWds)+            pure $ MutArrClosure itbl (rawWds !! 0) (rawWds !! 1) pts++        t | t == MUT_VAR_CLEAN || t == MUT_VAR_DIRTY ->+            pure $ MutVarClosure itbl (head pts)++        t | t == MVAR_CLEAN || t == MVAR_DIRTY -> do+            unless (length pts >= 3) $+                fail $ "Expected at least 3 ptrs to MVAR, found "+                        ++ show (length pts)+            pure $ MVarClosure itbl (pts !! 0) (pts !! 1) (pts !! 2)++        BLOCKING_QUEUE ->+            pure $ OtherClosure itbl pts wds+        --    pure $ BlockingQueueClosure itbl+        --        (pts !! 0) (pts !! 1) (pts !! 2) (pts !! 3)++        --  pure $ OtherClosure itbl pts wds+        --+        _ ->+            pure $ UnsupportedClosure itbl++-- | Like 'getClosureData', but taking a 'Box', so it is easier to work with.+getBoxedClosureData :: Box -> IO Closure+getBoxedClosureData (Box a) = getClosureData a
+ libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}++module GHC.Exts.Heap.ClosureTypes+    ( ClosureType(..)+    , closureTypeHeaderSize+    ) where++import Prelude -- See note [Why do we import Prelude here?]+import GHC.Generics++{- ---------------------------------------------+-- Enum representing closure types+-- This is a mirror of:+-- includes/rts/storage/ClosureTypes.h+-- ---------------------------------------------}++data ClosureType+    = INVALID_OBJECT+    | CONSTR+    | CONSTR_1_0+    | CONSTR_0_1+    | CONSTR_2_0+    | CONSTR_1_1+    | CONSTR_0_2+    | CONSTR_NOCAF+    | FUN+    | FUN_1_0+    | FUN_0_1+    | FUN_2_0+    | FUN_1_1+    | FUN_0_2+    | FUN_STATIC+    | THUNK+    | THUNK_1_0+    | THUNK_0_1+    | THUNK_2_0+    | THUNK_1_1+    | THUNK_0_2+    | THUNK_STATIC+    | THUNK_SELECTOR+    | BCO+    | AP+    | PAP+    | AP_STACK+    | IND+    | IND_STATIC+    | RET_BCO+    | RET_SMALL+    | RET_BIG+    | RET_FUN+    | UPDATE_FRAME+    | CATCH_FRAME+    | UNDERFLOW_FRAME+    | STOP_FRAME+    | BLOCKING_QUEUE+    | BLACKHOLE+    | MVAR_CLEAN+    | MVAR_DIRTY+    | TVAR+    | ARR_WORDS+    | MUT_ARR_PTRS_CLEAN+    | MUT_ARR_PTRS_DIRTY+    | MUT_ARR_PTRS_FROZEN_DIRTY+    | MUT_ARR_PTRS_FROZEN_CLEAN+    | MUT_VAR_CLEAN+    | MUT_VAR_DIRTY+    | WEAK+    | PRIM+    | MUT_PRIM+    | TSO+    | STACK+    | TREC_CHUNK+    | ATOMICALLY_FRAME+    | CATCH_RETRY_FRAME+    | CATCH_STM_FRAME+    | WHITEHOLE+    | SMALL_MUT_ARR_PTRS_CLEAN+    | SMALL_MUT_ARR_PTRS_DIRTY+    | SMALL_MUT_ARR_PTRS_FROZEN_DIRTY+    | SMALL_MUT_ARR_PTRS_FROZEN_CLEAN+    | COMPACT_NFDATA+    | N_CLOSURE_TYPES+ deriving (Enum, Eq, Ord, Show, Generic)++-- | Return the size of the closures header in words+closureTypeHeaderSize :: ClosureType -> Int+closureTypeHeaderSize closType =+    case closType of+        ct | THUNK <= ct && ct <= THUNK_0_2 -> thunkHeader+        ct | ct == THUNK_SELECTOR -> thunkHeader+        ct | ct == AP -> thunkHeader+        ct | ct == AP_STACK -> thunkHeader+        _ -> header+  where+    header = 1 + prof+    thunkHeader = 2 + prof+#if defined(PROFILING)+    prof = 2+#else+    prof = 0+#endif
+ libraries/ghc-heap/GHC/Exts/Heap/Closures.hs view
@@ -0,0 +1,340 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GHCForeignImportPrim #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE UnliftedFFITypes #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}++module GHC.Exts.Heap.Closures (+    -- * Closures+      Closure+    , GenClosure(..)+    , PrimType(..)+    , allClosures+#if __GLASGOW_HASKELL__ >= 809+    -- The closureSize# primop is unsupported on earlier GHC releases but we+    -- build ghc-heap as a boot library so it must be buildable. Drop this once+    -- we are guaranteed to bootstsrap with GHC >= 8.9.+    , closureSize+#endif++    -- * Boxes+    , Box(..)+    , areBoxesEqual+    , asBox+    ) where++import Prelude -- See note [Why do we import Prelude here?]+import GHC.Exts.Heap.Constants+#if defined(PROFILING)+import GHC.Exts.Heap.InfoTableProf+#else+import GHC.Exts.Heap.InfoTable++-- `ghc -M` currently doesn't properly account for ways when generating+-- dependencies (#15197). This import ensures correct build-ordering between+-- this module and GHC.Exts.Heap.InfoTableProf. It should be removed when #15197+-- is fixed.+import GHC.Exts.Heap.InfoTableProf ()+#endif++import Data.Bits+import Data.Int+import Data.Word+import GHC.Exts+import GHC.Generics+import Numeric++------------------------------------------------------------------------+-- Boxes++aToWord# :: Any -> Word#+aToWord# _ = 0##+++reallyUnsafePtrEqualityUpToTag# :: Any -> Any -> Int#+reallyUnsafePtrEqualityUpToTag# _ _ = 0#+++-- | An arbitrary Haskell value in a safe Box. The point is that even+-- unevaluated thunks can safely be moved around inside the Box, and when+-- required, e.g. in 'getBoxedClosureData', the function knows how far it has+-- to evaluate the argument.+data Box = Box Any++instance Show Box where+-- From libraries/base/GHC/Ptr.lhs+   showsPrec _ (Box a) rs =+    -- unsafePerformIO (print "↓" >> pClosure a) `seq`+    pad_out (showHex addr "") ++ (if tag>0 then "/" ++ show tag else "") ++ rs+     where+       ptr  = W# (aToWord# a)+       tag  = ptr .&. fromIntegral tAG_MASK -- ((1 `shiftL` TAG_BITS) -1)+       addr = ptr - tag+        -- want 0s prefixed to pad it out to a fixed length.+       pad_out ls =+          '0':'x':(replicate (2*wORD_SIZE - length ls) '0') ++ ls++-- |This takes an arbitrary value and puts it into a box.+-- Note that calls like+--+-- > asBox (head list)+--+-- will put the thunk \"head list\" into the box, /not/ the element at the head+-- of the list. For that, use careful case expressions:+--+-- > case list of x:_ -> asBox x+asBox :: a -> Box+asBox x = Box (unsafeCoerce# x)++-- | Boxes can be compared, but this is not pure, as different heap objects can,+-- after garbage collection, become the same object.+areBoxesEqual :: Box -> Box -> IO Bool+areBoxesEqual (Box a) (Box b) = case reallyUnsafePtrEqualityUpToTag# a b of+    0# -> pure False+    _  -> pure True+++------------------------------------------------------------------------+-- Closures++type Closure = GenClosure Box++-- | This is the representation of a Haskell value on the heap. It reflects+-- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/storage/Closures.h>+--+-- The data type is parametrized by the type to store references in. Usually+-- this is a 'Box' with the type synonym 'Closure'.+--+-- All Heap objects have the same basic layout. A header containing a pointer+-- to the info table and a payload with various fields. The @info@ field below+-- always refers to the info table pointed to by the header. The remaining+-- fields are the payload.+--+-- See+-- <https://gitlab.haskell.org/ghc/ghc/wikis/commentary/rts/storage/heap-objects>+-- for more information.+data GenClosure b+  = -- | A data constructor+    ConstrClosure+        { info       :: !StgInfoTable+        , ptrArgs    :: ![b]            -- ^ Pointer arguments+        , dataArgs   :: ![Word]         -- ^ Non-pointer arguments+        , pkg        :: !String         -- ^ Package name+        , modl       :: !String         -- ^ Module name+        , name       :: !String         -- ^ Constructor name+        }++    -- | A function+  | FunClosure+        { info       :: !StgInfoTable+        , ptrArgs    :: ![b]            -- ^ Pointer arguments+        , dataArgs   :: ![Word]         -- ^ Non-pointer arguments+        }++    -- | A thunk, an expression not obviously in head normal form+  | ThunkClosure+        { info       :: !StgInfoTable+        , ptrArgs    :: ![b]            -- ^ Pointer arguments+        , dataArgs   :: ![Word]         -- ^ Non-pointer arguments+        }++    -- | A thunk which performs a simple selection operation+  | SelectorClosure+        { info       :: !StgInfoTable+        , selectee   :: !b              -- ^ Pointer to the object being+                                        --   selected from+        }++    -- | An unsaturated function application+  | PAPClosure+        { info       :: !StgInfoTable+        , arity      :: !HalfWord       -- ^ Arity of the partial application+        , n_args     :: !HalfWord       -- ^ Size of the payload in words+        , fun        :: !b              -- ^ Pointer to a 'FunClosure'+        , payload    :: ![b]            -- ^ Sequence of already applied+                                        --   arguments+        }++    -- In GHCi, if Linker.h would allow a reverse lookup, we could for exported+    -- functions fun actually find the name here.+    -- At least the other direction works via "lookupSymbol+    -- base_GHCziBase_zpzp_closure" and yields the same address (up to tags)+    -- | A function application+  | APClosure+        { info       :: !StgInfoTable+        , arity      :: !HalfWord       -- ^ Always 0+        , n_args     :: !HalfWord       -- ^ Size of payload in words+        , fun        :: !b              -- ^ Pointer to a 'FunClosure'+        , payload    :: ![b]            -- ^ Sequence of already applied+                                        --   arguments+        }++    -- | A suspended thunk evaluation+  | APStackClosure+        { info       :: !StgInfoTable+        , fun        :: !b              -- ^ Function closure+        , payload    :: ![b]            -- ^ Stack right before suspension+        }++    -- | A pointer to another closure, introduced when a thunk is updated+    -- to point at its value+  | IndClosure+        { info       :: !StgInfoTable+        , indirectee :: !b              -- ^ Target closure+        }++   -- | A byte-code object (BCO) which can be interpreted by GHC's byte-code+   -- interpreter (e.g. as used by GHCi)+  | BCOClosure+        { info       :: !StgInfoTable+        , instrs     :: !b              -- ^ A pointer to an ArrWords+                                        --   of instructions+        , literals   :: !b              -- ^ A pointer to an ArrWords+                                        --   of literals+        , bcoptrs    :: !b              -- ^ A pointer to an ArrWords+                                        --   of byte code objects+        , arity      :: !HalfWord       -- ^ The arity of this BCO+        , size       :: !HalfWord       -- ^ The size of this BCO in words+        , bitmap     :: ![Word]         -- ^ An StgLargeBitmap describing the+                                        --   pointerhood of its args/free vars+        }++    -- | A thunk under evaluation by another thread+  | BlackholeClosure+        { info       :: !StgInfoTable+        , indirectee :: !b              -- ^ The target closure+        }++    -- | A @ByteArray#@+  | ArrWordsClosure+        { info       :: !StgInfoTable+        , bytes      :: !Word           -- ^ Size of array in bytes+        , arrWords   :: ![Word]         -- ^ Array payload+        }++    -- | A @MutableByteArray#@+  | MutArrClosure+        { info       :: !StgInfoTable+        , mccPtrs    :: !Word           -- ^ Number of pointers+        , mccSize    :: !Word           -- ^ ?? Closures.h vs ClosureMacros.h+        , mccPayload :: ![b]            -- ^ Array payload+        -- Card table ignored+        }++    -- | An @MVar#@, with a queue of thread state objects blocking on them+  | MVarClosure+        { info       :: !StgInfoTable+        , queueHead  :: !b              -- ^ Pointer to head of queue+        , queueTail  :: !b              -- ^ Pointer to tail of queue+        , value      :: !b              -- ^ Pointer to closure+        }++    -- | A @MutVar#@+  | MutVarClosure+        { info       :: !StgInfoTable+        , var        :: !b              -- ^ Pointer to contents+        }++    -- | An STM blocking queue.+  | BlockingQueueClosure+        { info       :: !StgInfoTable+        , link       :: !b              -- ^ ?? Here so it looks like an IND+        , blackHole  :: !b              -- ^ The blackhole closure+        , owner      :: !b              -- ^ The owning thread state object+        , queue      :: !b              -- ^ ??+        }++    ------------------------------------------------------------+    -- Unboxed unlifted closures++    -- | Primitive Int+  | IntClosure+        { ptipe      :: PrimType+        , intVal     :: !Int }++    -- | Primitive Word+  | WordClosure+        { ptipe      :: PrimType+        , wordVal    :: !Word }++    -- | Primitive Int64+  | Int64Closure+        { ptipe      :: PrimType+        , int64Val   :: !Int64 }++    -- | Primitive Word64+  | Word64Closure+        { ptipe      :: PrimType+        , word64Val  :: !Word64 }++    -- | Primitive Addr+  | AddrClosure+        { ptipe      :: PrimType+        , addrVal    :: !Int }++    -- | Primitive Float+  | FloatClosure+        { ptipe      :: PrimType+        , floatVal   :: !Float }++    -- | Primitive Double+  | DoubleClosure+        { ptipe      :: PrimType+        , doubleVal  :: !Double }++    -----------------------------------------------------------+    -- Anything else++    -- | Another kind of closure+  | OtherClosure+        { info       :: !StgInfoTable+        , hvalues    :: ![b]+        , rawWords   :: ![Word]+        }++  | UnsupportedClosure+        { info       :: !StgInfoTable+        }+  deriving (Show, Generic, Functor, Foldable, Traversable)+++data PrimType+  = PInt+  | PWord+  | PInt64+  | PWord64+  | PAddr+  | PFloat+  | PDouble+  deriving (Eq, Show, Generic)++-- | For generic code, this function returns all referenced closures.+allClosures :: GenClosure b -> [b]+allClosures (ConstrClosure {..}) = ptrArgs+allClosures (ThunkClosure {..}) = ptrArgs+allClosures (SelectorClosure {..}) = [selectee]+allClosures (IndClosure {..}) = [indirectee]+allClosures (BlackholeClosure {..}) = [indirectee]+allClosures (APClosure {..}) = fun:payload+allClosures (PAPClosure {..}) = fun:payload+allClosures (APStackClosure {..}) = fun:payload+allClosures (BCOClosure {..}) = [instrs,literals,bcoptrs]+allClosures (ArrWordsClosure {}) = []+allClosures (MutArrClosure {..}) = mccPayload+allClosures (MutVarClosure {..}) = [var]+allClosures (MVarClosure {..}) = [queueHead,queueTail,value]+allClosures (FunClosure {..}) = ptrArgs+allClosures (BlockingQueueClosure {..}) = [link, blackHole, owner, queue]+allClosures (OtherClosure {..}) = hvalues+allClosures _ = []++#if __GLASGOW_HASKELL__ >= 809+-- | Get the size of a closure in words.+--+-- @since 8.10.1+closureSize :: Box -> Int+closureSize (Box x) = I# (closureSize# x)+#endif
+ libraries/ghc-heap/GHC/Exts/Heap/Constants.hsc view
@@ -0,0 +1,17 @@+{-# LANGUAGE CPP #-}++module GHC.Exts.Heap.Constants+    ( wORD_SIZE+    , tAG_MASK+    , wORD_SIZE_IN_BITS+    ) where++#include "MachDeps.h"++import Prelude -- See note [Why do we import Prelude here?]+import Data.Bits++wORD_SIZE, tAG_MASK, wORD_SIZE_IN_BITS :: Int+wORD_SIZE = #const SIZEOF_HSWORD+wORD_SIZE_IN_BITS = #const WORD_SIZE_IN_BITS+tAG_MASK = (1 `shift` #const TAG_BITS) - 1
+ libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hsc view
@@ -0,0 +1,81 @@+module GHC.Exts.Heap.InfoTable+    ( module GHC.Exts.Heap.InfoTable.Types+    , itblSize+    , peekItbl+    , pokeItbl+    ) where++#include "Rts.h"++import Prelude -- See note [Why do we import Prelude here?]+import GHC.Exts.Heap.InfoTable.Types+#if !defined(TABLES_NEXT_TO_CODE)+import GHC.Exts.Heap.Constants+import Data.Maybe+#endif+import Foreign++-------------------------------------------------------------------------+-- Profiling specific code+--+-- The functions that follow all rely on PROFILING. They are duplicated in+-- ghc-heap/GHC/Exts/Heap/InfoTableProf.hsc where PROFILING is defined. This+-- allows hsc2hs to generate values for both profiling and non-profiling builds.++-- | Read an InfoTable from the heap into a haskell type.+-- WARNING: This code assumes it is passed a pointer to a "standard" info+-- table. If tables_next_to_code is enabled, it will look 1 byte before the+-- start for the entry field.+peekItbl :: Ptr StgInfoTable -> IO StgInfoTable+peekItbl a0 = do+#if !defined(TABLES_NEXT_TO_CODE)+  let ptr = a0 `plusPtr` (negate wORD_SIZE)+  entry' <- Just <$> (#peek struct StgInfoTable_, entry) ptr+#else+  let ptr = a0+      entry' = Nothing+#endif+  ptrs'   <- (#peek struct StgInfoTable_, layout.payload.ptrs) ptr+  nptrs'  <- (#peek struct StgInfoTable_, layout.payload.nptrs) ptr+  tipe'   <- (#peek struct StgInfoTable_, type) ptr+#if __GLASGOW_HASKELL__ > 804+  srtlen' <- (#peek struct StgInfoTable_, srt) a0+#else+  srtlen' <- (#peek struct StgInfoTable_, srt_bitmap) ptr+#endif+  return StgInfoTable+    { entry  = entry'+    , ptrs   = ptrs'+    , nptrs  = nptrs'+    , tipe   = toEnum (fromIntegral (tipe' :: HalfWord))+    , srtlen = srtlen'+    , code   = Nothing+    }++pokeItbl :: Ptr StgInfoTable -> StgInfoTable -> IO ()+pokeItbl a0 itbl = do+#if !defined(TABLES_NEXT_TO_CODE)+  (#poke StgInfoTable, entry) a0 (fromJust (entry itbl))+#endif+  (#poke StgInfoTable, layout.payload.ptrs) a0 (ptrs itbl)+  (#poke StgInfoTable, layout.payload.nptrs) a0 (nptrs itbl)+  (#poke StgInfoTable, type) a0 (toHalfWord (fromEnum (tipe itbl)))+#if __GLASGOW_HASKELL__ > 804+  (#poke StgInfoTable, srt) a0 (srtlen itbl)+#else+  (#poke StgInfoTable, srt_bitmap) a0 (srtlen itbl)+#endif+#if defined(TABLES_NEXT_TO_CODE)+  let code_offset = a0 `plusPtr` (#offset StgInfoTable, code)+  case code itbl of+    Nothing -> return ()+    Just (Left xs) -> pokeArray code_offset xs+    Just (Right xs) -> pokeArray code_offset xs+#endif+  where+    toHalfWord :: Int -> HalfWord+    toHalfWord i = fromIntegral i++-- | Size in bytes of a standard InfoTable+itblSize :: Int+itblSize = (#size struct StgInfoTable_)
+ libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc view
@@ -0,0 +1,40 @@+{-# LANGUAGE DeriveGeneric #-}+module GHC.Exts.Heap.InfoTable.Types+    ( StgInfoTable(..)+    , EntryFunPtr+    , HalfWord+    , ItblCodes+    ) where++#include "Rts.h"++import Prelude -- See note [Why do we import Prelude here?]+import GHC.Generics+import GHC.Exts.Heap.ClosureTypes+import Foreign++type ItblCodes = Either [Word8] [Word32]++#include "ghcautoconf.h"+-- Ultra-minimalist version specially for constructors+#if SIZEOF_VOID_P == 8+type HalfWord = Word32+#elif SIZEOF_VOID_P == 4+type HalfWord = Word16+#else+#error Unknown SIZEOF_VOID_P+#endif++type EntryFunPtr = FunPtr (Ptr () -> IO (Ptr ()))++-- | This is a somewhat faithful representation of an info table. See+-- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/storage/InfoTables.h>+-- for more details on this data structure.+data StgInfoTable = StgInfoTable {+   entry  :: Maybe EntryFunPtr, -- Just <=> not ghciTablesNextToCode+   ptrs   :: HalfWord,+   nptrs  :: HalfWord,+   tipe   :: ClosureType,+   srtlen :: HalfWord,+   code   :: Maybe ItblCodes -- Just <=> ghciTablesNextToCode+  } deriving (Show, Generic)
+ libraries/ghc-heap/GHC/Exts/Heap/InfoTableProf.hsc view
@@ -0,0 +1,74 @@+module GHC.Exts.Heap.InfoTableProf+    ( module GHC.Exts.Heap.InfoTable.Types+    , itblSize+    , peekItbl+    , pokeItbl+    ) where++-- This file overrides InfoTable.hsc's implementation of peekItbl and pokeItbl.+-- Manually defining PROFILING gives the #peek and #poke macros an accurate+-- representation of StgInfoTable_ when hsc2hs runs.+#define PROFILING+#include "Rts.h"++import Prelude -- See note [Why do we import Prelude here?]+import GHC.Exts.Heap.InfoTable.Types+#if !defined(TABLES_NEXT_TO_CODE)+import GHC.Exts.Heap.Constants+import Data.Maybe+#endif+import Foreign++-- | Read an InfoTable from the heap into a haskell type.+-- WARNING: This code assumes it is passed a pointer to a "standard" info+-- table. If tables_next_to_code is enabled, it will look 1 byte before the+-- start for the entry field.+peekItbl :: Ptr StgInfoTable -> IO StgInfoTable+peekItbl a0 = do+#if !defined(TABLES_NEXT_TO_CODE)+  let ptr = a0 `plusPtr` (negate wORD_SIZE)+  entry' <- Just <$> (#peek struct StgInfoTable_, entry) ptr+#else+  let ptr = a0+      entry' = Nothing+#endif+  ptrs'   <- (#peek struct StgInfoTable_, layout.payload.ptrs) ptr+  nptrs'  <- (#peek struct StgInfoTable_, layout.payload.nptrs) ptr+  tipe'   <- (#peek struct StgInfoTable_, type) ptr+#if __GLASGOW_HASKELL__ > 804+  srtlen' <- (#peek struct StgInfoTable_, srt) a0+#else+  srtlen' <- (#peek struct StgInfoTable_, srt_bitmap) ptr+#endif+  return StgInfoTable+    { entry  = entry'+    , ptrs   = ptrs'+    , nptrs  = nptrs'+    , tipe   = toEnum (fromIntegral (tipe' :: HalfWord))+    , srtlen = srtlen'+    , code   = Nothing+    }++pokeItbl :: Ptr StgInfoTable -> StgInfoTable -> IO ()+pokeItbl a0 itbl = do+#if !defined(TABLES_NEXT_TO_CODE)+  (#poke StgInfoTable, entry) a0 (fromJust (entry itbl))+#endif+  (#poke StgInfoTable, layout.payload.ptrs) a0 (ptrs itbl)+  (#poke StgInfoTable, layout.payload.nptrs) a0 (nptrs itbl)+  (#poke StgInfoTable, type) a0 (fromEnum (tipe itbl))+#if __GLASGOW_HASKELL__ > 804+  (#poke StgInfoTable, srt) a0 (srtlen itbl)+#else+  (#poke StgInfoTable, srt_bitmap) a0 (srtlen itbl)+#endif+#if defined(TABLES_NEXT_TO_CODE)+  let code_offset = a0 `plusPtr` (#offset StgInfoTable, code)+  case code itbl of+    Nothing -> return ()+    Just (Left xs) -> pokeArray code_offset xs+    Just (Right xs) -> pokeArray code_offset xs+#endif++itblSize :: Int+itblSize = (#size struct StgInfoTable_)
+ libraries/ghc-heap/GHC/Exts/Heap/Utils.hsc view
@@ -0,0 +1,129 @@+{-# LANGUAGE CPP, MagicHash #-}++module GHC.Exts.Heap.Utils (+    dataConNames+    ) where++#include "Rts.h"++import Prelude -- See note [Why do we import Prelude here?]+import GHC.Exts.Heap.Constants+import GHC.Exts.Heap.InfoTable++import Data.Char+import Data.List+import Foreign+import GHC.CString+import GHC.Exts++{- To find the string in the constructor's info table we need to consider+      the layout of info tables relative to the entry code for a closure.++      An info table can be next to the entry code for the closure, or it can+      be separate. The former (faster) is used in registerised versions of ghc,+      and the latter (portable) is for non-registerised versions.++      The diagrams below show where the string is to be found relative to+      the normal info table of the closure.++      1) Tables next to code:++         --------------+         |            |   <- pointer to the start of the string+         --------------+         |            |   <- the (start of the) info table structure+         |            |+         |            |+         --------------+         | entry code |+         |    ....    |++         In this case the pointer to the start of the string can be found in+         the memory location _one word before_ the first entry in the normal info+         table.++      2) Tables NOT next to code:++                                 --------------+         info table structure -> |     *------------------> --------------+                                 |            |             | entry code |+                                 |            |             |    ....    |+                                 --------------+         ptr to start of str ->  |            |+                                 --------------++         In this case the pointer to the start of the string can be found+         in the memory location: info_table_ptr + info_table_size+-}++-- Given a ptr to an 'StgInfoTable' for a data constructor+-- return (Package, Module, Name)+dataConNames :: Ptr StgInfoTable -> IO (String, String, String)+dataConNames ptr = do+    conDescAddress <- getConDescAddress+    pure $ parse conDescAddress+  where+    -- Retrieve the con_desc field address pointing to+    -- 'Package:Module.Name' string+    getConDescAddress :: IO (Ptr Word8)+    getConDescAddress+#if defined(TABLES_NEXT_TO_CODE)+      = do+        offsetToString <- peek (ptr `plusPtr` negate wORD_SIZE)+        pure $ (ptr `plusPtr` stdInfoTableSizeB)+                    `plusPtr` fromIntegral (offsetToString :: Int32)+#else+      = peek $ intPtrToPtr $ ptrToIntPtr ptr + fromIntegral stdInfoTableSizeB+#endif++    stdInfoTableSizeW :: Int+    -- The size of a standard info table varies with profiling/ticky etc,+    -- so we can't get it from Constants+    -- It must vary in sync with mkStdInfoTable+    stdInfoTableSizeW+      = size_fixed + size_prof+      where+        size_fixed = 2  -- layout, type+##if defined(PROFILING)+        size_prof = 2+##else+        size_prof = 0+##endif++    stdInfoTableSizeB :: Int+    stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE++-- parsing names is a little bit fiddly because we have a string in the form:+-- pkg:A.B.C.foo, and we want to split it into three parts: ("pkg", "A.B.C", "foo").+-- Thus we split at the leftmost colon and the rightmost occurrence of the dot.+-- It would be easier if the string was in the form pkg:A.B.C:foo, but alas+-- this is not the conventional way of writing Haskell names. We stick with+-- convention, even though it makes the parsing code more troublesome.+-- Warning: this code assumes that the string is well formed.+parse :: Ptr Word8 -> (String, String, String)+parse (Ptr addr) = if not . all (>0) . fmap length $ [p,m,occ]+                     then ([], [], input)+                     else (p, m, occ)+  where+    input = unpackCStringUtf8## addr+    (p, rest1) = break (== ':') input+    (m, occ)+        = (intercalate "." $ reverse modWords, occWord)+        where+        (modWords, occWord) =+            if length rest1 < 1 --  XXXXXXXXx YUKX+                --then error "getConDescAddress:parse:length rest1 < 1"+                then parseModOcc [] []+                else parseModOcc [] (tail rest1)+    -- We only look for dots if str could start with a module name,+    -- i.e. if it starts with an upper case character.+    -- Otherwise we might think that "X.:->" is the module name in+    -- "X.:->.+", whereas actually "X" is the module name and+    -- ":->.+" is a constructor name.+    parseModOcc :: [String] -> String -> ([String], String)+    parseModOcc acc str@(c : _)+        | isUpper c =+            case break (== '.') str of+                (top, []) -> (acc, top)+                (top, _:bot) -> parseModOcc (top : acc) bot+    parseModOcc acc str = (acc, str)
+ libraries/ghci/GHCi/BreakArray.hs view
@@ -0,0 +1,121 @@+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}++-------------------------------------------------------------------------------+--+-- (c) The University of Glasgow 2007+--+-- | Break Arrays+--+-- An array of bytes, indexed by a breakpoint number (breakpointId in Tickish)+-- There is one of these arrays per module.+--+-- Each byte is+--   1 if the corresponding breakpoint is enabled+--   0 otherwise+--+-------------------------------------------------------------------------------++module GHCi.BreakArray+    (+      BreakArray+#ifdef GHCI+          (BA) -- constructor is exported only for ByteCodeGen+    , newBreakArray+    , getBreak+    , setBreakOn+    , setBreakOff+    , showBreakArray+#endif+    ) where++#ifdef GHCI+import Prelude -- See note [Why do we import Prelude here?]+import Control.Monad+import Data.Word+import GHC.Word++import GHC.Exts+import GHC.IO ( IO(..) )+import System.IO.Unsafe ( unsafeDupablePerformIO )++data BreakArray = BA (MutableByteArray# RealWorld)++breakOff, breakOn :: Word8+breakOn  = 1+breakOff = 0++showBreakArray :: BreakArray -> IO ()+showBreakArray array = do+    forM_ [0 .. (size array - 1)] $ \i -> do+        val <- readBreakArray array i+        putStr $ ' ' : show val+    putStr "\n"++setBreakOn :: BreakArray -> Int -> IO Bool+setBreakOn array index+    | safeIndex array index = do+          writeBreakArray array index breakOn+          return True+    | otherwise = return False++setBreakOff :: BreakArray -> Int -> IO Bool+setBreakOff array index+    | safeIndex array index = do+          writeBreakArray array index breakOff+          return True+    | otherwise = return False++getBreak :: BreakArray -> Int -> IO (Maybe Word8)+getBreak array index+    | safeIndex array index = do+          val <- readBreakArray array index+          return $ Just val+    | otherwise = return Nothing++safeIndex :: BreakArray -> Int -> Bool+safeIndex array index = index < size array && index >= 0++size :: BreakArray -> Int+size (BA array) = size+  where+    -- We want to keep this operation pure. The mutable byte array+    -- is never resized so this is safe.+    size = unsafeDupablePerformIO $ sizeofMutableByteArray array++    sizeofMutableByteArray :: MutableByteArray# RealWorld -> IO Int+    sizeofMutableByteArray arr =+        IO $ \s -> case getSizeofMutableByteArray# arr s of+                       (# s', n# #) -> (# s', I# n# #)++allocBA :: Int -> IO BreakArray+allocBA (I# sz) = IO $ \s1 ->+    case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }++-- create a new break array and initialise elements to zero+newBreakArray :: Int -> IO BreakArray+newBreakArray entries@(I# sz) = do+    BA array <- allocBA entries+    case breakOff of+        W8# off -> do+           let loop n | isTrue# (n ==# sz) = return ()+                      | otherwise = do writeBA# array n off; loop (n +# 1#)+           loop 0#+    return $ BA array++writeBA# :: MutableByteArray# RealWorld -> Int# -> Word# -> IO ()+writeBA# array i word = IO $ \s ->+    case writeWord8Array# array i word s of { s -> (# s, () #) }++writeBreakArray :: BreakArray -> Int -> Word8 -> IO ()+writeBreakArray (BA array) (I# i) (W8# word) = writeBA# array i word++readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word8+readBA# array i = IO $ \s ->+    case readWord8Array# array i s of { (# s, c #) -> (# s, W8# c #) }++readBreakArray :: BreakArray -> Int -> IO Word8+readBreakArray (BA array) (I# i) = readBA# array i+#else+data BreakArray+#endif
+ libraries/ghci/GHCi/FFI.hsc view
@@ -0,0 +1,151 @@+-----------------------------------------------------------------------------+--+-- libffi bindings+--+-- (c) The University of Glasgow 2008+--+-----------------------------------------------------------------------------++#include <ffi.h>++{-# LANGUAGE CPP, DeriveGeneric, DeriveAnyClass #-}+module GHCi.FFI+  ( FFIType(..)+  , FFIConv(..)+  , C_ffi_cif+  , prepForeignCall+  , freeForeignCallInfo+  ) where++import Prelude -- See note [Why do we import Prelude here?]+import Control.Exception+import Data.Binary+import GHC.Generics+import Foreign+import Foreign.C++data FFIType+  = FFIVoid+  | FFIPointer+  | FFIFloat+  | FFIDouble+  | FFISInt8+  | FFISInt16+  | FFISInt32+  | FFISInt64+  | FFIUInt8+  | FFIUInt16+  | FFIUInt32+  | FFIUInt64+  deriving (Show, Generic, Binary)++data FFIConv+  = FFICCall+  | FFIStdCall+  deriving (Show, Generic, Binary)+++prepForeignCall+    :: FFIConv+    -> [FFIType]          -- arg types+    -> FFIType            -- result type+    -> IO (Ptr C_ffi_cif) -- token for making calls (must be freed by caller)++prepForeignCall cconv arg_types result_type = do+  let n_args = length arg_types+  arg_arr <- mallocArray n_args+  pokeArray arg_arr (map ffiType arg_types)+  cif <- mallocBytes (#const sizeof(ffi_cif))+  let abi = convToABI cconv+  r <- ffi_prep_cif cif abi (fromIntegral n_args) (ffiType result_type) arg_arr+  if (r /= fFI_OK)+     then throwIO (ErrorCall ("prepForeignCallFailed: " ++ show r))+     else return (castPtr cif)++freeForeignCallInfo :: Ptr C_ffi_cif -> IO ()+freeForeignCallInfo p = do+  free ((#ptr ffi_cif, arg_types) p)+  free p++convToABI :: FFIConv -> C_ffi_abi+convToABI FFICCall  = fFI_DEFAULT_ABI+#if defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH)+convToABI FFIStdCall = fFI_STDCALL+#endif+-- unknown conventions are mapped to the default, (#3336)+convToABI _           = fFI_DEFAULT_ABI++ffiType :: FFIType -> Ptr C_ffi_type+ffiType FFIVoid     = ffi_type_void+ffiType FFIPointer  = ffi_type_pointer+ffiType FFIFloat    = ffi_type_float+ffiType FFIDouble   = ffi_type_double+ffiType FFISInt8    = ffi_type_sint8+ffiType FFISInt16   = ffi_type_sint16+ffiType FFISInt32   = ffi_type_sint32+ffiType FFISInt64   = ffi_type_sint64+ffiType FFIUInt8    = ffi_type_uint8+ffiType FFIUInt16   = ffi_type_uint16+ffiType FFIUInt32   = ffi_type_uint32+ffiType FFIUInt64   = ffi_type_uint64++data C_ffi_type+data C_ffi_cif++type C_ffi_status = (#type ffi_status)+type C_ffi_abi    = (#type ffi_abi)++foreign import ccall "&ffi_type_void"   ffi_type_void    :: Ptr C_ffi_type+foreign import ccall "&ffi_type_uint8"  ffi_type_uint8   :: Ptr C_ffi_type+foreign import ccall "&ffi_type_sint8"  ffi_type_sint8   :: Ptr C_ffi_type+foreign import ccall "&ffi_type_uint16" ffi_type_uint16  :: Ptr C_ffi_type+foreign import ccall "&ffi_type_sint16" ffi_type_sint16  :: Ptr C_ffi_type+foreign import ccall "&ffi_type_uint32" ffi_type_uint32  :: Ptr C_ffi_type+foreign import ccall "&ffi_type_sint32" ffi_type_sint32  :: Ptr C_ffi_type+foreign import ccall "&ffi_type_uint64" ffi_type_uint64  :: Ptr C_ffi_type+foreign import ccall "&ffi_type_sint64" ffi_type_sint64  :: Ptr C_ffi_type+foreign import ccall "&ffi_type_float"  ffi_type_float   :: Ptr C_ffi_type+foreign import ccall "&ffi_type_double" ffi_type_double  :: Ptr C_ffi_type+foreign import ccall "&ffi_type_pointer"ffi_type_pointer :: Ptr C_ffi_type++fFI_OK            :: C_ffi_status+fFI_OK            = (#const FFI_OK)+--fFI_BAD_ABI     :: C_ffi_status+--fFI_BAD_ABI     = (#const FFI_BAD_ABI)+--fFI_BAD_TYPEDEF :: C_ffi_status+--fFI_BAD_TYPEDEF = (#const FFI_BAD_TYPEDEF)++fFI_DEFAULT_ABI :: C_ffi_abi+fFI_DEFAULT_ABI = (#const FFI_DEFAULT_ABI)+#if defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH)+fFI_STDCALL     :: C_ffi_abi+fFI_STDCALL     = (#const FFI_STDCALL)+#endif++-- ffi_status ffi_prep_cif(ffi_cif *cif,+--                         ffi_abi abi,+--                         unsigned int nargs,+--                         ffi_type *rtype,+--                         ffi_type **atypes);++foreign import ccall "ffi_prep_cif"+  ffi_prep_cif :: Ptr C_ffi_cif         -- cif+               -> C_ffi_abi             -- abi+               -> CUInt                 -- nargs+               -> Ptr C_ffi_type        -- result type+               -> Ptr (Ptr C_ffi_type)  -- arg types+               -> IO C_ffi_status++-- Currently unused:++-- void ffi_call(ffi_cif *cif,+--               void (*fn)(),+--               void *rvalue,+--               void **avalue);++-- foreign import ccall "ffi_call"+--   ffi_call :: Ptr C_ffi_cif             -- cif+--            -> FunPtr (IO ())            -- function to call+--            -> Ptr ()                    -- put result here+--            -> Ptr (Ptr ())              -- arg values+--            -> IO ()
+ libraries/ghci/GHCi/Message.hs view
@@ -0,0 +1,592 @@+{-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving, ScopedTypeVariables,+    GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-}++-- |+-- Remote GHCi message types and serialization.+--+-- For details on Remote GHCi, see Note [Remote GHCi] in+-- compiler/ghci/GHCi.hs.+--+module GHCi.Message+  ( Message(..), Msg(..)+  , THMessage(..), THMsg(..)+  , QResult(..)+  , EvalStatus_(..), EvalStatus, EvalResult(..), EvalOpts(..), EvalExpr(..)+  , SerializableException(..)+  , toSerializableException, fromSerializableException+  , THResult(..), THResultType(..)+  , ResumeContext(..)+  , QState(..)+  , getMessage, putMessage, getTHMessage, putTHMessage+  , Pipe(..), remoteCall, remoteTHCall, readPipe, writePipe+  ) where++import Prelude -- See note [Why do we import Prelude here?]+import GHCi.RemoteTypes+import GHCi.FFI+import GHCi.TH.Binary ()+import GHCi.BreakArray++import GHC.LanguageExtensions+import GHC.Exts.Heap+import GHC.ForeignSrcLang+import GHC.Fingerprint+import Control.Concurrent+import Control.Exception+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LB+import Data.Dynamic+import Data.Typeable (TypeRep)+import Data.IORef+import Data.Map (Map)+import Foreign+import GHC.Generics+import GHC.Stack.CCS+import qualified Language.Haskell.TH        as TH+import qualified Language.Haskell.TH.Syntax as TH+import System.Exit+import System.IO+import System.IO.Error++-- -----------------------------------------------------------------------------+-- The RPC protocol between GHC and the interactive server++-- | A @Message a@ is a message that returns a value of type @a@.+-- These are requests sent from GHC to the server.+data Message a where+  -- | Exit the iserv process+  Shutdown :: Message ()+  RtsRevertCAFs :: Message ()++  -- RTS Linker -------------------------------------------++  -- These all invoke the corresponding functions in the RTS Linker API.+  InitLinker :: Message ()+  LookupSymbol :: String -> Message (Maybe (RemotePtr ()))+  LookupClosure :: String -> Message (Maybe HValueRef)+  LoadDLL :: String -> Message (Maybe String)+  LoadArchive :: String -> Message () -- error?+  LoadObj :: String -> Message () -- error?+  UnloadObj :: String -> Message () -- error?+  AddLibrarySearchPath :: String -> Message (RemotePtr ())+  RemoveLibrarySearchPath :: RemotePtr () -> Message Bool+  ResolveObjs :: Message Bool+  FindSystemLibrary :: String -> Message (Maybe String)++  -- Interpreter -------------------------------------------++  -- | Create a set of BCO objects, and return HValueRefs to them+  -- Note: Each ByteString contains a Binary-encoded [ResolvedBCO], not+  -- a ResolvedBCO. The list is to allow us to serialise the ResolvedBCOs+  -- in parallel. See @createBCOs@ in compiler/ghci/GHCi.hsc.+  CreateBCOs :: [LB.ByteString] -> Message [HValueRef]++  -- | Release 'HValueRef's+  FreeHValueRefs :: [HValueRef] -> Message ()++  -- | Add entries to the Static Pointer Table+  AddSptEntry :: Fingerprint -> HValueRef -> Message ()++  -- | Malloc some data and return a 'RemotePtr' to it+  MallocData :: ByteString -> Message (RemotePtr ())+  MallocStrings :: [ByteString] -> Message [RemotePtr ()]++  -- | Calls 'GHCi.FFI.prepareForeignCall'+  PrepFFI :: FFIConv -> [FFIType] -> FFIType -> Message (RemotePtr C_ffi_cif)++  -- | Free data previously created by 'PrepFFI'+  FreeFFI :: RemotePtr C_ffi_cif -> Message ()++  -- | Create an info table for a constructor+  MkConInfoTable+   :: Int     -- ptr words+   -> Int     -- non-ptr words+   -> Int     -- constr tag+   -> Int     -- pointer tag+   -> ByteString -- constructor desccription+   -> Message (RemotePtr StgInfoTable)++  -- | Evaluate a statement+  EvalStmt+    :: EvalOpts+    -> EvalExpr HValueRef {- IO [a] -}+    -> Message (EvalStatus [HValueRef]) {- [a] -}++  -- | Resume evaluation of a statement after a breakpoint+  ResumeStmt+   :: EvalOpts+   -> RemoteRef (ResumeContext [HValueRef])+   -> Message (EvalStatus [HValueRef])++  -- | Abandon evaluation of a statement after a breakpoint+  AbandonStmt+   :: RemoteRef (ResumeContext [HValueRef])+   -> Message ()++  -- | Evaluate something of type @IO String@+  EvalString+    :: HValueRef {- IO String -}+    -> Message (EvalResult String)++  -- | Evaluate something of type @String -> IO String@+  EvalStringToString+    :: HValueRef {- String -> IO String -}+    -> String+    -> Message (EvalResult String)++  -- | Evaluate something of type @IO ()@+  EvalIO+   :: HValueRef {- IO a -}+   -> Message (EvalResult ())++  -- | Create a set of CostCentres with the same module name+  MkCostCentres+   :: String     -- module, RemotePtr so it can be shared+   -> [(String,String)] -- (name, SrcSpan)+   -> Message [RemotePtr CostCentre]++  -- | Show a 'CostCentreStack' as a @[String]@+  CostCentreStackInfo+   :: RemotePtr CostCentreStack+   -> Message [String]++  -- | Create a new array of breakpoint flags+  NewBreakArray+   :: Int                               -- size+   -> Message (RemoteRef BreakArray)++  -- | Enable a breakpoint+  EnableBreakpoint+   :: RemoteRef BreakArray+   -> Int                               -- index+   -> Bool                              -- on or off+   -> Message ()++  -- | Query the status of a breakpoint (True <=> enabled)+  BreakpointStatus+   :: RemoteRef BreakArray+   -> Int                               -- index+   -> Message Bool                      -- True <=> enabled++  -- | Get a reference to a free variable at a breakpoint+  GetBreakpointVar+   :: HValueRef                         -- the AP_STACK from EvalBreak+   -> Int+   -> Message (Maybe HValueRef)++  -- Template Haskell -------------------------------------------+  -- For more details on how TH works with Remote GHCi, see+  -- Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs.++  -- | Start a new TH module, return a state token that should be+  StartTH :: Message (RemoteRef (IORef QState))++  -- | Evaluate a TH computation.+  --+  -- Returns a ByteString, because we have to force the result+  -- before returning it to ensure there are no errors lurking+  -- in it.  The TH types don't have NFData instances, and even if+  -- they did, we have to serialize the value anyway, so we might+  -- as well serialize it to force it.+  RunTH+   :: RemoteRef (IORef QState)+   -> HValueRef {- e.g. TH.Q TH.Exp -}+   -> THResultType+   -> Maybe TH.Loc+   -> Message (QResult ByteString)++  -- | Run the given mod finalizers.+  RunModFinalizers :: RemoteRef (IORef QState)+                   -> [RemoteRef (TH.Q ())]+                   -> Message (QResult ())++  -- | Remote interface to GHC.Exts.Heap.getClosureData. This is used by+  -- the GHCi debugger to inspect values in the heap for :print and+  -- type reconstruction.+  GetClosure+    :: HValueRef+    -> Message (GenClosure HValueRef)++  -- | Evaluate something. This is used to support :force in GHCi.+  Seq+    :: HValueRef+    -> Message (EvalResult ())++deriving instance Show (Message a)+++-- | Template Haskell return values+data QResult a+  = QDone a+    -- ^ RunTH finished successfully; return value follows+  | QException String+    -- ^ RunTH threw an exception+  | QFail String+    -- ^ RunTH called 'fail'+  deriving (Generic, Show)++instance Binary a => Binary (QResult a)+++-- | Messages sent back to GHC from GHCi.TH, to implement the methods+-- of 'Quasi'.  For an overview of how TH works with Remote GHCi, see+-- Note [Remote Template Haskell] in GHCi.TH.+data THMessage a where+  NewName :: String -> THMessage (THResult TH.Name)+  Report :: Bool -> String -> THMessage (THResult ())+  LookupName :: Bool -> String -> THMessage (THResult (Maybe TH.Name))+  Reify :: TH.Name -> THMessage (THResult TH.Info)+  ReifyFixity :: TH.Name -> THMessage (THResult (Maybe TH.Fixity))+  ReifyInstances :: TH.Name -> [TH.Type] -> THMessage (THResult [TH.Dec])+  ReifyRoles :: TH.Name -> THMessage (THResult [TH.Role])+  ReifyAnnotations :: TH.AnnLookup -> TypeRep+    -> THMessage (THResult [ByteString])+  ReifyModule :: TH.Module -> THMessage (THResult TH.ModuleInfo)+  ReifyConStrictness :: TH.Name -> THMessage (THResult [TH.DecidedStrictness])++  AddDependentFile :: FilePath -> THMessage (THResult ())+  AddTempFile :: String -> THMessage (THResult FilePath)+  AddModFinalizer :: RemoteRef (TH.Q ()) -> THMessage (THResult ())+  AddCorePlugin :: String -> THMessage (THResult ())+  AddTopDecls :: [TH.Dec] -> THMessage (THResult ())+  AddForeignFilePath :: ForeignSrcLang -> FilePath -> THMessage (THResult ())+  IsExtEnabled :: Extension -> THMessage (THResult Bool)+  ExtsEnabled :: THMessage (THResult [Extension])++  StartRecover :: THMessage ()+  EndRecover :: Bool -> THMessage ()+  FailIfErrs :: THMessage (THResult ())++  -- | Indicates that this RunTH is finished, and the next message+  -- will be the result of RunTH (a QResult).+  RunTHDone :: THMessage ()++deriving instance Show (THMessage a)++data THMsg = forall a . (Binary a, Show a) => THMsg (THMessage a)++getTHMessage :: Get THMsg+getTHMessage = do+  b <- getWord8+  case b of+    0  -> THMsg <$> NewName <$> get+    1  -> THMsg <$> (Report <$> get <*> get)+    2  -> THMsg <$> (LookupName <$> get <*> get)+    3  -> THMsg <$> Reify <$> get+    4  -> THMsg <$> ReifyFixity <$> get+    5  -> THMsg <$> (ReifyInstances <$> get <*> get)+    6  -> THMsg <$> ReifyRoles <$> get+    7  -> THMsg <$> (ReifyAnnotations <$> get <*> get)+    8  -> THMsg <$> ReifyModule <$> get+    9  -> THMsg <$> ReifyConStrictness <$> get+    10 -> THMsg <$> AddDependentFile <$> get+    11 -> THMsg <$> AddTempFile <$> get+    12 -> THMsg <$> AddTopDecls <$> get+    13 -> THMsg <$> (IsExtEnabled <$> get)+    14 -> THMsg <$> return ExtsEnabled+    15 -> THMsg <$> return StartRecover+    16 -> THMsg <$> EndRecover <$> get+    17 -> THMsg <$> return FailIfErrs+    18 -> return (THMsg RunTHDone)+    19 -> THMsg <$> AddModFinalizer <$> get+    20 -> THMsg <$> (AddForeignFilePath <$> get <*> get)+    _  -> THMsg <$> AddCorePlugin <$> get++putTHMessage :: THMessage a -> Put+putTHMessage m = case m of+  NewName a                   -> putWord8 0  >> put a+  Report a b                  -> putWord8 1  >> put a >> put b+  LookupName a b              -> putWord8 2  >> put a >> put b+  Reify a                     -> putWord8 3  >> put a+  ReifyFixity a               -> putWord8 4  >> put a+  ReifyInstances a b          -> putWord8 5  >> put a >> put b+  ReifyRoles a                -> putWord8 6  >> put a+  ReifyAnnotations a b        -> putWord8 7  >> put a >> put b+  ReifyModule a               -> putWord8 8  >> put a+  ReifyConStrictness a        -> putWord8 9  >> put a+  AddDependentFile a          -> putWord8 10 >> put a+  AddTempFile a               -> putWord8 11 >> put a+  AddTopDecls a               -> putWord8 12 >> put a+  IsExtEnabled a              -> putWord8 13 >> put a+  ExtsEnabled                 -> putWord8 14+  StartRecover                -> putWord8 15+  EndRecover a                -> putWord8 16 >> put a+  FailIfErrs                  -> putWord8 17+  RunTHDone                   -> putWord8 18+  AddModFinalizer a           -> putWord8 19 >> put a+  AddForeignFilePath lang a   -> putWord8 20 >> put lang >> put a+  AddCorePlugin a             -> putWord8 21 >> put a+++data EvalOpts = EvalOpts+  { useSandboxThread :: Bool+  , singleStep :: Bool+  , breakOnException :: Bool+  , breakOnError :: Bool+  }+  deriving (Generic, Show)++instance Binary EvalOpts++data ResumeContext a = ResumeContext+  { resumeBreakMVar :: MVar ()+  , resumeStatusMVar :: MVar (EvalStatus a)+  , resumeThreadId :: ThreadId+  }++-- | We can pass simple expressions to EvalStmt, consisting of values+-- and application.  This allows us to wrap the statement to be+-- executed in another function, which is used by GHCi to implement+-- :set args and :set prog.  It might be worthwhile to extend this+-- little language in the future.+data EvalExpr a+  = EvalThis a+  | EvalApp (EvalExpr a) (EvalExpr a)+  deriving (Generic, Show)++instance Binary a => Binary (EvalExpr a)++type EvalStatus a = EvalStatus_ a a++data EvalStatus_ a b+  = EvalComplete Word64 (EvalResult a)+  | EvalBreak Bool+       HValueRef{- AP_STACK -}+       Int {- break index -}+       Int {- uniq of ModuleName -}+       (RemoteRef (ResumeContext b))+       (RemotePtr CostCentreStack) -- Cost centre stack+  deriving (Generic, Show)++instance Binary a => Binary (EvalStatus_ a b)++data EvalResult a+  = EvalException SerializableException+  | EvalSuccess a+  deriving (Generic, Show)++instance Binary a => Binary (EvalResult a)++-- SomeException can't be serialized because it contains dynamic+-- types.  However, we do very limited things with the exceptions that+-- are thrown by interpreted computations:+--+-- * We print them, e.g. "*** Exception: <something>"+-- * UserInterrupt has a special meaning+-- * In ghc -e, exitWith should exit with the appropriate exit code+--+-- So all we need to do is distinguish UserInterrupt and ExitCode, and+-- all other exceptions can be represented by their 'show' string.+--+data SerializableException+  = EUserInterrupt+  | EExitCode ExitCode+  | EOtherException String+  deriving (Generic, Show)++toSerializableException :: SomeException -> SerializableException+toSerializableException ex+  | Just UserInterrupt <- fromException ex  = EUserInterrupt+  | Just (ec::ExitCode) <- fromException ex = (EExitCode ec)+  | otherwise = EOtherException (show (ex :: SomeException))++fromSerializableException :: SerializableException -> SomeException+fromSerializableException EUserInterrupt = toException UserInterrupt+fromSerializableException (EExitCode c) = toException c+fromSerializableException (EOtherException str) = toException (ErrorCall str)++instance Binary ExitCode+instance Binary SerializableException++data THResult a+  = THException String+  | THComplete a+  deriving (Generic, Show)++instance Binary a => Binary (THResult a)++data THResultType = THExp | THPat | THType | THDec | THAnnWrapper+  deriving (Enum, Show, Generic)++instance Binary THResultType++-- | The server-side Template Haskell state.  This is created by the+-- StartTH message.  A new one is created per module that GHC+-- typechecks.+data QState = QState+  { qsMap        :: Map TypeRep Dynamic+       -- ^ persistent data between splices in a module+  , qsLocation   :: Maybe TH.Loc+       -- ^ location for current splice, if any+  , qsPipe :: Pipe+       -- ^ pipe to communicate with GHC+  }+instance Show QState where show _ = "<QState>"++-- Orphan instances of Binary for Ptr / FunPtr by conversion to Word64.+-- This is to support Binary StgInfoTable which includes these.+instance Binary (Ptr a) where+  put p = put (fromIntegral (ptrToWordPtr p) :: Word64)+  get = (wordPtrToPtr . fromIntegral) <$> (get :: Get Word64)++instance Binary (FunPtr a) where+  put = put . castFunPtrToPtr+  get = castPtrToFunPtr <$> get++-- Binary instances to support the GetClosure message+instance Binary StgInfoTable+instance Binary ClosureType+instance Binary PrimType+instance Binary a => Binary (GenClosure a)++data Msg = forall a . (Binary a, Show a) => Msg (Message a)++getMessage :: Get Msg+getMessage = do+    b <- getWord8+    case b of+      0  -> Msg <$> return Shutdown+      1  -> Msg <$> return InitLinker+      2  -> Msg <$> LookupSymbol <$> get+      3  -> Msg <$> LookupClosure <$> get+      4  -> Msg <$> LoadDLL <$> get+      5  -> Msg <$> LoadArchive <$> get+      6  -> Msg <$> LoadObj <$> get+      7  -> Msg <$> UnloadObj <$> get+      8  -> Msg <$> AddLibrarySearchPath <$> get+      9  -> Msg <$> RemoveLibrarySearchPath <$> get+      10 -> Msg <$> return ResolveObjs+      11 -> Msg <$> FindSystemLibrary <$> get+      12 -> Msg <$> CreateBCOs <$> get+      13 -> Msg <$> FreeHValueRefs <$> get+      14 -> Msg <$> MallocData <$> get+      15 -> Msg <$> MallocStrings <$> get+      16 -> Msg <$> (PrepFFI <$> get <*> get <*> get)+      17 -> Msg <$> FreeFFI <$> get+      18 -> Msg <$> (MkConInfoTable <$> get <*> get <*> get <*> get <*> get)+      19 -> Msg <$> (EvalStmt <$> get <*> get)+      20 -> Msg <$> (ResumeStmt <$> get <*> get)+      21 -> Msg <$> (AbandonStmt <$> get)+      22 -> Msg <$> (EvalString <$> get)+      23 -> Msg <$> (EvalStringToString <$> get <*> get)+      24 -> Msg <$> (EvalIO <$> get)+      25 -> Msg <$> (MkCostCentres <$> get <*> get)+      26 -> Msg <$> (CostCentreStackInfo <$> get)+      27 -> Msg <$> (NewBreakArray <$> get)+      28 -> Msg <$> (EnableBreakpoint <$> get <*> get <*> get)+      29 -> Msg <$> (BreakpointStatus <$> get <*> get)+      30 -> Msg <$> (GetBreakpointVar <$> get <*> get)+      31 -> Msg <$> return StartTH+      32 -> Msg <$> (RunModFinalizers <$> get <*> get)+      33 -> Msg <$> (AddSptEntry <$> get <*> get)+      34 -> Msg <$> (RunTH <$> get <*> get <*> get <*> get)+      35 -> Msg <$> (GetClosure <$> get)+      36 -> Msg <$> (Seq <$> get)+      37 -> Msg <$> return RtsRevertCAFs+      _  -> error $ "Unknown Message code " ++ (show b)++putMessage :: Message a -> Put+putMessage m = case m of+  Shutdown                    -> putWord8 0+  InitLinker                  -> putWord8 1+  LookupSymbol str            -> putWord8 2  >> put str+  LookupClosure str           -> putWord8 3  >> put str+  LoadDLL str                 -> putWord8 4  >> put str+  LoadArchive str             -> putWord8 5  >> put str+  LoadObj str                 -> putWord8 6  >> put str+  UnloadObj str               -> putWord8 7  >> put str+  AddLibrarySearchPath str    -> putWord8 8  >> put str+  RemoveLibrarySearchPath ptr -> putWord8 9  >> put ptr+  ResolveObjs                 -> putWord8 10+  FindSystemLibrary str       -> putWord8 11 >> put str+  CreateBCOs bco              -> putWord8 12 >> put bco+  FreeHValueRefs val          -> putWord8 13 >> put val+  MallocData bs               -> putWord8 14 >> put bs+  MallocStrings bss           -> putWord8 15 >> put bss+  PrepFFI conv args res       -> putWord8 16 >> put conv >> put args >> put res+  FreeFFI p                   -> putWord8 17 >> put p+  MkConInfoTable p n t pt d   -> putWord8 18 >> put p >> put n >> put t >> put pt >> put d+  EvalStmt opts val           -> putWord8 19 >> put opts >> put val+  ResumeStmt opts val         -> putWord8 20 >> put opts >> put val+  AbandonStmt val             -> putWord8 21 >> put val+  EvalString val              -> putWord8 22 >> put val+  EvalStringToString str val  -> putWord8 23 >> put str >> put val+  EvalIO val                  -> putWord8 24 >> put val+  MkCostCentres mod ccs       -> putWord8 25 >> put mod >> put ccs+  CostCentreStackInfo ptr     -> putWord8 26 >> put ptr+  NewBreakArray sz            -> putWord8 27 >> put sz+  EnableBreakpoint arr ix b   -> putWord8 28 >> put arr >> put ix >> put b+  BreakpointStatus arr ix     -> putWord8 29 >> put arr >> put ix+  GetBreakpointVar a b        -> putWord8 30 >> put a >> put b+  StartTH                     -> putWord8 31+  RunModFinalizers a b        -> putWord8 32 >> put a >> put b+  AddSptEntry a b             -> putWord8 33 >> put a >> put b+  RunTH st q loc ty           -> putWord8 34 >> put st >> put q >> put loc >> put ty+  GetClosure a                -> putWord8 35 >> put a+  Seq a                       -> putWord8 36 >> put a+  RtsRevertCAFs               -> putWord8 37++-- -----------------------------------------------------------------------------+-- Reading/writing messages++data Pipe = Pipe+  { pipeRead :: Handle+  , pipeWrite ::  Handle+  , pipeLeftovers :: IORef (Maybe ByteString)+  }++remoteCall :: Binary a => Pipe -> Message a -> IO a+remoteCall pipe msg = do+  writePipe pipe (putMessage msg)+  readPipe pipe get++remoteTHCall :: Binary a => Pipe -> THMessage a -> IO a+remoteTHCall pipe msg = do+  writePipe pipe (putTHMessage msg)+  readPipe pipe get++writePipe :: Pipe -> Put -> IO ()+writePipe Pipe{..} put+  | LB.null bs = return ()+  | otherwise  = do+    LB.hPut pipeWrite bs+    hFlush pipeWrite+ where+  bs = runPut put++readPipe :: Pipe -> Get a -> IO a+readPipe Pipe{..} get = do+  leftovers <- readIORef pipeLeftovers+  m <- getBin pipeRead get leftovers+  case m of+    Nothing -> throw $+      mkIOError eofErrorType "GHCi.Message.remoteCall" (Just pipeRead) Nothing+    Just (result, new_leftovers) -> do+      writeIORef pipeLeftovers new_leftovers+      return result++getBin+  :: Handle -> Get a -> Maybe ByteString+  -> IO (Maybe (a, Maybe ByteString))++getBin h get leftover = go leftover (runGetIncremental get)+ where+   go Nothing (Done leftover _ msg) =+     return (Just (msg, if B.null leftover then Nothing else Just leftover))+   go _ Done{} = throwIO (ErrorCall "getBin: Done with leftovers")+   go (Just leftover) (Partial fun) = do+     go Nothing (fun (Just leftover))+   go Nothing (Partial fun) = do+     -- putStrLn "before hGetSome"+     b <- B.hGetSome h (32*1024)+     -- printf "hGetSome: %d\n" (B.length b)+     if B.null b+        then return Nothing+        else go Nothing (fun (Just b))+   go _lft (Fail _rest _off str) =+     throwIO (ErrorCall ("getBin: " ++ str))
+ libraries/ghci/GHCi/RemoteTypes.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE CPP, StandaloneDeriving, GeneralizedNewtypeDeriving #-}++-- |+-- Types for referring to remote objects in Remote GHCi.  For more+-- details, see Note [External GHCi pointers] in compiler/ghci/GHCi.hs+--+-- For details on Remote GHCi, see Note [Remote GHCi] in+-- compiler/ghci/GHCi.hs.+--+module GHCi.RemoteTypes+  ( RemotePtr(..), toRemotePtr, fromRemotePtr, castRemotePtr+  , HValue(..)+  , RemoteRef, mkRemoteRef, localRef, freeRemoteRef+  , HValueRef, toHValueRef+  , ForeignRef, mkForeignRef, withForeignRef+  , ForeignHValue+  , unsafeForeignRefToRemoteRef, finalizeForeignRef+  ) where++import Prelude -- See note [Why do we import Prelude here?]+import Control.DeepSeq+import Data.Word+import Foreign hiding (newForeignPtr)+import Foreign.Concurrent+import Data.Binary+import Unsafe.Coerce+import GHC.Exts+import GHC.ForeignPtr++-- -----------------------------------------------------------------------------+-- RemotePtr++-- Static pointers only; don't use this for heap-resident pointers.+-- Instead use HValueRef. We will fix the remote pointer to be 64 bits. This+-- should cover 64 and 32bit systems, and permits the exchange of remote ptrs+-- between machines of different word size. For exmaple, when connecting to+-- an iserv instance on a different architecture with different word size via+-- -fexternal-interpreter.+newtype RemotePtr a = RemotePtr Word64++toRemotePtr :: Ptr a -> RemotePtr a+toRemotePtr p = RemotePtr (fromIntegral (ptrToWordPtr p))++fromRemotePtr :: RemotePtr a -> Ptr a+fromRemotePtr (RemotePtr p) = wordPtrToPtr (fromIntegral p)++castRemotePtr :: RemotePtr a -> RemotePtr b+castRemotePtr (RemotePtr a) = RemotePtr a++deriving instance Show (RemotePtr a)+deriving instance Binary (RemotePtr a)+deriving instance NFData (RemotePtr a)++-- -----------------------------------------------------------------------------+-- HValueRef++newtype HValue = HValue Any++instance Show HValue where+  show _ = "<HValue>"++-- | A reference to a remote value.  These are allocated and freed explicitly.+newtype RemoteRef a = RemoteRef (RemotePtr ())+  deriving (Show, Binary)++-- We can discard type information if we want+toHValueRef :: RemoteRef a -> RemoteRef HValue+toHValueRef = unsafeCoerce++-- For convenience+type HValueRef = RemoteRef HValue++-- | Make a reference to a local value that we can send remotely.+-- This reference will keep the value that it refers to alive until+-- 'freeRemoteRef' is called.+mkRemoteRef :: a -> IO (RemoteRef a)+mkRemoteRef a = do+  sp <- newStablePtr a+  return $! RemoteRef (toRemotePtr (castStablePtrToPtr sp))++-- | Convert an HValueRef to an HValue.  Should only be used if the HValue+-- originated in this process.+localRef :: RemoteRef a -> IO a+localRef (RemoteRef w) =+  deRefStablePtr (castPtrToStablePtr (fromRemotePtr w))++-- | Release an HValueRef that originated in this process+freeRemoteRef :: RemoteRef a -> IO ()+freeRemoteRef (RemoteRef w) =+  freeStablePtr (castPtrToStablePtr (fromRemotePtr w))++-- | An HValueRef with a finalizer+newtype ForeignRef a = ForeignRef (ForeignPtr ())++instance NFData (ForeignRef a) where+  rnf x = x `seq` ()++type ForeignHValue = ForeignRef HValue++-- | Create a 'ForeignRef' from a 'RemoteRef'.  The finalizer+-- should arrange to call 'freeHValueRef' on the 'HValueRef'.  (since+-- this function needs to be called in the process that created the+-- 'HValueRef', it cannot be called directly from the finalizer).+mkForeignRef :: RemoteRef a -> IO () -> IO (ForeignRef a)+mkForeignRef (RemoteRef hvref) finalizer =+  ForeignRef <$> newForeignPtr (fromRemotePtr hvref) finalizer++-- | Use a 'ForeignHValue'+withForeignRef :: ForeignRef a -> (RemoteRef a -> IO b) -> IO b+withForeignRef (ForeignRef fp) f =+   withForeignPtr fp (f . RemoteRef . toRemotePtr)++unsafeForeignRefToRemoteRef :: ForeignRef a -> RemoteRef a+unsafeForeignRefToRemoteRef (ForeignRef fp) =+  RemoteRef (toRemotePtr (unsafeForeignPtrToPtr fp))++finalizeForeignRef :: ForeignRef a -> IO ()+finalizeForeignRef (ForeignRef fp) = finalizeForeignPtr fp
+ libraries/ghci/GHCi/TH/Binary.hs view
@@ -0,0 +1,82 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GADTs #-}++-- This module is full of orphans, unfortunately+module GHCi.TH.Binary () where++import Prelude -- See note [Why do we import Prelude here?]+import Data.Binary+import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as B+import GHC.Serialized+import qualified Language.Haskell.TH        as TH+import qualified Language.Haskell.TH.Syntax as TH+-- Put these in a separate module because they take ages to compile++instance Binary TH.Loc+instance Binary TH.Name+instance Binary TH.ModName+instance Binary TH.NameFlavour+instance Binary TH.PkgName+instance Binary TH.NameSpace+instance Binary TH.Module+instance Binary TH.Info+instance Binary TH.Type+instance Binary TH.TyLit+instance Binary TH.TyVarBndr+instance Binary TH.Role+instance Binary TH.Lit+instance Binary TH.Range+instance Binary TH.Stmt+instance Binary TH.Pat+instance Binary TH.Exp+instance Binary TH.Dec+instance Binary TH.Overlap+instance Binary TH.DerivClause+instance Binary TH.DerivStrategy+instance Binary TH.Guard+instance Binary TH.Body+instance Binary TH.Match+instance Binary TH.Fixity+instance Binary TH.TySynEqn+instance Binary TH.FunDep+instance Binary TH.AnnTarget+instance Binary TH.RuleBndr+instance Binary TH.Phases+instance Binary TH.RuleMatch+instance Binary TH.Inline+instance Binary TH.Pragma+instance Binary TH.Safety+instance Binary TH.Callconv+instance Binary TH.Foreign+instance Binary TH.Bang+instance Binary TH.SourceUnpackedness+instance Binary TH.SourceStrictness+instance Binary TH.DecidedStrictness+instance Binary TH.FixityDirection+instance Binary TH.OccName+instance Binary TH.Con+instance Binary TH.AnnLookup+instance Binary TH.ModuleInfo+instance Binary TH.Clause+instance Binary TH.InjectivityAnn+instance Binary TH.FamilyResultSig+instance Binary TH.TypeFamilyHead+instance Binary TH.PatSynDir+instance Binary TH.PatSynArgs++-- We need Binary TypeRep for serializing annotations++instance Binary Serialized where+    put (Serialized tyrep wds) = put tyrep >> put (B.pack wds)+    get = Serialized <$> get <*> (B.unpack <$> get)++instance Binary TH.Bytes where+   put (TH.Bytes ptr off sz) = put bs+      where bs = B.PS ptr (fromIntegral off) (fromIntegral sz)+   get = do+      B.PS ptr off sz <- get+      return (TH.Bytes ptr (fromIntegral off) (fromIntegral sz))
+ libraries/ghci/SizedSeq.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE StandaloneDeriving, DeriveGeneric #-}+module SizedSeq+  ( SizedSeq(..)+  , emptySS+  , addToSS+  , addListToSS+  , ssElts+  , sizeSS+  ) where++import Prelude -- See note [Why do we import Prelude here?]+import Control.DeepSeq+import Data.Binary+import Data.List+import GHC.Generics++data SizedSeq a = SizedSeq {-# UNPACK #-} !Word [a]+  deriving (Generic, Show)++instance Functor SizedSeq where+  fmap f (SizedSeq sz l) = SizedSeq sz (fmap f l)++instance Foldable SizedSeq where+  foldr f c ss = foldr f c (ssElts ss)++instance Traversable SizedSeq where+  traverse f (SizedSeq sz l) = SizedSeq sz . reverse <$> traverse f (reverse l)++instance Binary a => Binary (SizedSeq a)++instance NFData a => NFData (SizedSeq a) where+  rnf (SizedSeq _ xs) = rnf xs++emptySS :: SizedSeq a+emptySS = SizedSeq 0 []++addToSS :: SizedSeq a -> a -> SizedSeq a+addToSS (SizedSeq n r_xs) x = SizedSeq (n+1) (x:r_xs)++addListToSS :: SizedSeq a -> [a] -> SizedSeq a+addListToSS (SizedSeq n r_xs) xs+  = SizedSeq (n + genericLength xs) (reverse xs ++ r_xs)++ssElts :: SizedSeq a -> [a]+ssElts (SizedSeq _ r_xs) = reverse r_xs++sizeSS :: SizedSeq a -> Word+sizeSS (SizedSeq n _) = n
+ libraries/template-haskell/Language/Haskell/TH.hs view
@@ -0,0 +1,97 @@+{- | The public face of Template Haskell++For other documentation, refer to:+<http://www.haskell.org/haskellwiki/Template_Haskell>++-}+module Language.Haskell.TH(+        -- * The monad and its operations+        Q,+        runQ,+        -- ** Administration: errors, locations and IO+        reportError,              -- :: String -> Q ()+        reportWarning,            -- :: String -> Q ()+        report,                   -- :: Bool -> String -> Q ()+        recover,          -- :: Q a -> Q a -> Q a+        location,         -- :: Q Loc+        Loc(..),+        runIO,            -- :: IO a -> Q a+        -- ** Querying the compiler+        -- *** Reify+        reify,            -- :: Name -> Q Info+        reifyModule,+        Info(..), ModuleInfo(..),+        InstanceDec,+        ParentName,+        SumAlt, SumArity,+        Arity,+        Unlifted,+        -- *** Language extension lookup+        Extension(..),+        extsEnabled, isExtEnabled,+        -- *** Name lookup+        lookupTypeName,  -- :: String -> Q (Maybe Name)+        lookupValueName, -- :: String -> Q (Maybe Name)+        -- *** Fixity lookup+        reifyFixity,+        -- *** Instance lookup+        reifyInstances,+        isInstance,+        -- *** Roles lookup+        reifyRoles,+        -- *** Annotation lookup+        reifyAnnotations, AnnLookup(..),+        -- *** Constructor strictness lookup+        reifyConStrictness,++        -- * Typed expressions+        TExp, unType,++        -- * Names+        Name, NameSpace,        -- Abstract+        -- ** Constructing names+        mkName,         -- :: String -> Name+        newName,        -- :: String -> Q Name+        -- ** Deconstructing names+        nameBase,       -- :: Name -> String+        nameModule,     -- :: Name -> Maybe String+        namePackage,    -- :: Name -> Maybe String+        nameSpace,      -- :: Name -> Maybe NameSpace+        -- ** Built-in names+        tupleTypeName, tupleDataName,   -- Int -> Name+        unboxedTupleTypeName, unboxedTupleDataName, -- :: Int -> Name+        unboxedSumTypeName, -- :: SumArity -> Name+        unboxedSumDataName, -- :: SumAlt -> SumArity -> Name++    -- * The algebraic data types+    -- | The lowercase versions (/syntax operators/) of these constructors are+    -- preferred to these constructors, since they compose better with+    -- quotations (@[| |]@) and splices (@$( ... )@)++    -- ** Declarations+        Dec(..), Con(..), Clause(..),+        SourceUnpackedness(..), SourceStrictness(..), DecidedStrictness(..),+        Bang(..), Strict, Foreign(..), Callconv(..), Safety(..), Pragma(..),+        Inline(..), RuleMatch(..), Phases(..), RuleBndr(..), AnnTarget(..),+        FunDep(..), TySynEqn(..), TypeFamilyHead(..),+        Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,+        PatSynDir(..), PatSynArgs(..),+    -- ** Expressions+        Exp(..), Match(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..),+    -- ** Patterns+        Pat(..), FieldExp, FieldPat,+    -- ** Types+        Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred, Syntax.Role(..),+        FamilyResultSig(..), Syntax.InjectivityAnn(..), PatSynType,++    -- * Library functions+    module Language.Haskell.TH.Lib,++    -- * Pretty-printer+    Ppr(..), pprint, pprExp, pprLit, pprPat, pprParendType++   ) where++import Language.Haskell.TH.Syntax as Syntax+import Language.Haskell.TH.Lib+import Language.Haskell.TH.Ppr
+ libraries/template-haskell/Language/Haskell/TH/LanguageExtensions.hs view
@@ -0,0 +1,22 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Language.Haskell.TH.LanguageExtensions+-- Copyright   :  (c) The University of Glasgow 2015+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- Language extensions known to GHC+--+-----------------------------------------------------------------------------++module Language.Haskell.TH.LanguageExtensions+   ( Extension(..)+   ) where++-- This module exists primarily to avoid inserting a massive list of language+-- extensions into the already quite large Haddocks for Language.Haskell.TH++import GHC.LanguageExtensions.Type (Extension(..))
+ libraries/template-haskell/Language/Haskell/TH/Lib.hs view
@@ -0,0 +1,321 @@+-- |+-- Language.Haskell.TH.Lib contains lots of useful helper functions for+-- generating and manipulating Template Haskell terms++-- Note: this module mostly re-exports functions from+-- Language.Haskell.TH.Lib.Internal, but if a change occurs to Template+-- Haskell which requires breaking the API offered in this module, we opt to+-- copy the old definition here, and make the changes in+-- Language.Haskell.TH.Lib.Internal. This way, we can retain backwards+-- compatibility while still allowing GHC to make changes as it needs.++module Language.Haskell.TH.Lib (+    -- All of the exports from this module should+    -- be "public" functions.  The main module TH+    -- re-exports them all.++    -- * Library functions+    -- ** Abbreviations+        InfoQ, ExpQ, TExpQ, DecQ, DecsQ, ConQ, TypeQ, KindQ, TyVarBndrQ,+        TyLitQ, CxtQ, PredQ, DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ,+        StmtQ, RangeQ, SourceStrictnessQ, SourceUnpackednessQ, BangQ,+        BangTypeQ, VarBangTypeQ, StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ,+        FieldPatQ, RuleBndrQ, TySynEqnQ, PatSynDirQ, PatSynArgsQ,+        FamilyResultSigQ, DerivStrategyQ,++    -- ** Constructors lifted to 'Q'+    -- *** Literals+        intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL,+        charL, stringL, stringPrimL, charPrimL, bytesPrimL, mkBytes,+    -- *** Patterns+        litP, varP, tupP, unboxedTupP, unboxedSumP, conP, uInfixP, parensP,+        infixP, tildeP, bangP, asP, wildP, recP,+        listP, sigP, viewP,+        fieldPat,++    -- *** Pattern Guards+        normalB, guardedB, normalG, normalGE, patG, patGE, match, clause,++    -- *** Expressions+        dyn, varE, unboundVarE, labelE, implicitParamVarE, conE, litE, staticE,+        appE, appTypeE, uInfixE, parensE, infixE, infixApp, sectionL, sectionR,+        lamE, lam1E, lamCaseE, tupE, unboxedTupE, unboxedSumE, condE, multiIfE,+        letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE, fieldExp,+    -- **** Ranges+    fromE, fromThenE, fromToE, fromThenToE,++    -- ***** Ranges with more indirection+    arithSeqE,+    fromR, fromThenR, fromToR, fromThenToR,+    -- **** Statements+    doE, mdoE, compE,+    bindS, letS, noBindS, parS, recS,++    -- *** Types+        forallT, forallVisT, varT, conT, appT, appKindT, arrowT, infixT,+        uInfixT, parensT, equalityT, listT, tupleT, unboxedTupleT, unboxedSumT,+        sigT, litT, wildCardT, promotedT, promotedTupleT, promotedNilT,+        promotedConsT, implicitParamT,+    -- **** Type literals+    numTyLit, strTyLit,+    -- **** Strictness+    noSourceUnpackedness, sourceNoUnpack, sourceUnpack,+    noSourceStrictness, sourceLazy, sourceStrict,+    isStrict, notStrict, unpacked,+    bang, bangType, varBangType, strictType, varStrictType,+    -- **** Class Contexts+    cxt, classP, equalP,+    -- **** Constructors+    normalC, recC, infixC, forallC, gadtC, recGadtC,++    -- *** Kinds+    varK, conK, tupleK, arrowK, listK, appK, starK, constraintK,++    -- *** Type variable binders+    plainTV, kindedTV,++    -- *** Roles+    nominalR, representationalR, phantomR, inferR,++    -- *** Top Level Declarations+    -- **** Data+    valD, funD, tySynD, dataD, newtypeD,+    derivClause, DerivClause(..),+    stockStrategy, anyclassStrategy, newtypeStrategy,+    viaStrategy, DerivStrategy(..),+    -- **** Class+    classD, instanceD, instanceWithOverlapD, Overlap(..),+    sigD, standaloneDerivD, standaloneDerivWithStrategyD, defaultSigD,++    -- **** Role annotations+    roleAnnotD,+    -- **** Type Family / Data Family+    dataFamilyD, openTypeFamilyD, closedTypeFamilyD, dataInstD,+    newtypeInstD, tySynInstD,+    tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig,++    -- **** Fixity+    infixLD, infixRD, infixND,++    -- **** Foreign Function Interface (FFI)+    cCall, stdCall, cApi, prim, javaScript,+    unsafe, safe, interruptible, forImpD,++    -- **** Functional dependencies+    funDep,++    -- **** Pragmas+    ruleVar, typedRuleVar,+    valueAnnotation, typeAnnotation, moduleAnnotation,+    pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD, pragAnnD,+    pragLineD, pragCompleteD,++    -- **** Pattern Synonyms+    patSynD, patSynSigD, unidir, implBidir, explBidir, prefixPatSyn,+    infixPatSyn, recordPatSyn,++    -- **** Implicit Parameters+    implicitParamBindD,++    -- ** Reify+    thisModule++   ) where++import Language.Haskell.TH.Lib.Internal hiding+  ( tySynD+  , dataD+  , newtypeD+  , classD+  , pragRuleD+  , dataInstD+  , newtypeInstD+  , dataFamilyD+  , openTypeFamilyD+  , closedTypeFamilyD+  , tySynEqn+  , forallC++  , forallT+  , sigT++  , plainTV+  , kindedTV+  , starK+  , constraintK++  , noSig+  , kindSig+  , tyVarSig++  , derivClause+  , standaloneDerivWithStrategyD++  , Role+  , InjectivityAnn+  )+import Language.Haskell.TH.Syntax++import Control.Monad (liftM2)+import Foreign.ForeignPtr+import Data.Word+import Prelude++-- All definitions below represent the "old" API, since their definitions are+-- different in Language.Haskell.TH.Lib.Internal. Please think carefully before+-- deciding to change the APIs of the functions below, as they represent the+-- public API (as opposed to the Internal module, which has no API promises.)++-------------------------------------------------------------------------------+-- *   Dec++tySynD :: Name -> [TyVarBndr] -> TypeQ -> DecQ+tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) }++dataD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]+      -> DecQ+dataD ctxt tc tvs ksig cons derivs =+  do+    ctxt1 <- ctxt+    cons1 <- sequence cons+    derivs1 <- sequence derivs+    return (DataD ctxt1 tc tvs ksig cons1 derivs1)++newtypeD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> ConQ -> [DerivClauseQ]+         -> DecQ+newtypeD ctxt tc tvs ksig con derivs =+  do+    ctxt1 <- ctxt+    con1 <- con+    derivs1 <- sequence derivs+    return (NewtypeD ctxt1 tc tvs ksig con1 derivs1)++classD :: CxtQ -> Name -> [TyVarBndr] -> [FunDep] -> [DecQ] -> DecQ+classD ctxt cls tvs fds decs =+  do+    decs1 <- sequence decs+    ctxt1 <- ctxt+    return $ ClassD ctxt1 cls tvs fds decs1++pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ+pragRuleD n bndrs lhs rhs phases+  = do+      bndrs1 <- sequence bndrs+      lhs1   <- lhs+      rhs1   <- rhs+      return $ PragmaD $ RuleP n Nothing bndrs1 lhs1 rhs1 phases++dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]+          -> DecQ+dataInstD ctxt tc tys ksig cons derivs =+  do+    ctxt1 <- ctxt+    ty1 <- foldl appT (conT tc) tys+    cons1 <- sequence cons+    derivs1 <- sequence derivs+    return (DataInstD ctxt1 Nothing ty1 ksig cons1 derivs1)++newtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> ConQ -> [DerivClauseQ]+             -> DecQ+newtypeInstD ctxt tc tys ksig con derivs =+  do+    ctxt1 <- ctxt+    ty1 <- foldl appT (conT tc) tys+    con1  <- con+    derivs1 <- sequence derivs+    return (NewtypeInstD ctxt1 Nothing ty1 ksig con1 derivs1)++dataFamilyD :: Name -> [TyVarBndr] -> Maybe Kind -> DecQ+dataFamilyD tc tvs kind+    = return $ DataFamilyD tc tvs kind++openTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig+                -> Maybe InjectivityAnn -> DecQ+openTypeFamilyD tc tvs res inj+    = return $ OpenTypeFamilyD (TypeFamilyHead tc tvs res inj)++closedTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig+                  -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ+closedTypeFamilyD tc tvs result injectivity eqns =+  do eqns1 <- sequence eqns+     return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1)++tySynEqn :: (Maybe [TyVarBndr]) -> TypeQ -> TypeQ -> TySynEqnQ+tySynEqn tvs lhs rhs =+  do+    lhs1 <- lhs+    rhs1 <- rhs+    return (TySynEqn tvs lhs1 rhs1)++forallC :: [TyVarBndr] -> CxtQ -> ConQ -> ConQ+forallC ns ctxt con = liftM2 (ForallC ns) ctxt con++-------------------------------------------------------------------------------+-- *   Type++forallT :: [TyVarBndr] -> CxtQ -> TypeQ -> TypeQ+forallT tvars ctxt ty = do+    ctxt1 <- ctxt+    ty1   <- ty+    return $ ForallT tvars ctxt1 ty1++sigT :: TypeQ -> Kind -> TypeQ+sigT t k+  = do+      t' <- t+      return $ SigT t' k++-------------------------------------------------------------------------------+-- *   Kind++plainTV :: Name -> TyVarBndr+plainTV = PlainTV++kindedTV :: Name -> Kind -> TyVarBndr+kindedTV = KindedTV++starK :: Kind+starK = StarT++constraintK :: Kind+constraintK = ConstraintT++-------------------------------------------------------------------------------+-- *   Type family result++noSig :: FamilyResultSig+noSig = NoSig++kindSig :: Kind -> FamilyResultSig+kindSig = KindSig++tyVarSig :: TyVarBndr -> FamilyResultSig+tyVarSig = TyVarSig++-------------------------------------------------------------------------------+-- * Top Level Declarations++derivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ+derivClause mds p = do+  p' <- cxt p+  return $ DerivClause mds p'++standaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ+standaloneDerivWithStrategyD mds ctxt ty = do+  ctxt' <- ctxt+  ty'   <- ty+  return $ StandaloneDerivD mds ctxt' ty'++-------------------------------------------------------------------------------+-- * Bytes literals++-- | Create a Bytes datatype representing raw bytes to be embedded into the+-- program/library binary.+--+-- @since 2.16.0.0+mkBytes+   :: ForeignPtr Word8 -- ^ Pointer to the data+   -> Word             -- ^ Offset from the pointer+   -> Word             -- ^ Number of bytes+   -> Bytes+mkBytes = Bytes
+ libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs view
@@ -0,0 +1,943 @@+-- |+-- Language.Haskell.TH.Lib.Internal exposes some additional functionality that+-- is used internally in GHC's integration with Template Haskell. This is not a+-- part of the public API, and as such, there are no API guarantees for this+-- module from version to version.++-- Why do we have both Language.Haskell.TH.Lib.Internal and+-- Language.Haskell.TH.Lib? Ultimately, it's because the functions in the+-- former (which are tailored for GHC's use) need different type signatures+-- than the ones in the latter. Syncing up the Internal type signatures would+-- involve a massive amount of breaking changes, so for the time being, we+-- relegate as many changes as we can to just the Internal module, where it+-- is safe to break things.++module Language.Haskell.TH.Lib.Internal where++import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn)+import qualified Language.Haskell.TH.Syntax as TH+import Control.Monad( liftM, liftM2 )+import Data.Word( Word8 )+import Prelude++----------------------------------------------------------+-- * Type synonyms+----------------------------------------------------------++type InfoQ               = Q Info+type PatQ                = Q Pat+type FieldPatQ           = Q FieldPat+type ExpQ                = Q Exp+type TExpQ a             = Q (TExp a)+type DecQ                = Q Dec+type DecsQ               = Q [Dec]+type ConQ                = Q Con+type TypeQ               = Q Type+type KindQ               = Q Kind+type TyVarBndrQ          = Q TyVarBndr+type TyLitQ              = Q TyLit+type CxtQ                = Q Cxt+type PredQ               = Q Pred+type DerivClauseQ        = Q DerivClause+type MatchQ              = Q Match+type ClauseQ             = Q Clause+type BodyQ               = Q Body+type GuardQ              = Q Guard+type StmtQ               = Q Stmt+type RangeQ              = Q Range+type SourceStrictnessQ   = Q SourceStrictness+type SourceUnpackednessQ = Q SourceUnpackedness+type BangQ               = Q Bang+type BangTypeQ           = Q BangType+type VarBangTypeQ        = Q VarBangType+type StrictTypeQ         = Q StrictType+type VarStrictTypeQ      = Q VarStrictType+type FieldExpQ           = Q FieldExp+type RuleBndrQ           = Q RuleBndr+type TySynEqnQ           = Q TySynEqn+type PatSynDirQ          = Q PatSynDir+type PatSynArgsQ         = Q PatSynArgs+type FamilyResultSigQ    = Q FamilyResultSig+type DerivStrategyQ      = Q DerivStrategy++-- must be defined here for DsMeta to find it+type Role                = TH.Role+type InjectivityAnn      = TH.InjectivityAnn++----------------------------------------------------------+-- * Lowercase pattern syntax functions+----------------------------------------------------------++intPrimL    :: Integer -> Lit+intPrimL    = IntPrimL+wordPrimL    :: Integer -> Lit+wordPrimL    = WordPrimL+floatPrimL  :: Rational -> Lit+floatPrimL  = FloatPrimL+doublePrimL :: Rational -> Lit+doublePrimL = DoublePrimL+integerL    :: Integer -> Lit+integerL    = IntegerL+charL       :: Char -> Lit+charL       = CharL+charPrimL   :: Char -> Lit+charPrimL   = CharPrimL+stringL     :: String -> Lit+stringL     = StringL+stringPrimL :: [Word8] -> Lit+stringPrimL = StringPrimL+bytesPrimL :: Bytes -> Lit+bytesPrimL = BytesPrimL+rationalL   :: Rational -> Lit+rationalL   = RationalL++litP :: Lit -> PatQ+litP l = return (LitP l)++varP :: Name -> PatQ+varP v = return (VarP v)++tupP :: [PatQ] -> PatQ+tupP ps = do { ps1 <- sequence ps; return (TupP ps1)}++unboxedTupP :: [PatQ] -> PatQ+unboxedTupP ps = do { ps1 <- sequence ps; return (UnboxedTupP ps1)}++unboxedSumP :: PatQ -> SumAlt -> SumArity -> PatQ+unboxedSumP p alt arity = do { p1 <- p; return (UnboxedSumP p1 alt arity) }++conP :: Name -> [PatQ] -> PatQ+conP n ps = do ps' <- sequence ps+               return (ConP n ps')+infixP :: PatQ -> Name -> PatQ -> PatQ+infixP p1 n p2 = do p1' <- p1+                    p2' <- p2+                    return (InfixP p1' n p2')+uInfixP :: PatQ -> Name -> PatQ -> PatQ+uInfixP p1 n p2 = do p1' <- p1+                     p2' <- p2+                     return (UInfixP p1' n p2')+parensP :: PatQ -> PatQ+parensP p = do p' <- p+               return (ParensP p')++tildeP :: PatQ -> PatQ+tildeP p = do p' <- p+              return (TildeP p')+bangP :: PatQ -> PatQ+bangP p = do p' <- p+             return (BangP p')+asP :: Name -> PatQ -> PatQ+asP n p = do p' <- p+             return (AsP n p')+wildP :: PatQ+wildP = return WildP+recP :: Name -> [FieldPatQ] -> PatQ+recP n fps = do fps' <- sequence fps+                return (RecP n fps')+listP :: [PatQ] -> PatQ+listP ps = do ps' <- sequence ps+              return (ListP ps')+sigP :: PatQ -> TypeQ -> PatQ+sigP p t = do p' <- p+              t' <- t+              return (SigP p' t')+viewP :: ExpQ -> PatQ -> PatQ+viewP e p = do e' <- e+               p' <- p+               return (ViewP e' p')++fieldPat :: Name -> PatQ -> FieldPatQ+fieldPat n p = do p' <- p+                  return (n, p')+++-------------------------------------------------------------------------------+-- *   Stmt++bindS :: PatQ -> ExpQ -> StmtQ+bindS p e = liftM2 BindS p e++letS :: [DecQ] -> StmtQ+letS ds = do { ds1 <- sequence ds; return (LetS ds1) }++noBindS :: ExpQ -> StmtQ+noBindS e = do { e1 <- e; return (NoBindS e1) }++parS :: [[StmtQ]] -> StmtQ+parS sss = do { sss1 <- mapM sequence sss; return (ParS sss1) }++recS :: [StmtQ] -> StmtQ+recS ss = do { ss1 <- sequence ss; return (RecS ss1) }++-------------------------------------------------------------------------------+-- *   Range++fromR :: ExpQ -> RangeQ+fromR x = do { a <- x; return (FromR a) }++fromThenR :: ExpQ -> ExpQ -> RangeQ+fromThenR x y = do { a <- x; b <- y; return (FromThenR a b) }++fromToR :: ExpQ -> ExpQ -> RangeQ+fromToR x y = do { a <- x; b <- y; return (FromToR a b) }++fromThenToR :: ExpQ -> ExpQ -> ExpQ -> RangeQ+fromThenToR x y z = do { a <- x; b <- y; c <- z;+                         return (FromThenToR a b c) }+-------------------------------------------------------------------------------+-- *   Body++normalB :: ExpQ -> BodyQ+normalB e = do { e1 <- e; return (NormalB e1) }++guardedB :: [Q (Guard,Exp)] -> BodyQ+guardedB ges = do { ges' <- sequence ges; return (GuardedB ges') }++-------------------------------------------------------------------------------+-- *   Guard++normalG :: ExpQ -> GuardQ+normalG e = do { e1 <- e; return (NormalG e1) }++normalGE :: ExpQ -> ExpQ -> Q (Guard, Exp)+normalGE g e = do { g1 <- g; e1 <- e; return (NormalG g1, e1) }++patG :: [StmtQ] -> GuardQ+patG ss = do { ss' <- sequence ss; return (PatG ss') }++patGE :: [StmtQ] -> ExpQ -> Q (Guard, Exp)+patGE ss e = do { ss' <- sequence ss;+                  e'  <- e;+                  return (PatG ss', e') }++-------------------------------------------------------------------------------+-- *   Match and Clause++-- | Use with 'caseE'+match :: PatQ -> BodyQ -> [DecQ] -> MatchQ+match p rhs ds = do { p' <- p;+                      r' <- rhs;+                      ds' <- sequence ds;+                      return (Match p' r' ds') }++-- | Use with 'funD'+clause :: [PatQ] -> BodyQ -> [DecQ] -> ClauseQ+clause ps r ds = do { ps' <- sequence ps;+                      r' <- r;+                      ds' <- sequence ds;+                      return (Clause ps' r' ds') }+++---------------------------------------------------------------------------+-- *   Exp++-- | Dynamically binding a variable (unhygenic)+dyn :: String -> ExpQ+dyn s = return (VarE (mkName s))++varE :: Name -> ExpQ+varE s = return (VarE s)++conE :: Name -> ExpQ+conE s =  return (ConE s)++litE :: Lit -> ExpQ+litE c = return (LitE c)++appE :: ExpQ -> ExpQ -> ExpQ+appE x y = do { a <- x; b <- y; return (AppE a b)}++appTypeE :: ExpQ -> TypeQ -> ExpQ+appTypeE x t = do { a <- x; s <- t; return (AppTypeE a s) }++parensE :: ExpQ -> ExpQ+parensE x = do { x' <- x; return (ParensE x') }++uInfixE :: ExpQ -> ExpQ -> ExpQ -> ExpQ+uInfixE x s y = do { x' <- x; s' <- s; y' <- y;+                     return (UInfixE x' s' y') }++infixE :: Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ+infixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y;+                                  return (InfixE (Just a) s' (Just b))}+infixE Nothing  s (Just y) = do { s' <- s; b <- y;+                                  return (InfixE Nothing s' (Just b))}+infixE (Just x) s Nothing  = do { a <- x; s' <- s;+                                  return (InfixE (Just a) s' Nothing)}+infixE Nothing  s Nothing  = do { s' <- s; return (InfixE Nothing s' Nothing) }++infixApp :: ExpQ -> ExpQ -> ExpQ -> ExpQ+infixApp x y z = infixE (Just x) y (Just z)+sectionL :: ExpQ -> ExpQ -> ExpQ+sectionL x y = infixE (Just x) y Nothing+sectionR :: ExpQ -> ExpQ -> ExpQ+sectionR x y = infixE Nothing x (Just y)++lamE :: [PatQ] -> ExpQ -> ExpQ+lamE ps e = do ps' <- sequence ps+               e' <- e+               return (LamE ps' e')++-- | Single-arg lambda+lam1E :: PatQ -> ExpQ -> ExpQ+lam1E p e = lamE [p] e++lamCaseE :: [MatchQ] -> ExpQ+lamCaseE ms = sequence ms >>= return . LamCaseE++tupE :: [ExpQ] -> ExpQ+tupE es = do { es1 <- sequence es; return (TupE es1)}++unboxedTupE :: [ExpQ] -> ExpQ+unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE es1)}++unboxedSumE :: ExpQ -> SumAlt -> SumArity -> ExpQ+unboxedSumE e alt arity = do { e1 <- e; return (UnboxedSumE e1 alt arity) }++condE :: ExpQ -> ExpQ -> ExpQ -> ExpQ+condE x y z =  do { a <- x; b <- y; c <- z; return (CondE a b c)}++multiIfE :: [Q (Guard, Exp)] -> ExpQ+multiIfE alts = sequence alts >>= return . MultiIfE++letE :: [DecQ] -> ExpQ -> ExpQ+letE ds e = do { ds2 <- sequence ds; e2 <- e; return (LetE ds2 e2) }++caseE :: ExpQ -> [MatchQ] -> ExpQ+caseE e ms = do { e1 <- e; ms1 <- sequence ms; return (CaseE e1 ms1) }++doE :: [StmtQ] -> ExpQ+doE ss = do { ss1 <- sequence ss; return (DoE ss1) }++mdoE :: [StmtQ] -> ExpQ+mdoE ss = do { ss1 <- sequence ss; return (MDoE ss1) }++compE :: [StmtQ] -> ExpQ+compE ss = do { ss1 <- sequence ss; return (CompE ss1) }++arithSeqE :: RangeQ -> ExpQ+arithSeqE r = do { r' <- r; return (ArithSeqE r') }++listE :: [ExpQ] -> ExpQ+listE es = do { es1 <- sequence es; return (ListE es1) }++sigE :: ExpQ -> TypeQ -> ExpQ+sigE e t = do { e1 <- e; t1 <- t; return (SigE e1 t1) }++recConE :: Name -> [Q (Name,Exp)] -> ExpQ+recConE c fs = do { flds <- sequence fs; return (RecConE c flds) }++recUpdE :: ExpQ -> [Q (Name,Exp)] -> ExpQ+recUpdE e fs = do { e1 <- e; flds <- sequence fs; return (RecUpdE e1 flds) }++stringE :: String -> ExpQ+stringE = litE . stringL++fieldExp :: Name -> ExpQ -> Q (Name, Exp)+fieldExp s e = do { e' <- e; return (s,e') }++-- | @staticE x = [| static x |]@+staticE :: ExpQ -> ExpQ+staticE = fmap StaticE++unboundVarE :: Name -> ExpQ+unboundVarE s = return (UnboundVarE s)++labelE :: String -> ExpQ+labelE s = return (LabelE s)++implicitParamVarE :: String -> ExpQ+implicitParamVarE n = return (ImplicitParamVarE n)++-- ** 'arithSeqE' Shortcuts+fromE :: ExpQ -> ExpQ+fromE x = do { a <- x; return (ArithSeqE (FromR a)) }++fromThenE :: ExpQ -> ExpQ -> ExpQ+fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) }++fromToE :: ExpQ -> ExpQ -> ExpQ+fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) }++fromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ+fromThenToE x y z = do { a <- x; b <- y; c <- z;+                         return (ArithSeqE (FromThenToR a b c)) }+++-------------------------------------------------------------------------------+-- *   Dec++valD :: PatQ -> BodyQ -> [DecQ] -> DecQ+valD p b ds =+  do { p' <- p+     ; ds' <- sequence ds+     ; b' <- b+     ; return (ValD p' b' ds')+     }++funD :: Name -> [ClauseQ] -> DecQ+funD nm cs =+ do { cs1 <- sequence cs+    ; return (FunD nm cs1)+    }++tySynD :: Name -> [TyVarBndrQ] -> TypeQ -> DecQ+tySynD tc tvs rhs =+  do { tvs1 <- sequenceA tvs+     ; rhs1 <- rhs+     ; return (TySynD tc tvs1 rhs1)+     }++dataD :: CxtQ -> Name -> [TyVarBndrQ] -> Maybe KindQ -> [ConQ]+      -> [DerivClauseQ] -> DecQ+dataD ctxt tc tvs ksig cons derivs =+  do+    ctxt1   <- ctxt+    tvs1    <- sequenceA tvs+    ksig1   <- sequenceA ksig+    cons1   <- sequence cons+    derivs1 <- sequence derivs+    return (DataD ctxt1 tc tvs1 ksig1 cons1 derivs1)++newtypeD :: CxtQ -> Name -> [TyVarBndrQ] -> Maybe KindQ -> ConQ+         -> [DerivClauseQ] -> DecQ+newtypeD ctxt tc tvs ksig con derivs =+  do+    ctxt1   <- ctxt+    tvs1    <- sequenceA tvs+    ksig1   <- sequenceA ksig+    con1    <- con+    derivs1 <- sequence derivs+    return (NewtypeD ctxt1 tc tvs1 ksig1 con1 derivs1)++classD :: CxtQ -> Name -> [TyVarBndrQ] -> [FunDep] -> [DecQ] -> DecQ+classD ctxt cls tvs fds decs =+  do+    tvs1  <- sequenceA tvs+    decs1 <- sequenceA decs+    ctxt1 <- ctxt+    return $ ClassD ctxt1 cls tvs1 fds decs1++instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ+instanceD = instanceWithOverlapD Nothing++instanceWithOverlapD :: Maybe Overlap -> CxtQ -> TypeQ -> [DecQ] -> DecQ+instanceWithOverlapD o ctxt ty decs =+  do+    ctxt1 <- ctxt+    decs1 <- sequence decs+    ty1   <- ty+    return $ InstanceD o ctxt1 ty1 decs1++++sigD :: Name -> TypeQ -> DecQ+sigD fun ty = liftM (SigD fun) $ ty++forImpD :: Callconv -> Safety -> String -> Name -> TypeQ -> DecQ+forImpD cc s str n ty+ = do ty' <- ty+      return $ ForeignD (ImportF cc s str n ty')++infixLD :: Int -> Name -> DecQ+infixLD prec nm = return (InfixD (Fixity prec InfixL) nm)++infixRD :: Int -> Name -> DecQ+infixRD prec nm = return (InfixD (Fixity prec InfixR) nm)++infixND :: Int -> Name -> DecQ+infixND prec nm = return (InfixD (Fixity prec InfixN) nm)++pragInlD :: Name -> Inline -> RuleMatch -> Phases -> DecQ+pragInlD name inline rm phases+  = return $ PragmaD $ InlineP name inline rm phases++pragSpecD :: Name -> TypeQ -> Phases -> DecQ+pragSpecD n ty phases+  = do+      ty1    <- ty+      return $ PragmaD $ SpecialiseP n ty1 Nothing phases++pragSpecInlD :: Name -> TypeQ -> Inline -> Phases -> DecQ+pragSpecInlD n ty inline phases+  = do+      ty1    <- ty+      return $ PragmaD $ SpecialiseP n ty1 (Just inline) phases++pragSpecInstD :: TypeQ -> DecQ+pragSpecInstD ty+  = do+      ty1    <- ty+      return $ PragmaD $ SpecialiseInstP ty1++pragRuleD :: String -> Maybe [TyVarBndrQ] -> [RuleBndrQ] -> ExpQ -> ExpQ+          -> Phases -> DecQ+pragRuleD n ty_bndrs tm_bndrs lhs rhs phases+  = do+      ty_bndrs1 <- traverse sequence ty_bndrs+      tm_bndrs1 <- sequence tm_bndrs+      lhs1   <- lhs+      rhs1   <- rhs+      return $ PragmaD $ RuleP n ty_bndrs1 tm_bndrs1 lhs1 rhs1 phases++pragAnnD :: AnnTarget -> ExpQ -> DecQ+pragAnnD target expr+  = do+      exp1 <- expr+      return $ PragmaD $ AnnP target exp1++pragLineD :: Int -> String -> DecQ+pragLineD line file = return $ PragmaD $ LineP line file++pragCompleteD :: [Name] -> Maybe Name -> DecQ+pragCompleteD cls mty = return $ PragmaD $ CompleteP cls mty++dataInstD :: CxtQ -> (Maybe [TyVarBndrQ]) -> TypeQ -> Maybe KindQ -> [ConQ]+          -> [DerivClauseQ] -> DecQ+dataInstD ctxt mb_bndrs ty ksig cons derivs =+  do+    ctxt1   <- ctxt+    mb_bndrs1 <- traverse sequence mb_bndrs+    ty1    <- ty+    ksig1   <- sequenceA ksig+    cons1   <- sequenceA cons+    derivs1 <- sequenceA derivs+    return (DataInstD ctxt1 mb_bndrs1 ty1 ksig1 cons1 derivs1)++newtypeInstD :: CxtQ -> (Maybe [TyVarBndrQ]) -> TypeQ -> Maybe KindQ -> ConQ+             -> [DerivClauseQ] -> DecQ+newtypeInstD ctxt mb_bndrs ty ksig con derivs =+  do+    ctxt1   <- ctxt+    mb_bndrs1 <- traverse sequence mb_bndrs+    ty1    <- ty+    ksig1   <- sequenceA ksig+    con1    <- con+    derivs1 <- sequence derivs+    return (NewtypeInstD ctxt1 mb_bndrs1 ty1 ksig1 con1 derivs1)++tySynInstD :: TySynEqnQ -> DecQ+tySynInstD eqn =+  do+    eqn1 <- eqn+    return (TySynInstD eqn1)++dataFamilyD :: Name -> [TyVarBndrQ] -> Maybe KindQ -> DecQ+dataFamilyD tc tvs kind =+  do tvs'  <- sequenceA tvs+     kind' <- sequenceA kind+     return $ DataFamilyD tc tvs' kind'++openTypeFamilyD :: Name -> [TyVarBndrQ] -> FamilyResultSigQ+                -> Maybe InjectivityAnn -> DecQ+openTypeFamilyD tc tvs res inj =+  do tvs' <- sequenceA tvs+     res' <- res+     return $ OpenTypeFamilyD (TypeFamilyHead tc tvs' res' inj)++closedTypeFamilyD :: Name -> [TyVarBndrQ] -> FamilyResultSigQ+                  -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ+closedTypeFamilyD tc tvs result injectivity eqns =+  do tvs1    <- sequenceA tvs+     result1 <- result+     eqns1   <- sequenceA eqns+     return (ClosedTypeFamilyD (TypeFamilyHead tc tvs1 result1 injectivity) eqns1)++roleAnnotD :: Name -> [Role] -> DecQ+roleAnnotD name roles = return $ RoleAnnotD name roles++standaloneDerivD :: CxtQ -> TypeQ -> DecQ+standaloneDerivD = standaloneDerivWithStrategyD Nothing++standaloneDerivWithStrategyD :: Maybe DerivStrategyQ -> CxtQ -> TypeQ -> DecQ+standaloneDerivWithStrategyD mdsq ctxtq tyq =+  do+    mds  <- sequenceA mdsq+    ctxt <- ctxtq+    ty   <- tyq+    return $ StandaloneDerivD mds ctxt ty++defaultSigD :: Name -> TypeQ -> DecQ+defaultSigD n tyq =+  do+    ty <- tyq+    return $ DefaultSigD n ty++-- | Pattern synonym declaration+patSynD :: Name -> PatSynArgsQ -> PatSynDirQ -> PatQ -> DecQ+patSynD name args dir pat = do+  args'    <- args+  dir'     <- dir+  pat'     <- pat+  return (PatSynD name args' dir' pat')++-- | Pattern synonym type signature+patSynSigD :: Name -> TypeQ -> DecQ+patSynSigD nm ty =+  do ty' <- ty+     return $ PatSynSigD nm ty'++-- | Implicit parameter binding declaration. Can only be used in let+-- and where clauses which consist entirely of implicit bindings.+implicitParamBindD :: String -> ExpQ -> DecQ+implicitParamBindD n e =+  do+    e' <- e+    return $ ImplicitParamBindD n e'++tySynEqn :: (Maybe [TyVarBndrQ]) -> TypeQ -> TypeQ -> TySynEqnQ+tySynEqn mb_bndrs lhs rhs =+  do+    mb_bndrs1 <- traverse sequence mb_bndrs+    lhs1 <- lhs+    rhs1 <- rhs+    return (TySynEqn mb_bndrs1 lhs1 rhs1)++cxt :: [PredQ] -> CxtQ+cxt = sequence++derivClause :: Maybe DerivStrategyQ -> [PredQ] -> DerivClauseQ+derivClause mds p = do mds' <- sequenceA mds+                       p'   <- cxt p+                       return $ DerivClause mds' p'++stockStrategy :: DerivStrategyQ+stockStrategy = pure StockStrategy++anyclassStrategy :: DerivStrategyQ+anyclassStrategy = pure AnyclassStrategy++newtypeStrategy :: DerivStrategyQ+newtypeStrategy = pure NewtypeStrategy++viaStrategy :: TypeQ -> DerivStrategyQ+viaStrategy = fmap ViaStrategy++normalC :: Name -> [BangTypeQ] -> ConQ+normalC con strtys = liftM (NormalC con) $ sequence strtys++recC :: Name -> [VarBangTypeQ] -> ConQ+recC con varstrtys = liftM (RecC con) $ sequence varstrtys++infixC :: Q (Bang, Type) -> Name -> Q (Bang, Type) -> ConQ+infixC st1 con st2 = do st1' <- st1+                        st2' <- st2+                        return $ InfixC st1' con st2'++forallC :: [TyVarBndrQ] -> CxtQ -> ConQ -> ConQ+forallC ns ctxt con = do+  ns'   <- sequenceA ns+  ctxt' <- ctxt+  con'  <- con+  pure $ ForallC ns' ctxt' con'++gadtC :: [Name] -> [StrictTypeQ] -> TypeQ -> ConQ+gadtC cons strtys ty = liftM2 (GadtC cons) (sequence strtys) ty++recGadtC :: [Name] -> [VarStrictTypeQ] -> TypeQ -> ConQ+recGadtC cons varstrtys ty = liftM2 (RecGadtC cons) (sequence varstrtys) ty++-------------------------------------------------------------------------------+-- *   Type++forallT :: [TyVarBndrQ] -> CxtQ -> TypeQ -> TypeQ+forallT tvars ctxt ty = do+    tvars1 <- sequenceA tvars+    ctxt1  <- ctxt+    ty1    <- ty+    return $ ForallT tvars1 ctxt1 ty1++forallVisT :: [TyVarBndrQ] -> TypeQ -> TypeQ+forallVisT tvars ty = ForallVisT <$> sequenceA tvars <*> ty++varT :: Name -> TypeQ+varT = return . VarT++conT :: Name -> TypeQ+conT = return . ConT++infixT :: TypeQ -> Name -> TypeQ -> TypeQ+infixT t1 n t2 = do t1' <- t1+                    t2' <- t2+                    return (InfixT t1' n t2')++uInfixT :: TypeQ -> Name -> TypeQ -> TypeQ+uInfixT t1 n t2 = do t1' <- t1+                     t2' <- t2+                     return (UInfixT t1' n t2')++parensT :: TypeQ -> TypeQ+parensT t = do t' <- t+               return (ParensT t')++appT :: TypeQ -> TypeQ -> TypeQ+appT t1 t2 = do+           t1' <- t1+           t2' <- t2+           return $ AppT t1' t2'++appKindT :: TypeQ -> KindQ -> TypeQ+appKindT ty ki = do+               ty' <- ty+               ki' <- ki+               return $ AppKindT ty' ki'++arrowT :: TypeQ+arrowT = return ArrowT++listT :: TypeQ+listT = return ListT++litT :: TyLitQ -> TypeQ+litT l = fmap LitT l++tupleT :: Int -> TypeQ+tupleT i = return (TupleT i)++unboxedTupleT :: Int -> TypeQ+unboxedTupleT i = return (UnboxedTupleT i)++unboxedSumT :: SumArity -> TypeQ+unboxedSumT arity = return (UnboxedSumT arity)++sigT :: TypeQ -> KindQ -> TypeQ+sigT t k+  = do+      t' <- t+      k' <- k+      return $ SigT t' k'++equalityT :: TypeQ+equalityT = return EqualityT++wildCardT :: TypeQ+wildCardT = return WildCardT++implicitParamT :: String -> TypeQ -> TypeQ+implicitParamT n t+  = do+      t' <- t+      return $ ImplicitParamT n t'++{-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-}+classP :: Name -> [Q Type] -> Q Pred+classP cla tys+  = do+      tysl <- sequence tys+      return (foldl AppT (ConT cla) tysl)++{-# DEPRECATED equalP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please see 'equalityT'." #-}+equalP :: TypeQ -> TypeQ -> PredQ+equalP tleft tright+  = do+      tleft1  <- tleft+      tright1 <- tright+      eqT <- equalityT+      return (foldl AppT eqT [tleft1, tright1])++promotedT :: Name -> TypeQ+promotedT = return . PromotedT++promotedTupleT :: Int -> TypeQ+promotedTupleT i = return (PromotedTupleT i)++promotedNilT :: TypeQ+promotedNilT = return PromotedNilT++promotedConsT :: TypeQ+promotedConsT = return PromotedConsT++noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: SourceUnpackednessQ+noSourceUnpackedness = return NoSourceUnpackedness+sourceNoUnpack       = return SourceNoUnpack+sourceUnpack         = return SourceUnpack++noSourceStrictness, sourceLazy, sourceStrict :: SourceStrictnessQ+noSourceStrictness = return NoSourceStrictness+sourceLazy         = return SourceLazy+sourceStrict       = return SourceStrict++{-# DEPRECATED isStrict+    ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",+     "Example usage: 'bang noSourceUnpackedness sourceStrict'"] #-}+{-# DEPRECATED notStrict+    ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",+     "Example usage: 'bang noSourceUnpackedness noSourceStrictness'"] #-}+{-# DEPRECATED unpacked+    ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",+     "Example usage: 'bang sourceUnpack sourceStrict'"] #-}+isStrict, notStrict, unpacked :: Q Strict+isStrict = bang noSourceUnpackedness sourceStrict+notStrict = bang noSourceUnpackedness noSourceStrictness+unpacked = bang sourceUnpack sourceStrict++bang :: SourceUnpackednessQ -> SourceStrictnessQ -> BangQ+bang u s = do u' <- u+              s' <- s+              return (Bang u' s')++bangType :: BangQ -> TypeQ -> BangTypeQ+bangType = liftM2 (,)++varBangType :: Name -> BangTypeQ -> VarBangTypeQ+varBangType v bt = do (b, t) <- bt+                      return (v, b, t)++{-# DEPRECATED strictType+               "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'bangType' instead." #-}+strictType :: Q Strict -> TypeQ -> StrictTypeQ+strictType = bangType++{-# DEPRECATED varStrictType+               "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'varBangType' instead." #-}+varStrictType :: Name -> StrictTypeQ -> VarStrictTypeQ+varStrictType = varBangType++-- * Type Literals++numTyLit :: Integer -> TyLitQ+numTyLit n = if n >= 0 then return (NumTyLit n)+                       else fail ("Negative type-level number: " ++ show n)++strTyLit :: String -> TyLitQ+strTyLit s = return (StrTyLit s)++-------------------------------------------------------------------------------+-- *   Kind++plainTV :: Name -> TyVarBndrQ+plainTV = pure . PlainTV++kindedTV :: Name -> KindQ -> TyVarBndrQ+kindedTV n = fmap (KindedTV n)++varK :: Name -> Kind+varK = VarT++conK :: Name -> Kind+conK = ConT++tupleK :: Int -> Kind+tupleK = TupleT++arrowK :: Kind+arrowK = ArrowT++listK :: Kind+listK = ListT++appK :: Kind -> Kind -> Kind+appK = AppT++starK :: KindQ+starK = pure StarT++constraintK :: KindQ+constraintK = pure ConstraintT++-------------------------------------------------------------------------------+-- *   Type family result++noSig :: FamilyResultSigQ+noSig = pure NoSig++kindSig :: KindQ -> FamilyResultSigQ+kindSig = fmap KindSig++tyVarSig :: TyVarBndrQ -> FamilyResultSigQ+tyVarSig = fmap TyVarSig++-------------------------------------------------------------------------------+-- *   Injectivity annotation++injectivityAnn :: Name -> [Name] -> InjectivityAnn+injectivityAnn = TH.InjectivityAnn++-------------------------------------------------------------------------------+-- *   Role++nominalR, representationalR, phantomR, inferR :: Role+nominalR          = NominalR+representationalR = RepresentationalR+phantomR          = PhantomR+inferR            = InferR++-------------------------------------------------------------------------------+-- *   Callconv++cCall, stdCall, cApi, prim, javaScript :: Callconv+cCall      = CCall+stdCall    = StdCall+cApi       = CApi+prim       = Prim+javaScript = JavaScript++-------------------------------------------------------------------------------+-- *   Safety++unsafe, safe, interruptible :: Safety+unsafe = Unsafe+safe = Safe+interruptible = Interruptible++-------------------------------------------------------------------------------+-- *   FunDep++funDep :: [Name] -> [Name] -> FunDep+funDep = FunDep++-------------------------------------------------------------------------------+-- *   RuleBndr+ruleVar :: Name -> RuleBndrQ+ruleVar = return . RuleVar++typedRuleVar :: Name -> TypeQ -> RuleBndrQ+typedRuleVar n ty = ty >>= return . TypedRuleVar n++-------------------------------------------------------------------------------+-- *   AnnTarget+valueAnnotation :: Name -> AnnTarget+valueAnnotation = ValueAnnotation++typeAnnotation :: Name -> AnnTarget+typeAnnotation = TypeAnnotation++moduleAnnotation :: AnnTarget+moduleAnnotation = ModuleAnnotation++-------------------------------------------------------------------------------+-- * Pattern Synonyms (sub constructs)++unidir, implBidir :: PatSynDirQ+unidir    = return Unidir+implBidir = return ImplBidir++explBidir :: [ClauseQ] -> PatSynDirQ+explBidir cls = do+  cls' <- sequence cls+  return (ExplBidir cls')++prefixPatSyn :: [Name] -> PatSynArgsQ+prefixPatSyn args = return $ PrefixPatSyn args++recordPatSyn :: [Name] -> PatSynArgsQ+recordPatSyn sels = return $ RecordPatSyn sels++infixPatSyn :: Name -> Name -> PatSynArgsQ+infixPatSyn arg1 arg2 = return $ InfixPatSyn arg1 arg2++--------------------------------------------------------------+-- * Useful helper function++appsE :: [ExpQ] -> ExpQ+appsE [] = error "appsE []"+appsE [x] = x+appsE (x:y:zs) = appsE ( (appE x y) : zs )++-- | Return the Module at the place of splicing.  Can be used as an+-- input for 'reifyModule'.+thisModule :: Q Module+thisModule = do+  loc <- location+  return $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)
+ libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE BangPatterns #-}++-- This is a non-exposed internal module+--+-- The code in this module has been ripped from containers-0.5.5.1:Data.Map.Base [1] almost+-- verbatimely to avoid a dependency of 'template-haskell' on the containers package.+--+-- [1] see https://hackage.haskell.org/package/containers-0.5.5.1+--+-- The original code is BSD-licensed and copyrighted by Daan Leijen, Andriy Palamarchuk, et al.++module Language.Haskell.TH.Lib.Map+    ( Map+    , empty+    , insert+    , Language.Haskell.TH.Lib.Map.lookup+    ) where++import Prelude++data Map k a  = Bin {-# UNPACK #-} !Size !k a !(Map k a) !(Map k a)+              | Tip++type Size     = Int++empty :: Map k a+empty = Tip+{-# INLINE empty #-}++singleton :: k -> a -> Map k a+singleton k x = Bin 1 k x Tip Tip+{-# INLINE singleton #-}++size :: Map k a -> Int+size Tip              = 0+size (Bin sz _ _ _ _) = sz+{-# INLINE size #-}++lookup :: Ord k => k -> Map k a -> Maybe a+lookup = go+  where+    go _ Tip = Nothing+    go !k (Bin _ kx x l r) = case compare k kx of+      LT -> go k l+      GT -> go k r+      EQ -> Just x+{-# INLINABLE lookup #-}+++insert :: Ord k => k -> a -> Map k a -> Map k a+insert = go+  where+    go :: Ord k => k -> a -> Map k a -> Map k a+    go !kx x Tip = singleton kx x+    go !kx x (Bin sz ky y l r) =+        case compare kx ky of+            LT -> balanceL ky y (go kx x l) r+            GT -> balanceR ky y l (go kx x r)+            EQ -> Bin sz kx x l r+{-# INLINABLE insert #-}++balanceL :: k -> a -> Map k a -> Map k a -> Map k a+balanceL k x l r = case r of+  Tip -> case l of+           Tip -> Bin 1 k x Tip Tip+           (Bin _ _ _ Tip Tip) -> Bin 2 k x l Tip+           (Bin _ lk lx Tip (Bin _ lrk lrx _ _)) -> Bin 3 lrk lrx (Bin 1 lk lx Tip Tip) (Bin 1 k x Tip Tip)+           (Bin _ lk lx ll@(Bin _ _ _ _ _) Tip) -> Bin 3 lk lx ll (Bin 1 k x Tip Tip)+           (Bin ls lk lx ll@(Bin lls _ _ _ _) lr@(Bin lrs lrk lrx lrl lrr))+             | lrs < ratio*lls -> Bin (1+ls) lk lx ll (Bin (1+lrs) k x lr Tip)+             | otherwise -> Bin (1+ls) lrk lrx (Bin (1+lls+size lrl) lk lx ll lrl) (Bin (1+size lrr) k x lrr Tip)++  (Bin rs _ _ _ _) -> case l of+           Tip -> Bin (1+rs) k x Tip r++           (Bin ls lk lx ll lr)+              | ls > delta*rs  -> case (ll, lr) of+                   (Bin lls _ _ _ _, Bin lrs lrk lrx lrl lrr)+                     | lrs < ratio*lls -> Bin (1+ls+rs) lk lx ll (Bin (1+rs+lrs) k x lr r)+                     | otherwise -> Bin (1+ls+rs) lrk lrx (Bin (1+lls+size lrl) lk lx ll lrl) (Bin (1+rs+size lrr) k x lrr r)+                   (_, _) -> error "Failure in Data.Map.balanceL"+              | otherwise -> Bin (1+ls+rs) k x l r+{-# NOINLINE balanceL #-}++balanceR :: k -> a -> Map k a -> Map k a -> Map k a+balanceR k x l r = case l of+  Tip -> case r of+           Tip -> Bin 1 k x Tip Tip+           (Bin _ _ _ Tip Tip) -> Bin 2 k x Tip r+           (Bin _ rk rx Tip rr@(Bin _ _ _ _ _)) -> Bin 3 rk rx (Bin 1 k x Tip Tip) rr+           (Bin _ rk rx (Bin _ rlk rlx _ _) Tip) -> Bin 3 rlk rlx (Bin 1 k x Tip Tip) (Bin 1 rk rx Tip Tip)+           (Bin rs rk rx rl@(Bin rls rlk rlx rll rlr) rr@(Bin rrs _ _ _ _))+             | rls < ratio*rrs -> Bin (1+rs) rk rx (Bin (1+rls) k x Tip rl) rr+             | otherwise -> Bin (1+rs) rlk rlx (Bin (1+size rll) k x Tip rll) (Bin (1+rrs+size rlr) rk rx rlr rr)++  (Bin ls _ _ _ _) -> case r of+           Tip -> Bin (1+ls) k x l Tip++           (Bin rs rk rx rl rr)+              | rs > delta*ls  -> case (rl, rr) of+                   (Bin rls rlk rlx rll rlr, Bin rrs _ _ _ _)+                     | rls < ratio*rrs -> Bin (1+ls+rs) rk rx (Bin (1+ls+rls) k x l rl) rr+                     | otherwise -> Bin (1+ls+rs) rlk rlx (Bin (1+ls+size rll) k x l rll) (Bin (1+rrs+size rlr) rk rx rlr rr)+                   (_, _) -> error "Failure in Data.Map.balanceR"+              | otherwise -> Bin (1+ls+rs) k x l r+{-# NOINLINE balanceR #-}++delta,ratio :: Int+delta = 3+ratio = 2
+ libraries/template-haskell/Language/Haskell/TH/Ppr.hs view
@@ -0,0 +1,918 @@+-- | contains a prettyprinter for the+-- Template Haskell datatypes++module Language.Haskell.TH.Ppr where+    -- All of the exports from this module should+    -- be "public" functions.  The main module TH+    -- re-exports them all.++import Text.PrettyPrint (render)+import Language.Haskell.TH.PprLib+import Language.Haskell.TH.Syntax+import Data.Word ( Word8 )+import Data.Char ( toLower, chr)+import GHC.Show  ( showMultiLineString )+import GHC.Lexeme( startsVarSym )+import Data.Ratio ( numerator, denominator )+import Prelude hiding ((<>))++nestDepth :: Int+nestDepth = 4++type Precedence = Int+appPrec, opPrec, unopPrec, sigPrec, noPrec :: Precedence+appPrec  = 4    -- Argument of a function application+opPrec   = 3    -- Argument of an infix operator+unopPrec = 2    -- Argument of an unresolved infix operator+sigPrec  = 1    -- Argument of an explicit type signature+noPrec   = 0    -- Others++parensIf :: Bool -> Doc -> Doc+parensIf True d = parens d+parensIf False d = d++------------------------------++pprint :: Ppr a => a -> String+pprint x = render $ to_HPJ_Doc $ ppr x++class Ppr a where+    ppr :: a -> Doc+    ppr_list :: [a] -> Doc+    ppr_list = vcat . map ppr++instance Ppr a => Ppr [a] where+    ppr x = ppr_list x++------------------------------+instance Ppr Name where+    ppr v = pprName v++------------------------------+instance Ppr Info where+    ppr (TyConI d)     = ppr d+    ppr (ClassI d is)  = ppr d $$ vcat (map ppr is)+    ppr (FamilyI d is) = ppr d $$ vcat (map ppr is)+    ppr (PrimTyConI name arity is_unlifted)+      = text "Primitive"+        <+> (if is_unlifted then text "unlifted" else empty)+        <+> text "type constructor" <+> quotes (ppr name)+        <+> parens (text "arity" <+> int arity)+    ppr (ClassOpI v ty cls)+      = text "Class op from" <+> ppr cls <> colon <+> ppr_sig v ty+    ppr (DataConI v ty tc)+      = text "Constructor from" <+> ppr tc <> colon <+> ppr_sig v ty+    ppr (PatSynI nm ty) = pprPatSynSig nm ty+    ppr (TyVarI v ty)+      = text "Type variable" <+> ppr v <+> equals <+> ppr ty+    ppr (VarI v ty mb_d)+      = vcat [ppr_sig v ty,+              case mb_d of { Nothing -> empty; Just d -> ppr d }]++ppr_sig :: Name -> Type -> Doc+ppr_sig v ty = pprName' Applied v <+> dcolon <+> ppr ty++pprFixity :: Name -> Fixity -> Doc+pprFixity _ f | f == defaultFixity = empty+pprFixity v (Fixity i d) = ppr_fix d <+> int i <+> ppr v+    where ppr_fix InfixR = text "infixr"+          ppr_fix InfixL = text "infixl"+          ppr_fix InfixN = text "infix"++-- | Pretty prints a pattern synonym type signature+pprPatSynSig :: Name -> PatSynType -> Doc+pprPatSynSig nm ty+  = text "pattern" <+> pprPrefixOcc nm <+> dcolon <+> pprPatSynType ty++-- | Pretty prints a pattern synonym's type; follows the usual+-- conventions to print a pattern synonym type compactly, yet+-- unambiguously. See the note on 'PatSynType' and the section on+-- pattern synonyms in the GHC user's guide for more information.+pprPatSynType :: PatSynType -> Doc+pprPatSynType ty@(ForallT uniTys reqs ty'@(ForallT exTys provs ty''))+  | null exTys,  null provs = ppr (ForallT uniTys reqs ty'')+  | null uniTys, null reqs  = noreqs <+> ppr ty'+  | null reqs               = forall uniTys <+> noreqs <+> ppr ty'+  | otherwise               = ppr ty+  where noreqs     = text "() =>"+        forall tvs = text "forall" <+> (hsep (map ppr tvs)) <+> text "."+pprPatSynType ty            = ppr ty++------------------------------+instance Ppr Module where+  ppr (Module pkg m) = text (pkgString pkg) <+> text (modString m)++instance Ppr ModuleInfo where+  ppr (ModuleInfo imps) = text "Module" <+> vcat (map ppr imps)++------------------------------+instance Ppr Exp where+    ppr = pprExp noPrec++pprPrefixOcc :: Name -> Doc+-- Print operators with parens around them+pprPrefixOcc n = parensIf (isSymOcc n) (ppr n)++isSymOcc :: Name -> Bool+isSymOcc n+  = case nameBase n of+      []    -> True  -- Empty name; weird+      (c:_) -> startsVarSym c+                   -- c.f. OccName.startsVarSym in GHC itself++pprInfixExp :: Exp -> Doc+pprInfixExp (VarE v) = pprName' Infix v+pprInfixExp (ConE v) = pprName' Infix v+pprInfixExp _        = text "<<Non-variable/constructor in infix context>>"++pprExp :: Precedence -> Exp -> Doc+pprExp _ (VarE v)     = pprName' Applied v+pprExp _ (ConE c)     = pprName' Applied c+pprExp i (LitE l)     = pprLit i l+pprExp i (AppE e1 e2) = parensIf (i >= appPrec) $ pprExp opPrec e1+                                              <+> pprExp appPrec e2+pprExp i (AppTypeE e t)+ = parensIf (i >= appPrec) $ pprExp opPrec e <+> char '@' <> pprParendType t+pprExp _ (ParensE e)  = parens (pprExp noPrec e)+pprExp i (UInfixE e1 op e2)+ = parensIf (i > unopPrec) $ pprExp unopPrec e1+                         <+> pprInfixExp op+                         <+> pprExp unopPrec e2+pprExp i (InfixE (Just e1) op (Just e2))+ = parensIf (i >= opPrec) $ pprExp opPrec e1+                        <+> pprInfixExp op+                        <+> pprExp opPrec e2+pprExp _ (InfixE me1 op me2) = parens $ pprMaybeExp noPrec me1+                                    <+> pprInfixExp op+                                    <+> pprMaybeExp noPrec me2+pprExp i (LamE [] e) = pprExp i e -- #13856+pprExp i (LamE ps e) = parensIf (i > noPrec) $ char '\\' <> hsep (map (pprPat appPrec) ps)+                                           <+> text "->" <+> ppr e+pprExp i (LamCaseE ms) = parensIf (i > noPrec)+                       $ text "\\case" $$ nest nestDepth (ppr ms)+pprExp _ (TupE es) = parens (commaSep es)+pprExp _ (UnboxedTupE es) = hashParens (commaSep es)+pprExp _ (UnboxedSumE e alt arity) = unboxedSumBars (ppr e) alt arity+-- Nesting in Cond is to avoid potential problems in do statements+pprExp i (CondE guard true false)+ = parensIf (i > noPrec) $ sep [text "if"   <+> ppr guard,+                       nest 1 $ text "then" <+> ppr true,+                       nest 1 $ text "else" <+> ppr false]+pprExp i (MultiIfE alts)+  = parensIf (i > noPrec) $ vcat $+      case alts of+        []            -> [text "if {}"]+        (alt : alts') -> text "if" <+> pprGuarded arrow alt+                         : map (nest 3 . pprGuarded arrow) alts'+pprExp i (LetE ds_ e) = parensIf (i > noPrec) $ text "let" <+> pprDecs ds_+                                             $$ text " in" <+> ppr e+  where+    pprDecs []  = empty+    pprDecs [d] = ppr d+    pprDecs ds  = braces (semiSep ds)++pprExp i (CaseE e ms)+ = parensIf (i > noPrec) $ text "case" <+> ppr e <+> text "of"+                        $$ nest nestDepth (ppr ms)+pprExp i (DoE ss_) = parensIf (i > noPrec) $ text "do" <+> pprStms ss_+  where+    pprStms []  = empty+    pprStms [s] = ppr s+    pprStms ss  = braces (semiSep ss)+pprExp i (MDoE ss_) = parensIf (i > noPrec) $ text "mdo" <+> pprStms ss_+  where+    pprStms []  = empty+    pprStms [s] = ppr s+    pprStms ss  = braces (semiSep ss)++pprExp _ (CompE []) = text "<<Empty CompExp>>"+-- This will probably break with fixity declarations - would need a ';'+pprExp _ (CompE ss) =+    if null ss'+       -- If there are no statements in a list comprehension besides the last+       -- one, we simply treat it like a normal list.+       then text "[" <> ppr s <> text "]"+       else text "[" <> ppr s+        <+> bar+        <+> commaSep ss'+         <> text "]"+  where s = last ss+        ss' = init ss+pprExp _ (ArithSeqE d) = ppr d+pprExp _ (ListE es) = brackets (commaSep es)+pprExp i (SigE e t) = parensIf (i > noPrec) $ pprExp sigPrec e+                                          <+> dcolon <+> ppr t+pprExp _ (RecConE nm fs) = ppr nm <> braces (pprFields fs)+pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields fs)+pprExp i (StaticE e) = parensIf (i >= appPrec) $+                         text "static"<+> pprExp appPrec e+pprExp _ (UnboundVarE v) = pprName' Applied v+pprExp _ (LabelE s) = text "#" <> text s+pprExp _ (ImplicitParamVarE n) = text ('?' : n)++pprFields :: [(Name,Exp)] -> Doc+pprFields = sep . punctuate comma . map (\(s,e) -> ppr s <+> equals <+> ppr e)++pprMaybeExp :: Precedence -> Maybe Exp -> Doc+pprMaybeExp _ Nothing = empty+pprMaybeExp i (Just e) = pprExp i e++------------------------------+instance Ppr Stmt where+    ppr (BindS p e) = ppr p <+> text "<-" <+> ppr e+    ppr (LetS ds) = text "let" <+> (braces (semiSep ds))+    ppr (NoBindS e) = ppr e+    ppr (ParS sss) = sep $ punctuate bar+                         $ map commaSep sss+    ppr (RecS ss) = text "rec" <+> (braces (semiSep ss))++------------------------------+instance Ppr Match where+    ppr (Match p rhs ds) = pprMatchPat p <+> pprBody False rhs+                        $$ where_clause ds++pprMatchPat :: Pat -> Doc+-- Everything except pattern signatures bind more tightly than (->)+pprMatchPat p@(SigP {}) = parens (ppr p)+pprMatchPat p           = ppr p++------------------------------+pprGuarded :: Doc -> (Guard, Exp) -> Doc+pprGuarded eqDoc (guard, expr) = case guard of+  NormalG guardExpr -> bar <+> ppr guardExpr <+> eqDoc <+> ppr expr+  PatG    stmts     -> bar <+> vcat (punctuate comma $ map ppr stmts) $$+                         nest nestDepth (eqDoc <+> ppr expr)++------------------------------+pprBody :: Bool -> Body -> Doc+pprBody eq body = case body of+    GuardedB xs -> nest nestDepth $ vcat $ map (pprGuarded eqDoc) xs+    NormalB  e  -> eqDoc <+> ppr e+  where eqDoc | eq        = equals+              | otherwise = arrow++------------------------------+instance Ppr Lit where+  ppr = pprLit noPrec++pprLit :: Precedence -> Lit -> Doc+pprLit i (IntPrimL x)    = parensIf (i > noPrec && x < 0)+                                    (integer x <> char '#')+pprLit _ (WordPrimL x)    = integer x <> text "##"+pprLit i (FloatPrimL x)  = parensIf (i > noPrec && x < 0)+                                    (float (fromRational x) <> char '#')+pprLit i (DoublePrimL x) = parensIf (i > noPrec && x < 0)+                                    (double (fromRational x) <> text "##")+pprLit i (IntegerL x)    = parensIf (i > noPrec && x < 0) (integer x)+pprLit _ (CharL c)       = text (show c)+pprLit _ (CharPrimL c)   = text (show c) <> char '#'+pprLit _ (StringL s)     = pprString s+pprLit _ (StringPrimL s) = pprString (bytesToString s) <> char '#'+pprLit _ (BytesPrimL {}) = pprString "<binary data>"+pprLit i (RationalL rat) = parensIf (i > noPrec) $+                           integer (numerator rat) <+> char '/'+                              <+> integer (denominator rat)++bytesToString :: [Word8] -> String+bytesToString = map (chr . fromIntegral)++pprString :: String -> Doc+-- Print newlines as newlines with Haskell string escape notation,+-- not as '\n'.  For other non-printables use regular escape notation.+pprString s = vcat (map text (showMultiLineString s))++------------------------------+instance Ppr Pat where+    ppr = pprPat noPrec++pprPat :: Precedence -> Pat -> Doc+pprPat i (LitP l)     = pprLit i l+pprPat _ (VarP v)     = pprName' Applied v+pprPat _ (TupP ps)    = parens (commaSep ps)+pprPat _ (UnboxedTupP ps) = hashParens (commaSep ps)+pprPat _ (UnboxedSumP p alt arity) = unboxedSumBars (ppr p) alt arity+pprPat i (ConP s ps)  = parensIf (i >= appPrec) $ pprName' Applied s+                                              <+> sep (map (pprPat appPrec) ps)+pprPat _ (ParensP p)  = parens $ pprPat noPrec p+pprPat i (UInfixP p1 n p2)+                      = parensIf (i > unopPrec) (pprPat unopPrec p1 <+>+                                                 pprName' Infix n   <+>+                                                 pprPat unopPrec p2)+pprPat i (InfixP p1 n p2)+                      = parensIf (i >= opPrec) (pprPat opPrec p1 <+>+                                                pprName' Infix n <+>+                                                pprPat opPrec p2)+pprPat i (TildeP p)   = parensIf (i > noPrec) $ char '~' <> pprPat appPrec p+pprPat i (BangP p)    = parensIf (i > noPrec) $ char '!' <> pprPat appPrec p+pprPat i (AsP v p)    = parensIf (i > noPrec) $ ppr v <> text "@"+                                                      <> pprPat appPrec p+pprPat _ WildP        = text "_"+pprPat _ (RecP nm fs)+ = parens $     ppr nm+            <+> braces (sep $ punctuate comma $+                        map (\(s,p) -> ppr s <+> equals <+> ppr p) fs)+pprPat _ (ListP ps) = brackets (commaSep ps)+pprPat i (SigP p t) = parensIf (i > noPrec) $ ppr p <+> dcolon <+> ppr t+pprPat _ (ViewP e p) = parens $ pprExp noPrec e <+> text "->" <+> pprPat noPrec p++------------------------------+instance Ppr Dec where+    ppr = ppr_dec True++ppr_dec :: Bool     -- declaration on the toplevel?+        -> Dec+        -> Doc+ppr_dec _ (FunD f cs)   = vcat $ map (\c -> pprPrefixOcc f <+> ppr c) cs+ppr_dec _ (ValD p r ds) = ppr p <+> pprBody True r+                          $$ where_clause ds+ppr_dec _ (TySynD t xs rhs)+  = ppr_tySyn empty (Just t) (hsep (map ppr xs)) rhs+ppr_dec _ (DataD ctxt t xs ksig cs decs)+  = ppr_data empty ctxt (Just t) (hsep (map ppr xs)) ksig cs decs+ppr_dec _ (NewtypeD ctxt t xs ksig c decs)+  = ppr_newtype empty ctxt (Just t) (sep (map ppr xs)) ksig c decs+ppr_dec _  (ClassD ctxt c xs fds ds)+  = text "class" <+> pprCxt ctxt <+> ppr c <+> hsep (map ppr xs) <+> ppr fds+    $$ where_clause ds+ppr_dec _ (InstanceD o ctxt i ds) =+        text "instance" <+> maybe empty ppr_overlap o <+> pprCxt ctxt <+> ppr i+                                  $$ where_clause ds+ppr_dec _ (SigD f t)    = pprPrefixOcc f <+> dcolon <+> ppr t+ppr_dec _ (ForeignD f)  = ppr f+ppr_dec _ (InfixD fx n) = pprFixity n fx+ppr_dec _ (PragmaD p)   = ppr p+ppr_dec isTop (DataFamilyD tc tvs kind)+  = text "data" <+> maybeFamily <+> ppr tc <+> hsep (map ppr tvs) <+> maybeKind+  where+    maybeFamily | isTop     = text "family"+                | otherwise = empty+    maybeKind | (Just k') <- kind = dcolon <+> ppr k'+              | otherwise = empty+ppr_dec isTop (DataInstD ctxt bndrs ty ksig cs decs)+  = ppr_data (maybeInst <+> ppr_bndrs bndrs)+             ctxt Nothing (ppr ty) ksig cs decs+  where+    maybeInst | isTop     = text "instance"+              | otherwise = empty+ppr_dec isTop (NewtypeInstD ctxt bndrs ty ksig c decs)+  = ppr_newtype (maybeInst <+> ppr_bndrs bndrs)+                ctxt Nothing (ppr ty) ksig c decs+  where+    maybeInst | isTop     = text "instance"+              | otherwise = empty+ppr_dec isTop (TySynInstD (TySynEqn mb_bndrs ty rhs))+  = ppr_tySyn (maybeInst <+> ppr_bndrs mb_bndrs)+              Nothing (ppr ty) rhs+  where+    maybeInst | isTop     = text "instance"+              | otherwise = empty+ppr_dec isTop (OpenTypeFamilyD tfhead)+  = text "type" <+> maybeFamily <+> ppr_tf_head tfhead+  where+    maybeFamily | isTop     = text "family"+                | otherwise = empty+ppr_dec _ (ClosedTypeFamilyD tfhead eqns)+  = hang (text "type family" <+> ppr_tf_head tfhead <+> text "where")+      nestDepth (vcat (map ppr_eqn eqns))+  where+    ppr_eqn (TySynEqn mb_bndrs lhs rhs)+      = ppr_bndrs mb_bndrs <+> ppr lhs <+> text "=" <+> ppr rhs+ppr_dec _ (RoleAnnotD name roles)+  = hsep [ text "type role", ppr name ] <+> hsep (map ppr roles)+ppr_dec _ (StandaloneDerivD ds cxt ty)+  = hsep [ text "deriving"+         , maybe empty ppr_deriv_strategy ds+         , text "instance"+         , pprCxt cxt+         , ppr ty ]+ppr_dec _ (DefaultSigD n ty)+  = hsep [ text "default", pprPrefixOcc n, dcolon, ppr ty ]+ppr_dec _ (PatSynD name args dir pat)+  = text "pattern" <+> pprNameArgs <+> ppr dir <+> pprPatRHS+  where+    pprNameArgs | InfixPatSyn a1 a2 <- args = ppr a1 <+> ppr name <+> ppr a2+                | otherwise                 = ppr name <+> ppr args+    pprPatRHS   | ExplBidir cls <- dir = hang (ppr pat <+> text "where")+                                           nestDepth (ppr name <+> ppr cls)+                | otherwise            = ppr pat+ppr_dec _ (PatSynSigD name ty)+  = pprPatSynSig name ty+ppr_dec _ (ImplicitParamBindD n e)+  = hsep [text ('?' : n), text "=", ppr e]++ppr_deriv_strategy :: DerivStrategy -> Doc+ppr_deriv_strategy ds =+  case ds of+    StockStrategy    -> text "stock"+    AnyclassStrategy -> text "anyclass"+    NewtypeStrategy  -> text "newtype"+    ViaStrategy ty   -> text "via" <+> pprParendType ty++ppr_overlap :: Overlap -> Doc+ppr_overlap o = text $+  case o of+    Overlaps      -> "{-# OVERLAPS #-}"+    Overlappable  -> "{-# OVERLAPPABLE #-}"+    Overlapping   -> "{-# OVERLAPPING #-}"+    Incoherent    -> "{-# INCOHERENT #-}"++ppr_data :: Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause]+         -> Doc+ppr_data maybeInst ctxt t argsDoc ksig cs decs+  = sep [text "data" <+> maybeInst+            <+> pprCxt ctxt+            <+> case t of+                 Just n -> pprName' Applied n <+> argsDoc+                 Nothing -> argsDoc+            <+> ksigDoc <+> maybeWhere,+         nest nestDepth (sep (pref $ map ppr cs)),+         if null decs+           then empty+           else nest nestDepth+              $ vcat $ map ppr_deriv_clause decs]+  where+    pref :: [Doc] -> [Doc]+    pref xs | isGadtDecl = xs+    pref []              = []      -- No constructors; can't happen in H98+    pref (d:ds)          = (char '=' <+> d):map (bar <+>) ds++    maybeWhere :: Doc+    maybeWhere | isGadtDecl = text "where"+               | otherwise  = empty++    isGadtDecl :: Bool+    isGadtDecl = not (null cs) && all isGadtCon cs+        where isGadtCon (GadtC _ _ _   ) = True+              isGadtCon (RecGadtC _ _ _) = True+              isGadtCon (ForallC _ _ x ) = isGadtCon x+              isGadtCon  _               = False++    ksigDoc = case ksig of+                Nothing -> empty+                Just k  -> dcolon <+> ppr k++ppr_newtype :: Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> Con -> [DerivClause]+            -> Doc+ppr_newtype maybeInst ctxt t argsDoc ksig c decs+  = sep [text "newtype" <+> maybeInst+            <+> pprCxt ctxt+            <+> case t of+                 Just n -> ppr n <+> argsDoc+                 Nothing -> argsDoc+            <+> ksigDoc,+         nest 2 (char '=' <+> ppr c),+         if null decs+           then empty+           else nest nestDepth+                $ vcat $ map ppr_deriv_clause decs]+  where+    ksigDoc = case ksig of+                Nothing -> empty+                Just k  -> dcolon <+> ppr k++ppr_deriv_clause :: DerivClause -> Doc+ppr_deriv_clause (DerivClause ds ctxt)+  = text "deriving" <+> pp_strat_before+                    <+> ppr_cxt_preds ctxt+                    <+> pp_strat_after+  where+    -- @via@ is unique in that in comes /after/ the class being derived,+    -- so we must special-case it.+    (pp_strat_before, pp_strat_after) =+      case ds of+        Just (via@ViaStrategy{}) -> (empty, ppr_deriv_strategy via)+        _                        -> (maybe empty ppr_deriv_strategy ds, empty)++ppr_tySyn :: Doc -> Maybe Name -> Doc -> Type -> Doc+ppr_tySyn maybeInst t argsDoc rhs+  = text "type" <+> maybeInst+    <+> case t of+         Just n -> ppr n <+> argsDoc+         Nothing -> argsDoc+    <+> text "=" <+> ppr rhs++ppr_tf_head :: TypeFamilyHead -> Doc+ppr_tf_head (TypeFamilyHead tc tvs res inj)+  = ppr tc <+> hsep (map ppr tvs) <+> ppr res <+> maybeInj+  where+    maybeInj | (Just inj') <- inj = ppr inj'+             | otherwise          = empty++ppr_bndrs :: Maybe [TyVarBndr] -> Doc+ppr_bndrs (Just bndrs) = text "forall" <+> sep (map ppr bndrs) <> text "."+ppr_bndrs Nothing = empty++------------------------------+instance Ppr FunDep where+    ppr (FunDep xs ys) = hsep (map ppr xs) <+> text "->" <+> hsep (map ppr ys)+    ppr_list [] = empty+    ppr_list xs = bar <+> commaSep xs++------------------------------+instance Ppr FamilyResultSig where+    ppr NoSig           = empty+    ppr (KindSig k)     = dcolon <+> ppr k+    ppr (TyVarSig bndr) = text "=" <+> ppr bndr++------------------------------+instance Ppr InjectivityAnn where+    ppr (InjectivityAnn lhs rhs) =+        bar <+> ppr lhs <+> text "->" <+> hsep (map ppr rhs)++------------------------------+instance Ppr Foreign where+    ppr (ImportF callconv safety impent as typ)+       = text "foreign import"+     <+> showtextl callconv+     <+> showtextl safety+     <+> text (show impent)+     <+> ppr as+     <+> dcolon <+> ppr typ+    ppr (ExportF callconv expent as typ)+        = text "foreign export"+      <+> showtextl callconv+      <+> text (show expent)+      <+> ppr as+      <+> dcolon <+> ppr typ++------------------------------+instance Ppr Pragma where+    ppr (InlineP n inline rm phases)+       = text "{-#"+     <+> ppr inline+     <+> ppr rm+     <+> ppr phases+     <+> ppr n+     <+> text "#-}"+    ppr (SpecialiseP n ty inline phases)+       =   text "{-# SPECIALISE"+       <+> maybe empty ppr inline+       <+> ppr phases+       <+> sep [ ppr n <+> dcolon+               , nest 2 $ ppr ty ]+       <+> text "#-}"+    ppr (SpecialiseInstP inst)+       = text "{-# SPECIALISE instance" <+> ppr inst <+> text "#-}"+    ppr (RuleP n ty_bndrs tm_bndrs lhs rhs phases)+       = sep [ text "{-# RULES" <+> pprString n <+> ppr phases+             , nest 4 $ ppr_ty_forall ty_bndrs <+> ppr_tm_forall ty_bndrs+                                               <+> ppr lhs+             , nest 4 $ char '=' <+> ppr rhs <+> text "#-}" ]+      where ppr_ty_forall Nothing      = empty+            ppr_ty_forall (Just bndrs) = text "forall"+                                         <+> fsep (map ppr bndrs)+                                         <+> char '.'+            ppr_tm_forall Nothing | null tm_bndrs = empty+            ppr_tm_forall _ = text "forall"+                              <+> fsep (map ppr tm_bndrs)+                              <+> char '.'+    ppr (AnnP tgt expr)+       = text "{-# ANN" <+> target1 tgt <+> ppr expr <+> text "#-}"+      where target1 ModuleAnnotation    = text "module"+            target1 (TypeAnnotation t)  = text "type" <+> ppr t+            target1 (ValueAnnotation v) = ppr v+    ppr (LineP line file)+       = text "{-# LINE" <+> int line <+> text (show file) <+> text "#-}"+    ppr (CompleteP cls mty)+       = text "{-# COMPLETE" <+> (fsep $ punctuate comma $ map ppr cls)+                <+> maybe empty (\ty -> dcolon <+> ppr ty) mty++------------------------------+instance Ppr Inline where+    ppr NoInline  = text "NOINLINE"+    ppr Inline    = text "INLINE"+    ppr Inlinable = text "INLINABLE"++------------------------------+instance Ppr RuleMatch where+    ppr ConLike = text "CONLIKE"+    ppr FunLike = empty++------------------------------+instance Ppr Phases where+    ppr AllPhases       = empty+    ppr (FromPhase i)   = brackets $ int i+    ppr (BeforePhase i) = brackets $ char '~' <> int i++------------------------------+instance Ppr RuleBndr where+    ppr (RuleVar n)         = ppr n+    ppr (TypedRuleVar n ty) = parens $ ppr n <+> dcolon <+> ppr ty++------------------------------+instance Ppr Clause where+    ppr (Clause ps rhs ds) = hsep (map (pprPat appPrec) ps) <+> pprBody True rhs+                             $$ where_clause ds++------------------------------+instance Ppr Con where+    ppr (NormalC c sts) = ppr c <+> sep (map pprBangType sts)++    ppr (RecC c vsts)+        = ppr c <+> braces (sep (punctuate comma $ map pprVarBangType vsts))++    ppr (InfixC st1 c st2) = pprBangType st1+                         <+> pprName' Infix c+                         <+> pprBangType st2++    ppr (ForallC ns ctxt (GadtC c sts ty))+        = commaSepApplied c <+> dcolon <+> pprForall ns ctxt+      <+> pprGadtRHS sts ty++    ppr (ForallC ns ctxt (RecGadtC c vsts ty))+        = commaSepApplied c <+> dcolon <+> pprForall ns ctxt+      <+> pprRecFields vsts ty++    ppr (ForallC ns ctxt con)+        = pprForall ns ctxt <+> ppr con++    ppr (GadtC c sts ty)+        = commaSepApplied c <+> dcolon <+> pprGadtRHS sts ty++    ppr (RecGadtC c vsts ty)+        = commaSepApplied c <+> dcolon <+> pprRecFields vsts ty++instance Ppr PatSynDir where+  ppr Unidir        = text "<-"+  ppr ImplBidir     = text "="+  ppr (ExplBidir _) = text "<-"+    -- the ExplBidir's clauses are pretty printed together with the+    -- entire pattern synonym; so only print the direction here.++instance Ppr PatSynArgs where+  ppr (PrefixPatSyn args) = sep $ map ppr args+  ppr (InfixPatSyn a1 a2) = ppr a1 <+> ppr a2+  ppr (RecordPatSyn sels) = braces $ sep (punctuate comma (map ppr sels))++commaSepApplied :: [Name] -> Doc+commaSepApplied = commaSepWith (pprName' Applied)++pprForall :: [TyVarBndr] -> Cxt -> Doc+pprForall = pprForall' ForallInvis++pprForallVis :: [TyVarBndr] -> Cxt -> Doc+pprForallVis = pprForall' ForallVis++pprForall' :: ForallVisFlag -> [TyVarBndr] -> Cxt -> Doc+pprForall' fvf tvs cxt+  -- even in the case without any tvs, there could be a non-empty+  -- context cxt (e.g., in the case of pattern synonyms, where there+  -- are multiple forall binders and contexts).+  | [] <- tvs = pprCxt cxt+  | otherwise = text "forall" <+> hsep (map ppr tvs)+                              <+> separator <+> pprCxt cxt+  where+    separator = case fvf of+                  ForallVis   -> text "->"+                  ForallInvis -> char '.'++pprRecFields :: [(Name, Strict, Type)] -> Type -> Doc+pprRecFields vsts ty+    = braces (sep (punctuate comma $ map pprVarBangType vsts))+  <+> arrow <+> ppr ty++pprGadtRHS :: [(Strict, Type)] -> Type -> Doc+pprGadtRHS [] ty+    = ppr ty+pprGadtRHS sts ty+    = sep (punctuate (space <> arrow) (map pprBangType sts))+  <+> arrow <+> ppr ty++------------------------------+pprVarBangType :: VarBangType -> Doc+-- Slight infelicity: with print non-atomic type with parens+pprVarBangType (v, bang, t) = ppr v <+> dcolon <+> pprBangType (bang, t)++------------------------------+pprBangType :: BangType -> Doc+-- Make sure we print+--+-- Con {-# UNPACK #-} a+--+-- rather than+--+-- Con {-# UNPACK #-}a+--+-- when there's no strictness annotation. If there is a strictness annotation,+-- it's okay to not put a space between it and the type.+pprBangType (bt@(Bang _ NoSourceStrictness), t) = ppr bt <+> pprParendType t+pprBangType (bt, t) = ppr bt <> pprParendType t++------------------------------+instance Ppr Bang where+    ppr (Bang su ss) = ppr su <+> ppr ss++------------------------------+instance Ppr SourceUnpackedness where+    ppr NoSourceUnpackedness = empty+    ppr SourceNoUnpack       = text "{-# NOUNPACK #-}"+    ppr SourceUnpack         = text "{-# UNPACK #-}"++------------------------------+instance Ppr SourceStrictness where+    ppr NoSourceStrictness = empty+    ppr SourceLazy         = char '~'+    ppr SourceStrict       = char '!'++------------------------------+instance Ppr DecidedStrictness where+    ppr DecidedLazy   = empty+    ppr DecidedStrict = char '!'+    ppr DecidedUnpack = text "{-# UNPACK #-} !"++------------------------------+{-# DEPRECATED pprVarStrictType+               "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'pprVarBangType' instead." #-}+pprVarStrictType :: (Name, Strict, Type) -> Doc+pprVarStrictType = pprVarBangType++------------------------------+{-# DEPRECATED pprStrictType+               "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'pprBangType' instead." #-}+pprStrictType :: (Strict, Type) -> Doc+pprStrictType = pprBangType++------------------------------+pprParendType :: Type -> Doc+pprParendType (VarT v)            = pprName' Applied v+-- `Applied` is used here instead of `ppr` because of infix names (#13887)+pprParendType (ConT c)            = pprName' Applied c+pprParendType (TupleT 0)          = text "()"+pprParendType (TupleT n)          = parens (hcat (replicate (n-1) comma))+pprParendType (UnboxedTupleT n)   = hashParens $ hcat $ replicate (n-1) comma+pprParendType (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar+pprParendType ArrowT              = parens (text "->")+pprParendType ListT               = text "[]"+pprParendType (LitT l)            = pprTyLit l+pprParendType (PromotedT c)       = text "'" <> pprName' Applied c+pprParendType (PromotedTupleT 0)  = text "'()"+pprParendType (PromotedTupleT n)  = quoteParens (hcat (replicate (n-1) comma))+pprParendType PromotedNilT        = text "'[]"+pprParendType PromotedConsT       = text "'(:)"+pprParendType StarT               = char '*'+pprParendType ConstraintT         = text "Constraint"+pprParendType (SigT ty k)         = parens (ppr ty <+> text "::" <+> ppr k)+pprParendType WildCardT           = char '_'+pprParendType (InfixT x n y)      = parens (ppr x <+> pprName' Infix n <+> ppr y)+pprParendType t@(UInfixT {})      = parens (pprUInfixT t)+pprParendType (ParensT t)         = ppr t+pprParendType tuple | (TupleT n, args) <- split tuple+                    , length args == n+                    = parens (commaSep args)+pprParendType (ImplicitParamT n t)= text ('?':n) <+> text "::" <+> ppr t+pprParendType EqualityT           = text "(~)"+pprParendType t@(ForallT {})      = parens (ppr t)+pprParendType t@(ForallVisT {})   = parens (ppr t)+pprParendType t@(AppT {})         = parens (ppr t)+pprParendType t@(AppKindT {})     = parens (ppr t)++pprUInfixT :: Type -> Doc+pprUInfixT (UInfixT x n y) = pprUInfixT x <+> pprName' Infix n <+> pprUInfixT y+pprUInfixT t               = ppr t++instance Ppr Type where+    ppr (ForallT tvars ctxt ty) = sep [pprForall tvars ctxt, ppr ty]+    ppr (ForallVisT tvars ty)   = sep [pprForallVis tvars [], ppr ty]+    ppr ty = pprTyApp (split ty)+       -- Works, in a degnerate way, for SigT, and puts parens round (ty :: kind)+       -- See Note [Pretty-printing kind signatures]+instance Ppr TypeArg where+    ppr (TANormal ty) = ppr ty+    ppr (TyArg ki) = char '@' <> ppr ki++pprParendTypeArg :: TypeArg -> Doc+pprParendTypeArg (TANormal ty) = pprParendType ty+pprParendTypeArg (TyArg ki) = char '@' <> pprParendType ki+{- Note [Pretty-printing kind signatures]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+GHC's parser only recognises a kind signature in a type when there are+parens around it.  E.g. the parens are required here:+   f :: (Int :: *)+   type instance F Int = (Bool :: *)+So we always print a SigT with parens (see #10050). -}++pprTyApp :: (Type, [TypeArg]) -> Doc+pprTyApp (ArrowT, [TANormal arg1, TANormal arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2]+pprTyApp (EqualityT, [TANormal arg1, TANormal arg2]) =+    sep [pprFunArgType arg1 <+> text "~", ppr arg2]+pprTyApp (ListT, [TANormal arg]) = brackets (ppr arg)+pprTyApp (TupleT n, args)+ | length args == n = parens (commaSep args)+pprTyApp (PromotedTupleT n, args)+ | length args == n = quoteParens (commaSep args)+pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendTypeArg args)++pprFunArgType :: Type -> Doc    -- Should really use a precedence argument+-- Everything except forall and (->) binds more tightly than (->)+pprFunArgType ty@(ForallT {})                 = parens (ppr ty)+pprFunArgType ty@(ForallVisT {})              = parens (ppr ty)+pprFunArgType ty@((ArrowT `AppT` _) `AppT` _) = parens (ppr ty)+pprFunArgType ty@(SigT _ _)                   = parens (ppr ty)+pprFunArgType ty                              = ppr ty++data ForallVisFlag = ForallVis   -- forall a -> {...}+                   | ForallInvis -- forall a.   {...}+  deriving Show++data TypeArg = TANormal Type+             | TyArg Kind++split :: Type -> (Type, [TypeArg])    -- Split into function and args+split t = go t []+    where go (AppT t1 t2) args = go t1 (TANormal t2:args)+          go (AppKindT ty ki) args = go ty (TyArg ki:args)+          go ty           args = (ty, args)++pprTyLit :: TyLit -> Doc+pprTyLit (NumTyLit n) = integer n+pprTyLit (StrTyLit s) = text (show s)++instance Ppr TyLit where+  ppr = pprTyLit++------------------------------+instance Ppr TyVarBndr where+    ppr (PlainTV nm)    = ppr nm+    ppr (KindedTV nm k) = parens (ppr nm <+> dcolon <+> ppr k)++instance Ppr Role where+    ppr NominalR          = text "nominal"+    ppr RepresentationalR = text "representational"+    ppr PhantomR          = text "phantom"+    ppr InferR            = text "_"++------------------------------+pprCxt :: Cxt -> Doc+pprCxt [] = empty+pprCxt ts = ppr_cxt_preds ts <+> text "=>"++ppr_cxt_preds :: Cxt -> Doc+ppr_cxt_preds [] = empty+ppr_cxt_preds [t@ImplicitParamT{}] = parens (ppr t)+ppr_cxt_preds [t@ForallT{}] = parens (ppr t)+ppr_cxt_preds [t] = ppr t+ppr_cxt_preds ts = parens (commaSep ts)++------------------------------+instance Ppr Range where+    ppr = brackets . pprRange+        where pprRange :: Range -> Doc+              pprRange (FromR e) = ppr e <> text ".."+              pprRange (FromThenR e1 e2) = ppr e1 <> text ","+                                        <> ppr e2 <> text ".."+              pprRange (FromToR e1 e2) = ppr e1 <> text ".." <> ppr e2+              pprRange (FromThenToR e1 e2 e3) = ppr e1 <> text ","+                                             <> ppr e2 <> text ".."+                                             <> ppr e3++------------------------------+where_clause :: [Dec] -> Doc+where_clause [] = empty+where_clause ds = nest nestDepth $ text "where" <+> vcat (map (ppr_dec False) ds)++showtextl :: Show a => a -> Doc+showtextl = text . map toLower . show++hashParens :: Doc -> Doc+hashParens d = text "(# " <> d <> text " #)"++quoteParens :: Doc -> Doc+quoteParens d = text "'(" <> d <> text ")"++-----------------------------+instance Ppr Loc where+  ppr (Loc { loc_module = md+           , loc_package = pkg+           , loc_start = (start_ln, start_col)+           , loc_end = (end_ln, end_col) })+    = hcat [ text pkg, colon, text md, colon+           , parens $ int start_ln <> comma <> int start_col+           , text "-"+           , parens $ int end_ln <> comma <> int end_col ]++-- Takes a list of printable things and prints them separated by commas followed+-- by space.+commaSep :: Ppr a => [a] -> Doc+commaSep = commaSepWith ppr++-- Takes a list of things and prints them with the given pretty-printing+-- function, separated by commas followed by space.+commaSepWith :: (a -> Doc) -> [a] -> Doc+commaSepWith pprFun = sep . punctuate comma . map pprFun++-- Takes a list of printable things and prints them separated by semicolons+-- followed by space.+semiSep :: Ppr a => [a] -> Doc+semiSep = sep . punctuate semi . map ppr++-- Prints out the series of vertical bars that wraps an expression or pattern+-- used in an unboxed sum.+unboxedSumBars :: Doc -> SumAlt -> SumArity -> Doc+unboxedSumBars d alt arity = hashParens $+    bars (alt-1) <> d <> bars (arity - alt)+  where+    bars i = hsep (replicate i bar)++-- Text containing the vertical bar character.+bar :: Doc+bar = char '|'
+ libraries/template-haskell/Language/Haskell/TH/PprLib.hs view
@@ -0,0 +1,226 @@+{-# LANGUAGE FlexibleInstances #-}++-- | Monadic front-end to Text.PrettyPrint++module Language.Haskell.TH.PprLib (++        -- * The document type+        Doc,            -- Abstract, instance of Show+        PprM,++        -- * Primitive Documents+        empty,+        semi, comma, colon, dcolon, space, equals, arrow,+        lparen, rparen, lbrack, rbrack, lbrace, rbrace,++        -- * Converting values into documents+        text, char, ptext,+        int, integer, float, double, rational,++        -- * Wrapping documents in delimiters+        parens, brackets, braces, quotes, doubleQuotes,++        -- * Combining documents+        (<>), (<+>), hcat, hsep,+        ($$), ($+$), vcat,+        sep, cat,+        fsep, fcat,+        nest,+        hang, punctuate,++        -- * Predicates on documents+        isEmpty,++    to_HPJ_Doc, pprName, pprName'+  ) where+++import Language.Haskell.TH.Syntax+    (Name(..), showName', NameFlavour(..), NameIs(..))+import qualified Text.PrettyPrint as HPJ+import Control.Monad (liftM, liftM2, ap)+import Language.Haskell.TH.Lib.Map ( Map )+import qualified Language.Haskell.TH.Lib.Map as Map ( lookup, insert, empty )+import Prelude hiding ((<>))++infixl 6 <> +infixl 6 <+>+infixl 5 $$, $+$++-- ---------------------------------------------------------------------------+-- The interface++-- The primitive Doc values++instance Show Doc where+   show d = HPJ.render (to_HPJ_Doc d)++isEmpty :: Doc    -> PprM Bool;  -- ^ Returns 'True' if the document is empty++empty   :: Doc;                 -- ^ An empty document+semi    :: Doc;                 -- ^ A ';' character+comma   :: Doc;                 -- ^ A ',' character+colon   :: Doc;                 -- ^ A ':' character+dcolon  :: Doc;                 -- ^ A "::" string+space   :: Doc;                 -- ^ A space character+equals  :: Doc;                 -- ^ A '=' character+arrow   :: Doc;                 -- ^ A "->" string+lparen  :: Doc;                 -- ^ A '(' character+rparen  :: Doc;                 -- ^ A ')' character+lbrack  :: Doc;                 -- ^ A '[' character+rbrack  :: Doc;                 -- ^ A ']' character+lbrace  :: Doc;                 -- ^ A '{' character+rbrace  :: Doc;                 -- ^ A '}' character++text     :: String   -> Doc+ptext    :: String   -> Doc+char     :: Char     -> Doc+int      :: Int      -> Doc+integer  :: Integer  -> Doc+float    :: Float    -> Doc+double   :: Double   -> Doc+rational :: Rational -> Doc+++parens       :: Doc -> Doc;     -- ^ Wrap document in @(...)@+brackets     :: Doc -> Doc;     -- ^ Wrap document in @[...]@+braces       :: Doc -> Doc;     -- ^ Wrap document in @{...}@+quotes       :: Doc -> Doc;     -- ^ Wrap document in @\'...\'@+doubleQuotes :: Doc -> Doc;     -- ^ Wrap document in @\"...\"@++-- Combining @Doc@ values++(<>)   :: Doc -> Doc -> Doc;     -- ^Beside+hcat   :: [Doc] -> Doc;          -- ^List version of '<>'+(<+>)  :: Doc -> Doc -> Doc;     -- ^Beside, separated by space+hsep   :: [Doc] -> Doc;          -- ^List version of '<+>'++($$)   :: Doc -> Doc -> Doc;     -- ^Above; if there is no+                                 -- overlap it \"dovetails\" the two+($+$)  :: Doc -> Doc -> Doc;     -- ^Above, without dovetailing.+vcat   :: [Doc] -> Doc;          -- ^List version of '$$'++cat    :: [Doc] -> Doc;          -- ^ Either hcat or vcat+sep    :: [Doc] -> Doc;          -- ^ Either hsep or vcat+fcat   :: [Doc] -> Doc;          -- ^ \"Paragraph fill\" version of cat+fsep   :: [Doc] -> Doc;          -- ^ \"Paragraph fill\" version of sep++nest   :: Int -> Doc -> Doc;     -- ^ Nested+++-- GHC-specific ones.++hang :: Doc -> Int -> Doc -> Doc;      -- ^ @hang d1 n d2 = sep [d1, nest n d2]@+punctuate :: Doc -> [Doc] -> [Doc]+   -- ^ @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@++-- ---------------------------------------------------------------------------+-- The "implementation"++type State = (Map Name Name, Int)+data PprM a = PprM { runPprM :: State -> (a, State) }++pprName :: Name -> Doc+pprName = pprName' Alone++pprName' :: NameIs -> Name -> Doc+pprName' ni n@(Name o (NameU _))+ = PprM $ \s@(fm, i)+        -> let (n', s') = case Map.lookup n fm of+                         Just d -> (d, s)+                         Nothing -> let n'' = Name o (NameU i)+                                    in (n'', (Map.insert n n'' fm, i + 1))+           in (HPJ.text $ showName' ni n', s')+pprName' ni n = text $ showName' ni n++{-+instance Show Name where+  show (Name occ (NameU u))    = occString occ ++ "_" ++ show (I# u)+  show (Name occ NameS)        = occString occ+  show (Name occ (NameG ns m)) = modString m ++ "." ++ occString occ++data Name = Name OccName NameFlavour++data NameFlavour+  | NameU Int#                  -- A unique local name+-}++to_HPJ_Doc :: Doc -> HPJ.Doc+to_HPJ_Doc d = fst $ runPprM d (Map.empty, 0)++instance Functor PprM where+      fmap = liftM++instance Applicative PprM where+      pure x = PprM $ \s -> (x, s)+      (<*>) = ap++instance Monad PprM where+    m >>= k  = PprM $ \s -> let (x, s') = runPprM m s+                            in runPprM (k x) s'++type Doc = PprM HPJ.Doc++-- The primitive Doc values++isEmpty = liftM HPJ.isEmpty++empty = return HPJ.empty+semi = return HPJ.semi+comma = return HPJ.comma+colon = return HPJ.colon+dcolon = return $ HPJ.text "::"+space = return HPJ.space+equals = return HPJ.equals+arrow = return $ HPJ.text "->"+lparen = return HPJ.lparen+rparen = return HPJ.rparen+lbrack = return HPJ.lbrack+rbrack = return HPJ.rbrack+lbrace = return HPJ.lbrace+rbrace = return HPJ.rbrace++text = return . HPJ.text+ptext = return . HPJ.ptext+char = return . HPJ.char+int = return . HPJ.int+integer = return . HPJ.integer+float = return . HPJ.float+double = return . HPJ.double+rational = return . HPJ.rational+++parens = liftM HPJ.parens+brackets = liftM HPJ.brackets+braces = liftM HPJ.braces+quotes = liftM HPJ.quotes+doubleQuotes = liftM HPJ.doubleQuotes++-- Combining @Doc@ values++(<>) = liftM2 (HPJ.<>)+hcat = liftM HPJ.hcat . sequence+(<+>) = liftM2 (HPJ.<+>)+hsep = liftM HPJ.hsep . sequence++($$) = liftM2 (HPJ.$$)+($+$) = liftM2 (HPJ.$+$)+vcat = liftM HPJ.vcat . sequence++cat  = liftM HPJ.cat . sequence+sep  = liftM HPJ.sep . sequence+fcat = liftM HPJ.fcat . sequence+fsep = liftM HPJ.fsep . sequence++nest n = liftM (HPJ.nest n)++hang d1 n d2 = do d1' <- d1+                  d2' <- d2+                  return (HPJ.hang d1' n d2')++-- punctuate uses the same definition as Text.PrettyPrint+punctuate _ []     = []+punctuate p (d:ds) = go d ds+                   where+                     go d' [] = [d']+                     go d' (e:es) = (d' <> p) : go e es
+ libraries/template-haskell/Language/Haskell/TH/Syntax.hs view
@@ -0,0 +1,2232 @@+{-# LANGUAGE CPP, DeriveDataTypeable,+             DeriveGeneric, FlexibleInstances, DefaultSignatures,+             RankNTypes, RoleAnnotations, ScopedTypeVariables,+             Trustworthy #-}++{-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Language.Haskell.Syntax+-- Copyright   :  (c) The University of Glasgow 2003+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- Abstract syntax definitions for Template Haskell.+--+-----------------------------------------------------------------------------++module Language.Haskell.TH.Syntax+    ( module Language.Haskell.TH.Syntax+      -- * Language extensions+    , module Language.Haskell.TH.LanguageExtensions+    , ForeignSrcLang(..)+    ) where++import Data.Data hiding (Fixity(..))+import Data.IORef+import System.IO.Unsafe ( unsafePerformIO )+import Control.Monad (liftM)+import Control.Monad.IO.Class (MonadIO (..))+import System.IO        ( hPutStrLn, stderr )+import Data.Char        ( isAlpha, isAlphaNum, isUpper )+import Data.Int+import Data.List.NonEmpty ( NonEmpty(..) )+import Data.Void        ( Void, absurd )+import Data.Word+import Data.Ratio+import GHC.Generics     ( Generic )+import GHC.Lexeme       ( startsVarSym, startsVarId )+import GHC.ForeignSrcLang.Type+import Language.Haskell.TH.LanguageExtensions+import Numeric.Natural+import Prelude+import Foreign.ForeignPtr++import qualified Control.Monad.Fail as Fail++-----------------------------------------------------+--+--              The Quasi class+--+-----------------------------------------------------++class (MonadIO m, Fail.MonadFail m) => Quasi m where+  qNewName :: String -> m Name+        -- ^ Fresh names++        -- Error reporting and recovery+  qReport  :: Bool -> String -> m ()    -- ^ Report an error (True) or warning (False)+                                        -- ...but carry on; use 'fail' to stop+  qRecover :: m a -- ^ the error handler+           -> m a -- ^ action which may fail+           -> m a               -- ^ Recover from the monadic 'fail'++        -- Inspect the type-checker's environment+  qLookupName :: Bool -> String -> m (Maybe Name)+       -- True <=> type namespace, False <=> value namespace+  qReify          :: Name -> m Info+  qReifyFixity    :: Name -> m (Maybe Fixity)+  qReifyInstances :: Name -> [Type] -> m [Dec]+       -- Is (n tys) an instance?+       -- Returns list of matching instance Decs+       --    (with empty sub-Decs)+       -- Works for classes and type functions+  qReifyRoles         :: Name -> m [Role]+  qReifyAnnotations   :: Data a => AnnLookup -> m [a]+  qReifyModule        :: Module -> m ModuleInfo+  qReifyConStrictness :: Name -> m [DecidedStrictness]++  qLocation :: m Loc++  qRunIO :: IO a -> m a+  qRunIO = liftIO+  -- ^ Input/output (dangerous)++  qAddDependentFile :: FilePath -> m ()++  qAddTempFile :: String -> m FilePath++  qAddTopDecls :: [Dec] -> m ()++  qAddForeignFilePath :: ForeignSrcLang -> String -> m ()++  qAddModFinalizer :: Q () -> m ()++  qAddCorePlugin :: String -> m ()++  qGetQ :: Typeable a => m (Maybe a)++  qPutQ :: Typeable a => a -> m ()++  qIsExtEnabled :: Extension -> m Bool+  qExtsEnabled :: m [Extension]++-----------------------------------------------------+--      The IO instance of Quasi+--+--  This instance is used only when running a Q+--  computation in the IO monad, usually just to+--  print the result.  There is no interesting+--  type environment, so reification isn't going to+--  work.+--+-----------------------------------------------------++instance Quasi IO where+  qNewName s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))+                  ; pure (mkNameU s n) }++  qReport True  msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)+  qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)++  qLookupName _ _       = badIO "lookupName"+  qReify _              = badIO "reify"+  qReifyFixity _        = badIO "reifyFixity"+  qReifyInstances _ _   = badIO "reifyInstances"+  qReifyRoles _         = badIO "reifyRoles"+  qReifyAnnotations _   = badIO "reifyAnnotations"+  qReifyModule _        = badIO "reifyModule"+  qReifyConStrictness _ = badIO "reifyConStrictness"+  qLocation             = badIO "currentLocation"+  qRecover _ _          = badIO "recover" -- Maybe we could fix this?+  qAddDependentFile _   = badIO "addDependentFile"+  qAddTempFile _        = badIO "addTempFile"+  qAddTopDecls _        = badIO "addTopDecls"+  qAddForeignFilePath _ _ = badIO "addForeignFilePath"+  qAddModFinalizer _    = badIO "addModFinalizer"+  qAddCorePlugin _      = badIO "addCorePlugin"+  qGetQ                 = badIO "getQ"+  qPutQ _               = badIO "putQ"+  qIsExtEnabled _       = badIO "isExtEnabled"+  qExtsEnabled          = badIO "extsEnabled"++badIO :: String -> IO a+badIO op = do   { qReport True ("Can't do `" ++ op ++ "' in the IO monad")+                ; fail "Template Haskell failure" }++-- Global variable to generate unique symbols+counter :: IORef Int+{-# NOINLINE counter #-}+counter = unsafePerformIO (newIORef 0)+++-----------------------------------------------------+--+--              The Q monad+--+-----------------------------------------------------++newtype Q a = Q { unQ :: forall m. Quasi m => m a }++-- \"Runs\" the 'Q' monad. Normal users of Template Haskell+-- should not need this function, as the splice brackets @$( ... )@+-- are the usual way of running a 'Q' computation.+--+-- This function is primarily used in GHC internals, and for debugging+-- splices by running them in 'IO'.+--+-- Note that many functions in 'Q', such as 'reify' and other compiler+-- queries, are not supported when running 'Q' in 'IO'; these operations+-- simply fail at runtime. Indeed, the only operations guaranteed to succeed+-- are 'newName', 'runIO', 'reportError' and 'reportWarning'.+runQ :: Quasi m => Q a -> m a+runQ (Q m) = m++instance Monad Q where+  Q m >>= k  = Q (m >>= \x -> unQ (k x))+  (>>) = (*>)+#if !MIN_VERSION_base(4,13,0)+  fail       = Fail.fail+#endif++instance Fail.MonadFail Q where+  fail s     = report True s >> Q (Fail.fail "Q monad failure")++instance Functor Q where+  fmap f (Q x) = Q (fmap f x)++instance Applicative Q where+  pure x = Q (pure x)+  Q f <*> Q x = Q (f <*> x)+  Q m *> Q n = Q (m *> n)++-----------------------------------------------------+--+--              The TExp type+--+-----------------------------------------------------++type role TExp nominal   -- See Note [Role of TExp]+newtype TExp a = TExp+  { unType :: Exp -- ^ Underlying untyped Template Haskell expression+  }+-- ^ Represents an expression which has type @a@. Built on top of 'Exp', typed+-- expressions allow for type-safe splicing via:+--+--   - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if+--     that expression has type @a@, then the quotation has type+--     @'Q' ('TExp' a)@+--+--   - typed splices inside of typed quotes, written as @$$(...)@ where @...@+--     is an arbitrary expression of type @'Q' ('TExp' a)@+--+-- Traditional expression quotes and splices let us construct ill-typed+-- expressions:+--+-- >>> fmap ppr $ runQ [| True == $( [| "foo" |] ) |]+-- GHC.Types.True GHC.Classes.== "foo"+-- >>> GHC.Types.True GHC.Classes.== "foo"+-- <interactive> error:+--     • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’+--     • In the second argument of ‘(==)’, namely ‘"foo"’+--       In the expression: True == "foo"+--       In an equation for ‘it’: it = True == "foo"+--+-- With typed expressions, the type error occurs when /constructing/ the+-- Template Haskell expression:+--+-- >>> fmap ppr $ runQ [|| True == $$( [|| "foo" ||] ) ||]+-- <interactive> error:+--     • Couldn't match type ‘[Char]’ with ‘Bool’+--       Expected type: Q (TExp Bool)+--         Actual type: Q (TExp [Char])+--     • In the Template Haskell quotation [|| "foo" ||]+--       In the expression: [|| "foo" ||]+--       In the Template Haskell splice $$([|| "foo" ||])++-- | Discard the type annotation and produce a plain Template Haskell+-- expression+unTypeQ :: Q (TExp a) -> Q Exp+unTypeQ m = do { TExp e <- m+               ; return e }++-- | Annotate the Template Haskell expression with a type+--+-- This is unsafe because GHC cannot check for you that the expression+-- really does have the type you claim it has.+unsafeTExpCoerce :: Q Exp -> Q (TExp a)+unsafeTExpCoerce m = do { e <- m+                        ; return (TExp e) }++{- Note [Role of TExp]+~~~~~~~~~~~~~~~~~~~~~~+TExp's argument must have a nominal role, not phantom as would+be inferred (#8459).  Consider++  e :: TExp Age+  e = MkAge 3++  foo = $(coerce e) + 4::Int++The splice will evaluate to (MkAge 3) and you can't add that to+4::Int. So you can't coerce a (TExp Age) to a (TExp Int). -}++----------------------------------------------------+-- Packaged versions for the programmer, hiding the Quasi-ness++{- |+Generate a fresh name, which cannot be captured.++For example, this:++@f = $(do+  nm1 <- newName \"x\"+  let nm2 = 'mkName' \"x\"+  return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))+ )@++will produce the splice++>f = \x0 -> \x -> x0++In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,+and is not captured by the binding @VarP nm2@.++Although names generated by @newName@ cannot /be captured/, they can+/capture/ other names. For example, this:++>g = $(do+>  nm1 <- newName "x"+>  let nm2 = mkName "x"+>  return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))+> )++will produce the splice++>g = \x -> \x0 -> x0++since the occurrence @VarE nm2@ is captured by the innermost binding+of @x@, namely @VarP nm1@.+-}+newName :: String -> Q Name+newName s = Q (qNewName s)++-- | Report an error (True) or warning (False),+-- but carry on; use 'fail' to stop.+report  :: Bool -> String -> Q ()+report b s = Q (qReport b s)+{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6++-- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'.+reportError :: String -> Q ()+reportError = report True++-- | Report a warning to the user, and carry on.+reportWarning :: String -> Q ()+reportWarning = report False++-- | Recover from errors raised by 'reportError' or 'fail'.+recover :: Q a -- ^ handler to invoke on failure+        -> Q a -- ^ computation to run+        -> Q a+recover (Q r) (Q m) = Q (qRecover r m)++-- We don't export lookupName; the Bool isn't a great API+-- Instead we export lookupTypeName, lookupValueName+lookupName :: Bool -> String -> Q (Maybe Name)+lookupName ns s = Q (qLookupName ns s)++-- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.+lookupTypeName :: String -> Q (Maybe Name)+lookupTypeName  s = Q (qLookupName True s)++-- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.+lookupValueName :: String -> Q (Maybe Name)+lookupValueName s = Q (qLookupName False s)++{-+Note [Name lookup]+~~~~~~~~~~~~~~~~~~+-}+{- $namelookup #namelookup#+The functions 'lookupTypeName' and 'lookupValueName' provide+a way to query the current splice's context for what names+are in scope. The function 'lookupTypeName' queries the type+namespace, whereas 'lookupValueName' queries the value namespace,+but the functions are otherwise identical.++A call @lookupValueName s@ will check if there is a value+with name @s@ in scope at the current splice's location. If+there is, the @Name@ of this value is returned;+if not, then @Nothing@ is returned.++The returned name cannot be \"captured\".+For example:++> f = "global"+> g = $( do+>          Just nm <- lookupValueName "f"+>          [| let f = "local" in $( varE nm ) |]++In this case, @g = \"global\"@; the call to @lookupValueName@+returned the global @f@, and this name was /not/ captured by+the local definition of @f@.++The lookup is performed in the context of the /top-level/ splice+being run. For example:++> f = "global"+> g = $( [| let f = "local" in+>            $(do+>                Just nm <- lookupValueName "f"+>                varE nm+>             ) |] )++Again in this example, @g = \"global\"@, because the call to+@lookupValueName@ queries the context of the outer-most @$(...)@.++Operators should be queried without any surrounding parentheses, like so:++> lookupValueName "+"++Qualified names are also supported, like so:++> lookupValueName "Prelude.+"+> lookupValueName "Prelude.map"++-}+++{- | 'reify' looks up information about the 'Name'.++It is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName'+to ensure that we are reifying from the right namespace. For instance, in this context:++> data D = D++which @D@ does @reify (mkName \"D\")@ return information about? (Answer: @D@-the-type, but don't rely on it.)+To ensure we get information about @D@-the-value, use 'lookupValueName':++> do+>   Just nm <- lookupValueName "D"+>   reify nm++and to get information about @D@-the-type, use 'lookupTypeName'.+-}+reify :: Name -> Q Info+reify v = Q (qReify v)++{- | @reifyFixity nm@ attempts to find a fixity declaration for @nm@. For+example, if the function @foo@ has the fixity declaration @infixr 7 foo@, then+@reifyFixity 'foo@ would return @'Just' ('Fixity' 7 'InfixR')@. If the function+@bar@ does not have a fixity declaration, then @reifyFixity 'bar@ returns+'Nothing', so you may assume @bar@ has 'defaultFixity'.+-}+reifyFixity :: Name -> Q (Maybe Fixity)+reifyFixity nm = Q (qReifyFixity nm)++{- | @reifyInstances nm tys@ returns a list of visible instances of @nm tys@. That is,+if @nm@ is the name of a type class, then all instances of this class at the types @tys@+are returned. Alternatively, if @nm@ is the name of a data family or type family,+all instances of this family at the types @tys@ are returned.++Note that this is a \"shallow\" test; the declarations returned merely have+instance heads which unify with @nm tys@, they need not actually be satisfiable.++  - @reifyInstances ''Eq [ 'TupleT' 2 \``AppT`\` 'ConT' ''A \``AppT`\` 'ConT' ''B ]@ contains+    the @instance (Eq a, Eq b) => Eq (a, b)@ regardless of whether @A@ and+    @B@ themselves implement 'Eq'++  - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available+    instance of 'Eq'++There is one edge case: @reifyInstances ''Typeable tys@ currently always+produces an empty list (no matter what @tys@ are given).+-}+reifyInstances :: Name -> [Type] -> Q [InstanceDec]+reifyInstances cls tys = Q (qReifyInstances cls tys)++{- | @reifyRoles nm@ returns the list of roles associated with the parameters of+the tycon @nm@. Fails if @nm@ cannot be found or is not a tycon.+The returned list should never contain 'InferR'.+-}+reifyRoles :: Name -> Q [Role]+reifyRoles nm = Q (qReifyRoles nm)++-- | @reifyAnnotations target@ returns the list of annotations+-- associated with @target@.  Only the annotations that are+-- appropriately typed is returned.  So if you have @Int@ and @String@+-- annotations for the same target, you have to call this function twice.+reifyAnnotations :: Data a => AnnLookup -> Q [a]+reifyAnnotations an = Q (qReifyAnnotations an)++-- | @reifyModule mod@ looks up information about module @mod@.  To+-- look up the current module, call this function with the return+-- value of 'Language.Haskell.TH.Lib.thisModule'.+reifyModule :: Module -> Q ModuleInfo+reifyModule m = Q (qReifyModule m)++-- | @reifyConStrictness nm@ looks up the strictness information for the fields+-- of the constructor with the name @nm@. Note that the strictness information+-- that 'reifyConStrictness' returns may not correspond to what is written in+-- the source code. For example, in the following data declaration:+--+-- @+-- data Pair a = Pair a a+-- @+--+-- 'reifyConStrictness' would return @['DecidedLazy', DecidedLazy]@ under most+-- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the+-- @-XStrictData@ language extension was enabled.+reifyConStrictness :: Name -> Q [DecidedStrictness]+reifyConStrictness n = Q (qReifyConStrictness n)++-- | Is the list of instances returned by 'reifyInstances' nonempty?+isInstance :: Name -> [Type] -> Q Bool+isInstance nm tys = do { decs <- reifyInstances nm tys+                       ; return (not (null decs)) }++-- | The location at which this computation is spliced.+location :: Q Loc+location = Q qLocation++-- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.+-- Take care: you are guaranteed the ordering of calls to 'runIO' within+-- a single 'Q' computation, but not about the order in which splices are run.+--+-- Note: for various murky reasons, stdout and stderr handles are not+-- necessarily flushed when the compiler finishes running, so you should+-- flush them yourself.+runIO :: IO a -> Q a+runIO m = Q (qRunIO m)++-- | Record external files that runIO is using (dependent upon).+-- The compiler can then recognize that it should re-compile the Haskell file+-- when an external file changes.+--+-- Expects an absolute file path.+--+-- Notes:+--+--   * ghc -M does not know about these dependencies - it does not execute TH.+--+--   * The dependency is based on file content, not a modification time+addDependentFile :: FilePath -> Q ()+addDependentFile fp = Q (qAddDependentFile fp)++-- | Obtain a temporary file path with the given suffix. The compiler will+-- delete this file after compilation.+addTempFile :: String -> Q FilePath+addTempFile suffix = Q (qAddTempFile suffix)++-- | Add additional top-level declarations. The added declarations will be type+-- checked along with the current declaration group.+addTopDecls :: [Dec] -> Q ()+addTopDecls ds = Q (qAddTopDecls ds)++-- |+addForeignFile :: ForeignSrcLang -> String -> Q ()+addForeignFile = addForeignSource+{-# DEPRECATED addForeignFile+               "Use 'Language.Haskell.TH.Syntax.addForeignSource' instead"+  #-} -- deprecated in 8.6++-- | Emit a foreign file which will be compiled and linked to the object for+-- the current module. Currently only languages that can be compiled with+-- the C compiler are supported, and the flags passed as part of -optc will+-- be also applied to the C compiler invocation that will compile them.+--+-- Note that for non-C languages (for example C++) @extern "C"@ directives+-- must be used to get symbols that we can access from Haskell.+--+-- To get better errors, it is recommended to use #line pragmas when+-- emitting C files, e.g.+--+-- > {-# LANGUAGE CPP #-}+-- > ...+-- > addForeignSource LangC $ unlines+-- >   [ "#line " ++ show (__LINE__ + 1) ++ " " ++ show __FILE__+-- >   , ...+-- >   ]+addForeignSource :: ForeignSrcLang -> String -> Q ()+addForeignSource lang src = do+  let suffix = case lang of+                 LangC      -> "c"+                 LangCxx    -> "cpp"+                 LangObjc   -> "m"+                 LangObjcxx -> "mm"+                 LangAsm    -> "s"+                 RawObject  -> "a"+  path <- addTempFile suffix+  runIO $ writeFile path src+  addForeignFilePath lang path++-- | Same as 'addForeignSource', but expects to receive a path pointing to the+-- foreign file instead of a 'String' of its contents. Consider using this in+-- conjunction with 'addTempFile'.+--+-- This is a good alternative to 'addForeignSource' when you are trying to+-- directly link in an object file.+addForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()+addForeignFilePath lang fp = Q (qAddForeignFilePath lang fp)++-- | Add a finalizer that will run in the Q monad after the current module has+-- been type checked. This only makes sense when run within a top-level splice.+--+-- The finalizer is given the local type environment at the splice point. Thus+-- 'reify' is able to find the local definitions when executed inside the+-- finalizer.+addModFinalizer :: Q () -> Q ()+addModFinalizer act = Q (qAddModFinalizer (unQ act))++-- | Adds a core plugin to the compilation pipeline.+--+-- @addCorePlugin m@ has almost the same effect as passing @-fplugin=m@ to ghc+-- in the command line. The major difference is that the plugin module @m@+-- must not belong to the current package. When TH executes, it is too late+-- to tell the compiler that we needed to compile first a plugin module in the+-- current package.+addCorePlugin :: String -> Q ()+addCorePlugin plugin = Q (qAddCorePlugin plugin)++-- | Get state from the 'Q' monad. Note that the state is local to the+-- Haskell module in which the Template Haskell expression is executed.+getQ :: Typeable a => Q (Maybe a)+getQ = Q qGetQ++-- | Replace the state in the 'Q' monad. Note that the state is local to the+-- Haskell module in which the Template Haskell expression is executed.+putQ :: Typeable a => a -> Q ()+putQ x = Q (qPutQ x)++-- | Determine whether the given language extension is enabled in the 'Q' monad.+isExtEnabled :: Extension -> Q Bool+isExtEnabled ext = Q (qIsExtEnabled ext)++-- | List all enabled language extensions.+extsEnabled :: Q [Extension]+extsEnabled = Q qExtsEnabled++instance MonadIO Q where+  liftIO = runIO++instance Quasi Q where+  qNewName            = newName+  qReport             = report+  qRecover            = recover+  qReify              = reify+  qReifyFixity        = reifyFixity+  qReifyInstances     = reifyInstances+  qReifyRoles         = reifyRoles+  qReifyAnnotations   = reifyAnnotations+  qReifyModule        = reifyModule+  qReifyConStrictness = reifyConStrictness+  qLookupName         = lookupName+  qLocation           = location+  qAddDependentFile   = addDependentFile+  qAddTempFile        = addTempFile+  qAddTopDecls        = addTopDecls+  qAddForeignFilePath = addForeignFilePath+  qAddModFinalizer    = addModFinalizer+  qAddCorePlugin      = addCorePlugin+  qGetQ               = getQ+  qPutQ               = putQ+  qIsExtEnabled       = isExtEnabled+  qExtsEnabled        = extsEnabled+++----------------------------------------------------+-- The following operations are used solely in DsMeta when desugaring brackets+-- They are not necessary for the user, who can use ordinary return and (>>=) etc++returnQ :: a -> Q a+returnQ = return++bindQ :: Q a -> (a -> Q b) -> Q b+bindQ = (>>=)++sequenceQ :: [Q a] -> Q [a]+sequenceQ = sequence+++-----------------------------------------------------+--+--              The Lift class+--+-----------------------------------------------------++-- | A 'Lift' instance can have any of its values turned into a Template+-- Haskell expression. This is needed when a value used within a Template+-- Haskell quotation is bound outside the Oxford brackets (@[| ... |]@) but not+-- at the top level. As an example:+--+-- > add1 :: Int -> Q Exp+-- > add1 x = [| x + 1 |]+--+-- Template Haskell has no way of knowing what value @x@ will take on at+-- splice-time, so it requires the type of @x@ to be an instance of 'Lift'.+--+-- A 'Lift' instance must satisfy @$(lift x) ≡ x@ for all @x@, where @$(...)@+-- is a Template Haskell splice.+--+-- 'Lift' instances can be derived automatically by use of the @-XDeriveLift@+-- GHC language extension:+--+-- > {-# LANGUAGE DeriveLift #-}+-- > module Foo where+-- >+-- > import Language.Haskell.TH.Syntax+-- >+-- > data Bar a = Bar1 a (Bar a) | Bar2 String+-- >   deriving Lift+class Lift t where+  -- | Turn a value into a Template Haskell expression, suitable for use in+  -- a splice.+  lift :: t -> Q Exp+  lift = unTypeQ . liftTyped++  -- | Turn a value into a Template Haskell typed expression, suitable for use+  -- in a typed splice.+  --+  -- @since 2.16.0.0+  liftTyped :: t -> Q (TExp t)+  liftTyped = unsafeTExpCoerce . lift++  {-# MINIMAL lift | liftTyped #-}+++-- If you add any instances here, consider updating test th/TH_Lift+instance Lift Integer where+  lift x = return (LitE (IntegerL x))++instance Lift Int where+  lift x = return (LitE (IntegerL (fromIntegral x)))++instance Lift Int8 where+  lift x = return (LitE (IntegerL (fromIntegral x)))++instance Lift Int16 where+  lift x = return (LitE (IntegerL (fromIntegral x)))++instance Lift Int32 where+  lift x = return (LitE (IntegerL (fromIntegral x)))++instance Lift Int64 where+  lift x = return (LitE (IntegerL (fromIntegral x)))++instance Lift Word where+  lift x = return (LitE (IntegerL (fromIntegral x)))++instance Lift Word8 where+  lift x = return (LitE (IntegerL (fromIntegral x)))++instance Lift Word16 where+  lift x = return (LitE (IntegerL (fromIntegral x)))++instance Lift Word32 where+  lift x = return (LitE (IntegerL (fromIntegral x)))++instance Lift Word64 where+  lift x = return (LitE (IntegerL (fromIntegral x)))++instance Lift Natural where+  lift x = return (LitE (IntegerL (fromIntegral x)))++instance Integral a => Lift (Ratio a) where+  lift x = return (LitE (RationalL (toRational x)))++instance Lift Float where+  lift x = return (LitE (RationalL (toRational x)))++instance Lift Double where+  lift x = return (LitE (RationalL (toRational x)))++instance Lift Char where+  lift x = return (LitE (CharL x))++instance Lift Bool where+  lift True  = return (ConE trueName)+  lift False = return (ConE falseName)++instance Lift a => Lift (Maybe a) where+  lift Nothing  = return (ConE nothingName)+  lift (Just x) = liftM (ConE justName `AppE`) (lift x)++instance (Lift a, Lift b) => Lift (Either a b) where+  lift (Left x)  = liftM (ConE leftName  `AppE`) (lift x)+  lift (Right y) = liftM (ConE rightName `AppE`) (lift y)++instance Lift a => Lift [a] where+  lift xs = do { xs' <- mapM lift xs; return (ListE xs') }++liftString :: String -> Q Exp+-- Used in TcExpr to short-circuit the lifting for strings+liftString s = return (LitE (StringL s))++-- | @since 2.15.0.0+instance Lift a => Lift (NonEmpty a) where+  lift (x :| xs) = do+    x' <- lift x+    xs' <- lift xs+    return (InfixE (Just x') (ConE nonemptyName) (Just xs'))++-- | @since 2.15.0.0+instance Lift Void where+  lift = pure . absurd++instance Lift () where+  lift () = return (ConE (tupleDataName 0))++instance (Lift a, Lift b) => Lift (a, b) where+  lift (a, b)+    = liftM TupE $ sequence [lift a, lift b]++instance (Lift a, Lift b, Lift c) => Lift (a, b, c) where+  lift (a, b, c)+    = liftM TupE $ sequence [lift a, lift b, lift c]++instance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where+  lift (a, b, c, d)+    = liftM TupE $ sequence [lift a, lift b, lift c, lift d]++instance (Lift a, Lift b, Lift c, Lift d, Lift e)+      => Lift (a, b, c, d, e) where+  lift (a, b, c, d, e)+    = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e]++instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)+      => Lift (a, b, c, d, e, f) where+  lift (a, b, c, d, e, f)+    = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f]++instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)+      => Lift (a, b, c, d, e, f, g) where+  lift (a, b, c, d, e, f, g)+    = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f, lift g]++-- TH has a special form for literal strings,+-- which we should take advantage of.+-- NB: the lhs of the rule has no args, so that+--     the rule will apply to a 'lift' all on its own+--     which happens to be the way the type checker+--     creates it.+{-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-}+++trueName, falseName :: Name+trueName  = mkNameG DataName "ghc-prim" "GHC.Types" "True"+falseName = mkNameG DataName "ghc-prim" "GHC.Types" "False"++nothingName, justName :: Name+nothingName = mkNameG DataName "base" "GHC.Maybe" "Nothing"+justName    = mkNameG DataName "base" "GHC.Maybe" "Just"++leftName, rightName :: Name+leftName  = mkNameG DataName "base" "Data.Either" "Left"+rightName = mkNameG DataName "base" "Data.Either" "Right"++nonemptyName :: Name+nonemptyName = mkNameG DataName "base" "GHC.Base" ":|"++-----------------------------------------------------+--+--              Generic Lift implementations+--+-----------------------------------------------------++-- | 'dataToQa' is an internal utility function for constructing generic+-- conversion functions from types with 'Data' instances to various+-- quasi-quoting representations.  See the source of 'dataToExpQ' and+-- 'dataToPatQ' for two example usages: @mkCon@, @mkLit@+-- and @appQ@ are overloadable to account for different syntax for+-- expressions and patterns; @antiQ@ allows you to override type-specific+-- cases, a common usage is just @const Nothing@, which results in+-- no overloading.+dataToQa  ::  forall a k q. Data a+          =>  (Name -> k)+          ->  (Lit -> Q q)+          ->  (k -> [Q q] -> Q q)+          ->  (forall b . Data b => b -> Maybe (Q q))+          ->  a+          ->  Q q+dataToQa mkCon mkLit appCon antiQ t =+    case antiQ t of+      Nothing ->+          case constrRep constr of+            AlgConstr _ ->+                appCon (mkCon funOrConName) conArgs+              where+                funOrConName :: Name+                funOrConName =+                    case showConstr constr of+                      "(:)"       -> Name (mkOccName ":")+                                          (NameG DataName+                                                (mkPkgName "ghc-prim")+                                                (mkModName "GHC.Types"))+                      con@"[]"    -> Name (mkOccName con)+                                          (NameG DataName+                                                (mkPkgName "ghc-prim")+                                                (mkModName "GHC.Types"))+                      con@('(':_) -> Name (mkOccName con)+                                          (NameG DataName+                                                (mkPkgName "ghc-prim")+                                                (mkModName "GHC.Tuple"))++                      -- Tricky case: see Note [Data for non-algebraic types]+                      fun@(x:_)   | startsVarSym x || startsVarId x+                                  -> mkNameG_v tyconPkg tyconMod fun+                      con         -> mkNameG_d tyconPkg tyconMod con++                  where+                    tycon :: TyCon+                    tycon = (typeRepTyCon . typeOf) t++                    tyconPkg, tyconMod :: String+                    tyconPkg = tyConPackage tycon+                    tyconMod = tyConModule  tycon++                conArgs :: [Q q]+                conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t+            IntConstr n ->+                mkLit $ IntegerL n+            FloatConstr n ->+                mkLit $ RationalL n+            CharConstr c ->+                mkLit $ CharL c+        where+          constr :: Constr+          constr = toConstr t++      Just y -> y+++{- Note [Data for non-algebraic types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Class Data was originally intended for algebraic data types.  But+it is possible to use it for abstract types too.  For example, in+package `text` we find++  instance Data Text where+    ...+    toConstr _ = packConstr++  packConstr :: Constr+  packConstr = mkConstr textDataType "pack" [] Prefix++Here `packConstr` isn't a real data constructor, it's an ordinary+function.  Two complications++* In such a case, we must take care to build the Name using+  mkNameG_v (for values), not mkNameG_d (for data constructors).+  See #10796.++* The pseudo-constructor is named only by its string, here "pack".+  But 'dataToQa' needs the TyCon of its defining module, and has+  to assume it's defined in the same module as the TyCon itself.+  But nothing enforces that; #12596 shows what goes wrong if+  "pack" is defined in a different module than the data type "Text".+  -}++-- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the+-- same value, in the SYB style. It is generalized to take a function+-- override type-specific cases; see 'liftData' for a more commonly+-- used variant.+dataToExpQ  ::  Data a+            =>  (forall b . Data b => b -> Maybe (Q Exp))+            ->  a+            ->  Q Exp+dataToExpQ = dataToQa varOrConE litE (foldl appE)+    where+          -- Make sure that VarE is used if the Constr value relies on a+          -- function underneath the surface (instead of a constructor).+          -- See #10796.+          varOrConE s =+            case nameSpace s of+                 Just VarName  -> return (VarE s)+                 Just DataName -> return (ConE s)+                 _ -> fail $ "Can't construct an expression from name "+                          ++ showName s+          appE x y = do { a <- x; b <- y; return (AppE a b)}+          litE c = return (LitE c)++-- | 'liftData' is a variant of 'lift' in the 'Lift' type class which+-- works for any type with a 'Data' instance.+liftData :: Data a => a -> Q Exp+liftData = dataToExpQ (const Nothing)++-- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same+-- value, in the SYB style. It takes a function to handle type-specific cases,+-- alternatively, pass @const Nothing@ to get default behavior.+dataToPatQ  ::  Data a+            =>  (forall b . Data b => b -> Maybe (Q Pat))+            ->  a+            ->  Q Pat+dataToPatQ = dataToQa id litP conP+    where litP l = return (LitP l)+          conP n ps =+            case nameSpace n of+                Just DataName -> do+                    ps' <- sequence ps+                    return (ConP n ps')+                _ -> fail $ "Can't construct a pattern from name "+                         ++ showName n++-----------------------------------------------------+--              Names and uniques+-----------------------------------------------------++newtype ModName = ModName String        -- Module name+ deriving (Show,Eq,Ord,Data,Generic)++newtype PkgName = PkgName String        -- package name+ deriving (Show,Eq,Ord,Data,Generic)++-- | Obtained from 'reifyModule' and 'Language.Haskell.TH.Lib.thisModule'.+data Module = Module PkgName ModName -- package qualified module name+ deriving (Show,Eq,Ord,Data,Generic)++newtype OccName = OccName String+ deriving (Show,Eq,Ord,Data,Generic)++mkModName :: String -> ModName+mkModName s = ModName s++modString :: ModName -> String+modString (ModName m) = m+++mkPkgName :: String -> PkgName+mkPkgName s = PkgName s++pkgString :: PkgName -> String+pkgString (PkgName m) = m+++-----------------------------------------------------+--              OccName+-----------------------------------------------------++mkOccName :: String -> OccName+mkOccName s = OccName s++occString :: OccName -> String+occString (OccName occ) = occ+++-----------------------------------------------------+--               Names+-----------------------------------------------------+--+-- For "global" names ('NameG') we need a totally unique name,+-- so we must include the name-space of the thing+--+-- For unique-numbered things ('NameU'), we've got a unique reference+-- anyway, so no need for name space+--+-- For dynamically bound thing ('NameS') we probably want them to+-- in a context-dependent way, so again we don't want the name+-- space.  For example:+--+-- > let v = mkName "T" in [| data $v = $v |]+--+-- Here we use the same Name for both type constructor and data constructor+--+--+-- NameL and NameG are bound *outside* the TH syntax tree+-- either globally (NameG) or locally (NameL). Ex:+--+-- > f x = $(h [| (map, x) |])+--+-- The 'map' will be a NameG, and 'x' wil be a NameL+--+-- These Names should never appear in a binding position in a TH syntax tree++{- $namecapture #namecapture#+Much of 'Name' API is concerned with the problem of /name capture/, which+can be seen in the following example.++> f expr = [| let x = 0 in $expr |]+> ...+> g x = $( f [| x |] )+> h y = $( f [| y |] )++A naive desugaring of this would yield:++> g x = let x = 0 in x+> h y = let x = 0 in y++All of a sudden, @g@ and @h@ have different meanings! In this case,+we say that the @x@ in the RHS of @g@ has been /captured/+by the binding of @x@ in @f@.++What we actually want is for the @x@ in @f@ to be distinct from the+@x@ in @g@, so we get the following desugaring:++> g x = let x' = 0 in x+> h y = let x' = 0 in y++which avoids name capture as desired.++In the general case, we say that a @Name@ can be captured if+the thing it refers to can be changed by adding new declarations.+-}++{- |+An abstract type representing names in the syntax tree.++'Name's can be constructed in several ways, which come with different+name-capture guarantees (see "Language.Haskell.TH.Syntax#namecapture" for+an explanation of name capture):++  * the built-in syntax @'f@ and @''T@ can be used to construct names,+    The expression @'f@ gives a @Name@ which refers to the value @f@+    currently in scope, and @''T@ gives a @Name@ which refers to the+    type @T@ currently in scope. These names can never be captured.++  * 'lookupValueName' and 'lookupTypeName' are similar to @'f@ and+     @''T@ respectively, but the @Name@s are looked up at the point+     where the current splice is being run. These names can never be+     captured.++  * 'newName' monadically generates a new name, which can never+     be captured.++  * 'mkName' generates a capturable name.++Names constructed using @newName@ and @mkName@ may be used in bindings+(such as @let x = ...@ or @\x -> ...@), but names constructed using+@lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not.+-}+data Name = Name OccName NameFlavour deriving (Data, Eq, Generic)++instance Ord Name where+    -- check if unique is different before looking at strings+  (Name o1 f1) `compare` (Name o2 f2) = (f1 `compare` f2)   `thenCmp`+                                        (o1 `compare` o2)++data NameFlavour+  = NameS           -- ^ An unqualified name; dynamically bound+  | NameQ ModName   -- ^ A qualified name; dynamically bound+  | NameU !Int      -- ^ A unique local name+  | NameL !Int      -- ^ Local name bound outside of the TH AST+  | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST:+                -- An original name (occurrences only, not binders)+                -- Need the namespace too to be sure which+                -- thing we are naming+  deriving ( Data, Eq, Ord, Show, Generic )++data NameSpace = VarName        -- ^ Variables+               | DataName       -- ^ Data constructors+               | TcClsName      -- ^ Type constructors and classes; Haskell has them+                                -- in the same name space for now.+               deriving( Eq, Ord, Show, Data, Generic )++type Uniq = Int++-- | The name without its module prefix.+--+-- ==== __Examples__+--+-- >>> nameBase ''Data.Either.Either+-- "Either"+-- >>> nameBase (mkName "foo")+-- "foo"+-- >>> nameBase (mkName "Module.foo")+-- "foo"+nameBase :: Name -> String+nameBase (Name occ _) = occString occ++-- | Module prefix of a name, if it exists.+--+-- ==== __Examples__+--+-- >>> nameModule ''Data.Either.Either+-- Just "Data.Either"+-- >>> nameModule (mkName "foo")+-- Nothing+-- >>> nameModule (mkName "Module.foo")+-- Just "Module"+nameModule :: Name -> Maybe String+nameModule (Name _ (NameQ m))     = Just (modString m)+nameModule (Name _ (NameG _ _ m)) = Just (modString m)+nameModule _                      = Nothing++-- | A name's package, if it exists.+--+-- ==== __Examples__+--+-- >>> namePackage ''Data.Either.Either+-- Just "base"+-- >>> namePackage (mkName "foo")+-- Nothing+-- >>> namePackage (mkName "Module.foo")+-- Nothing+namePackage :: Name -> Maybe String+namePackage (Name _ (NameG _ p _)) = Just (pkgString p)+namePackage _                      = Nothing++-- | Returns whether a name represents an occurrence of a top-level variable+-- ('VarName'), data constructor ('DataName'), type constructor, or type class+-- ('TcClsName'). If we can't be sure, it returns 'Nothing'.+--+-- ==== __Examples__+--+-- >>> nameSpace 'Prelude.id+-- Just VarName+-- >>> nameSpace (mkName "id")+-- Nothing -- only works for top-level variable names+-- >>> nameSpace 'Data.Maybe.Just+-- Just DataName+-- >>> nameSpace ''Data.Maybe.Maybe+-- Just TcClsName+-- >>> nameSpace ''Data.Ord.Ord+-- Just TcClsName+nameSpace :: Name -> Maybe NameSpace+nameSpace (Name _ (NameG ns _ _)) = Just ns+nameSpace _                       = Nothing++{- |+Generate a capturable name. Occurrences of such names will be+resolved according to the Haskell scoping rules at the occurrence+site.++For example:++> f = [| pi + $(varE (mkName "pi")) |]+> ...+> g = let pi = 3 in $f++In this case, @g@ is desugared to++> g = Prelude.pi + 3++Note that @mkName@ may be used with qualified names:++> mkName "Prelude.pi"++See also 'Language.Haskell.TH.Lib.dyn' for a useful combinator. The above example could+be rewritten using 'Language.Haskell.TH.Lib.dyn' as++> f = [| pi + $(dyn "pi") |]+-}+mkName :: String -> Name+-- The string can have a '.', thus "Foo.baz",+-- giving a dynamically-bound qualified name,+-- in which case we want to generate a NameQ+--+-- Parse the string to see if it has a "." in it+-- so we know whether to generate a qualified or unqualified name+-- It's a bit tricky because we need to parse+--+-- > Foo.Baz.x   as    Qual Foo.Baz x+--+-- So we parse it from back to front+mkName str+  = split [] (reverse str)+  where+    split occ []        = Name (mkOccName occ) NameS+    split occ ('.':rev) | not (null occ)+                        , is_rev_mod_name rev+                        = Name (mkOccName occ) (NameQ (mkModName (reverse rev)))+        -- The 'not (null occ)' guard ensures that+        --      mkName "&." = Name "&." NameS+        -- The 'is_rev_mod' guards ensure that+        --      mkName ".&" = Name ".&" NameS+        --      mkName "^.." = Name "^.." NameS      -- #8633+        --      mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits")+        -- This rather bizarre case actually happened; (.&.) is in Data.Bits+    split occ (c:rev)   = split (c:occ) rev++    -- Recognises a reversed module name xA.yB.C,+    -- with at least one component,+    -- and each component looks like a module name+    --   (i.e. non-empty, starts with capital, all alpha)+    is_rev_mod_name rev_mod_str+      | (compt, rest) <- break (== '.') rev_mod_str+      , not (null compt), isUpper (last compt), all is_mod_char compt+      = case rest of+          []             -> True+          (_dot : rest') -> is_rev_mod_name rest'+      | otherwise+      = False++    is_mod_char c = isAlphaNum c || c == '_' || c == '\''++-- | Only used internally+mkNameU :: String -> Uniq -> Name+mkNameU s u = Name (mkOccName s) (NameU u)++-- | Only used internally+mkNameL :: String -> Uniq -> Name+mkNameL s u = Name (mkOccName s) (NameL u)++-- | Used for 'x etc, but not available to the programmer+mkNameG :: NameSpace -> String -> String -> String -> Name+mkNameG ns pkg modu occ+  = Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu))++mkNameS :: String -> Name+mkNameS n = Name (mkOccName n) NameS++mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name+mkNameG_v  = mkNameG VarName+mkNameG_tc = mkNameG TcClsName+mkNameG_d  = mkNameG DataName++data NameIs = Alone | Applied | Infix++showName :: Name -> String+showName = showName' Alone++showName' :: NameIs -> Name -> String+showName' ni nm+ = case ni of+       Alone        -> nms+       Applied+        | pnam      -> nms+        | otherwise -> "(" ++ nms ++ ")"+       Infix+        | pnam      -> "`" ++ nms ++ "`"+        | otherwise -> nms+    where+        -- For now, we make the NameQ and NameG print the same, even though+        -- NameQ is a qualified name (so what it means depends on what the+        -- current scope is), and NameG is an original name (so its meaning+        -- should be independent of what's in scope.+        -- We may well want to distinguish them in the end.+        -- Ditto NameU and NameL+        nms = case nm of+                    Name occ NameS         -> occString occ+                    Name occ (NameQ m)     -> modString m ++ "." ++ occString occ+                    Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ+                    Name occ (NameU u)     -> occString occ ++ "_" ++ show u+                    Name occ (NameL u)     -> occString occ ++ "_" ++ show u++        pnam = classify nms++        -- True if we are function style, e.g. f, [], (,)+        -- False if we are operator style, e.g. +, :++        classify "" = False -- shouldn't happen; . operator is handled below+        classify (x:xs) | isAlpha x || (x `elem` "_[]()") =+                            case dropWhile (/='.') xs of+                                  (_:xs') -> classify xs'+                                  []      -> True+                        | otherwise = False++instance Show Name where+  show = showName++-- Tuple data and type constructors+-- | Tuple data constructor+tupleDataName :: Int -> Name+-- | Tuple type constructor+tupleTypeName :: Int -> Name++tupleDataName 0 = mk_tup_name 0 DataName+tupleDataName 1 = error "tupleDataName 1"+tupleDataName n = mk_tup_name (n-1) DataName++tupleTypeName 0 = mk_tup_name 0 TcClsName+tupleTypeName 1 = error "tupleTypeName 1"+tupleTypeName n = mk_tup_name (n-1) TcClsName++mk_tup_name :: Int -> NameSpace -> Name+mk_tup_name n_commas space+  = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)+  where+    occ = mkOccName ('(' : replicate n_commas ',' ++ ")")+    tup_mod = mkModName "GHC.Tuple"++-- Unboxed tuple data and type constructors+-- | Unboxed tuple data constructor+unboxedTupleDataName :: Int -> Name+-- | Unboxed tuple type constructor+unboxedTupleTypeName :: Int -> Name++unboxedTupleDataName n = mk_unboxed_tup_name n DataName+unboxedTupleTypeName n = mk_unboxed_tup_name n TcClsName++mk_unboxed_tup_name :: Int -> NameSpace -> Name+mk_unboxed_tup_name n space+  = Name (mkOccName tup_occ) (NameG space (mkPkgName "ghc-prim") tup_mod)+  where+    tup_occ | n == 1    = "Unit#" -- See Note [One-tuples] in TysWiredIn+            | otherwise = "(#" ++ replicate n_commas ',' ++ "#)"+    n_commas = n - 1+    tup_mod  = mkModName "GHC.Tuple"++-- Unboxed sum data and type constructors+-- | Unboxed sum data constructor+unboxedSumDataName :: SumAlt -> SumArity -> Name+-- | Unboxed sum type constructor+unboxedSumTypeName :: SumArity -> Name++unboxedSumDataName alt arity+  | alt > arity+  = error $ prefix ++ "Index out of bounds." ++ debug_info++  | alt <= 0+  = error $ prefix ++ "Alt must be > 0." ++ debug_info++  | arity < 2+  = error $ prefix ++ "Arity must be >= 2." ++ debug_info++  | otherwise+  = Name (mkOccName sum_occ)+         (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Prim"))++  where+    prefix     = "unboxedSumDataName: "+    debug_info = " (alt: " ++ show alt ++ ", arity: " ++ show arity ++ ")"++    -- Synced with the definition of mkSumDataConOcc in TysWiredIn+    sum_occ = '(' : '#' : bars nbars_before ++ '_' : bars nbars_after ++ "#)"+    bars i = replicate i '|'+    nbars_before = alt - 1+    nbars_after  = arity - alt++unboxedSumTypeName arity+  | arity < 2+  = error $ "unboxedSumTypeName: Arity must be >= 2."+         ++ " (arity: " ++ show arity ++ ")"++  | otherwise+  = Name (mkOccName sum_occ)+         (NameG TcClsName (mkPkgName "ghc-prim") (mkModName "GHC.Prim"))++  where+    -- Synced with the definition of mkSumTyConOcc in TysWiredIn+    sum_occ = '(' : '#' : replicate (arity - 1) '|' ++ "#)"++-----------------------------------------------------+--              Locations+-----------------------------------------------------++data Loc+  = Loc { loc_filename :: String+        , loc_package  :: String+        , loc_module   :: String+        , loc_start    :: CharPos+        , loc_end      :: CharPos }+   deriving( Show, Eq, Ord, Data, Generic )++type CharPos = (Int, Int)       -- ^ Line and character position+++-----------------------------------------------------+--+--      The Info returned by reification+--+-----------------------------------------------------++-- | Obtained from 'reify' in the 'Q' Monad.+data Info+  =+  -- | A class, with a list of its visible instances+  ClassI+      Dec+      [InstanceDec]++  -- | A class method+  | ClassOpI+       Name+       Type+       ParentName++  -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned+  -- using 'PrimTyConI' or 'FamilyI' as appropriate. At present, this reified+  -- declaration will never have derived instances attached to it (if you wish+  -- to check for an instance, see 'reifyInstances').+  | TyConI+        Dec++  -- | A type or data family, with a list of its visible instances. A closed+  -- type family is returned with 0 instances.+  | FamilyI+        Dec+        [InstanceDec]++  -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'.+  -- Examples: @(->)@, @Int#@.+  | PrimTyConI+       Name+       Arity+       Unlifted++  -- | A data constructor+  | DataConI+       Name+       Type+       ParentName++  -- | A pattern synonym+  | PatSynI+       Name+       PatSynType++  {- |+  A \"value\" variable (as opposed to a type variable, see 'TyVarI').++  The @Maybe Dec@ field contains @Just@ the declaration which+  defined the variable - including the RHS of the declaration -+  or else @Nothing@, in the case where the RHS is unavailable to+  the compiler. At present, this value is /always/ @Nothing@:+  returning the RHS has not yet been implemented because of+  lack of interest.+  -}+  | VarI+       Name+       Type+       (Maybe Dec)++  {- |+  A type variable.++  The @Type@ field contains the type which underlies the variable.+  At present, this is always @'VarT' theName@, but future changes+  may permit refinement of this.+  -}+  | TyVarI      -- Scoped type variable+        Name+        Type    -- What it is bound to+  deriving( Show, Eq, Ord, Data, Generic )++-- | Obtained from 'reifyModule' in the 'Q' Monad.+data ModuleInfo =+  -- | Contains the import list of the module.+  ModuleInfo [Module]+  deriving( Show, Eq, Ord, Data, Generic )++{- |+In 'ClassOpI' and 'DataConI', name of the parent class or type+-}+type ParentName = Name++-- | In 'UnboxedSumE' and 'UnboxedSumP', the number associated with a+-- particular data constructor. 'SumAlt's are one-indexed and should never+-- exceed the value of its corresponding 'SumArity'. For example:+--+-- * @(\#_|\#)@ has 'SumAlt' 1 (out of a total 'SumArity' of 2)+--+-- * @(\#|_\#)@ has 'SumAlt' 2 (out of a total 'SumArity' of 2)+type SumAlt = Int++-- | In 'UnboxedSumE', 'UnboxedSumT', and 'UnboxedSumP', the total number of+-- 'SumAlt's. For example, @(\#|\#)@ has a 'SumArity' of 2.+type SumArity = Int++-- | In 'PrimTyConI', arity of the type constructor+type Arity = Int++-- | In 'PrimTyConI', is the type constructor unlifted?+type Unlifted = Bool++-- | 'InstanceDec' desribes a single instance of a class or type function.+-- It is just a 'Dec', but guaranteed to be one of the following:+--+--   * 'InstanceD' (with empty @['Dec']@)+--+--   * 'DataInstD' or 'NewtypeInstD' (with empty derived @['Name']@)+--+--   * 'TySynInstD'+type InstanceDec = Dec++data Fixity          = Fixity Int FixityDirection+    deriving( Eq, Ord, Show, Data, Generic )+data FixityDirection = InfixL | InfixR | InfixN+    deriving( Eq, Ord, Show, Data, Generic )++-- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9)+maxPrecedence :: Int+maxPrecedence = (9::Int)++-- | Default fixity: @infixl 9@+defaultFixity :: Fixity+defaultFixity = Fixity maxPrecedence InfixL+++{-+Note [Unresolved infix]+~~~~~~~~~~~~~~~~~~~~~~~+-}+{- $infix #infix#+When implementing antiquotation for quasiquoters, one often wants+to parse strings into expressions:++> parse :: String -> Maybe Exp++But how should we parse @a + b * c@? If we don't know the fixities of+@+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a++ b) * c@.++In cases like this, use 'UInfixE', 'UInfixP', or 'UInfixT', which stand for+\"unresolved infix expression/pattern/type\", respectively. When the compiler+is given a splice containing a tree of @UInfixE@ applications such as++> UInfixE+>   (UInfixE e1 op1 e2)+>   op2+>   (UInfixE e3 op3 e4)++it will look up and the fixities of the relevant operators and+reassociate the tree as necessary.++  * trees will not be reassociated across 'ParensE', 'ParensP', or 'ParensT',+    which are of use for parsing expressions like++    > (a + b * c) + d * e++  * 'InfixE', 'InfixP', and 'InfixT' expressions are never reassociated.++  * The 'UInfixE' constructor doesn't support sections. Sections+    such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer+    sections such as @(a + b * c -)@, use an 'InfixE' constructor for the+    outer-most section, and use 'UInfixE' constructors for all+    other operators:++    > InfixE+    >   Just (UInfixE ...a + b * c...)+    >   op+    >   Nothing++    Sections such as @(a + b +)@ and @((a + b) +)@ should be rendered+    into 'Exp's differently:++    > (+ a + b)   ---> InfixE Nothing + (Just $ UInfixE a + b)+    >                    -- will result in a fixity error if (+) is left-infix+    > (+ (a + b)) ---> InfixE Nothing + (Just $ ParensE $ UInfixE a + b)+    >                    -- no fixity errors++  * Quoted expressions such as++    > [| a * b + c |] :: Q Exp+    > [p| a : b : c |] :: Q Pat+    > [t| T + T |] :: Q Type++    will never contain 'UInfixE', 'UInfixP', 'UInfixT', 'InfixT', 'ParensE',+    'ParensP', or 'ParensT' constructors.++-}++-----------------------------------------------------+--+--      The main syntax data types+--+-----------------------------------------------------++data Lit = CharL Char+         | StringL String+         | IntegerL Integer     -- ^ Used for overloaded and non-overloaded+                                -- literals. We don't have a good way to+                                -- represent non-overloaded literals at+                                -- the moment. Maybe that doesn't matter?+         | RationalL Rational   -- Ditto+         | IntPrimL Integer+         | WordPrimL Integer+         | FloatPrimL Rational+         | DoublePrimL Rational+         | StringPrimL [Word8]  -- ^ A primitive C-style string, type Addr#+         | BytesPrimL Bytes     -- ^ Some raw bytes, type Addr#:+         | CharPrimL Char+    deriving( Show, Eq, Ord, Data, Generic )++    -- We could add Int, Float, Double etc, as we do in HsLit,+    -- but that could complicate the+    -- supposedly-simple TH.Syntax literal type++-- | Raw bytes embedded into the binary.+--+-- Avoid using Bytes constructor directly as it is likely to change in the+-- future. Use helpers such as `mkBytes` in Language.Haskell.TH.Lib instead.+data Bytes = Bytes+   { bytesPtr    :: ForeignPtr Word8 -- ^ Pointer to the data+   , bytesOffset :: Word             -- ^ Offset from the pointer+   , bytesSize   :: Word             -- ^ Number of bytes+   -- Maybe someday:+   -- , bytesAlignement  :: Word -- ^ Alignement constraint+   -- , bytesReadOnly    :: Bool -- ^ Shall we embed into a read-only+   --                            --   section or not+   -- , bytesInitialized :: Bool -- ^ False: only use `bytesSize` to allocate+   --                            --   an uninitialized region+   }+   deriving (Eq,Ord,Data,Generic,Show)+++-- | Pattern in Haskell given in @{}@+data Pat+  = LitP Lit                        -- ^ @{ 5 or \'c\' }@+  | VarP Name                       -- ^ @{ x }@+  | TupP [Pat]                      -- ^ @{ (p1,p2) }@+  | UnboxedTupP [Pat]               -- ^ @{ (\# p1,p2 \#) }@+  | UnboxedSumP Pat SumAlt SumArity -- ^ @{ (\#|p|\#) }@+  | ConP Name [Pat]                 -- ^ @data T1 = C1 t1 t2; {C1 p1 p1} = e@+  | InfixP Pat Name Pat             -- ^ @foo ({x :+ y}) = e@+  | UInfixP Pat Name Pat            -- ^ @foo ({x :+ y}) = e@+                                    --+                                    -- See "Language.Haskell.TH.Syntax#infix"+  | ParensP Pat                     -- ^ @{(p)}@+                                    --+                                    -- See "Language.Haskell.TH.Syntax#infix"+  | TildeP Pat                      -- ^ @{ ~p }@+  | BangP Pat                       -- ^ @{ !p }@+  | AsP Name Pat                    -- ^ @{ x \@ p }@+  | WildP                           -- ^ @{ _ }@+  | RecP Name [FieldPat]            -- ^ @f (Pt { pointx = x }) = g x@+  | ListP [ Pat ]                   -- ^ @{ [1,2,3] }@+  | SigP Pat Type                   -- ^ @{ p :: t }@+  | ViewP Exp Pat                   -- ^ @{ e -> p }@+  deriving( Show, Eq, Ord, Data, Generic )++type FieldPat = (Name,Pat)++data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@+    deriving( Show, Eq, Ord, Data, Generic )+data Clause = Clause [Pat] Body [Dec]+                                  -- ^ @f { p1 p2 = body where decs }@+    deriving( Show, Eq, Ord, Data, Generic )++data Exp+  = VarE Name                          -- ^ @{ x }@+  | ConE Name                          -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2  @+  | LitE Lit                           -- ^ @{ 5 or \'c\'}@+  | AppE Exp Exp                       -- ^ @{ f x }@+  | AppTypeE Exp Type                  -- ^ @{ f \@Int }@++  | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@++    -- It's a bit gruesome to use an Exp as the+    -- operator, but how else can we distinguish+    -- constructors from non-constructors?+    -- Maybe there should be a var-or-con type?+    -- Or maybe we should leave it to the String itself?++  | UInfixE Exp Exp Exp                -- ^ @{x + y}@+                                       --+                                       -- See "Language.Haskell.TH.Syntax#infix"+  | ParensE Exp                        -- ^ @{ (e) }@+                                       --+                                       -- See "Language.Haskell.TH.Syntax#infix"+  | LamE [Pat] Exp                     -- ^ @{ \\ p1 p2 -> e }@+  | LamCaseE [Match]                   -- ^ @{ \\case m1; m2 }@+  | TupE [Exp]                         -- ^ @{ (e1,e2) }  @+  | UnboxedTupE [Exp]                  -- ^ @{ (\# e1,e2 \#) }  @+  | UnboxedSumE Exp SumAlt SumArity    -- ^ @{ (\#|e|\#) }@+  | CondE Exp Exp Exp                  -- ^ @{ if e1 then e2 else e3 }@+  | MultiIfE [(Guard, Exp)]            -- ^ @{ if | g1 -> e1 | g2 -> e2 }@+  | LetE [Dec] Exp                     -- ^ @{ let { x=e1; y=e2 } in e3 }@+  | CaseE Exp [Match]                  -- ^ @{ case e of m1; m2 }@+  | DoE [Stmt]                         -- ^ @{ do { p <- e1; e2 }  }@+  | MDoE [Stmt]                        -- ^ @{ mdo { x <- e1 y; y <- e2 x; } }@+  | CompE [Stmt]                       -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@+      --+      -- The result expression of the comprehension is+      -- the /last/ of the @'Stmt'@s, and should be a 'NoBindS'.+      --+      -- E.g. translation:+      --+      -- > [ f x | x <- xs ]+      --+      -- > CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))]++  | ArithSeqE Range                    -- ^ @{ [ 1 ,2 .. 10 ] }@+  | ListE [ Exp ]                      -- ^ @{ [1,2,3] }@+  | SigE Exp Type                      -- ^ @{ e :: t }@+  | RecConE Name [FieldExp]            -- ^ @{ T { x = y, z = w } }@+  | RecUpdE Exp [FieldExp]             -- ^ @{ (f x) { z = w } }@+  | StaticE Exp                        -- ^ @{ static e }@+  | UnboundVarE Name                   -- ^ @{ _x }@+                                       --+                                       -- This is used for holes or unresolved+                                       -- identifiers in AST quotes. Note that+                                       -- it could either have a variable name+                                       -- or constructor name.+  | LabelE String                      -- ^ @{ #x }@ ( Overloaded label )+  | ImplicitParamVarE String           -- ^ @{ ?x }@ ( Implicit parameter )+  deriving( Show, Eq, Ord, Data, Generic )++type FieldExp = (Name,Exp)++-- Omitted: implicit parameters++data Body+  = GuardedB [(Guard,Exp)]   -- ^ @f p { | e1 = e2+                                 --      | e3 = e4 }+                                 -- where ds@+  | NormalB Exp              -- ^ @f p { = e } where ds@+  deriving( Show, Eq, Ord, Data, Generic )++data Guard+  = NormalG Exp -- ^ @f x { | odd x } = x@+  | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@+  deriving( Show, Eq, Ord, Data, Generic )++data Stmt+  = BindS Pat Exp -- ^ @p <- e@+  | LetS [ Dec ]  -- ^ @{ let { x=e1; y=e2 } }@+  | NoBindS Exp   -- ^ @e@+  | ParS [[Stmt]] -- ^ @x <- e1 | s2, s3 | s4@ (in 'CompE')+  | RecS [Stmt]   -- ^ @rec { s1; s2 }@+  deriving( Show, Eq, Ord, Data, Generic )++data Range = FromR Exp | FromThenR Exp Exp+           | FromToR Exp Exp | FromThenToR Exp Exp Exp+          deriving( Show, Eq, Ord, Data, Generic )++data Dec+  = FunD Name [Clause]            -- ^ @{ f p1 p2 = b where decs }@+  | ValD Pat Body [Dec]           -- ^ @{ p = b where decs }@+  | DataD Cxt Name [TyVarBndr]+          (Maybe Kind)            -- Kind signature (allowed only for GADTs)+          [Con] [DerivClause]+                                  -- ^ @{ data Cxt x => T x = A x | B (T x)+                                  --       deriving (Z,W)+                                  --       deriving stock Eq }@+  | NewtypeD Cxt Name [TyVarBndr]+             (Maybe Kind)         -- Kind signature+             Con [DerivClause]    -- ^ @{ newtype Cxt x => T x = A (B x)+                                  --       deriving (Z,W Q)+                                  --       deriving stock Eq }@+  | TySynD Name [TyVarBndr] Type  -- ^ @{ type T x = (x,x) }@+  | ClassD Cxt Name [TyVarBndr]+         [FunDep] [Dec]           -- ^ @{ class Eq a => Ord a where ds }@+  | InstanceD (Maybe Overlap) Cxt Type [Dec]+                                  -- ^ @{ instance {\-\# OVERLAPS \#-\}+                                  --        Show w => Show [w] where ds }@+  | SigD Name Type                -- ^ @{ length :: [a] -> Int }@+  | ForeignD Foreign              -- ^ @{ foreign import ... }+                                  --{ foreign export ... }@++  | InfixD Fixity Name            -- ^ @{ infix 3 foo }@++  -- | pragmas+  | PragmaD Pragma                -- ^ @{ {\-\# INLINE [1] foo \#-\} }@++  -- | data families (may also appear in [Dec] of 'ClassD' and 'InstanceD')+  | DataFamilyD Name [TyVarBndr]+               (Maybe Kind)+         -- ^ @{ data family T a b c :: * }@++  | DataInstD Cxt (Maybe [TyVarBndr]) Type+             (Maybe Kind)         -- Kind signature+             [Con] [DerivClause]  -- ^ @{ data instance Cxt x => T [x]+                                  --       = A x | B (T x)+                                  --       deriving (Z,W)+                                  --       deriving stock Eq }@++  | NewtypeInstD Cxt (Maybe [TyVarBndr]) Type -- Quantified type vars+                 (Maybe Kind)      -- Kind signature+                 Con [DerivClause] -- ^ @{ newtype instance Cxt x => T [x]+                                   --        = A (B x)+                                   --        deriving (Z,W)+                                   --        deriving stock Eq }@+  | TySynInstD TySynEqn            -- ^ @{ type instance ... }@++  -- | open type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')+  | OpenTypeFamilyD TypeFamilyHead+         -- ^ @{ type family T a b c = (r :: *) | r -> a b }@++  | ClosedTypeFamilyD TypeFamilyHead [TySynEqn]+       -- ^ @{ type family F a b = (r :: *) | r -> a where ... }@++  | RoleAnnotD Name [Role]     -- ^ @{ type role T nominal representational }@+  | StandaloneDerivD (Maybe DerivStrategy) Cxt Type+       -- ^ @{ deriving stock instance Ord a => Ord (Foo a) }@+  | DefaultSigD Name Type      -- ^ @{ default size :: Data a => a -> Int }@++  -- | Pattern Synonyms+  | PatSynD Name PatSynArgs PatSynDir Pat+      -- ^ @{ pattern P v1 v2 .. vn <- p }@  unidirectional           or+      --   @{ pattern P v1 v2 .. vn = p  }@  implicit bidirectional   or+      --   @{ pattern P v1 v2 .. vn <- p+      --        where P v1 v2 .. vn = e  }@  explicit bidirectional+      --+      -- also, besides prefix pattern synonyms, both infix and record+      -- pattern synonyms are supported. See 'PatSynArgs' for details++  | PatSynSigD Name PatSynType  -- ^ A pattern synonym's type signature.++  | ImplicitParamBindD String Exp+      -- ^ @{ ?x = expr }@+      --+      -- Implicit parameter binding declaration. Can only be used in let+      -- and where clauses which consist entirely of implicit bindings.+  deriving( Show, Eq, Ord, Data, Generic )++-- | Varieties of allowed instance overlap.+data Overlap = Overlappable   -- ^ May be overlapped by more specific instances+             | Overlapping    -- ^ May overlap a more general instance+             | Overlaps       -- ^ Both 'Overlapping' and 'Overlappable'+             | Incoherent     -- ^ Both 'Overlappable' and 'Overlappable', and+                              -- pick an arbitrary one if multiple choices are+                              -- available.+  deriving( Show, Eq, Ord, Data, Generic )++-- | A single @deriving@ clause at the end of a datatype.+data DerivClause = DerivClause (Maybe DerivStrategy) Cxt+    -- ^ @{ deriving stock (Eq, Ord) }@+  deriving( Show, Eq, Ord, Data, Generic )++-- | What the user explicitly requests when deriving an instance.+data DerivStrategy = StockStrategy    -- ^ A \"standard\" derived instance+                   | AnyclassStrategy -- ^ @-XDeriveAnyClass@+                   | NewtypeStrategy  -- ^ @-XGeneralizedNewtypeDeriving@+                   | ViaStrategy Type -- ^ @-XDerivingVia@+  deriving( Show, Eq, Ord, Data, Generic )++-- | A pattern synonym's type. Note that a pattern synonym's /fully/+-- specified type has a peculiar shape coming with two forall+-- quantifiers and two constraint contexts. For example, consider the+-- pattern synonym+--+-- > pattern P x1 x2 ... xn = <some-pattern>+--+-- P's complete type is of the following form+--+-- > pattern P :: forall universals.   required constraints+-- >           => forall existentials. provided constraints+-- >           => t1 -> t2 -> ... -> tn -> t+--+-- consisting of four parts:+--+--   1. the (possibly empty lists of) universally quantified type+--      variables and required constraints on them.+--   2. the (possibly empty lists of) existentially quantified+--      type variables and the provided constraints on them.+--   3. the types @t1@, @t2@, .., @tn@ of @x1@, @x2@, .., @xn@, respectively+--   4. the type @t@ of @\<some-pattern\>@, mentioning only universals.+--+-- Pattern synonym types interact with TH when (a) reifying a pattern+-- synonym, (b) pretty printing, or (c) specifying a pattern synonym's+-- type signature explicitly:+--+--   * Reification always returns a pattern synonym's /fully/ specified+--     type in abstract syntax.+--+--   * Pretty printing via 'Language.Haskell.TH.Ppr.pprPatSynType' abbreviates+--     a pattern synonym's type unambiguously in concrete syntax: The rule of+--     thumb is to print initial empty universals and the required+--     context as @() =>@, if existentials and a provided context+--     follow. If only universals and their required context, but no+--     existentials are specified, only the universals and their+--     required context are printed. If both or none are specified, so+--     both (or none) are printed.+--+--   * When specifying a pattern synonym's type explicitly with+--     'PatSynSigD' either one of the universals, the existentials, or+--     their contexts may be left empty.+--+-- See the GHC user's guide for more information on pattern synonyms+-- and their types:+-- <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#pattern-synonyms>.+type PatSynType = Type++-- | Common elements of 'OpenTypeFamilyD' and 'ClosedTypeFamilyD'. By+-- analogy with "head" for type classes and type class instances as+-- defined in /Type classes: an exploration of the design space/, the+-- @TypeFamilyHead@ is defined to be the elements of the declaration+-- between @type family@ and @where@.+data TypeFamilyHead =+  TypeFamilyHead Name [TyVarBndr] FamilyResultSig (Maybe InjectivityAnn)+  deriving( Show, Eq, Ord, Data, Generic )++-- | One equation of a type family instance or closed type family. The+-- arguments are the left-hand-side type and the right-hand-side result.+--+-- For instance, if you had the following type family:+--+-- @+-- type family Foo (a :: k) :: k where+--   forall k (a :: k). Foo \@k a = a+-- @+--+-- The @Foo \@k a = a@ equation would be represented as follows:+--+-- @+-- 'TySynEqn' ('Just' ['PlainTV' k, 'KindedTV' a ('VarT' k)])+--            ('AppT' ('AppKindT' ('ConT' ''Foo) ('VarT' k)) ('VarT' a))+--            ('VarT' a)+-- @+data TySynEqn = TySynEqn (Maybe [TyVarBndr]) Type Type+  deriving( Show, Eq, Ord, Data, Generic )++data FunDep = FunDep [Name] [Name]+  deriving( Show, Eq, Ord, Data, Generic )++data Foreign = ImportF Callconv Safety String Name Type+             | ExportF Callconv        String Name Type+         deriving( Show, Eq, Ord, Data, Generic )++-- keep Callconv in sync with module ForeignCall in ghc/compiler/prelude/ForeignCall.hs+data Callconv = CCall | StdCall | CApi | Prim | JavaScript+          deriving( Show, Eq, Ord, Data, Generic )++data Safety = Unsafe | Safe | Interruptible+        deriving( Show, Eq, Ord, Data, Generic )++data Pragma = InlineP         Name Inline RuleMatch Phases+            | SpecialiseP     Name Type (Maybe Inline) Phases+            | SpecialiseInstP Type+            | RuleP           String (Maybe [TyVarBndr]) [RuleBndr] Exp Exp Phases+            | AnnP            AnnTarget Exp+            | LineP           Int String+            | CompleteP       [Name] (Maybe Name)+                -- ^ @{ {\-\# COMPLETE C_1, ..., C_i [ :: T ] \#-} }@+        deriving( Show, Eq, Ord, Data, Generic )++data Inline = NoInline+            | Inline+            | Inlinable+            deriving (Show, Eq, Ord, Data, Generic)++data RuleMatch = ConLike+               | FunLike+               deriving (Show, Eq, Ord, Data, Generic)++data Phases = AllPhases+            | FromPhase Int+            | BeforePhase Int+            deriving (Show, Eq, Ord, Data, Generic)++data RuleBndr = RuleVar Name+              | TypedRuleVar Name Type+              deriving (Show, Eq, Ord, Data, Generic)++data AnnTarget = ModuleAnnotation+               | TypeAnnotation Name+               | ValueAnnotation Name+              deriving (Show, Eq, Ord, Data, Generic)++type Cxt = [Pred]                 -- ^ @(Eq a, Ord b)@++-- | Since the advent of @ConstraintKinds@, constraints are really just types.+-- Equality constraints use the 'EqualityT' constructor. Constraints may also+-- be tuples of other constraints.+type Pred = Type++data SourceUnpackedness+  = NoSourceUnpackedness -- ^ @C a@+  | SourceNoUnpack       -- ^ @C { {\-\# NOUNPACK \#-\} } a@+  | SourceUnpack         -- ^ @C { {\-\# UNPACK \#-\} } a@+        deriving (Show, Eq, Ord, Data, Generic)++data SourceStrictness = NoSourceStrictness    -- ^ @C a@+                      | SourceLazy            -- ^ @C {~}a@+                      | SourceStrict          -- ^ @C {!}a@+        deriving (Show, Eq, Ord, Data, Generic)++-- | Unlike 'SourceStrictness' and 'SourceUnpackedness', 'DecidedStrictness'+-- refers to the strictness that the compiler chooses for a data constructor+-- field, which may be different from what is written in source code. See+-- 'reifyConStrictness' for more information.+data DecidedStrictness = DecidedLazy+                       | DecidedStrict+                       | DecidedUnpack+        deriving (Show, Eq, Ord, Data, Generic)++-- | A single data constructor.+--+-- The constructors for 'Con' can roughly be divided up into two categories:+-- those for constructors with \"vanilla\" syntax ('NormalC', 'RecC', and+-- 'InfixC'), and those for constructors with GADT syntax ('GadtC' and+-- 'RecGadtC'). The 'ForallC' constructor, which quantifies additional type+-- variables and class contexts, can surround either variety of constructor.+-- However, the type variables that it quantifies are different depending+-- on what constructor syntax is used:+--+-- * If a 'ForallC' surrounds a constructor with vanilla syntax, then the+--   'ForallC' will only quantify /existential/ type variables. For example:+--+--   @+--   data Foo a = forall b. MkFoo a b+--   @+--+--   In @MkFoo@, 'ForallC' will quantify @b@, but not @a@.+--+-- * If a 'ForallC' surrounds a constructor with GADT syntax, then the+--   'ForallC' will quantify /all/ type variables used in the constructor.+--   For example:+--+--   @+--   data Bar a b where+--     MkBar :: (a ~ b) => c -> MkBar a b+--   @+--+--   In @MkBar@, 'ForallC' will quantify @a@, @b@, and @c@.+data Con = NormalC Name [BangType]       -- ^ @C Int a@+         | RecC Name [VarBangType]       -- ^ @C { v :: Int, w :: a }@+         | InfixC BangType Name BangType -- ^ @Int :+ a@+         | ForallC [TyVarBndr] Cxt Con   -- ^ @forall a. Eq a => C [a]@+         | GadtC [Name] [BangType]+                 Type                    -- See Note [GADT return type]+                                         -- ^ @C :: a -> b -> T b Int@+         | RecGadtC [Name] [VarBangType]+                    Type                 -- See Note [GADT return type]+                                         -- ^ @C :: { v :: Int } -> T b Int@+        deriving (Show, Eq, Ord, Data, Generic)++-- Note [GADT return type]+-- ~~~~~~~~~~~~~~~~~~~~~~~+--+-- The return type of a GADT constructor does not necessarily match the name of+-- the data type:+--+-- type S = T+--+-- data T a where+--     MkT :: S Int+--+--+-- type S a = T+--+-- data T a where+--     MkT :: S Char Int+--+--+-- type Id a = a+-- type S a = T+--+-- data T a where+--     MkT :: Id (S Char Int)+--+--+-- That is why we allow the return type stored by a constructor to be an+-- arbitrary type. See also #11341++data Bang = Bang SourceUnpackedness SourceStrictness+         -- ^ @C { {\-\# UNPACK \#-\} !}a@+        deriving (Show, Eq, Ord, Data, Generic)++type BangType    = (Bang, Type)+type VarBangType = (Name, Bang, Type)++-- | As of @template-haskell-2.11.0.0@, 'Strict' has been replaced by 'Bang'.+type Strict      = Bang++-- | As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by+-- 'BangType'.+type StrictType    = BangType++-- | As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by+-- 'VarBangType'.+type VarStrictType = VarBangType++-- | A pattern synonym's directionality.+data PatSynDir+  = Unidir             -- ^ @pattern P x {<-} p@+  | ImplBidir          -- ^ @pattern P x {=} p@+  | ExplBidir [Clause] -- ^ @pattern P x {<-} p where P x = e@+  deriving( Show, Eq, Ord, Data, Generic )++-- | A pattern synonym's argument type.+data PatSynArgs+  = PrefixPatSyn [Name]        -- ^ @pattern P {x y z} = p@+  | InfixPatSyn Name Name      -- ^ @pattern {x P y} = p@+  | RecordPatSyn [Name]        -- ^ @pattern P { {x,y,z} } = p@+  deriving( Show, Eq, Ord, Data, Generic )++data Type = ForallT [TyVarBndr] Cxt Type  -- ^ @forall \<vars\>. \<ctxt\> => \<type\>@+          | ForallVisT [TyVarBndr] Type   -- ^ @forall \<vars\> -> \<type\>@+          | AppT Type Type                -- ^ @T a b@+          | AppKindT Type Kind            -- ^ @T \@k t@+          | SigT Type Kind                -- ^ @t :: k@+          | VarT Name                     -- ^ @a@+          | ConT Name                     -- ^ @T@+          | PromotedT Name                -- ^ @'T@+          | InfixT Type Name Type         -- ^ @T + T@+          | UInfixT Type Name Type        -- ^ @T + T@+                                          --+                                          -- See "Language.Haskell.TH.Syntax#infix"+          | ParensT Type                  -- ^ @(T)@++          -- See Note [Representing concrete syntax in types]+          | TupleT Int                    -- ^ @(,), (,,), etc.@+          | UnboxedTupleT Int             -- ^ @(\#,\#), (\#,,\#), etc.@+          | UnboxedSumT SumArity          -- ^ @(\#|\#), (\#||\#), etc.@+          | ArrowT                        -- ^ @->@+          | EqualityT                     -- ^ @~@+          | ListT                         -- ^ @[]@+          | PromotedTupleT Int            -- ^ @'(), '(,), '(,,), etc.@+          | PromotedNilT                  -- ^ @'[]@+          | PromotedConsT                 -- ^ @(':)@+          | StarT                         -- ^ @*@+          | ConstraintT                   -- ^ @Constraint@+          | LitT TyLit                    -- ^ @0,1,2, etc.@+          | WildCardT                     -- ^ @_@+          | ImplicitParamT String Type    -- ^ @?x :: t@+      deriving( Show, Eq, Ord, Data, Generic )++data TyVarBndr = PlainTV  Name            -- ^ @a@+               | KindedTV Name Kind       -- ^ @(a :: k)@+      deriving( Show, Eq, Ord, Data, Generic )++-- | Type family result signature+data FamilyResultSig = NoSig              -- ^ no signature+                     | KindSig  Kind      -- ^ @k@+                     | TyVarSig TyVarBndr -- ^ @= r, = (r :: k)@+      deriving( Show, Eq, Ord, Data, Generic )++-- | Injectivity annotation+data InjectivityAnn = InjectivityAnn Name [Name]+  deriving ( Show, Eq, Ord, Data, Generic )++data TyLit = NumTyLit Integer             -- ^ @2@+           | StrTyLit String              -- ^ @\"Hello\"@+  deriving ( Show, Eq, Ord, Data, Generic )++-- | Role annotations+data Role = NominalR            -- ^ @nominal@+          | RepresentationalR   -- ^ @representational@+          | PhantomR            -- ^ @phantom@+          | InferR              -- ^ @_@+  deriving( Show, Eq, Ord, Data, Generic )++-- | Annotation target for reifyAnnotations+data AnnLookup = AnnLookupModule Module+               | AnnLookupName Name+               deriving( Show, Eq, Ord, Data, Generic )++-- | To avoid duplication between kinds and types, they+-- are defined to be the same. Naturally, you would never+-- have a type be 'StarT' and you would never have a kind+-- be 'SigT', but many of the other constructors are shared.+-- Note that the kind @Bool@ is denoted with 'ConT', not+-- 'PromotedT'. Similarly, tuple kinds are made with 'TupleT',+-- not 'PromotedTupleT'.++type Kind = Type++{- Note [Representing concrete syntax in types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Haskell has a rich concrete syntax for types, including+  t1 -> t2, (t1,t2), [t], and so on+In TH we represent all of this using AppT, with a distinguished+type constructor at the head.  So,+  Type              TH representation+  -----------------------------------------------+  t1 -> t2          ArrowT `AppT` t2 `AppT` t2+  [t]               ListT `AppT` t+  (t1,t2)           TupleT 2 `AppT` t1 `AppT` t2+  '(t1,t2)          PromotedTupleT 2 `AppT` t1 `AppT` t2++But if the original HsSyn used prefix application, we won't use+these special TH constructors.  For example+  [] t              ConT "[]" `AppT` t+  (->) t            ConT "->" `AppT` t+In this way we can faithfully represent in TH whether the original+HsType used concrete syntax or not.++The one case that doesn't fit this pattern is that of promoted lists+  '[ Maybe, IO ]    PromotedListT 2 `AppT` t1 `AppT` t2+but it's very smelly because there really is no type constructor+corresponding to PromotedListT. So we encode HsExplicitListTy with+PromotedConsT and PromotedNilT (which *do* have underlying type+constructors):+  '[ Maybe, IO ]    PromotedConsT `AppT` Maybe `AppT`+                    (PromotedConsT  `AppT` IO `AppT` PromotedNilT)+-}++-----------------------------------------------------+--              Internal helper functions+-----------------------------------------------------++cmpEq :: Ordering -> Bool+cmpEq EQ = True+cmpEq _  = False++thenCmp :: Ordering -> Ordering -> Ordering+thenCmp EQ o2 = o2+thenCmp o1 _  = o1